helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gButton.ml

   1 (* $Id$ *)
   2
   3 open Gaux
   4 open Gtk
   5 open GtkBase
   6 open GtkButton
   7 open GObj
   8 open GContainer
   9
  10 class button_skel obj = object (self)
  11   inherit container obj
  12   method clicked () = Button.clicked obj
  13   method grab_default () =
  14     Widget.set_can_default obj true;
  15     Widget.grab_default obj
  16 end
  17
  18 class button_signals obj = object
  19   inherit container_signals obj
  20   method clicked = GtkSignal.connect ~sgn:Button.Signals.clicked ~after obj
  21   method pressed = GtkSignal.connect ~sgn:Button.Signals.pressed ~after obj
  22   method released = GtkSignal.connect ~sgn:Button.Signals.released ~after obj
  23   method enter = GtkSignal.connect ~sgn:Button.Signals.enter ~after obj
  24   method leave = GtkSignal.connect ~sgn:Button.Signals.leave ~after obj
  25 end
  26
  27 class button obj = object
  28   inherit button_skel (Button.coerce obj)
  29   method connect = new button_signals obj
  30   method event = new GObj.event_ops obj
  31 end
  32
  33 let button ?label ?border_width ?width ?height ?packing ?show () =
  34   let w = Button.create ?label () in
  35   Container.set w ?border_width ?width ?height;
  36   pack_return (new button w) ~packing ~show
  37
  38 class toggle_button_signals obj = object
  39   inherit button_signals obj
  40   method toggled =
  41     GtkSignal.connect ~sgn:ToggleButton.Signals.toggled obj ~after
  42 end
  43
  44 class toggle_button obj = object
  45   inherit button_skel obj
  46   method connect = new toggle_button_signals obj
  47   method active = ToggleButton.get_active obj
  48   method set_active = ToggleButton.set_active obj
  49   method set_draw_indicator = ToggleButton.set_mode obj
  50 end
  51
  52 let toggle_button ?label ?active ?draw_indicator
  53     ?border_width ?width ?height ?packing ?show () =
  54   let w = ToggleButton.create_toggle ?label () in
  55   ToggleButton.set w ?active ?draw_indicator;
  56   Container.set w ?border_width ?width ?height;
  57   pack_return (new toggle_button w) ~packing ~show
  58
  59 let check_button ?label ?active ?draw_indicator
  60     ?border_width ?width ?height ?packing ?show () =
  61   let w = ToggleButton.create_check ?label () in
  62   ToggleButton.set w ?active ?draw_indicator;
  63   Container.set w ?border_width ?width ?height;
  64   pack_return (new toggle_button w) ~packing ~show
  65
  66 class radio_button obj = object
  67   inherit toggle_button (obj : Gtk.radio_button obj)
  68   method set_group = RadioButton.set_group obj
  69   method group = Some obj
  70 end
  71
  72 let radio_button ?group ?label ?active ?draw_indicator
  73     ?border_width ?width ?height ?packing ?show () =
  74   let w = RadioButton.create ?group ?label () in
  75   ToggleButton.set w ?active ?draw_indicator;
  76   Container.set w ?border_width ?width ?height;
  77   pack_return (new radio_button w) ~packing ~show
  78
  79 class toolbar obj = object
  80   inherit container_full (obj : Gtk.toolbar obj)
  81   method insert_widget ?tooltip ?tooltip_private ?pos w =
  82     Toolbar.insert_widget obj (as_widget w) ?tooltip ?tooltip_private ?pos
  83
  84   method insert_button ?text ?tooltip ?tooltip_private ?icon
  85       ?pos ?callback () =
  86     let icon = may_map icon ~f:as_widget in
  87     new button
  88       (Toolbar.insert_button obj ~kind:`BUTTON ?icon ?text
  89          ?tooltip ?tooltip_private ?pos ?callback ())
  90
  91   method insert_toggle_button ?text ?tooltip ?tooltip_private ?icon
  92       ?pos ?callback () =
  93     let icon = may_map icon ~f:as_widget in
  94     new toggle_button
  95       (ToggleButton.cast
  96          (Toolbar.insert_button obj ~kind:`TOGGLEBUTTON ?icon ?text
  97             ?tooltip ?tooltip_private ?pos ?callback ()))
  98
  99   method insert_radio_button ?text ?tooltip ?tooltip_private ?icon
 100       ?pos ?callback () =
 101     let icon = may_map icon ~f:as_widget in
 102     new radio_button
 103       (RadioButton.cast
 104          (Toolbar.insert_button obj ~kind:`RADIOBUTTON ?icon ?text
 105             ?tooltip ?tooltip_private ?pos ?callback ()))
 106
 107   method insert_space = Toolbar.insert_space obj
 108
 109   method set_orientation = Toolbar.set_orientation obj
 110   method set_style = Toolbar.set_style obj
 111   method set_space_size = Toolbar.set_space_size obj
 112   method set_space_style = Toolbar.set_space_style obj
 113   method set_tooltips = Toolbar.set_tooltips obj
 114   method set_button_relief = Toolbar.set_button_relief obj
 115   method button_relief = Toolbar.get_button_relief obj
 116 end
 117
 118 let toolbar ?(orientation=`HORIZONTAL) ?style
 119     ?space_size ?space_style ?tooltips ?button_relief
 120     ?border_width ?width ?height ?packing ?show () =
 121   let w = Toolbar.create orientation ?style () in
 122   Toolbar.set w ?space_size ?space_style ?tooltips ?button_relief;
 123   Container.set w ?border_width ?width ?height;
 124   pack_return (new toolbar w) ~packing ~show