+++ /dev/null
-(* $Id$ *)
-
-open Gaux
-open Gtk
-open Tags
-open GtkBase
-
-module Alignment = struct
- let cast w : alignment obj = Object.try_cast w "GtkAlignment"
- external create :
- x:clampf -> y:clampf -> xscale:clampf -> yscale:clampf -> alignment obj
- = "ml_gtk_alignment_new"
- let create ?(x=0.5) ?(y=0.5) ?(xscale=1.) ?(yscale=1.) () =
- create ~x ~y ~xscale ~yscale
- external set :
- ?x:clampf -> ?y:clampf -> ?xscale:clampf -> ?yscale:clampf ->
- [>`alignment] obj -> unit
- = "ml_gtk_alignment_set"
-end
-
-module EventBox = struct
- let cast w : event_box obj = Object.try_cast w "GtkEventBox"
- external create : unit -> event_box obj = "ml_gtk_event_box_new"
-end
-
-module Frame = struct
- let cast w : frame obj = Object.try_cast w "GtkFrame"
- external coerce : [>`frame] obj -> frame obj = "%identity"
- external create : string -> frame obj = "ml_gtk_frame_new"
- external set_label : [>`frame] obj -> string -> unit
- = "ml_gtk_frame_set_label"
- external set_label_align : [>`frame] obj -> x:clampf -> y:clampf -> unit
- = "ml_gtk_frame_set_label_align"
- external set_shadow_type : [>`frame] obj -> shadow_type -> unit
- = "ml_gtk_frame_set_shadow_type"
- external get_label_xalign : [>`frame] obj -> float
- = "ml_gtk_frame_get_label_xalign"
- external get_label_yalign : [>`frame] obj -> float
- = "ml_gtk_frame_get_label_yalign"
- let set_label_align' ?x ?y w =
- set_label_align w
- ~x:(may_default get_label_xalign w ~opt:x)
- ~y:(may_default get_label_yalign w ~opt:y)
- let set ?label ?label_xalign ?label_yalign ?shadow_type w =
- may label ~f:(set_label w);
- if label_xalign <> None || label_yalign <> None then
- set_label_align' w ?x:label_xalign ?y:label_yalign;
- may shadow_type ~f:(set_shadow_type w)
-end
-
-module AspectFrame = struct
- let cast w : aspect_frame obj = Object.try_cast w "GtkAspectFrame"
- external create :
- label:string -> xalign:clampf ->
- yalign:clampf -> ratio:float -> obey_child:bool -> aspect_frame obj
- = "ml_gtk_aspect_frame_new"
- let create ?(label="") ?(xalign=0.5) ?(yalign=0.5)
- ?(ratio=1.0) ?(obey_child=true) () =
- create ~label ~xalign ~yalign ~ratio ~obey_child
- external set :
- [>`aspect] obj ->
- xalign:clampf -> yalign:clampf -> ratio:float -> obey_child:bool -> unit
- = "ml_gtk_aspect_frame_set"
- external get_xalign : [>`aspect] obj -> clampf
- = "ml_gtk_aspect_frame_get_xalign"
- external get_yalign : [>`aspect] obj -> clampf
- = "ml_gtk_aspect_frame_get_yalign"
- external get_ratio : [>`aspect] obj -> clampf
- = "ml_gtk_aspect_frame_get_ratio"
- external get_obey_child : [>`aspect] obj -> bool
- = "ml_gtk_aspect_frame_get_obey_child"
- let set ?xalign ?yalign ?ratio ?obey_child w =
- if xalign <> None || yalign <> None || ratio <> None || obey_child <> None
- then set w
- ~xalign:(may_default get_xalign w ~opt:xalign)
- ~yalign:(may_default get_yalign w ~opt:yalign)
- ~ratio:(may_default get_ratio w ~opt:ratio)
- ~obey_child:(may_default get_obey_child w ~opt:obey_child)
-end
-
-module HandleBox = struct
- let cast w : handle_box obj = Object.try_cast w "GtkHandleBox"
- external create : unit -> handle_box obj = "ml_gtk_handle_box_new"
- external set_shadow_type : [>`handlebox] obj -> shadow_type -> unit =
- "ml_gtk_handle_box_set_shadow_type"
- external set_handle_position : [>`handlebox] obj -> position -> unit =
- "ml_gtk_handle_box_set_handle_position"
- external set_snap_edge : [>`handlebox] obj -> position -> unit =
- "ml_gtk_handle_box_set_snap_edge"
- module Signals = struct
- open GtkSignal
- let child_attached : ([>`handlebox],_) t =
- { name = "child_attached"; marshaller = Widget.Signals.marshal }
- let child_detached : ([>`handlebox],_) t =
- { name = "child_detached"; marshaller = Widget.Signals.marshal }
- end
-end
-
-module Viewport = struct
- let cast w : viewport obj = Object.try_cast w "GtkViewport"
- external create :
- [>`adjustment] optobj -> [>`adjustment] optobj -> viewport obj
- = "ml_gtk_viewport_new"
- let create ?hadjustment ?vadjustment () =
- create (Gpointer.optboxed hadjustment) (Gpointer.optboxed vadjustment)
- external get_hadjustment : [>`viewport] obj -> adjustment obj
- = "ml_gtk_viewport_get_hadjustment"
- external get_vadjustment : [>`viewport] obj -> adjustment obj
- = "ml_gtk_viewport_get_vadjustment"
- external set_hadjustment : [>`viewport] obj -> [>`adjustment] obj -> unit
- = "ml_gtk_viewport_set_hadjustment"
- external set_vadjustment : [>`viewport] obj -> [>`adjustment] obj -> unit
- = "ml_gtk_viewport_set_vadjustment"
- external set_shadow_type : [>`viewport] obj -> shadow_type -> unit
- = "ml_gtk_viewport_set_shadow_type"
- let set ?hadjustment ?vadjustment ?shadow_type w =
- may hadjustment ~f:(set_hadjustment w);
- may vadjustment ~f:(set_vadjustment w);
- may shadow_type ~f:(set_shadow_type w)
-end
-
-module ScrolledWindow = struct
- let cast w : scrolled_window obj = Object.try_cast w "GtkScrolledWindow"
- external create :
- [>`adjustment] optobj -> [>`adjustment] optobj -> scrolled_window obj
- = "ml_gtk_scrolled_window_new"
- let create ?hadjustment ?vadjustment () =
- create (Gpointer.optboxed hadjustment) (Gpointer.optboxed vadjustment)
- external set_hadjustment : [>`scrolled] obj -> [>`adjustment] obj -> unit
- = "ml_gtk_scrolled_window_set_hadjustment"
- external set_vadjustment : [>`scrolled] obj -> [>`adjustment] obj -> unit
- = "ml_gtk_scrolled_window_set_vadjustment"
- external get_hadjustment : [>`scrolled] obj -> adjustment obj
- = "ml_gtk_scrolled_window_get_hadjustment"
- external get_vadjustment : [>`scrolled] obj -> adjustment obj
- = "ml_gtk_scrolled_window_get_vadjustment"
- external set_policy : [>`scrolled] obj -> policy_type -> policy_type -> unit
- = "ml_gtk_scrolled_window_set_policy"
- external add_with_viewport : [>`scrolled] obj -> [>`widget] obj -> unit
- = "ml_gtk_scrolled_window_add_with_viewport"
- external get_hscrollbar_policy : [>`scrolled] obj -> policy_type
- = "ml_gtk_scrolled_window_get_hscrollbar_policy"
- external get_vscrollbar_policy : [>`scrolled] obj -> policy_type
- = "ml_gtk_scrolled_window_get_vscrollbar_policy"
- external set_placement : [>`scrolled] obj -> corner_type -> unit
- = "ml_gtk_scrolled_window_set_placement"
- let set_policy' ?hpolicy ?vpolicy w =
- set_policy w
- (may_default get_hscrollbar_policy w ~opt:hpolicy)
- (may_default get_vscrollbar_policy w ~opt:vpolicy)
- let set ?hpolicy ?vpolicy ?placement w =
- if hpolicy <> None || vpolicy <> None then
- set_policy' w ?hpolicy ?vpolicy;
- may placement ~f:(set_placement w)
-end
-
-module Socket = struct
- let cast w : socket obj = Object.try_cast w "GtkSocket"
- external coerce : [>`socket] obj -> socket obj = "%identity"
- external create : unit -> socket obj = "ml_gtk_socket_new"
- external steal : [>`socket] obj -> Gdk.xid -> unit = "ml_gtk_socket_steal"
-end
-
-(*
-module Invisible = struct
- let cast w : socket obj = Object.try_cast w "GtkInvisible"
- external coerce : [>`invisible] obj -> invisible obj = "%identity"
- external create : unit -> invisible obj = "ml_gtk_invisible_new"
-end
-*)
projects / helm.git / blobdiff