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 *)