]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gBin.ml
- DoubleTypeInference.does_not_occur exposed
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / gBin.ml
1 (* $Id$ *)
2
3 open Gaux
4 open Gtk
5 open GtkBase
6 open GtkBin
7 open GObj
8 open GContainer
9
10 class scrolled_window obj = object
11   inherit container_full (obj : Gtk.scrolled_window obj)
12   method hadjustment =
13     new GData.adjustment (ScrolledWindow.get_hadjustment obj)
14   method vadjustment =
15     new GData.adjustment (ScrolledWindow.get_vadjustment obj)
16   method set_hadjustment adj =
17     ScrolledWindow.set_hadjustment obj (GData.as_adjustment adj)
18   method set_vadjustment adj =
19     ScrolledWindow.set_vadjustment obj (GData.as_adjustment adj)
20   method set_hpolicy hpolicy = ScrolledWindow.set_policy' obj ~hpolicy
21   method set_vpolicy vpolicy = ScrolledWindow.set_policy' obj ~vpolicy
22   method set_placement = ScrolledWindow.set_placement obj
23   method add_with_viewport w =
24     ScrolledWindow.add_with_viewport obj (as_widget w)
25 end
26
27 let scrolled_window ?hadjustment ?vadjustment ?hpolicy ?vpolicy
28     ?placement ?border_width ?width ?height ?packing ?show () =
29   let w =
30     ScrolledWindow.create ()
31       ?hadjustment:(may_map ~f:GData.as_adjustment hadjustment)
32       ?vadjustment:(may_map ~f:GData.as_adjustment vadjustment) in
33   ScrolledWindow.set w ?hpolicy ?vpolicy ?placement;
34   Container.set w ?border_width ?width ?height;
35   pack_return (new scrolled_window w) ~packing ~show
36
37 class event_box obj = object
38   inherit container_full (obj : Gtk.event_box obj)
39   method event = new GObj.event_ops obj
40 end
41
42 let event_box ?border_width ?width ?height ?packing ?show () =
43   let w = EventBox.create () in
44   Container.set w ?border_width ?width ?height;
45   pack_return (new event_box w) ~packing ~show
46
47 class handle_box_signals obj = object
48   inherit container_signals obj
49   method child_attached ~callback =
50     GtkSignal.connect ~sgn:HandleBox.Signals.child_attached obj ~after
51       ~callback:(fun obj -> callback (new widget obj))
52   method child_detached ~callback =
53     GtkSignal.connect ~sgn:HandleBox.Signals.child_detached obj ~after
54       ~callback:(fun obj -> callback (new widget obj))
55 end
56
57 class handle_box obj = object
58   inherit container (obj : Gtk.handle_box obj)
59   method set_shadow_type     = HandleBox.set_shadow_type     obj
60   method set_handle_position = HandleBox.set_handle_position obj
61   method set_snap_edge       = HandleBox.set_snap_edge       obj
62   method connect = new handle_box_signals obj
63   method event = new GObj.event_ops obj
64 end
65
66 let handle_box ?border_width ?width ?height ?packing ?show () =
67   let w = HandleBox.create () in
68   let () = Container.set w ?border_width ?width ?height in
69   pack_return (new handle_box w) ~packing ~show
70
71 class frame_skel obj = object
72   inherit container obj
73   method set_label = Frame.set_label obj
74   method set_label_align ?x ?y () = Frame.set_label_align' obj ?x ?y
75   method set_shadow_type = Frame.set_shadow_type obj
76 end
77
78 class frame obj = object
79   inherit frame_skel (Frame.coerce obj)
80   method connect = new container_signals obj
81 end
82
83 let frame ?(label="") ?label_xalign ?label_yalign ?shadow_type
84     ?border_width ?width ?height ?packing ?show () =
85   let w = Frame.create label in
86   Frame.set w ?label_xalign ?label_yalign ?shadow_type;
87   Container.set w ?border_width ?width ?height;
88   pack_return (new frame w) ~packing ~show
89
90 class aspect_frame obj = object
91   inherit frame_skel (obj : Gtk.aspect_frame obj)
92   method connect = new container_signals obj
93   method set_alignment ?x ?y () = AspectFrame.set obj ?xalign:x ?yalign:y
94   method set_ratio ratio = AspectFrame.set obj ~ratio
95   method set_obey_child obey_child = AspectFrame.set obj ~obey_child
96 end
97
98 let aspect_frame ?label ?xalign ?yalign ?ratio ?obey_child
99     ?label_xalign ?label_yalign ?shadow_type
100     ?border_width ?width ?height ?packing ?show () =
101   let w =
102     AspectFrame.create ?label ?xalign ?yalign ?ratio ?obey_child () in
103   Frame.set w ?label_xalign ?label_yalign ?shadow_type;
104   Container.set w ?border_width ?width ?height;
105   pack_return (new aspect_frame w) ~packing ~show
106
107 class viewport obj = object
108   inherit container_full (obj : Gtk.viewport obj)
109   method event = new event_ops obj
110   method set_hadjustment adj =
111     Viewport.set_hadjustment obj (GData.as_adjustment adj)
112   method set_vadjustment adj =
113     Viewport.set_vadjustment obj (GData.as_adjustment adj)
114   method set_shadow_type = Viewport.set_shadow_type obj
115   method hadjustment = new GData.adjustment (Viewport.get_hadjustment obj)
116   method vadjustment = new GData.adjustment (Viewport.get_vadjustment obj)
117 end
118
119 let viewport ?hadjustment ?vadjustment ?shadow_type
120     ?border_width ?width ?height ?packing ?show () =
121   let w = Viewport.create ()
122       ?hadjustment:(may_map ~f:GData.as_adjustment hadjustment)
123       ?vadjustment:(may_map ~f:GData.as_adjustment vadjustment) in
124   may shadow_type ~f:(Viewport.set_shadow_type w);
125   Container.set w ?border_width ?width ?height;
126   pack_return (new viewport w) ~packing ~show
127
128 class alignment obj = object
129   inherit container_full (obj : Gtk.alignment obj)
130   method set_alignment ?x ?y () = Alignment.set ?x ?y obj
131   method set_scale ?x ?y () = Alignment.set ?xscale:x ?yscale:y obj
132 end
133
134 let alignment ?x ?y ?xscale ?yscale
135     ?border_width ?width ?height ?packing ?show () =
136   let w = Alignment.create ?x ?y ?xscale ?yscale () in
137   Container.set w ?border_width ?width ?height;
138   pack_return (new alignment w) ~packing ~show
139   
140 let alignment_cast w = new alignment (Alignment.cast w#as_widget)
141
142 class socket obj = object (self)
143   inherit container_full (obj : Gtk.socket obj)
144   method steal = Socket.steal obj
145   method xwindow =
146     self#misc#realize ();
147     Gdk.Window.get_xwindow self#misc#window
148 end
149
150 let socket ?border_width ?width ?height ?packing ?show () =
151   let w = Socket.create () in
152   Container.set w ?border_width ?width ?height;
153   pack_return (new socket w) ?packing ?show