(* $Id$ *)

open Gaux
open Gtk
open GtkBase
open GObj
open GData

class focus obj = object
  val obj = obj
  method circulate = Container.focus obj
  method set (child : widget option) =
    let child = may_map child ~f:(fun x -> x#as_widget) in
    Container.set_focus_child obj (Gpointer.optboxed child)
  method set_hadjustment adj =
    Container.set_focus_hadjustment obj
      (Gpointer.optboxed (may_map adj ~f:as_adjustment))
  method set_vadjustment adj =
    Container.set_focus_vadjustment obj
      (Gpointer.optboxed (may_map adj ~f:as_adjustment))
end

class container obj = object (self)
  inherit widget obj
  method add w =
    (* Hack to avoid creating a bin class *)
    if GtkBase.Object.is_a obj "GtkBin" && Container.children obj <> [] then
      raise (Gtk.Error "GContainer.container#add: already full");
    Container.add obj (as_widget w)
  method remove w = Container.remove obj (as_widget w)
  method children = List.map ~f:(new widget) (Container.children obj)
  method set_border_width = Container.set_border_width obj
  method focus = new focus obj
end

class container_signals obj = object
  inherit widget_signals obj
  method add ~callback =
    GtkSignal.connect ~sgn:Container.Signals.add obj ~after
      ~callback:(fun w -> callback (new widget w))
  method remove ~callback =
    GtkSignal.connect ~sgn:Container.Signals.remove obj ~after
      ~callback:(fun w -> callback (new widget w))
end

class container_full obj = object
  inherit container obj
  method connect = new container_signals obj
end

let cast_container (w : widget) =
  new container_full (GtkBase.Container.cast w#as_widget)

class virtual ['a] item_container obj = object (self)
  inherit widget obj
  method add (w : 'a) =
    Container.add obj w#as_item
  method remove (w : 'a) =
    Container.remove obj w#as_item
  method private virtual wrap : Gtk.widget obj -> 'a
  method children : 'a list =
    List.map ~f:self#wrap (Container.children obj)
  method set_border_width = Container.set_border_width obj
  method focus = new focus obj
  method virtual insert : 'a -> pos:int -> unit
  method append (w : 'a) = self#insert w ~pos:(-1)
  method prepend (w : 'a) = self#insert w ~pos:0
end

class item_signals obj = object
  inherit container_signals obj
  method select = GtkSignal.connect ~sgn:Item.Signals.select obj ~after
  method deselect = GtkSignal.connect ~sgn:Item.Signals.deselect obj ~after
  method toggle = GtkSignal.connect ~sgn:Item.Signals.toggle obj ~after
end