X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2FgtkWindow.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2FgtkWindow.ml;h=ffe00e9211ac82f2728705f9152803ac62088635;hb=2ee84a2a641938988703e329aef9fc3c5eb5aacf;hp=0000000000000000000000000000000000000000;hpb=34d83812af9b7064cc8f735c2a78169881140010;p=helm.git

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkWindow.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkWindow.ml
new file mode 100644
index 000000000..ffe00e921
--- /dev/null
+++ b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkWindow.ml
@@ -0,0 +1,189 @@
+(* $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