--- /dev/null
+(* $Id$ *)
+
+open Gaux
+open Gtk
+open Tags
+open GtkBase
+
+module Window = struct
+ let cast w : window obj = Object.try_cast w "GtkWindow"
+ external coerce : [>`window] obj -> window obj = "%identity"
+ external create : window_type -> window obj = "ml_gtk_window_new"
+ external set_title : [>`window] obj -> string -> unit
+ = "ml_gtk_window_set_title"
+ external set_wmclass : [>`window] obj -> name:string -> clas:string -> unit
+ = "ml_gtk_window_set_title"
+ external get_wmclass_name : [>`window] obj -> string
+ = "ml_gtk_window_get_wmclass_name"
+ external get_wmclass_class : [>`window] obj -> string
+ = "ml_gtk_window_get_wmclass_class"
+ (* set_focus/default are called by Widget.grab_focus/default *)
+ external set_focus : [>`window] obj -> [>`widget] obj -> unit
+ = "ml_gtk_window_set_focus"
+ external set_default : [>`window] obj -> [>`widget] obj -> unit
+ = "ml_gtk_window_set_default"
+ external set_policy :
+ [>`window] obj ->
+ allow_shrink:bool -> allow_grow:bool -> auto_shrink:bool -> unit
+ = "ml_gtk_window_set_policy"
+ external get_allow_shrink : [>`window] obj -> bool
+ = "ml_gtk_window_get_allow_shrink"
+ external get_allow_grow : [>`window] obj -> bool
+ = "ml_gtk_window_get_allow_grow"
+ external get_auto_shrink : [>`window] obj -> bool
+ = "ml_gtk_window_get_auto_shrink"
+ external activate_focus : [>`window] obj -> bool
+ = "ml_gtk_window_activate_focus"
+ external activate_default : [>`window] obj -> bool
+ = "ml_gtk_window_activate_default"
+ external set_modal : [>`window] obj -> bool -> unit
+ = "ml_gtk_window_set_modal"
+ external set_default_size :
+ [>`window] obj -> width:int -> height:int -> unit
+ = "ml_gtk_window_set_default_size"
+ external set_position : [>`window] obj -> window_position -> unit
+ = "ml_gtk_window_set_position"
+ external set_transient_for : [>`window] obj ->[>`window] obj -> unit
+ = "ml_gtk_window_set_transient_for"
+
+ let set_wmclass ?name ?clas:wm_class w =
+ set_wmclass w ~name:(may_default get_wmclass_name w ~opt:name)
+ ~clas:(may_default get_wmclass_class w ~opt:wm_class)
+ let set_policy ?allow_shrink ?allow_grow ?auto_shrink w =
+ set_policy w
+ ~allow_shrink:(may_default get_allow_shrink w ~opt:allow_shrink)
+ ~allow_grow:(may_default get_allow_grow w ~opt:allow_grow)
+ ~auto_shrink:(may_default get_auto_shrink w ~opt:auto_shrink)
+ let set ?title ?wm_name ?wm_class ?position ?allow_shrink ?allow_grow
+ ?auto_shrink ?modal ?(x = -2) ?(y = -2) w =
+ may title ~f:(set_title w);
+ if wm_name <> None || wm_class <> None then
+ set_wmclass w ?name:wm_name ?clas:wm_class;
+ may position ~f:(set_position w);
+ if allow_shrink <> None || allow_grow <> None || auto_shrink <> None then
+ set_policy w ?allow_shrink ?allow_grow ?auto_shrink;
+ may ~f:(set_modal w) modal;
+ if x <> -2 || y <> -2 then Widget.set_uposition w ~x ~y
+ external add_accel_group : [>`window] obj -> accel_group -> unit
+ = "ml_gtk_window_add_accel_group"
+ external remove_accel_group :
+ [>`window] obj -> accel_group -> unit
+ = "ml_gtk_window_remove_accel_group"
+ external activate_focus : [>`window] obj -> unit
+ = "ml_gtk_window_activate_focus"
+ external activate_default : [>`window] obj -> unit
+ = "ml_gtk_window_activate_default"
+ module Signals = struct
+ open GtkSignal
+ let move_resize : ([>`window],_) t =
+ { name = "move_resize"; marshaller = marshal_unit }
+ let set_focus : ([>`window],_) t =
+ { name = "set_focus"; marshaller = Widget.Signals.marshal_opt }
+ end
+end
+
+module Dialog = struct
+ let cast w : dialog obj = Object.try_cast w "GtkDialog"
+ external coerce : [>`dialog] obj -> dialog obj = "%identity"
+ external create : unit -> dialog obj = "ml_gtk_dialog_new"
+ external action_area : [>`dialog] obj -> box obj
+ = "ml_GtkDialog_action_area"
+ external vbox : [>`dialog] obj -> box obj
+ = "ml_GtkDialog_vbox"
+end
+
+module InputDialog = struct
+ let cast w : input_dialog obj = Object.try_cast w "GtkInputDialog"
+ external create : unit -> input_dialog obj = "ml_gtk_input_dialog_new"
+ module Signals = struct
+ open GtkSignal
+ let enable_device : ([>`inputdialog],_) t =
+ { name = "enable_device"; marshaller = marshal_int }
+ let disable_device : ([>`inputdialog],_) t =
+ { name = "disable_device"; marshaller = marshal_int }
+ end
+end
+
+module FileSelection = struct
+ let cast w : file_selection obj = Object.try_cast w "GtkFileSelection"
+ external create : string -> file_selection obj = "ml_gtk_file_selection_new"
+ external set_filename : [>`filesel] obj -> string -> unit
+ = "ml_gtk_file_selection_set_filename"
+ external get_filename : [>`filesel] obj -> string
+ = "ml_gtk_file_selection_get_filename"
+ external show_fileop_buttons : [>`filesel] obj -> unit
+ = "ml_gtk_file_selection_show_fileop_buttons"
+ external hide_fileop_buttons : [>`filesel] obj -> unit
+ = "ml_gtk_file_selection_hide_fileop_buttons"
+ external get_ok_button : [>`filesel] obj -> button obj
+ = "ml_gtk_file_selection_get_ok_button"
+ external get_cancel_button : [>`filesel] obj -> button obj
+ = "ml_gtk_file_selection_get_cancel_button"
+ external get_help_button : [>`filesel] obj -> button obj
+ = "ml_gtk_file_selection_get_help_button"
+ let set_fileop_buttons w = function
+ true -> show_fileop_buttons w
+ | false -> hide_fileop_buttons w
+ let set ?filename ?fileop_buttons w =
+ may filename ~f:(set_filename w);
+ may fileop_buttons ~f:(set_fileop_buttons w)
+end
+
+module FontSelectionDialog = struct
+ let cast w : font_selection_dialog obj =
+ Object.try_cast w "GtkFontSelectionDialog"
+ external create : ?title:string -> unit -> font_selection_dialog obj
+ = "ml_gtk_font_selection_dialog_new"
+ external font_selection : [>`fontseldialog] obj -> font_selection obj
+ = "ml_gtk_font_selection_dialog_fontsel"
+ external ok_button : [>`fontseldialog] obj -> button obj
+ = "ml_gtk_font_selection_dialog_ok_button"
+ external apply_button : [>`fontseldialog] obj -> button obj
+ = "ml_gtk_font_selection_dialog_apply_button"
+ external cancel_button : [>`fontseldialog] obj -> button obj
+ = "ml_gtk_font_selection_dialog_cancel_button"
+(*
+ type null_terminated
+ let null_terminated arg : null_terminated =
+ match arg with None -> Obj.magic Gpointer.raw_null
+ | Some l ->
+ let len = List.length l in
+ let arr = Array.create (len + 1) "" in
+ let rec loop i = function
+ [] -> arr.(i) <- Obj.magic Gpointer.raw_null
+ | s::l -> arr.(i) <- s; loop (i+1) l
+ in loop 0 l;
+ Obj.magic (arr : string array)
+ external get_font : [>`fontseldialog] obj -> Gdk.font
+ = "ml_gtk_font_selection_dialog_get_font"
+ let get_font w =
+ try Some (get_font w) with Gpointer.Null -> None
+ external get_font_name : [>`fontseldialog] obj -> string
+ = "ml_gtk_font_selection_dialog_get_font_name"
+ let get_font_name w =
+ try Some (get_font_name w) with Gpointer.Null -> None
+ external set_font_name : [>`fontseldialog] obj -> string -> unit
+ = "ml_gtk_font_selection_dialog_set_font_name"
+ external set_filter :
+ [>`fontseldialog] obj -> font_filter_type -> font_type list ->
+ null_terminated -> null_terminated -> null_terminated ->
+ null_terminated -> null_terminated -> null_terminated -> unit
+ = "ml_gtk_font_selection_dialog_set_filter_bc"
+ "ml_gtk_font_selection_dialog_set_filter"
+ let set_filter w ?kind:(tl=[`ALL]) ?foundry
+ ?weight ?slant ?setwidth ?spacing ?charset filter =
+ set_filter w filter tl (null_terminated foundry)
+ (null_terminated weight) (null_terminated slant)
+ (null_terminated setwidth) (null_terminated spacing)
+ (null_terminated charset)
+ external get_preview_text : [>`fontseldialog] obj -> string
+ = "ml_gtk_font_selection_dialog_get_preview_text"
+ external set_preview_text : [>`fontseldialog] obj -> string -> unit
+ = "ml_gtk_font_selection_dialog_set_preview_text"
+*)
+end
+
+module Plug = struct
+ let cast w : plug obj = Object.try_cast w "GtkPlug"
+ external create : Gdk.xid -> plug obj = "ml_gtk_plug_new"
+end
projects / helm.git / blobdiff