X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2FgtkNew.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2FgtkNew.ml;h=0000000000000000000000000000000000000000;hb=e108abe5c0b4eb841c4ad332229a6c0e57e70079;hp=532a709d7917bed74bd7265075f405f86b237f37;hpb=1456c337a60f6677ee742ff7891d43fc382359a9;p=helm.git diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkNew.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkNew.ml deleted file mode 100644 index 532a709d7..000000000 --- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkNew.ml +++ /dev/null @@ -1,56 +0,0 @@ -(* $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 *)