X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2FgtkMenu.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2FgtkMenu.ml;h=2f1eb30f01ca381a36de6a8163df00fdd709994b;hb=2ee84a2a641938988703e329aef9fc3c5eb5aacf;hp=0000000000000000000000000000000000000000;hpb=34d83812af9b7064cc8f735c2a78169881140010;p=helm.git diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkMenu.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkMenu.ml new file mode 100644 index 000000000..2f1eb30f0 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkMenu.ml @@ -0,0 +1,144 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase + +module MenuItem = struct + let cast w : menu_item obj = Object.try_cast w "GtkMenuItem" + external coerce : [>`menuitem] obj -> menu_item obj = "%identity" + external create : unit -> menu_item obj = "ml_gtk_menu_item_new" + external create_with_label : string -> menu_item obj + = "ml_gtk_menu_item_new_with_label" + external tearoff_create : unit -> menu_item obj + = "ml_gtk_tearoff_menu_item_new" + let create ?label () = + match label with None -> create () + | Some label -> create_with_label label + external set_submenu : [>`menuitem] obj -> [>`menu] obj -> unit + = "ml_gtk_menu_item_set_submenu" + external remove_submenu : [>`menuitem] obj -> unit + = "ml_gtk_menu_item_remove_submenu" + external configure : + [>`menuitem] obj -> show_toggle:bool -> show_indicator:bool -> unit + = "ml_gtk_menu_item_configure" + external activate : [>`menuitem] obj -> unit + = "ml_gtk_menu_item_activate" + external right_justify : [>`menuitem] obj -> unit + = "ml_gtk_menu_item_right_justify" + module Signals = struct + open GtkSignal + let activate : ([>`menuitem],_) t = + { name = "activate"; marshaller = marshal_unit } + let activate_item : ([>`menuitem],_) t = + { name = "activate_item"; marshaller = marshal_unit } + end +end + +module CheckMenuItem = struct + let cast w : check_menu_item obj = Object.try_cast w "GtkCheckMenuItem" + external coerce : [>`checkmenuitem] obj -> check_menu_item obj = "%identity" + external create : unit -> check_menu_item obj = "ml_gtk_check_menu_item_new" + external create_with_label : string -> check_menu_item obj + = "ml_gtk_check_menu_item_new_with_label" + let create ?label () = + match label with None -> create () + | Some label -> create_with_label label + external set_active : [>`checkmenuitem] obj -> bool -> unit + = "ml_gtk_check_menu_item_set_active" + external get_active : [>`checkmenuitem] obj -> bool + = "ml_gtk_check_menu_item_get_active" + external set_show_toggle : [>`checkmenuitem] obj -> bool -> unit + = "ml_gtk_check_menu_item_set_show_toggle" + let set ?active ?show_toggle w = + may active ~f:(set_active w); + may show_toggle ~f:(set_show_toggle w) + external toggled : [>`checkmenuitem] obj -> unit + = "ml_gtk_check_menu_item_toggled" + module Signals = struct + open GtkSignal + let toggled : ([>`checkmenuitem],_) t = + { name = "toggled"; marshaller = marshal_unit } + end +end + +module RadioMenuItem = struct + let cast w : radio_menu_item obj = Object.try_cast w "GtkRadioMenuItem" + external create : radio_menu_item group -> radio_menu_item obj + = "ml_gtk_radio_menu_item_new" + external create_with_label : + radio_menu_item group -> string -> radio_menu_item obj + = "ml_gtk_radio_menu_item_new_with_label" + let create ?(group = None) ?label () = + match label with None -> create group + | Some label -> create_with_label group label + external set_group : [>`radiomenuitem] obj -> radio_menu_item group -> unit + = "ml_gtk_radio_menu_item_set_group" +end + +module OptionMenu = struct + let cast w : option_menu obj = Object.try_cast w "GtkOptionMenu" + external create : unit -> option_menu obj = "ml_gtk_option_menu_new" + external get_menu : [>`optionmenu] obj -> menu obj + = "ml_gtk_option_menu_get_menu" + external set_menu : [>`optionmenu] obj -> [>`menu] obj -> unit + = "ml_gtk_option_menu_set_menu" + external remove_menu : [>`optionmenu] obj -> unit + = "ml_gtk_option_menu_remove_menu" + external set_history : [>`optionmenu] obj -> int -> unit + = "ml_gtk_option_menu_set_history" + let set ?menu ?history w = + may menu ~f:(set_menu w); + may history ~f:(set_history w) +end + +module MenuShell = struct + let cast w : menu_shell obj = Object.try_cast w "GtkMenuShell" + external coerce : [>`menushell] obj -> menu_shell obj = "%identity" + external append : [>`menushell] obj -> [>`widget] obj -> unit + = "ml_gtk_menu_shell_append" + external prepend : [>`menushell] obj -> [>`widget] obj -> unit + = "ml_gtk_menu_shell_prepend" + external insert : [>`menushell] obj -> [>`widget] obj -> pos:int -> unit + = "ml_gtk_menu_shell_insert" + external deactivate : [>`menushell] obj -> unit + = "ml_gtk_menu_shell_deactivate" + module Signals = struct + open GtkSignal + let deactivate : ([>`menushell],_) t = + { name = "deactivate"; marshaller = marshal_unit } + end +end + +module Menu = struct + let cast w : menu obj = Object.try_cast w "GtkMenu" + external create : unit -> menu obj = "ml_gtk_menu_new" + external popup : + [>`menu] obj -> [>`menushell] optobj -> + [>`menuitem] optobj -> button:int -> time:int -> unit + = "ml_gtk_menu_popup" + let popup ?parent_menu ?parent_item w = + popup w (Gpointer.optboxed parent_menu) (Gpointer.optboxed parent_item) + external popdown : [>`menu] obj -> unit = "ml_gtk_menu_popdown" + external get_active : [>`menu] obj -> widget obj= "ml_gtk_menu_get_active" + external set_active : [>`menu] obj -> int -> unit = "ml_gtk_menu_set_active" + external set_accel_group : [>`menu] obj -> accel_group -> unit + = "ml_gtk_menu_set_accel_group" + external get_accel_group : [>`menu] obj -> accel_group + = "ml_gtk_menu_get_accel_group" + external ensure_uline_accel_group : [>`menu] obj -> accel_group + = "ml_gtk_menu_ensure_uline_accel_group" + external attach_to_widget : [>`menu] obj -> [>`widget] obj -> unit + = "ml_gtk_menu_attach_to_widget" + external get_attach_widget : [>`menu] obj -> widget obj + = "ml_gtk_menu_get_attach_widget" + external detach : [>`menu] obj -> unit = "ml_gtk_menu_detach" + let set ?active ?accel_group w = + may active ~f:(set_active w); + may accel_group ~f:(set_accel_group w) +end + +module MenuBar = struct + let cast w : menu_bar obj = Object.try_cast w "GtkMenuBar" + external create : unit -> menu_bar obj = "ml_gtk_menu_bar_new" +end