lablgtk_20001129* created

[helm.git] / helm / DEVEL / lablgtk / lablgtk_20001129-0.1.0 / gTree.ml

diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gTree.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gTree.ml
new file mode 100644 (file)
index 0000000..80dab7b
--- /dev/null
+++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gTree.ml
@@ -0,0 +1,76 @@
+(* $Id$ *)
+
+open Gaux
+open Gtk
+open GtkBase
+open GtkTree
+open GObj
+open GContainer
+
+class tree_item_signals obj = object
+  inherit item_signals obj
+  method expand = GtkSignal.connect obj ~sgn:TreeItem.Signals.expand ~after
+  method collapse = GtkSignal.connect obj ~sgn:TreeItem.Signals.collapse ~after
+end
+
+class tree_item obj = object
+  inherit container obj
+  method event = new GObj.event_ops obj
+  method as_item : Gtk.tree_item obj = obj
+  method connect = new tree_item_signals obj
+  method set_subtree (w : tree) = TreeItem.set_subtree obj w#as_tree
+  method remove_subtree () = TreeItem.remove_subtree obj
+  method expand () = TreeItem.expand obj
+  method collapse () = TreeItem.collapse obj
+  method subtree =
+    try Some(new tree (TreeItem.subtree obj)) with Gpointer.Null -> None
+end
+
+and tree_signals obj = object
+  inherit container_signals obj
+  method selection_changed =
+    GtkSignal.connect obj ~sgn:Tree.Signals.selection_changed ~after
+  method select_child ~callback =
+    GtkSignal.connect obj ~sgn:Tree.Signals.select_child ~after
+      ~callback:(fun w -> callback (new tree_item (TreeItem.cast w))) 
+  method unselect_child ~callback =
+    GtkSignal.connect obj ~sgn:Tree.Signals.unselect_child ~after
+      ~callback:(fun w -> callback (new tree_item (TreeItem.cast w))) 
+end
+
+and tree obj = object (self)
+  inherit [tree_item] item_container obj
+  method event = new GObj.event_ops obj
+  method as_tree = Tree.coerce obj
+  method insert w ~pos = Tree.insert obj w#as_item ~pos
+  method connect = new tree_signals obj
+  method clear_items = Tree.clear_items obj
+  method select_item = Tree.select_item obj
+  method unselect_item = Tree.unselect_item obj
+  method child_position (w : tree_item) = Tree.child_position obj w#as_item
+  method remove_items items =
+    Tree.remove_items obj
+      (List.map ~f:(fun (t : tree_item) -> t#as_item) items)
+  method set_selection_mode = Tree.set_selection_mode obj
+  method set_view_mode = Tree.set_view_mode obj
+  method set_view_lines = Tree.set_view_lines obj
+  method selection =
+    List.map ~f:(fun w -> self#wrap (Widget.coerce w)) (Tree.selection obj)
+  method private wrap w =
+    new tree_item (TreeItem.cast w)
+end
+
+let tree_item ?label ?border_width ?width ?height ?packing ?show () =
+  let w = TreeItem.create ?label () in
+  Container.set w ?border_width ?width ?height;
+  let self = new tree_item w in
+  may packing ~f:(fun f -> (f self : unit));
+  if show <> Some false then self#misc#show ();
+  self
+
+let tree ?selection_mode ?view_mode ?view_lines
+    ?border_width ?width ?height ?packing ?show () =
+  let w = Tree.create () in
+  Tree.set w ?selection_mode ?view_mode ?view_lines;
+  Container.set w ?border_width ?width ?height;
+  pack_return (new tree w) ~packing ~show