]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gButton.ml
implemented and exported heal_header_name and heal_header_value
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-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