(* $Id$ *)

open Gtk

type t

(* if you modify this type modify widget_info_array 
   in ml_gtk.c in accordance *)
type object_type =
  | OBJECT  | WIDGET  | MISC  | LABEL  | ACCELLABEL  | TIPSQUERY  | ARROW
  | IMAGE   | PIXMAP  | CONTAINER  | BIN  | ALIGNMENT  | FRAME  | ASPECTFRAME
  | BUTTON  | TOGGLEBUTTON  | CHECKBUTTON  | RADIOBUTTON  | OPTIONMENU
  | ITEM  | MENUITEM  | CHECKMENUITEM  | RADIOMENUITEM  | TEAROFFMENUITEM
  | LISTITEM  | TREEITEM  | WINDOW  | COLORSELECTIONDIALOG  | DIALOG
  | INPUTDIALOG  | FILESELECTION  | FONTSELECTIONDIALOG  | PLUG
  | EVENTBOX  | HANDLEBOX  | SCROLLEDWINDOW  | VIEWPORT  | BOX
  | BUTTONBOX  | HBUTTONBOX  | VBUTTONBOX  | VBOX  | COLORSELECTION
  | GAMMACURVE  | HBOX  | COMBO  | STATUSBAR  | CLIST  | CTREE  | FIXED
  | NOTEBOOK  | FONTSELECTION  | PANED  | HPANED  | VPANED  | LAYOUT
  | LIST  | MENUSHELL  | MENUBAR  | MENU  | PACKER  | SOCKET  | TABLE
  | TOOLBAR  | TREE  | CALENDAR  | DRAWINGAREA  | CURVE  | EDITABLE
  | ENTRY  | SPINBUTTON  | TEXT  | RULER  | HRULER  | VRULER  | RANGE
  | SCALE  | HSCALE  | VSCALE  | SCROLLBAR  | HSCROLLBAR  | VSCROLLBAR
  | SEPARATOR  | HSEPARATOR  | VSEPARATOR  | PREVIEW  | PROGRESS
  | PROGRESSBAR  | DATA  | ADJUSTMENT  | TOOLTIPS  | ITEMFACTORY

external set_ml_class_init  : (t -> unit) -> unit = "set_ml_class_init"
external signal_new : string -> int -> t -> object_type -> int  -> int
    = "ml_gtk_signal_new"
external object_class_add_signals : t -> int array -> int -> unit
    = "ml_gtk_object_class_add_signals"
external type_unique :
    name:string -> parent:object_type -> nsignals:int -> gtk_type
    = "ml_gtk_type_unique"
external type_new : gtk_type -> unit obj
    = "ml_gtk_type_new"

open GtkSignal

let make_new_widget ~name ~parent
    ~(signals : ('a, unit -> unit) GtkSignal.t list) =
  let nsignals = List.length signals in
  let new_type = type_unique ~name ~parent ~nsignals in
  let signal_num_array = Array.create nsignals 0 in
  let class_init_func classe =
    List.fold_left signals ~init:0 ~f:
      (fun i signal ->
	signal_num_array.(i) <- signal_new signal.name 1 classe parent i;
	i+1);
    object_class_add_signals classe signal_num_array nsignals
  in
  new_type,
  (fun () ->
    set_ml_class_init class_init_func;
    type_new new_type)
  (* , signal_num_array *)