X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;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=0000000000000000000000000000000000000000;hp=ffe00e9211ac82f2728705f9152803ac62088635;hb=3ef089a4c58fbe429dd539af6215991ecbe11ee2;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkWindow.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkWindow.ml deleted file mode 100644 index ffe00e921..000000000 --- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkWindow.ml +++ /dev/null @@ -1,189 +0,0 @@ -(* $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