Initial revision

[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / gtkTree.ml

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkTree.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkTree.ml
new file mode 100644 (file)
index 0000000..9260741
--- /dev/null
+++ b/helm/DEVEL/lablgtk/lablgtk_20000829-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
+*)