helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/radtest/gToolbar2.ml

   1 (* $Id$ *)
   2
   3 open Gaux
   4 open Gtk
   5 open GtkBase
   6 open GtkButton
   7 open GObj
   8 open GContainer
   9 open GButton
  10
  11 module Toolbar2 = struct
  12   external set_text : [>`toolbar] obj -> string -> int -> unit =
  13     "ml_gtk_toolbar2_set_text"
  14   external set_icon : [>`toolbar] obj -> [>`widget] obj -> int -> unit =
  15     "ml_gtk_toolbar2_set_icon"
  16 end
  17
  18 class toolbar2 obj = object
  19   inherit container_full (obj : Gtk.toolbar obj)
  20   method insert_widget ?tooltip ?tooltip_private ?pos w =
  21     Toolbar.insert_widget obj (as_widget w) ?tooltip ?tooltip_private ?pos
  22
  23   method insert_button ?text ?tooltip ?tooltip_private ?icon
  24       ?pos ?callback () =
  25     let icon = may_map icon ~f:as_widget in
  26     new button
  27       (Toolbar.insert_button obj ~kind:`BUTTON ?icon ?text
  28          ?tooltip ?tooltip_private ?pos ?callback ())
  29
  30   method insert_toggle_button ?text ?tooltip ?tooltip_private ?icon
  31       ?pos ?callback () =
  32     let icon = may_map icon ~f:as_widget in
  33     new toggle_button
  34       (ToggleButton.cast
  35          (Toolbar.insert_button obj ~kind:`TOGGLEBUTTON ?icon ?text
  36             ?tooltip ?tooltip_private ?pos ?callback ()))
  37
  38   method insert_radio_button ?text ?tooltip ?tooltip_private ?icon
  39       ?pos ?callback () =
  40     let icon = may_map icon ~f:as_widget in
  41     new radio_button
  42       (RadioButton.cast
  43          (Toolbar.insert_button obj ~kind:`RADIOBUTTON ?icon ?text
  44             ?tooltip ?tooltip_private ?pos ?callback ()))
  45
  46   method insert_space = Toolbar.insert_space obj
  47
  48   method set_orientation = Toolbar.set_orientation obj
  49   method set_style = Toolbar.set_style obj
  50   method set_space_size = Toolbar.set_space_size obj
  51   method set_space_style = Toolbar.set_space_style obj
  52   method set_tooltips = Toolbar.set_tooltips obj
  53   method set_button_relief = Toolbar.set_button_relief obj
  54   method button_relief = Toolbar.get_button_relief obj
  55   method set_text = Toolbar2.set_text obj
  56   method set_icon (icon : widget) = Toolbar2.set_icon obj icon#as_widget
  57 end
  58
  59 let toolbar2 ?(orientation=`HORIZONTAL) ?style
  60     ?space_size ?space_style ?tooltips ?button_relief
  61     ?border_width ?width ?height ?packing ?show () =
  62   let w = Toolbar.create orientation ?style () in
  63   Toolbar.set w ?space_size ?space_style ?tooltips ?button_relief;
  64   Container.set w ?border_width ?width ?height;
  65   pack_return (new toolbar2 w) ~packing ~show