aboutsummaryrefslogtreecommitdiffhomepage
path: root/ide/wg_Notebook.ml
blob: 0e5284c2f9bf41812772894df53ef0f7b0b40ac4 (plain)
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
(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

class ['a] typed_notebook make_page kill_page nb =
object(self)
  inherit GPack.notebook nb as super
  val mutable term_list = []

  method append_term (term:'a) =
    let tab_label,menu_label,page = make_page term in
      (* XXX - Temporary hack to compile with archaic lablgtk *)
    ignore (super#append_page ?tab_label ?menu_label page);
    let real_pos = super#page_num page in
    let lower,higher = Util.List.chop real_pos term_list in
      term_list <- lower@[term]@higher;
      real_pos
(* XXX - Temporary hack to compile with archaic lablgtk
  method insert_term ?(build=default_build) ?pos (term:'a) =
    let tab_label,menu_label,page = build term in
    let real_pos = super#insert_page ?tab_label ?menu_label ?pos page in
    let lower,higher = Util.List.chop real_pos term_list in
      term_list <- lower@[term]@higher;
      real_pos
 *)
  method prepend_term (term:'a) =
    let tab_label,menu_label,page = make_page term in
      (* XXX - Temporary hack to compile with archaic lablgtk *)
    ignore (super#prepend_page ?tab_label ?menu_label page);
    let real_pos = super#page_num page in
    let lower,higher = Util.List.chop real_pos term_list in
      term_list <- lower@[term]@higher;
      real_pos

  method set_term (term:'a) =
    let tab_label,menu_label,page = make_page term in
    let real_pos = super#current_page in
      term_list <- Util.List.map_i (fun i x -> if i = real_pos then term else x) 0 term_list;
      super#set_page ?tab_label ?menu_label page

  method get_nth_term i =
    List.nth term_list i

  method term_num f p =
    Util.List.index0 f p term_list

  method pages = term_list

  method! remove_page index =
    term_list <- Util.List.filteri (fun i x -> if i = index then kill_page x; i <> index) term_list;
    super#remove_page index

  method current_term =
    List.nth term_list super#current_page
end

let create make kill =
  GtkPack.Notebook.make_params []
    ~cont:(GContainer.pack_container
             ~create:(fun pl ->
                        let nb = GtkPack.Notebook.create pl in
                         (new typed_notebook make kill nb)))