(* $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
*)