helm/DEVEL/lablgtk/lablgtk_20001129-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