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
|
(************************************************************************)
(* * The Coq Proof Assistant / The Coq Development Team *)
(* v * Copyright INRIA, CNRS and contributors *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
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
method goto_term term =
List.iteri (fun i sn -> if sn == term then self#goto_page i) term_list
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)))
|