--- /dev/null
+(* $Id$ *)
+
+open GObj
+
+(* The memo class provides an easy way to remember the real class of
+ a widget.
+ Insert all widgets of class in one single t memo, and you can then
+ recover their original ML object with #find.
+*)
+
+class ['a] memo : unit ->
+ object
+ constraint 'a = #widget
+ val tbl : (int, 'a) Hashtbl.t
+ method add : 'a -> unit
+ method find : widget -> 'a
+ method remove : widget -> unit
+ end
+
+(* The ML signal mechanism allows one to add GTK-like signals to
+ arbitrary objects.
+*)
+
+val next_callback_id : unit -> GtkSignal.id
+
+class ['a] signal :
+ unit ->
+ object
+ val mutable callbacks : (GtkSignal.id * ('a -> unit)) list
+ method callbacks : (GtkSignal.id * ('a -> unit)) list
+ method call : 'a -> unit
+ method connect : after:bool -> callback:('a -> unit) -> GtkSignal.id
+ method disconnect : GtkSignal.id -> bool
+ end
+(* As with GTK signals, you can use [GtkSignal.stop_emit] inside a
+ callback to prevent other callbacks from being called. *)
+
+class virtual ml_signals : (GtkSignal.id -> bool) list ->
+ object ('a)
+ val after : bool
+ method after : 'a
+ method disconnect : GtkSignal.id -> unit
+ val mutable disconnectors : (GtkSignal.id -> bool) list
+ end
+class virtual add_ml_signals :
+ 'a Gtk.obj -> (GtkSignal.id -> bool) list ->
+ object
+ method disconnect : GtkSignal.id -> unit
+ val mutable disconnectors : (GtkSignal.id -> bool) list
+ end
+
+(* To add ML signals to a LablGTK object:
+
+ class mywidget_signals obj ~mysignal1 ~mysignal2 = object
+ inherit somewidget_signals obj
+ inherit add_ml_signals obj [mysignal1#disconnect; mysignal2#disconnect]
+ method mysignal1 = mysignal1#connect ~after
+ method mysignal2 = mysignal2#connect ~after
+ end
+
+ class mywidget obj = object (self)
+ inherit somewidget obj
+ val mysignal1 = new signal obj
+ val mysignal2 = new signal obj
+ method connect = new mywidget_signals obj ~mysignal1 ~mysignal2
+ method call1 = mysignal1#call
+ method call2 = mysignal2#call
+ end
+
+ You can also add ML signals to an arbitrary object; just inherit
+ from [ml_signals] in place of [widget_signals]+[add_ml_signals].
+
+ class mysignals ~mysignal1 ~mysignal2 = object
+ inherit ml_signals [mysignal1#disconnect; mysignal2#disconnect]
+ method mysignal1 = mysignal1#connect ~after
+ method mysignal2 = mysignal2#connect ~after
+ end
+*)
+
+(* The variable class provides an easy way to propagate state modifications.
+ A new variable is created by [new variable init]. The [#set] method just
+ calls the [set] signal, which by default only calls [real_set].
+ [real_set] sets the variable and calls [changed] when needed.
+ Deep equality is used to compare values, but check is only done if
+ there are callbacks for [changed].
+*)
+
+class ['a] variable_signals :
+ set:'a signal -> changed:'a signal ->
+ object ('b)
+ val after : bool
+ method after : 'b
+ method set : callback:('a -> unit) -> GtkSignal.id
+ method changed : callback:('a -> unit) -> GtkSignal.id
+ method disconnect : GtkSignal.id -> unit
+ val mutable disconnectors : (GtkSignal.id -> bool) list
+ end
+
+class ['a] variable : 'a ->
+ object
+ val set : 'a signal
+ val changed : 'a signal
+ val mutable x : 'a
+ method connect : 'a variable_signals
+ method get : 'a
+ method set : 'a -> unit
+ method private equal : 'a -> 'a -> bool
+ method private real_set : 'a -> unit
+ end