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