]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gWindow.ml
.cvsignore files missing
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20001129-0.1.0 / gWindow.ml
1 (* $Id$ *)
2
3 open Gaux
4 open Gtk
5 open GtkBase
6 open GtkWindow
7 open GtkMisc
8 open GObj
9 open GContainer
10
11 class ['a] window_skel obj = object
12   constraint 'a = _ #window_skel
13   inherit container obj
14   method event = new GObj.event_ops obj
15   method as_window = Window.coerce obj
16   method activate_focus () = Window.activate_focus obj
17   method activate_default () = Window.activate_default obj
18   method add_accel_group = Window.add_accel_group obj
19   method set_modal = Window.set_modal obj
20   method set_default_size = Window.set_default_size obj
21   method set_position = Window.set_position obj
22   method set_resize_mode = Container.set_resize_mode obj
23   method set_transient_for (w : 'a) =
24     Window.set_transient_for obj w#as_window
25   method set_title = Window.set_title obj
26   method set_wm_name name = Window.set_wmclass obj ~name
27   method set_wm_class cls = Window.set_wmclass obj ~clas:cls
28   method set_allow_shrink allow_shrink = Window.set_policy obj ~allow_shrink
29   method set_allow_grow allow_grow = Window.set_policy obj ~allow_grow
30   method set_auto_shrink auto_shrink = Window.set_policy obj ~auto_shrink
31   method show () = Widget.show obj
32 end
33
34 class window obj = object
35   inherit [window] window_skel (Window.coerce obj)
36   method connect = new container_signals obj
37 end
38
39 let window ?kind:(t=`TOPLEVEL) ?title ?wm_name ?wm_class ?position
40     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y
41     ?border_width ?width ?height ?(show=false) () =
42   let w = Window.create t in
43   Window.set w ?title ?wm_name ?wm_class ?position
44     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y;
45   Container.set w ?border_width ?width ?height;
46   if show then Widget.show w;
47   new window w
48
49 class dialog obj = object
50   inherit [window] window_skel (Dialog.coerce obj)
51   method connect = new container_signals obj
52   method action_area = new GPack.box (Dialog.action_area obj)
53   method vbox = new GPack.box (Dialog.vbox obj)
54 end
55
56 let dialog ?title ?wm_name ?wm_class ?position ?allow_shrink
57     ?allow_grow ?auto_shrink ?modal ?x ?y ?border_width ?width ?height
58     ?(show=false) () =
59   let w = Dialog.create () in
60   Window.set w ?title ?wm_name ?wm_class ?position
61     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y;
62   Container.set w ?border_width ?width ?height;
63   if show then Widget.show w;
64   new dialog w
65
66 class color_selection_dialog obj = object
67   inherit [window] window_skel (obj : Gtk.color_selection_dialog obj)
68   method connect = new container_signals obj
69   method ok_button =
70     new GButton.button (ColorSelection.ok_button obj)
71   method cancel_button =
72     new GButton.button (ColorSelection.cancel_button obj)
73   method help_button =
74     new GButton.button (ColorSelection.help_button obj)
75   method colorsel =
76     new GMisc.color_selection (ColorSelection.colorsel obj)
77 end
78
79 let color_selection_dialog ?(title="Pick a color")
80     ?wm_name ?wm_class ?position
81     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y
82     ?border_width ?width ?height ?(show=false) () =
83   let w = ColorSelection.create_dialog title in
84   Window.set w ?wm_name ?wm_class ?position
85     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y;
86   Container.set w ?border_width ?width ?height;
87   if show then Widget.show w;
88   new color_selection_dialog w
89
90 class file_selection obj = object
91   inherit [window] window_skel (obj : Gtk.file_selection obj)
92   method connect = new container_signals obj
93   method set_filename = FileSelection.set_filename obj
94   method get_filename = FileSelection.get_filename obj
95   method set_fileop_buttons = FileSelection.set_fileop_buttons obj
96   method ok_button = new GButton.button (FileSelection.get_ok_button obj)
97   method cancel_button =
98     new GButton.button (FileSelection.get_cancel_button obj)
99   method help_button = new GButton.button (FileSelection.get_help_button obj)
100 end
101
102 let file_selection ?(title="Choose a file") ?filename
103     ?(fileop_buttons=false)
104     ?wm_name ?wm_class ?position
105     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y
106     ?border_width ?width ?height ?(show=false) () =
107   let w = FileSelection.create title in
108   FileSelection.set w ?filename ~fileop_buttons;
109   Window.set w ?wm_name ?wm_class ?position
110     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y;
111   Container.set w ?border_width ?width ?height;
112   if show then Widget.show w;
113   new file_selection w
114
115 class font_selection_dialog obj = object
116   inherit [window] window_skel (obj : Gtk.font_selection_dialog obj)
117   method connect = new container_signals obj
118 (*
119   method font = FontSelectionDialog.get_font obj
120   method font_name = FontSelectionDialog.get_font_name obj
121   method set_font_name = FontSelectionDialog.set_font_name obj
122   method preview_text = FontSelectionDialog.get_preview_text obj
123   method set_preview_text = FontSelectionDialog.set_preview_text obj
124   method set_filter = FontSelectionDialog.set_filter obj
125 *)
126   method selection =
127     new GMisc.font_selection (FontSelectionDialog.font_selection obj)
128   method ok_button =  new GButton.button (FontSelectionDialog.ok_button obj)
129   method apply_button =
130     new GButton.button (FontSelectionDialog.apply_button obj)
131   method cancel_button =
132     new GButton.button (FontSelectionDialog.cancel_button obj)
133 end
134
135 let font_selection_dialog ?title ?wm_name ?wm_class ?position
136     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y
137     ?border_width ?width ?height ?(show=false) () =
138   let w = FontSelectionDialog.create ?title () in
139   Window.set w ?wm_name ?wm_class ?position
140     ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y;
141   Container.set w ?border_width ?width ?height;
142   if show then Widget.show w;
143   new font_selection_dialog w
144
145 class plug (obj : Gtk.plug obj) = window obj
146
147 let plug ~window:xid ?border_width ?width ?height ?(show=false) () =
148   let w = Plug.create xid in
149   Container.set w ?border_width ?width ?height;
150   if show then Widget.show w;
151   new plug w