1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
open Gaux
open Gobject
open Gtk
open GtkData
open GtkBase
open GtkContainers
open GtkMenu
open OgtkBaseProps
open OgtkMenuProps
open GObj
open GContainer
class obj = object (self)
inherit container_signals_impl obj
method deactivate = self#connect MenuShell.S.deactivate
end
class type virtual ['a] = object
inherit ['a] item_container
method as_menu : Gtk.menu Gtk.obj
method deactivate : unit -> unit
method connect : menu_shell_signals
method event : event_ops
method popup : button:int -> time:int32 -> unit
method popdown : unit -> unit
method set_accel_group : accel_group -> unit
method set_accel_path : string -> unit
end
class obj = object (self)
inherit container_signals_impl (obj : [>menu_item] obj)
method activate = self#connect MenuItem.S.activate
end
class ['a] obj = object
inherit container obj
method as_item = (obj :> Gtk.menu_item obj)
method set_submenu (w : 'a pre_menu) =
MenuItem.set_submenu obj (Some w#as_menu)
method remove_submenu () = MenuItem.set_submenu obj None
method get_submenu =
may_map (new GObj.widget) (MenuItem.get_submenu obj)
method activate () = MenuItem.activate obj
method select () = MenuItem.select obj
method deselect () = MenuItem.deselect obj
method add_accelerator ~group ?modi:m ?flags key=
Widget.add_accelerator obj ~sgn:MenuItem.S.activate group ?flags
?modi:m ~key
end
class obj = object
inherit [menu_item] pre_menu_item_skel obj
method connect = new menu_item_signals obj
method event = new GObj.event_ops obj
end
class = [menu_item] pre_menu_item_skel
let pack_item ?packing ?(show=true) self =
may packing ~f:(fun f -> (f (self :> menu_item) : unit));
if show then self#misc#show ();
self
let ?use_mnemonic ?label ?packing ?show () =
let w = MenuItem.create ?use_mnemonic ?label () in
pack_item (new menu_item w) ?packing ?show
let separator_item ?packing ?show () =
let w = MenuItem.separator_create () in
pack_item (new menu_item w) ?packing ?show
class obj = object (self)
inherit menu_item_signals obj
method toggled = self#connect CheckMenuItem.S.toggled
end
class obj = object
inherit menu_item_skel obj
method set_active = set CheckMenuItem.P.active obj
method set_inconsistent = set CheckMenuItem.P.inconsistent obj
method inconsistent = get CheckMenuItem.P.inconsistent obj
method active = get CheckMenuItem.P.active obj
method toggled () = CheckMenuItem.toggled obj
method connect = new check_menu_item_signals obj
method event = new GObj.event_ops obj
end
let ?label ?use_mnemonic ?active ?packing ?show () =
let w = CheckMenuItem.create ?use_mnemonic ?label () in
CheckMenuItem.set w ?active;
pack_item (new check_menu_item w) ?packing ?show
class obj = object
inherit check_menu_item (obj : Gtk.radio_menu_item obj)
method group = Some obj
method set_group = RadioMenuItem.set_group obj
end
let ?group ?label ?use_mnemonic ?active ?packing ?show () =
let w = RadioMenuItem.create ?use_mnemonic ?group ?label () in
CheckMenuItem.set w ?active;
pack_item (new radio_menu_item w) ?packing ?show
class obj = object
inherit [menu_item] item_container obj
method private wrap w = new menu_item (MenuItem.cast w)
method insert w = MenuShell.insert obj w#as_item
method deactivate () = MenuShell.deactivate obj
method connect = new menu_shell_signals obj
method event = new GObj.event_ops obj
end
class obj = object
inherit menu_shell obj
method popup = Menu.popup obj
method popdown () = Menu.popdown obj
method as_menu : Gtk.menu obj = obj
method set_accel_group = Menu.set_accel_group obj
method set_accel_path = Menu.set_accel_path obj
end
let ?accel_path ?border_width ?packing ?show () =
let w = Menu.create [] in
may border_width ~f:(set Container.P.border_width w);
may accel_path ~f:(fun ap -> Menu.set_accel_path w ap);
let self = new menu w in
may packing ~f:(fun f -> (f self : unit));
if show <> Some false then self#misc#show ();
self
let =
pack_container [] ~create:(fun p -> new menu_shell (MenuBar.create p))
class ['a] factory
?(accel_group=AccelGroup.create ())
?(accel_path="<DEFAULT ROOT>/")
?(accel_modi=[`CONTROL])
?(accel_flags=[`VISIBLE]) ( : 'a) =
object (self)
val menu_shell : #menu_shell = menu_shell
val group = accel_group
val m = accel_modi
val flags = (accel_flags:Gtk.Tags.accel_flag list)
val accel_path = accel_path
method menu = menu_shell
method accel_group = group
method private bind ?(modi=m) ?key ?callback (item : menu_item) label =
menu_shell#append item;
let accel_path = accel_path ^ label ^ "/" in
GtkData.AccelMap.add_entry accel_path ?key ~modi:m;
GtkBase.Widget.set_accel_path item#as_widget accel_path accel_group;
may callback ~f:(fun callback -> item#connect#activate ~callback)
method add_item ?key ?callback ? label =
let item = menu_item ~use_mnemonic:true ~label () in
self#bind item ?key ?callback label;
may (submenu : menu option) ~f:item#set_submenu;
item
method add_check_item ?active ?key ?callback label =
let item = check_menu_item ~label ~use_mnemonic:true ?active () in
self#bind (item : check_menu_item :> menu_item) label ?key
?callback:(may_map callback ~f:(fun f () -> f item#active));
item
method add_radio_item ?group ?active ?key ?callback label =
let item = radio_menu_item ~label ~use_mnemonic:true ?group ?active () in
self#bind (item : radio_menu_item :> menu_item) label ?key
?callback:(may_map callback ~f:(fun f () -> f item#active));
item
method add_separator () = separator_item ~packing:menu_shell#append ()
method add_submenu ?key label =
let item = menu_item ~use_mnemonic:true ~label () in
self#bind item ?key label;
menu ~packing:item#set_submenu ()
end