From 7cfc4e5146be5666419451bdd516f1f3f264d24a Mon Sep 17 00:00:00 2001
From: Enrico Tassi <gareuselesinge@debian.org>
Date: Sun, 25 Jan 2015 14:42:51 +0100
Subject: Imported Upstream version 8.5~beta1+dfsg

---
 ide/wg_Notebook.ml | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 67 insertions(+)
 create mode 100644 ide/wg_Notebook.ml

(limited to 'ide/wg_Notebook.ml')

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)))
+
-- 
cgit v1.2.3