diff options
author | Enrico Tassi <gareuselesinge@debian.org> | 2015-01-25 14:42:51 +0100 |
---|---|---|
committer | Enrico Tassi <gareuselesinge@debian.org> | 2015-01-25 14:42:51 +0100 |
commit | 7cfc4e5146be5666419451bdd516f1f3f264d24a (patch) | |
tree | e4197645da03dc3c7cc84e434cc31d0a0cca7056 /ide/wg_Notebook.ml | |
parent | 420f78b2caeaaddc6fe484565b2d0e49c66888e5 (diff) |
Imported Upstream version 8.5~beta1+dfsg
Diffstat (limited to 'ide/wg_Notebook.ml')
-rw-r--r-- | ide/wg_Notebook.ml | 67 |
1 files changed, 67 insertions, 0 deletions
diff --git a/ide/wg_Notebook.ml b/ide/wg_Notebook.ml new file mode 100644 index 00000000..0611c3f3 --- /dev/null +++ b/ide/wg_Notebook.ml @@ -0,0 +1,67 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *) +(* \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))) + |