helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/applications/radtest/gtkTree2.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 =
  10     if Object.is_a w "GtkTreeItem" then Obj.magic w
  11     else invalid_arg "Gtk.TreeItem.cast"
  12   external create : unit -> tree_item obj = "ml_gtk_tree_item2_new"
  13   external create_with_label : string -> tree_item obj
  14       = "ml_gtk_tree_item2_new_with_label"
  15   let create ?label () =
  16     match label with None -> create ()
  17     | Some label -> create_with_label label
  18   external set_subtree : [>`treeitem] obj -> [>`widget] obj -> unit
  19       = "ml_gtk_tree_item2_set_subtree"
  20   external remove_subtree : [>`treeitem] obj -> unit
  21       = "ml_gtk_tree_item2_remove_subtree"
  22   external expand : [>`treeitem] obj -> unit
  23       = "ml_gtk_tree_item2_expand"
  24   external collapse : [>`treeitem] obj -> unit
  25       = "ml_gtk_tree_item2_collapse"
  26   external subtree : [>`treeitem] obj -> tree obj
  27       = "ml_GTK_TREE_ITEM2_SUBTREE"
  28   let subtree t = try subtree t with Gpointer.Null -> raise Not_found
  29   module Signals = struct
  30     open GtkSignal
  31     let expand : ([>`treeitem],_) t =
  32       { name = "expand"; marshaller = marshal_unit }
  33     let collapse : ([>`treeitem],_) t =
  34       { name = "collapse"; marshaller = marshal_unit }
  35   end
  36 end
  37
  38 module Tree = struct
  39   let cast w : tree obj =
  40     if Object.is_a w "GtkTree" then Obj.magic w
  41     else invalid_arg "Gtk.Tree.cast"
  42   external coerce : [>`tree] obj -> tree obj = "%identity"
  43   external create : unit -> tree obj = "ml_gtk_tree2_new"
  44   external insert : [>`tree] obj -> [>`treeitem] obj -> pos:int -> unit
  45       = "ml_gtk_tree2_insert"
  46   external remove_items : [>`tree] obj -> [>`treeitem] obj list -> unit
  47       = "ml_gtk_tree2_remove_items"
  48   external clear_items : [>`tree] obj -> start:int -> stop:int -> unit
  49       = "ml_gtk_tree2_clear_items"
  50   external select_item : [>`tree] obj -> pos:int -> unit
  51       = "ml_gtk_tree2_select_item"
  52   external unselect_item : [>`tree] obj -> pos:int -> unit
  53       = "ml_gtk_tree2_unselect_item"
  54   external child_position : [>`tree] obj -> [>`treeitem] obj -> int
  55       = "ml_gtk_tree2_child_position"
  56 (*  external set_selection_mode : [>`tree] obj -> selection_mode -> unit
  57       = "ml_gtk_tree2_set_selection_mode"
  58   external set_view_mode : [>`tree] obj -> [`LINE|`ITEM] -> unit
  59       = "ml_gtk_tree2_set_view_mode"
  60 *)
  61   external set_view_lines : [>`tree] obj -> bool -> unit
  62       = "ml_gtk_tree2_set_view_lines"
  63   external selection : [>`tree] obj -> tree_item obj list =
  64     "ml_gtk_tree2_selection"
  65   external item_up : [>`tree] obj -> int -> unit =
  66     "ml_gtk_tree2_item_up"
  67
  68   let set ?selection_mode ?view_mode ?view_lines w =
  69     let may_set f = may ~f:(f w) in
  70 (*    may_set set_selection_mode selection_mode;
  71     may_set set_view_mode view_mode; *)
  72     may_set set_view_lines view_lines
  73   module Signals = struct
  74     open GtkSignal
  75     let selection_changed : ([>`tree],_) t =
  76       { name = "selection_changed"; marshaller = marshal_unit }
  77     let select_child : ([>`tree],_) t =
  78       { name = "select_child"; marshaller = Widget.Signals.marshal }
  79     let unselect_child : ([>`tree],_) t =
  80       { name = "unselect_child"; marshaller = Widget.Signals.marshal }
  81   end
  82 end