]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkTree.ml
- DoubleTypeInference.does_not_occur exposed
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / gtkTree.ml
1 (* $Id$ *)
2
3 open Gaux
4 open Gtk
5 open Tags
6 open GtkBase
7
8 module TreeItem = struct
9   let cast w : tree_item obj = Object.try_cast w "GtkTreeItem"
10   external create : unit -> tree_item obj = "ml_gtk_tree_item_new"
11   external create_with_label : string -> tree_item obj
12       = "ml_gtk_tree_item_new_with_label"
13   let create ?label () =
14     match label with None -> create ()
15     | Some label -> create_with_label label
16   external set_subtree : [>`treeitem] obj -> [>`widget] obj -> unit
17       = "ml_gtk_tree_item_set_subtree"
18   external remove_subtree : [>`treeitem] obj -> unit
19       = "ml_gtk_tree_item_remove_subtree"
20   external expand : [>`treeitem] obj -> unit
21       = "ml_gtk_tree_item_expand"
22   external collapse : [>`treeitem] obj -> unit
23       = "ml_gtk_tree_item_collapse"
24   external subtree : [>`treeitem] obj -> tree obj
25       = "ml_GTK_TREE_ITEM_SUBTREE"
26   module Signals = struct
27     open GtkSignal
28     let expand : ([>`treeitem],_) t =
29       { name = "expand"; marshaller = marshal_unit }
30     let collapse : ([>`treeitem],_) t =
31       { name = "collapse"; marshaller = marshal_unit }
32   end
33 end
34
35 module Tree = struct
36   let cast w : tree obj = Object.try_cast w "GtkTree"
37   external coerce : [>`tree] obj -> tree obj = "%identity"
38   external create : unit -> tree obj = "ml_gtk_tree_new"
39   external insert : [>`tree] obj -> [>`treeitem] obj -> pos:int -> unit
40       = "ml_gtk_tree_insert"
41   external remove_items : [>`tree] obj -> [>`treeitem] obj list -> unit
42       = "ml_gtk_tree_remove_items"
43   external clear_items : [>`tree] obj -> start:int -> stop:int -> unit
44       = "ml_gtk_tree_clear_items"
45   external select_item : [>`tree] obj -> pos:int -> unit
46       = "ml_gtk_tree_select_item"
47   external unselect_item : [>`tree] obj -> pos:int -> unit
48       = "ml_gtk_tree_unselect_item"
49   external child_position : [>`tree] obj -> [>`treeitem] obj -> int
50       = "ml_gtk_tree_child_position"
51   external set_selection_mode : [>`tree] obj -> selection_mode -> unit
52       = "ml_gtk_tree_set_selection_mode"
53   external set_view_mode : [>`tree] obj -> [`LINE|`ITEM] -> unit
54       = "ml_gtk_tree_set_view_mode"
55   external set_view_lines : [>`tree] obj -> bool -> unit
56       = "ml_gtk_tree_set_view_lines"
57   external selection : [>`tree] obj -> tree_item obj list =
58     "ml_gtk_tree_selection"
59   let set ?selection_mode ?view_mode ?view_lines w =
60     let may_set f = may ~f:(f w) in
61     may_set set_selection_mode selection_mode;
62     may_set set_view_mode view_mode;
63     may_set set_view_lines view_lines
64   module Signals = struct
65     open GtkSignal
66     let selection_changed : ([>`tree],_) t =
67       { name = "selection_changed"; marshaller = marshal_unit }
68     let select_child : ([>`tree],_) t =
69       { name = "select_child"; marshaller = Widget.Signals.marshal }
70     let unselect_child : ([>`tree],_) t =
71       { name = "unselect_child"; marshaller = Widget.Signals.marshal }
72   end
73 end
74 (*
75 module CTree = struct
76   type t
77   type node =  [`ctree] obj * t
78   let cast w : ctree obj = Object.try_cast w "GtkCTree"
79   external create : cols:int -> treecol:int -> ctree obj = "ml_gtk_ctree_new"
80   external insert_node :
81       [>`ctree] obj -> ?parent:node -> ?sibling:node ->
82       titles:optstring array ->
83       spacing:int -> ?pclosed:Gdk.pixmap -> ?mclosed:Gdk.bitmap obj ->
84       ?popened:Gdk.pixmap -> ?mopened:Gdk.bitmap obj ->
85       is_leaf:bool -> expanded:bool -> node
86       = "ml_gtk_ctree_insert_node_bc" "ml_gtk_ctree_insert_node"
87   let insert_node'
88       w ?parent ?sibling ?(spacing = 0) ?(is_leaf = true)
89       ?(expanded = false)
90       ?pclosed ?mclosed ?popened ?mopened titles =
91     let len = GtkList.CList.get_columns w in
92     if List.length titles > len then invalid_arg "CTree.insert_node";
93     let arr = Array.create ~len None in
94     List.fold_left titles ~acc:0
95       ~f:(fun ~acc text -> arr.(acc) <- Some text; acc+1);
96     insert_node w
97       ?parent ?sibling ~titles:(Array.map ~f:optstring arr)
98       ~spacing ~is_leaf ~expanded
99       ?pclosed ?mclosed ?popened ?mopened 
100   external node_set_row_data : [>`ctree] obj -> node:node -> Obj.t -> unit
101       = "ml_gtk_ctree_node_set_row_data"
102   external node_get_row_data : [>`ctree] obj -> node:node -> Obj.t
103       = "ml_gtk_ctree_node_get_row_data"
104   external set_indent : [>`ctree] obj -> int -> unit
105       = "ml_gtk_ctree_set_indent"
106   module Signals = struct
107     open GtkSignal
108     let marshal_select f argv =
109       let node : node =
110         match GtkArgv.get_pointer argv ~pos:0 with
111           Some p -> Obj.magic p
112         | None -> invalid_arg "GtkTree.CTree.Signals.marshal_select"
113       in
114       f ~node ~column:(GtkArgv.get_int argv ~pos:1)
115
116     let tree_select_row : ([>`ctree],_) t =
117       { name = "tree_select_row"; marshaller = marshal_select }
118     let tree_unselect_row : ([>`ctree],_) t =
119       { name = "tree_unselect_row"; marshaller = marshal_select }
120   end
121 end
122 *)