This commit was manufactured by cvs2svn to create branch 'init'.

[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / gtkSignal.ml

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkSignal.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkSignal.ml
deleted file mode 100644 (file)
index 8fa4602..0000000
--- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkSignal.ml
+++ /dev/null
@@ -1,65 +0,0 @@
-(* $Id$ *)
-
-open Gtk
-
-type id
-type ('a,'b) t =
- { name: string;
-   marshaller: ('b -> GtkArgv.t -> GtkArgv.data list -> unit) }
-
-let enter_callback = ref (fun () -> ())
-and exit_callback = ref (fun () -> ())
-
-let stop_emit_ref = ref false
-let stop_emit () = stop_emit_ref := true
-
-type saved_state = State of bool
-let push_callback () =
-  !enter_callback ();
-  let old = !stop_emit_ref in
-  stop_emit_ref := false;
-  State old
-
-let pop_callback (State old) =
-  let res = !stop_emit_ref in
-  stop_emit_ref := old;
-  !exit_callback ();
-  res
-
-external connect :
-  'a obj -> name:string -> callback:(GtkArgv.t -> unit) -> after:bool -> id
-  = "ml_gtk_signal_connect"
-external emit_stop_by_name : 'a obj -> name:string -> unit
-  = "ml_gtk_signal_emit_stop_by_name"
-let connect  ~(sgn : ('a, _) t) ~callback ?(after=false) (obj : 'a obj) =
-  let callback argv =
-    let old = push_callback () in
-    let exn =
-      try sgn.marshaller callback argv (GtkArgv.get_args argv); None
-      with exn -> Some exn
-    in
-    if pop_callback old then emit_stop_by_name obj ~name:sgn.name;
-    Gaux.may ~f:raise exn
-  in
-  connect obj ~name:sgn.name ~callback ~after
-external disconnect : 'a obj -> id -> unit
-  = "ml_gtk_signal_disconnect"
-external handler_block : 'a obj -> id -> unit
-  = "ml_gtk_signal_handler_block"
-external handler_unblock : 'a obj -> id -> unit
-  = "ml_gtk_signal_handler_unblock"
-
-let marshal_unit f _ _ = f ()
-let marshal_int f _ = function
-  | GtkArgv.INT n :: _ -> f n
-  | _ -> invalid_arg "GtkSignal.marshal_int"
-
-let emit (obj : 'a obj) ~(sgn : ('a, 'b) t)
-    ~(emitter : 'a obj -> name:string -> 'b) =
-  emitter obj ~name:sgn.name
-external emit_none : 'a obj -> name:string -> unit -> unit
-    = "ml_gtk_signal_emit_none"
-let emit_unit obj ~sgn = emit obj ~emitter:emit_none ~sgn ()
-external emit_int : 'a obj -> name:string -> int -> unit
-    = "ml_gtk_signal_emit_int"
-let emit_int = emit ~emitter:emit_int