]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/radtest/gTree2.ml
Debugging stuff removed.
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / applications / radtest / gTree2.ml
1 (* $Id$ *)
2
3 open Gaux
4 open Gtk
5 open GtkBase
6 open GtkTree2
7 open GObj
8 open GContainer
9
10 class tree_item_signals obj = object
11   inherit item_signals obj
12   method expand = GtkSignal.connect obj ~sgn:TreeItem.Signals.expand ~after
13   method collapse = GtkSignal.connect obj ~sgn:TreeItem.Signals.collapse ~after
14 end
15
16 class tree_item obj = object
17   inherit container obj
18   method event = new GObj.event_ops obj
19   method as_item : Gtk.tree_item obj = obj
20   method connect = new tree_item_signals obj
21   method set_subtree (w : tree) = TreeItem.set_subtree obj w#as_tree
22   method remove_subtree () = TreeItem.remove_subtree obj
23   method expand () = TreeItem.expand obj
24   method collapse () = TreeItem.collapse obj
25   method subtree =
26     try Some(new tree (TreeItem.subtree obj)) with Gpointer.Null -> None
27 end
28
29 and tree_signals obj = object
30   inherit container_signals obj
31   method selection_changed =
32     GtkSignal.connect obj ~sgn:Tree.Signals.selection_changed ~after
33   method select_child ~callback =
34     GtkSignal.connect obj ~sgn:Tree.Signals.select_child ~after
35       ~callback:(fun w -> callback (new tree_item (TreeItem.cast w))) 
36   method unselect_child ~callback =
37     GtkSignal.connect obj ~sgn:Tree.Signals.unselect_child ~after
38       ~callback:(fun w -> callback (new tree_item (TreeItem.cast w))) 
39 end
40
41 and tree obj = object (self)
42   inherit [tree_item] item_container obj
43   method event = new GObj.event_ops obj
44   method as_tree = Tree.coerce obj
45   method insert w ~pos = Tree.insert obj w#as_item ~pos
46   method connect = new tree_signals obj
47   method clear_items = Tree.clear_items obj
48   method select_item = Tree.select_item obj
49   method unselect_item = Tree.unselect_item obj
50   method child_position (w : tree_item) = Tree.child_position obj w#as_item
51   method remove_items items =
52     Tree.remove_items obj
53       (List.map ~f:(fun (t : tree_item) -> t#as_item) items)
54 (*  method set_selection_mode = Tree.set_selection_mode obj
55   method set_view_mode = Tree.set_view_mode obj *)
56   method set_view_lines = Tree.set_view_lines obj
57   method selection =
58     List.map ~f:(fun w -> self#wrap (Widget.coerce w)) (Tree.selection obj)
59   method item_up ~pos =
60     Tree.item_up obj pos
61   method private wrap w =
62     new tree_item (TreeItem.cast w)
63 end
64
65 let tree_item ?label ?border_width ?width ?height ?packing ?show () =
66   let w = TreeItem.create ?label () in
67   Container.set w ?border_width ?width ?height;
68   let self = new tree_item w in
69   may packing ~f:(fun f -> (f self : unit));
70   if show <> Some false then self#misc#show ();
71   self
72
73 let tree ?selection_mode ?view_mode ?view_lines
74     ?border_width ?width ?height ?packing ?show () =
75   let w = Tree.create () in
76   Tree.set w ?selection_mode ?view_mode ?view_lines;
77   Container.set w ?border_width ?width ?height;
78   pack_return (new tree w) ~packing ~show