package frama-c

  1. Overview
  2. Docs
package frama-c
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file book_manager.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
(**************************************************************************)
(*                                                                        *)
(*  This file is part of Frama-C.                                         *)
(*                                                                        *)
(*  Copyright (C) 2007-2024                                               *)
(*    CEA (Commissariat à l'énergie atomique et aux énergies              *)
(*         alternatives)                                                  *)
(*                                                                        *)
(*  you can redistribute it and/or modify it under the terms of the GNU   *)
(*  Lesser General Public License as published by the Free Software       *)
(*  Foundation, version 2.1.                                              *)
(*                                                                        *)
(*  It is distributed in the hope that it will be useful,                 *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU Lesser General Public License for more details.                   *)
(*                                                                        *)
(*  See the GNU Lesser General Public License version 2.1                 *)
(*  for more details (enclosed in the file licenses/LGPLv2.1).            *)
(*                                                                        *)
(**************************************************************************)

let dkey = Gui_parameters.register_category "book_manager"

module Q = Qstack.Make
    (struct
      type t = GSourceView.source_view
      let equal x y = x == y
    end)

type t = {
  notebook : GPack.notebook ;
  views : Q.t ;
}

let make ?tab_pos ?packing () =
  let notebook = GPack.notebook
      ~scrollable:true ~show_tabs:true ?tab_pos ?packing ()
  in
  notebook#set_enable_popup true ;
  {
    notebook = notebook ;
    views = Q.create ();
  }

let get_notebook t = t.notebook


let set_current_view t n =
  if (n>=0) && (n < (Q.length t.views)) then t.notebook#goto_page n

let prepend_source_tab w titre =
  Gui_parameters.debug ~dkey "prepend_source_tab";
  (* insert one extra tab in the source window w, with label *)
  let label = GMisc.label ~text:titre () in
  let sw = GBin.scrolled_window
      ~vpolicy:`AUTOMATIC
      ~hpolicy:`AUTOMATIC
      ~packing:(fun arg ->
          ignore
            (w.notebook#prepend_page ~tab_label:label#coerce arg))
      ()
  in
  let window = (Source_viewer.make ~packing:sw#add ()) in
  (* Remove default pango menu for textviews *)
  ignore (window#event#connect#button_press ~callback:
            (fun ev -> GdkEvent.Button.button ev = 3));
  Q.add window w.views;
  w.notebook#goto_page 0;
  window

let get_nth_page (t:t) n =
  let nb =  t.notebook in
  nb#get_nth_page n (* Deprecated *)

let current_page (t:t) =
  let nb =  t.notebook in
  nb#current_page

let last_page t = Q.length t.views - 1

(* ABP and methods to manage this memory *)
let get_current_view (t:t) =
  let nb =  t.notebook in
  let cp = nb#current_page in
  Gui_parameters.debug ~dkey "get_current_view: %d" cp;
  Q.nth cp t.views

let get_current_index (t:t) =
  let cp = t.notebook#current_page in
  Gui_parameters.debug ~dkey "get_current_index: %d" cp;
  cp

let delete_view (t:t) cp =
  let nb =  t.notebook in
  Gui_parameters.debug ~dkey "delete_current_view - cur is page %d" cp;
  Q.remove (Q.nth cp t.views) t.views;
  nb#remove_page cp;
  let last = pred (Q.length t.views) in
  Gui_parameters.debug ~dkey "Going to page (delete_current_view) %d" last;
  nb#goto_page last

(* delete within w the tab that contains window win *)
let delete_view_and_loc w win () =
  Gui_parameters.debug ~dkey "delete_view_and_loc ";
  let idx = Q.idx win w.views in
  delete_view w idx

let delete_current_view t =  delete_view t t.notebook#current_page

let delete_all_views (t:t) =
  Q.iter (fun _ -> t.notebook#remove_page 0) t.views;
  Q.clear t.views

let append_view (t:t) (v:GSourceView.source_view) =
  let nb =  t.notebook in
  let next =  Q.length t.views in
  let text = Printf.sprintf "Page %d" next in
  let label = GMisc.label ~text:text () in
  let sw = GBin.scrolled_window
      ~vpolicy:`AUTOMATIC
      ~hpolicy:`AUTOMATIC
      ~packing:(fun arg ->
          ignore
            (nb#append_page ~tab_label:label#coerce arg)) () in
  sw#add (v:>GObj.widget);
  nb#goto_page next;
  Gui_parameters.debug ~dkey "Going to page (append_view) %d" next;
  Q.add_at_end v t.views;
  Gui_parameters.debug ~dkey "append_view - nb pages is %d" (Q.length t.views);
  Gui_parameters.debug ~dkey
    "append_view - current nb page is %d" nb#current_page

let get_nth_view t (n:int) = Q.nth n t.views

let enable_popup (t:t) (b:bool) =
  let nb =  t.notebook in
  nb#set_enable_popup b

let set_scrollable (t:t) (b:bool) =
  let nb =  t.notebook in
  nb#set_scrollable b

(* get length of the current source_views list *)
let length t = Q.length t.views


let append_source_tab w titre =
  Gui_parameters.debug ~dkey "append_source_tab";
  (* insert one extra tab in the source window w, with some title *)
  let composed_label = GPack.hbox  () in

  let _ = GMisc.label ~text:(titre) ~packing:composed_label#add () in

  let cbutton = GButton.button  ~packing:composed_label#add () in

  cbutton#set_use_stock false ;
  cbutton#set_label "X";
  cbutton#misc#set_size_request ~width:20 ~height:20 ();

  let sw = GBin.scrolled_window
      ~vpolicy:`AUTOMATIC
      ~hpolicy:`AUTOMATIC
      ~packing:(fun arg ->
          ignore
            (w.notebook#append_page ~tab_label:composed_label#coerce arg))
    (*
    ~packing:(fun arg ->
                ignore
                  (w.notebook#append_page ~tab_label:label#coerce arg)) *)
      ()
  in
  let window = (Source_viewer.make ~packing:sw#add ()) in
  ignore
    (cbutton#connect#clicked
       ~callback:(fun () -> delete_view_and_loc w window ()));
  (* Remove default pango menu for textviews *)
  ignore (window#event#connect#button_press ~callback:
            (fun ev -> GdkEvent.Button.button ev = 3));
  Q.add_at_end window w.views;
  let last = pred (Q.length w.views) in
  (* THIS CALLS THE SWITCH_PAGE CALLBACK IMMEDIATELY! *)
  w.notebook#goto_page last;
  window

(*
Local Variables:
compile-command: "make -C ../../.."
End:
*)
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct