]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkMenu.ml
updated the binding so that it works well with lablgtk-1.00,
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20001129-0.1.0 / gtkMenu.ml
1 (* $Id$ *)
2
3 open Gaux
4 open Gtk
5 open GtkBase
6
7 module MenuItem = struct
8   let cast w : menu_item obj = Object.try_cast w "GtkMenuItem"
9   external coerce : [>`menuitem] obj -> menu_item obj = "%identity"
10   external create : unit -> menu_item obj = "ml_gtk_menu_item_new"
11   external create_with_label : string -> menu_item obj
12       = "ml_gtk_menu_item_new_with_label"
13   external tearoff_create : unit -> menu_item obj
14       = "ml_gtk_tearoff_menu_item_new"
15   let create ?label () =
16     match label with None -> create ()
17     | Some label -> create_with_label label
18   external set_submenu : [>`menuitem] obj -> [>`menu] obj -> unit
19       = "ml_gtk_menu_item_set_submenu"
20   external remove_submenu : [>`menuitem] obj -> unit
21       = "ml_gtk_menu_item_remove_submenu"
22   external configure :
23       [>`menuitem] obj -> show_toggle:bool -> show_indicator:bool -> unit
24       = "ml_gtk_menu_item_configure"
25   external activate : [>`menuitem] obj -> unit
26       = "ml_gtk_menu_item_activate"
27   external right_justify : [>`menuitem] obj -> unit
28       = "ml_gtk_menu_item_right_justify"
29   module Signals = struct
30     open GtkSignal
31     let activate : ([>`menuitem],_) t =
32       { name = "activate"; marshaller = marshal_unit }
33     let activate_item : ([>`menuitem],_) t =
34       { name = "activate_item"; marshaller = marshal_unit }
35   end
36 end
37
38 module CheckMenuItem = struct
39   let cast w : check_menu_item obj = Object.try_cast w "GtkCheckMenuItem"
40   external coerce : [>`checkmenuitem] obj -> check_menu_item obj = "%identity"
41   external create : unit -> check_menu_item obj = "ml_gtk_check_menu_item_new"
42   external create_with_label : string -> check_menu_item obj
43       = "ml_gtk_check_menu_item_new_with_label"
44   let create ?label () =
45     match label with None -> create ()
46     | Some label -> create_with_label label
47   external set_active : [>`checkmenuitem] obj -> bool -> unit
48       = "ml_gtk_check_menu_item_set_active"
49   external get_active : [>`checkmenuitem] obj -> bool
50       = "ml_gtk_check_menu_item_get_active"
51   external set_show_toggle : [>`checkmenuitem] obj -> bool -> unit
52       = "ml_gtk_check_menu_item_set_show_toggle"
53   let set ?active ?show_toggle w =
54     may active ~f:(set_active w);
55     may show_toggle ~f:(set_show_toggle w)
56   external toggled : [>`checkmenuitem] obj -> unit
57       = "ml_gtk_check_menu_item_toggled"
58   module Signals = struct
59     open GtkSignal
60     let toggled : ([>`checkmenuitem],_) t =
61       { name = "toggled"; marshaller = marshal_unit }
62   end
63 end
64
65 module RadioMenuItem = struct
66   let cast w : radio_menu_item obj = Object.try_cast w "GtkRadioMenuItem"
67   external create : radio_menu_item group -> radio_menu_item obj
68       = "ml_gtk_radio_menu_item_new"
69   external create_with_label :
70       radio_menu_item group -> string -> radio_menu_item obj
71       = "ml_gtk_radio_menu_item_new_with_label"
72   let create ?(group = None) ?label () =
73     match label with None -> create group
74     | Some label -> create_with_label group label
75   external set_group : [>`radiomenuitem] obj -> radio_menu_item group -> unit
76       = "ml_gtk_radio_menu_item_set_group"
77 end
78
79 module OptionMenu = struct
80   let cast w : option_menu obj = Object.try_cast w "GtkOptionMenu"
81   external create : unit -> option_menu obj = "ml_gtk_option_menu_new"
82   external get_menu : [>`optionmenu] obj -> menu obj
83       = "ml_gtk_option_menu_get_menu"
84   external set_menu : [>`optionmenu] obj -> [>`menu] obj -> unit
85       = "ml_gtk_option_menu_set_menu"
86   external remove_menu : [>`optionmenu] obj -> unit
87       = "ml_gtk_option_menu_remove_menu"
88   external set_history : [>`optionmenu] obj -> int -> unit
89       = "ml_gtk_option_menu_set_history"
90   let set ?menu ?history w =
91     may menu ~f:(set_menu w);
92     may history ~f:(set_history w)
93 end
94
95 module MenuShell = struct
96   let cast w : menu_shell obj = Object.try_cast w "GtkMenuShell"
97   external coerce : [>`menushell] obj -> menu_shell obj = "%identity"
98   external append : [>`menushell] obj -> [>`widget] obj -> unit
99       = "ml_gtk_menu_shell_append"
100   external prepend : [>`menushell] obj -> [>`widget] obj -> unit
101       = "ml_gtk_menu_shell_prepend"
102   external insert : [>`menushell] obj -> [>`widget] obj -> pos:int -> unit
103       = "ml_gtk_menu_shell_insert"
104   external deactivate : [>`menushell] obj -> unit
105       = "ml_gtk_menu_shell_deactivate"
106   module Signals = struct
107     open GtkSignal
108     let deactivate : ([>`menushell],_) t =
109       { name = "deactivate"; marshaller = marshal_unit }
110   end
111 end
112
113 module Menu = struct
114   let cast w : menu obj = Object.try_cast w "GtkMenu"
115   external create : unit -> menu obj = "ml_gtk_menu_new"
116   external popup :
117       [>`menu] obj -> [>`menushell] optobj ->
118       [>`menuitem] optobj -> button:int -> time:int -> unit
119       = "ml_gtk_menu_popup"
120   let popup ?parent_menu ?parent_item w =
121     popup w (Gpointer.optboxed parent_menu) (Gpointer.optboxed parent_item)
122   external popdown : [>`menu] obj -> unit = "ml_gtk_menu_popdown"
123   external get_active : [>`menu] obj -> widget obj= "ml_gtk_menu_get_active"
124   external set_active : [>`menu] obj -> int -> unit = "ml_gtk_menu_set_active"
125   external set_accel_group : [>`menu] obj -> accel_group -> unit
126       = "ml_gtk_menu_set_accel_group"
127   external get_accel_group : [>`menu] obj -> accel_group
128       = "ml_gtk_menu_get_accel_group"
129   external ensure_uline_accel_group : [>`menu] obj -> accel_group
130       = "ml_gtk_menu_ensure_uline_accel_group"
131   external attach_to_widget : [>`menu] obj -> [>`widget] obj -> unit
132       = "ml_gtk_menu_attach_to_widget"
133   external get_attach_widget : [>`menu] obj -> widget obj
134       = "ml_gtk_menu_get_attach_widget"
135   external detach : [>`menu] obj -> unit = "ml_gtk_menu_detach"
136   let set ?active ?accel_group w =
137     may active ~f:(set_active w);
138     may accel_group ~f:(set_accel_group w)
139 end
140
141 module MenuBar = struct
142   let cast w : menu_bar obj = Object.try_cast w "GtkMenuBar"
143   external create : unit -> menu_bar obj = "ml_gtk_menu_bar_new"
144 end