+++ /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