helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkButton.ml

   1 (* $Id$ *)
   2
   3 open Gaux
   4 open Gtk
   5 open Tags
   6 open GtkBase
   7
   8 module Button = struct
   9   let cast w : button obj = Object.try_cast w "GtkButton"
  10   external coerce : [>`button] obj -> button obj = "%identity"
  11   external create : unit -> button obj = "ml_gtk_button_new"
  12   external create_with_label : string -> button obj
  13       = "ml_gtk_button_new_with_label"
  14   let create ?label () =
  15     match label with None -> create ()
  16     | Some x -> create_with_label x
  17   external pressed : [>`button] obj -> unit = "ml_gtk_button_pressed"
  18   external released : [>`button] obj -> unit = "ml_gtk_button_released"
  19   external clicked : [>`button] obj -> unit = "ml_gtk_button_clicked"
  20   external enter : [>`button] obj -> unit = "ml_gtk_button_enter"
  21   external leave : [>`button] obj -> unit = "ml_gtk_button_leave"
  22   module Signals = struct
  23     open GtkSignal
  24     let pressed : ([>`button],_) t =
  25       { name = "pressed"; marshaller = marshal_unit }
  26     let released : ([>`button],_) t =
  27       { name = "released"; marshaller = marshal_unit }
  28     let clicked : ([>`button],_) t =
  29       { name = "clicked"; marshaller = marshal_unit }
  30     let enter : ([>`button],_) t =
  31       { name = "enter"; marshaller = marshal_unit }
  32     let leave : ([>`button],_) t =
  33       { name = "leave"; marshaller = marshal_unit }
  34   end
  35 end
  36
  37 module ToggleButton = struct
  38   let cast w : toggle_button obj = Object.try_cast w "GtkToggleButton"
  39   external coerce : [>`toggle] obj -> toggle_button obj = "%identity"
  40   external toggle_button_create : unit -> toggle_button obj
  41       = "ml_gtk_toggle_button_new"
  42   external toggle_button_create_with_label : string -> toggle_button obj
  43       = "ml_gtk_toggle_button_new_with_label"
  44   external check_button_create : unit -> toggle_button obj
  45       = "ml_gtk_check_button_new"
  46   external check_button_create_with_label : string -> toggle_button obj
  47       = "ml_gtk_check_button_new_with_label"
  48   let create_toggle ?label () =
  49     match label with None -> toggle_button_create ()
  50     | Some label -> toggle_button_create_with_label label
  51   let create_check ?label () =
  52     match label with None -> check_button_create ()
  53     | Some label -> check_button_create_with_label label
  54   external set_mode : [>`toggle] obj -> bool -> unit
  55       = "ml_gtk_toggle_button_set_mode"
  56   external set_active : [>`toggle] obj -> bool -> unit
  57       = "ml_gtk_toggle_button_set_active"
  58   let set ?active ?draw_indicator w =
  59     may ~f:(set_mode w) draw_indicator;
  60     may ~f:(set_active w) active
  61   external get_active : [>`toggle] obj -> bool
  62       = "ml_gtk_toggle_button_get_active"
  63   external toggled : [>`toggle] obj -> unit
  64       = "ml_gtk_toggle_button_toggled"
  65   module Signals = struct
  66     open GtkSignal
  67     let toggled : ([>`toggle],_) t =
  68       { name = "toggled"; marshaller = marshal_unit }
  69   end
  70 end
  71
  72 module RadioButton = struct
  73   let cast w : radio_button obj = Object.try_cast w "GtkRadioButton"
  74   external create : radio_button group -> radio_button obj
  75       = "ml_gtk_radio_button_new"
  76   external create_with_label : radio_button group -> string -> radio_button obj
  77       = "ml_gtk_radio_button_new_with_label"
  78   external set_group : [>`radio] obj -> radio_button group -> unit
  79       = "ml_gtk_radio_button_set_group"
  80   let create ?(group = None) ?label () =
  81     match label with None -> create group
  82     | Some label -> create_with_label group label
  83 end
  84
  85 module Toolbar = struct
  86   let cast w : toolbar obj = Object.try_cast w "GtkToolbar"
  87   external create : orientation -> style:toolbar_style -> toolbar obj
  88       = "ml_gtk_toolbar_new"
  89   let create dir ?(style=`BOTH) () = create dir ~style
  90   external insert_space : [>`toolbar] obj -> pos:int -> unit
  91       = "ml_gtk_toolbar_insert_space"
  92   let insert_space w ?(pos = -1) () = insert_space w ~pos
  93   external insert_button :
  94       [>`toolbar] obj -> kind:[`BUTTON|`TOGGLEBUTTON|`RADIOBUTTON] ->
  95       text:string -> tooltip:string ->
  96       tooltip_private:string ->
  97       icon:[>`widget] optobj -> pos:int -> button obj
  98       = "ml_gtk_toolbar_insert_element_bc" "ml_gtk_toolbar_insert_element"
  99   let insert_button w ?(kind=`BUTTON) ?(text="") ?(tooltip="")
 100       ?(tooltip_private="") ?icon ?(pos = -1) ?callback () =
 101     let b =insert_button w ~kind ~text ~tooltip ~tooltip_private ~pos
 102         ~icon:(Gpointer.optboxed icon)
 103     in
 104     match callback with
 105     | None   -> b
 106     | Some c -> GtkSignal.connect b ~sgn:Button.Signals.clicked
 107           ~callback: c; b
 108   external insert_widget :
 109       [>`toolbar] obj -> [>`widget] obj ->
 110       tooltip:string -> tooltip_private:string -> pos:int -> unit
 111       = "ml_gtk_toolbar_insert_widget"
 112   let insert_widget w ?(tooltip="") ?(tooltip_private="") ?(pos = -1) w' =
 113     insert_widget w w' ~tooltip ~tooltip_private ~pos
 114   external set_orientation : [>`toolbar] obj -> orientation -> unit =
 115     "ml_gtk_toolbar_set_orientation"
 116   external set_style : [>`toolbar] obj -> toolbar_style -> unit =
 117     "ml_gtk_toolbar_set_style"
 118   external set_space_size : [>`toolbar] obj -> int -> unit =
 119     "ml_gtk_toolbar_set_space_size"
 120   external set_space_style : [>`toolbar] obj -> [ `EMPTY|`LINE ] -> unit =
 121     "ml_gtk_toolbar_set_space_style"
 122   external set_tooltips : [>`toolbar] obj -> bool -> unit =
 123     "ml_gtk_toolbar_set_tooltips"
 124   external set_button_relief : [>`toolbar] obj -> relief_style -> unit =
 125     "ml_gtk_toolbar_set_button_relief"
 126   external get_button_relief : [>`toolbar] obj -> relief_style =
 127     "ml_gtk_toolbar_get_button_relief"
 128   let set ?orientation ?style ?space_size
 129       ?space_style ?tooltips ?button_relief w =
 130     may orientation ~f:(set_orientation w);
 131     may style ~f:(set_style w);
 132     may space_size ~f:(set_space_size w);
 133     may space_style ~f:(set_space_style w);
 134     may tooltips ~f:(set_tooltips w);
 135     may button_relief ~f:(set_button_relief w)
 136   module Signals = struct
 137     open GtkSignal
 138     external val_orientation : int -> orientation = "ml_Val_orientation"
 139     external val_toolbar_style : int -> toolbar_style
 140         = "ml_Val_toolbar_style"
 141     let orientation_changed : ([>`toolbar],_) t =
 142       let marshal f = marshal_int (fun x -> f (val_orientation x)) in
 143       { name = "orientation_changed"; marshaller = marshal }
 144     let style_changed : ([>`toolbar],_) t =
 145       let marshal f = marshal_int (fun x -> f (val_toolbar_style x)) in
 146       { name = "style_changed"; marshaller = marshal }
 147   end
 148 end