helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkBin.ml

   1 (* $Id$ *)
   2
   3 open Gaux
   4 open Gtk
   5 open Tags
   6 open GtkBase
   7
   8 module Alignment = struct
   9   let cast w : alignment obj = Object.try_cast w "GtkAlignment"
  10   external create :
  11       x:clampf -> y:clampf -> xscale:clampf -> yscale:clampf -> alignment obj
  12       = "ml_gtk_alignment_new"
  13   let create ?(x=0.5) ?(y=0.5) ?(xscale=1.) ?(yscale=1.) () =
  14     create ~x ~y ~xscale ~yscale
  15   external set :
  16       ?x:clampf -> ?y:clampf -> ?xscale:clampf -> ?yscale:clampf ->
  17       [>`alignment] obj -> unit
  18       = "ml_gtk_alignment_set"
  19 end
  20
  21 module EventBox = struct
  22   let cast w : event_box obj = Object.try_cast w "GtkEventBox"
  23   external create : unit -> event_box obj = "ml_gtk_event_box_new"
  24 end
  25
  26 module Frame = struct
  27   let cast w : frame obj = Object.try_cast w "GtkFrame"
  28   external coerce : [>`frame] obj -> frame obj = "%identity"
  29   external create : string -> frame obj = "ml_gtk_frame_new"
  30   external set_label : [>`frame] obj -> string -> unit
  31       = "ml_gtk_frame_set_label"
  32   external set_label_align : [>`frame] obj -> x:clampf -> y:clampf -> unit
  33       = "ml_gtk_frame_set_label_align"
  34   external set_shadow_type : [>`frame] obj -> shadow_type -> unit
  35       = "ml_gtk_frame_set_shadow_type"
  36   external get_label_xalign : [>`frame] obj -> float
  37       = "ml_gtk_frame_get_label_xalign"
  38   external get_label_yalign : [>`frame] obj -> float
  39       = "ml_gtk_frame_get_label_yalign"
  40   let set_label_align' ?x ?y w =
  41     set_label_align w
  42       ~x:(may_default get_label_xalign w ~opt:x)
  43       ~y:(may_default get_label_yalign w ~opt:y)
  44   let set ?label ?label_xalign ?label_yalign ?shadow_type w =
  45     may label ~f:(set_label w);
  46     if label_xalign <> None || label_yalign <> None then
  47       set_label_align' w ?x:label_xalign ?y:label_yalign;
  48     may shadow_type ~f:(set_shadow_type w)
  49 end
  50
  51 module AspectFrame = struct
  52   let cast w : aspect_frame obj = Object.try_cast w "GtkAspectFrame"
  53   external create :
  54       label:string -> xalign:clampf ->
  55       yalign:clampf -> ratio:float -> obey_child:bool -> aspect_frame obj
  56       = "ml_gtk_aspect_frame_new"
  57   let create ?(label="") ?(xalign=0.5) ?(yalign=0.5)
  58       ?(ratio=1.0) ?(obey_child=true) () =
  59     create ~label ~xalign ~yalign ~ratio ~obey_child
  60   external set :
  61       [>`aspect] obj ->
  62       xalign:clampf -> yalign:clampf -> ratio:float -> obey_child:bool -> unit
  63       = "ml_gtk_aspect_frame_set"
  64   external get_xalign : [>`aspect] obj -> clampf
  65       = "ml_gtk_aspect_frame_get_xalign"
  66   external get_yalign : [>`aspect] obj -> clampf
  67       = "ml_gtk_aspect_frame_get_yalign"
  68   external get_ratio : [>`aspect] obj -> clampf
  69       = "ml_gtk_aspect_frame_get_ratio"
  70   external get_obey_child : [>`aspect] obj -> bool
  71       = "ml_gtk_aspect_frame_get_obey_child"
  72   let set ?xalign ?yalign ?ratio ?obey_child w =
  73     if xalign <> None || yalign <> None || ratio <> None || obey_child <> None
  74     then set w
  75         ~xalign:(may_default get_xalign w ~opt:xalign)
  76         ~yalign:(may_default get_yalign w ~opt:yalign)
  77         ~ratio:(may_default get_ratio w ~opt:ratio)
  78         ~obey_child:(may_default get_obey_child w ~opt:obey_child)
  79 end
  80
  81 module HandleBox = struct
  82   let cast w : handle_box obj = Object.try_cast w "GtkHandleBox"
  83   external create : unit -> handle_box obj = "ml_gtk_handle_box_new"
  84   external set_shadow_type : [>`handlebox] obj -> shadow_type -> unit =
  85    "ml_gtk_handle_box_set_shadow_type"
  86   external set_handle_position : [>`handlebox] obj -> position -> unit =
  87    "ml_gtk_handle_box_set_handle_position"
  88   external set_snap_edge : [>`handlebox] obj -> position -> unit =
  89    "ml_gtk_handle_box_set_snap_edge"
  90   module Signals = struct
  91     open GtkSignal
  92     let child_attached : ([>`handlebox],_) t =
  93       { name = "child_attached"; marshaller = Widget.Signals.marshal }
  94     let child_detached : ([>`handlebox],_) t =
  95       { name = "child_detached"; marshaller = Widget.Signals.marshal }
  96   end
  97 end
  98
  99 module Viewport = struct
 100   let cast w : viewport obj = Object.try_cast w "GtkViewport"
 101   external create :
 102       [>`adjustment] optobj -> [>`adjustment] optobj -> viewport obj
 103       = "ml_gtk_viewport_new"
 104   let create ?hadjustment ?vadjustment () =
 105     create (Gpointer.optboxed hadjustment) (Gpointer.optboxed vadjustment)
 106   external get_hadjustment : [>`viewport] obj -> adjustment obj
 107       = "ml_gtk_viewport_get_hadjustment"
 108   external get_vadjustment : [>`viewport] obj -> adjustment obj
 109       = "ml_gtk_viewport_get_vadjustment"
 110   external set_hadjustment : [>`viewport] obj -> [>`adjustment] obj -> unit
 111       = "ml_gtk_viewport_set_hadjustment"
 112   external set_vadjustment : [>`viewport] obj -> [>`adjustment] obj -> unit
 113       = "ml_gtk_viewport_set_vadjustment"
 114   external set_shadow_type : [>`viewport] obj -> shadow_type -> unit
 115       = "ml_gtk_viewport_set_shadow_type"
 116   let set ?hadjustment ?vadjustment ?shadow_type w =
 117     may hadjustment ~f:(set_hadjustment w);
 118     may vadjustment ~f:(set_vadjustment w);
 119     may shadow_type ~f:(set_shadow_type w)
 120 end
 121
 122 module ScrolledWindow = struct
 123   let cast w : scrolled_window obj = Object.try_cast w "GtkScrolledWindow"
 124   external create :
 125       [>`adjustment] optobj -> [>`adjustment] optobj -> scrolled_window obj
 126       = "ml_gtk_scrolled_window_new"
 127   let create ?hadjustment ?vadjustment () =
 128     create (Gpointer.optboxed hadjustment) (Gpointer.optboxed vadjustment)
 129   external set_hadjustment : [>`scrolled] obj -> [>`adjustment] obj -> unit
 130       = "ml_gtk_scrolled_window_set_hadjustment"
 131   external set_vadjustment : [>`scrolled] obj -> [>`adjustment] obj -> unit
 132       = "ml_gtk_scrolled_window_set_vadjustment"
 133   external get_hadjustment : [>`scrolled] obj -> adjustment obj
 134       = "ml_gtk_scrolled_window_get_hadjustment"
 135   external get_vadjustment : [>`scrolled] obj -> adjustment obj
 136       = "ml_gtk_scrolled_window_get_vadjustment"
 137   external set_policy : [>`scrolled] obj -> policy_type -> policy_type -> unit
 138       = "ml_gtk_scrolled_window_set_policy"
 139   external add_with_viewport : [>`scrolled] obj -> [>`widget] obj -> unit
 140       = "ml_gtk_scrolled_window_add_with_viewport"
 141   external get_hscrollbar_policy : [>`scrolled] obj -> policy_type
 142       = "ml_gtk_scrolled_window_get_hscrollbar_policy"
 143   external get_vscrollbar_policy : [>`scrolled] obj -> policy_type
 144       = "ml_gtk_scrolled_window_get_vscrollbar_policy"
 145   external set_placement : [>`scrolled] obj -> corner_type -> unit
 146       = "ml_gtk_scrolled_window_set_placement"
 147   let set_policy' ?hpolicy ?vpolicy w =
 148     set_policy w
 149       (may_default get_hscrollbar_policy w ~opt:hpolicy)
 150       (may_default get_vscrollbar_policy w ~opt:vpolicy)
 151   let set ?hpolicy ?vpolicy ?placement w =
 152     if hpolicy <> None || vpolicy <> None then
 153       set_policy' w ?hpolicy ?vpolicy;
 154     may placement ~f:(set_placement w)
 155 end
 156
 157 module Socket = struct
 158   let cast w : socket obj = Object.try_cast w "GtkSocket"
 159   external coerce : [>`socket] obj -> socket obj = "%identity"
 160   external create : unit -> socket obj = "ml_gtk_socket_new"
 161   external steal : [>`socket] obj -> Gdk.xid -> unit = "ml_gtk_socket_steal"
 162 end
 163
 164 (*
 165 module Invisible = struct
 166   let cast w : socket obj = Object.try_cast w "GtkInvisible"
 167   external coerce : [>`invisible] obj -> invisible obj = "%identity"
 168   external create : unit -> invisible obj = "ml_gtk_invisible_new"
 169 end
 170 *)