+++ /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