X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20001129-0.1.0%2FgtkTree.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20001129-0.1.0%2FgtkTree.ml;h=926074167711a9bc4757ce7fe6e62312b2ed24d7;hb=993347ab3975ccc7c39dc0324255fab4a75bc0e2;hp=0000000000000000000000000000000000000000;hpb=1cd4dd7c3838fee49e5851c0ac7acf42f4fc3d67;p=helm.git diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkTree.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkTree.ml new file mode 100644 index 000000000..926074167 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkTree.ml @@ -0,0 +1,122 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags +open GtkBase + +module TreeItem = struct + let cast w : tree_item obj = Object.try_cast w "GtkTreeItem" + external create : unit -> tree_item obj = "ml_gtk_tree_item_new" + external create_with_label : string -> tree_item obj + = "ml_gtk_tree_item_new_with_label" + let create ?label () = + match label with None -> create () + | Some label -> create_with_label label + external set_subtree : [>`treeitem] obj -> [>`widget] obj -> unit + = "ml_gtk_tree_item_set_subtree" + external remove_subtree : [>`treeitem] obj -> unit + = "ml_gtk_tree_item_remove_subtree" + external expand : [>`treeitem] obj -> unit + = "ml_gtk_tree_item_expand" + external collapse : [>`treeitem] obj -> unit + = "ml_gtk_tree_item_collapse" + external subtree : [>`treeitem] obj -> tree obj + = "ml_GTK_TREE_ITEM_SUBTREE" + module Signals = struct + open GtkSignal + let expand : ([>`treeitem],_) t = + { name = "expand"; marshaller = marshal_unit } + let collapse : ([>`treeitem],_) t = + { name = "collapse"; marshaller = marshal_unit } + end +end + +module Tree = struct + let cast w : tree obj = Object.try_cast w "GtkTree" + external coerce : [>`tree] obj -> tree obj = "%identity" + external create : unit -> tree obj = "ml_gtk_tree_new" + external insert : [>`tree] obj -> [>`treeitem] obj -> pos:int -> unit + = "ml_gtk_tree_insert" + external remove_items : [>`tree] obj -> [>`treeitem] obj list -> unit + = "ml_gtk_tree_remove_items" + external clear_items : [>`tree] obj -> start:int -> stop:int -> unit + = "ml_gtk_tree_clear_items" + external select_item : [>`tree] obj -> pos:int -> unit + = "ml_gtk_tree_select_item" + external unselect_item : [>`tree] obj -> pos:int -> unit + = "ml_gtk_tree_unselect_item" + external child_position : [>`tree] obj -> [>`treeitem] obj -> int + = "ml_gtk_tree_child_position" + external set_selection_mode : [>`tree] obj -> selection_mode -> unit + = "ml_gtk_tree_set_selection_mode" + external set_view_mode : [>`tree] obj -> [`LINE|`ITEM] -> unit + = "ml_gtk_tree_set_view_mode" + external set_view_lines : [>`tree] obj -> bool -> unit + = "ml_gtk_tree_set_view_lines" + external selection : [>`tree] obj -> tree_item obj list = + "ml_gtk_tree_selection" + let set ?selection_mode ?view_mode ?view_lines w = + let may_set f = may ~f:(f w) in + may_set set_selection_mode selection_mode; + may_set set_view_mode view_mode; + may_set set_view_lines view_lines + module Signals = struct + open GtkSignal + let selection_changed : ([>`tree],_) t = + { name = "selection_changed"; marshaller = marshal_unit } + let select_child : ([>`tree],_) t = + { name = "select_child"; marshaller = Widget.Signals.marshal } + let unselect_child : ([>`tree],_) t = + { name = "unselect_child"; marshaller = Widget.Signals.marshal } + end +end +(* +module CTree = struct + type t + type node = [`ctree] obj * t + let cast w : ctree obj = Object.try_cast w "GtkCTree" + external create : cols:int -> treecol:int -> ctree obj = "ml_gtk_ctree_new" + external insert_node : + [>`ctree] obj -> ?parent:node -> ?sibling:node -> + titles:optstring array -> + spacing:int -> ?pclosed:Gdk.pixmap -> ?mclosed:Gdk.bitmap obj -> + ?popened:Gdk.pixmap -> ?mopened:Gdk.bitmap obj -> + is_leaf:bool -> expanded:bool -> node + = "ml_gtk_ctree_insert_node_bc" "ml_gtk_ctree_insert_node" + let insert_node' + w ?parent ?sibling ?(spacing = 0) ?(is_leaf = true) + ?(expanded = false) + ?pclosed ?mclosed ?popened ?mopened titles = + let len = GtkList.CList.get_columns w in + if List.length titles > len then invalid_arg "CTree.insert_node"; + let arr = Array.create ~len None in + List.fold_left titles ~acc:0 + ~f:(fun ~acc text -> arr.(acc) <- Some text; acc+1); + insert_node w + ?parent ?sibling ~titles:(Array.map ~f:optstring arr) + ~spacing ~is_leaf ~expanded + ?pclosed ?mclosed ?popened ?mopened + external node_set_row_data : [>`ctree] obj -> node:node -> Obj.t -> unit + = "ml_gtk_ctree_node_set_row_data" + external node_get_row_data : [>`ctree] obj -> node:node -> Obj.t + = "ml_gtk_ctree_node_get_row_data" + external set_indent : [>`ctree] obj -> int -> unit + = "ml_gtk_ctree_set_indent" + module Signals = struct + open GtkSignal + let marshal_select f argv = + let node : node = + match GtkArgv.get_pointer argv ~pos:0 with + Some p -> Obj.magic p + | None -> invalid_arg "GtkTree.CTree.Signals.marshal_select" + in + f ~node ~column:(GtkArgv.get_int argv ~pos:1) + + let tree_select_row : ([>`ctree],_) t = + { name = "tree_select_row"; marshaller = marshal_select } + let tree_unselect_row : ([>`ctree],_) t = + { name = "tree_unselect_row"; marshaller = marshal_select } + end +end +*)