]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/radtest/gToolbar2.ml
...
[helm.git] / 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