]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkWindow.ml
SQL quoting fixed in relation.ml
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / gtkWindow.ml
1 (* $Id$ *)
2
3 open Gaux
4 open Gtk
5 open Tags
6 open GtkBase
7
8 module Window = struct
9   let cast w : window obj = Object.try_cast w "GtkWindow"
10   external coerce : [>`window] obj -> window obj = "%identity"
11   external create : window_type -> window obj = "ml_gtk_window_new"
12   external set_title : [>`window] obj -> string -> unit
13       = "ml_gtk_window_set_title"
14   external set_wmclass : [>`window] obj -> name:string -> clas:string -> unit
15       = "ml_gtk_window_set_title"
16   external get_wmclass_name : [>`window] obj -> string
17       = "ml_gtk_window_get_wmclass_name"
18   external get_wmclass_class : [>`window] obj -> string
19       = "ml_gtk_window_get_wmclass_class"
20   (* set_focus/default are called by Widget.grab_focus/default *)
21   external set_focus : [>`window] obj -> [>`widget] obj -> unit
22       = "ml_gtk_window_set_focus"
23   external set_default : [>`window] obj -> [>`widget] obj -> unit
24       = "ml_gtk_window_set_default"
25   external set_policy :
26       [>`window] obj ->
27       allow_shrink:bool -> allow_grow:bool -> auto_shrink:bool -> unit
28       = "ml_gtk_window_set_policy"
29   external get_allow_shrink : [>`window] obj -> bool
30       = "ml_gtk_window_get_allow_shrink"
31   external get_allow_grow : [>`window] obj -> bool
32       = "ml_gtk_window_get_allow_grow"
33   external get_auto_shrink : [>`window] obj -> bool
34       = "ml_gtk_window_get_auto_shrink"
35   external activate_focus : [>`window] obj -> bool
36       = "ml_gtk_window_activate_focus"
37   external activate_default : [>`window] obj -> bool
38       = "ml_gtk_window_activate_default"
39   external set_modal : [>`window] obj -> bool -> unit
40       = "ml_gtk_window_set_modal"
41   external set_default_size :
42       [>`window] obj -> width:int -> height:int -> unit
43       = "ml_gtk_window_set_default_size"
44   external set_position : [>`window] obj -> window_position -> unit
45       = "ml_gtk_window_set_position"
46   external set_transient_for : [>`window] obj ->[>`window] obj -> unit
47       = "ml_gtk_window_set_transient_for"
48
49   let set_wmclass ?name ?clas:wm_class w =
50     set_wmclass w ~name:(may_default get_wmclass_name w ~opt:name)
51       ~clas:(may_default get_wmclass_class w ~opt:wm_class)
52   let set_policy ?allow_shrink ?allow_grow ?auto_shrink w =
53     set_policy w
54       ~allow_shrink:(may_default get_allow_shrink w ~opt:allow_shrink)
55       ~allow_grow:(may_default get_allow_grow w ~opt:allow_grow)
56       ~auto_shrink:(may_default get_auto_shrink w ~opt:auto_shrink)
57   let set ?title ?wm_name ?wm_class ?position ?allow_shrink ?allow_grow
58       ?auto_shrink ?modal ?(x = -2) ?(y = -2) w =
59     may title ~f:(set_title w);
60     if wm_name <> None || wm_class <> None then
61       set_wmclass w ?name:wm_name ?clas:wm_class;
62     may position ~f:(set_position w);
63     if allow_shrink <> None || allow_grow <> None || auto_shrink <> None then
64       set_policy w ?allow_shrink ?allow_grow ?auto_shrink;
65     may ~f:(set_modal w) modal;
66     if x <> -2 || y <> -2 then Widget.set_uposition w ~x ~y
67   external add_accel_group : [>`window] obj -> accel_group -> unit
68       = "ml_gtk_window_add_accel_group"
69   external remove_accel_group :
70       [>`window] obj -> accel_group -> unit
71       = "ml_gtk_window_remove_accel_group"
72   external activate_focus : [>`window] obj -> unit
73       = "ml_gtk_window_activate_focus"
74   external activate_default : [>`window] obj -> unit
75       = "ml_gtk_window_activate_default"
76   module Signals = struct
77     open GtkSignal
78     let move_resize : ([>`window],_) t =
79       { name = "move_resize"; marshaller = marshal_unit }
80     let set_focus : ([>`window],_) t =
81       { name = "set_focus"; marshaller = Widget.Signals.marshal_opt }
82   end
83 end
84
85 module Dialog = struct
86   let cast w : dialog obj = Object.try_cast w "GtkDialog"
87   external coerce : [>`dialog] obj -> dialog obj = "%identity"
88   external create : unit -> dialog obj = "ml_gtk_dialog_new"
89   external action_area : [>`dialog] obj -> box obj
90       = "ml_GtkDialog_action_area"
91   external vbox : [>`dialog] obj -> box obj
92       = "ml_GtkDialog_vbox"
93 end
94
95 module InputDialog = struct
96   let cast w : input_dialog obj = Object.try_cast w "GtkInputDialog"
97   external create : unit -> input_dialog obj = "ml_gtk_input_dialog_new"
98   module Signals = struct
99     open GtkSignal
100     let enable_device : ([>`inputdialog],_) t =
101       { name = "enable_device"; marshaller = marshal_int }
102     let disable_device : ([>`inputdialog],_) t =
103       { name = "disable_device"; marshaller = marshal_int }
104   end
105 end
106
107 module FileSelection = struct
108   let cast w : file_selection obj = Object.try_cast w "GtkFileSelection"
109   external create : string -> file_selection obj = "ml_gtk_file_selection_new"
110   external set_filename : [>`filesel] obj -> string -> unit
111       = "ml_gtk_file_selection_set_filename"
112   external get_filename : [>`filesel] obj -> string
113       = "ml_gtk_file_selection_get_filename"
114   external show_fileop_buttons : [>`filesel] obj -> unit
115       = "ml_gtk_file_selection_show_fileop_buttons"
116   external hide_fileop_buttons : [>`filesel] obj -> unit
117       = "ml_gtk_file_selection_hide_fileop_buttons"
118   external get_ok_button : [>`filesel] obj -> button obj
119       = "ml_gtk_file_selection_get_ok_button"
120   external get_cancel_button : [>`filesel] obj -> button obj
121       = "ml_gtk_file_selection_get_cancel_button"
122   external get_help_button : [>`filesel] obj -> button obj
123       = "ml_gtk_file_selection_get_help_button"
124   let set_fileop_buttons w = function
125       true -> show_fileop_buttons w
126     | false -> hide_fileop_buttons w
127   let set ?filename ?fileop_buttons w =
128     may filename ~f:(set_filename w);
129     may fileop_buttons ~f:(set_fileop_buttons w)
130 end
131
132 module FontSelectionDialog = struct
133   let cast w : font_selection_dialog obj =
134     Object.try_cast w "GtkFontSelectionDialog"
135   external create : ?title:string -> unit -> font_selection_dialog obj
136       = "ml_gtk_font_selection_dialog_new"
137   external font_selection : [>`fontseldialog] obj -> font_selection obj
138       = "ml_gtk_font_selection_dialog_fontsel"
139   external ok_button : [>`fontseldialog] obj -> button obj
140       = "ml_gtk_font_selection_dialog_ok_button"
141   external apply_button : [>`fontseldialog] obj -> button obj
142       = "ml_gtk_font_selection_dialog_apply_button"
143   external cancel_button : [>`fontseldialog] obj -> button obj
144       = "ml_gtk_font_selection_dialog_cancel_button"
145 (*
146   type null_terminated
147   let null_terminated arg : null_terminated =
148     match arg with None -> Obj.magic Gpointer.raw_null
149     | Some l ->
150         let len = List.length l in
151         let arr = Array.create (len + 1) "" in
152         let rec loop i = function
153             [] -> arr.(i) <- Obj.magic Gpointer.raw_null
154           | s::l -> arr.(i) <- s; loop (i+1) l
155         in loop 0 l;
156         Obj.magic (arr : string array)
157   external get_font : [>`fontseldialog] obj -> Gdk.font
158       = "ml_gtk_font_selection_dialog_get_font"
159   let get_font w =
160     try Some (get_font w) with Gpointer.Null -> None
161   external get_font_name : [>`fontseldialog] obj -> string
162       = "ml_gtk_font_selection_dialog_get_font_name"
163   let get_font_name w =
164     try Some (get_font_name w) with Gpointer.Null -> None
165   external set_font_name : [>`fontseldialog] obj -> string -> unit
166       = "ml_gtk_font_selection_dialog_set_font_name"
167   external set_filter :
168     [>`fontseldialog] obj -> font_filter_type -> font_type list ->
169     null_terminated -> null_terminated -> null_terminated ->
170     null_terminated -> null_terminated -> null_terminated -> unit
171     = "ml_gtk_font_selection_dialog_set_filter_bc"
172       "ml_gtk_font_selection_dialog_set_filter"
173   let set_filter w ?kind:(tl=[`ALL]) ?foundry
174       ?weight ?slant ?setwidth ?spacing ?charset filter =
175     set_filter w filter tl (null_terminated foundry)
176       (null_terminated weight) (null_terminated slant)
177       (null_terminated setwidth) (null_terminated spacing)
178       (null_terminated charset)
179   external get_preview_text : [>`fontseldialog] obj -> string
180       = "ml_gtk_font_selection_dialog_get_preview_text"
181   external set_preview_text : [>`fontseldialog] obj -> string -> unit
182       = "ml_gtk_font_selection_dialog_set_preview_text"
183 *)
184 end
185
186 module Plug = struct
187   let cast w : plug obj = Object.try_cast w "GtkPlug"
188   external create : Gdk.xid -> plug obj = "ml_gtk_plug_new"
189 end