diff options
author | Stephane Glondu <steph@glondu.net> | 2010-07-21 09:46:51 +0200 |
---|---|---|
committer | Stephane Glondu <steph@glondu.net> | 2010-07-21 09:46:51 +0200 |
commit | 5b7eafd0f00a16d78f99a27f5c7d5a0de77dc7e6 (patch) | |
tree | 631ad791a7685edafeb1fb2e8faeedc8379318ae /ide/typed_notebook.ml | |
parent | da178a880e3ace820b41d38b191d3785b82991f5 (diff) |
Imported Upstream snapshot 8.3~beta0+13298
Diffstat (limited to 'ide/typed_notebook.ml')
-rw-r--r-- | ide/typed_notebook.ml | 68 |
1 files changed, 68 insertions, 0 deletions
diff --git a/ide/typed_notebook.ml b/ide/typed_notebook.ml new file mode 100644 index 00000000..39e8155d --- /dev/null +++ b/ide/typed_notebook.ml @@ -0,0 +1,68 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(* $Id: coqide.ml 11952 2009-03-02 15:29:08Z vgross $ *) + +class ['a] typed_notebook default_build nb = +object(self) + inherit GPack.notebook nb as super + val mutable term_list = [] + + method append_term ?(build=default_build) (term:'a) = + let tab_label,menu_label,page = build 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_split_at 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_split_at real_pos term_list in + term_list <- lower@[term]@higher; + real_pos + *) + method prepend_term ?(build=default_build) (term:'a) = + let tab_label,menu_label,page = build 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_split_at real_pos term_list in + term_list <- lower@[term]@higher; + real_pos + + method set_term ?(build=default_build) (term:'a) = + let tab_label,menu_label,page = build 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 remove_page index = + term_list <- Util.list_filter_i (fun i x -> i <> index) term_list; + super#remove_page index + + method get_nth_term i = + List.nth term_list i + + method term_num p = + Util.list_index0 p term_list + + method pages = term_list + + method current_term = List.nth term_list super#current_page +end + +let create build = + GtkPack.Notebook.make_params [] + ~cont:(GContainer.pack_container + ~create:(fun pl -> + let nb = GtkPack.Notebook.create pl in + (new typed_notebook build nb))) + |