From: Olivier Andrieu <andrieu at ijm.jussieu.fr>
Message-ID: <16234.49739.381798.15267 at akasha.ijm.jussieu.fr>
Date: Fri, 19 Sep 2003 10:46:03 +0200
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="m5tGbNX+B5"
Content-Transfer-Encoding: 7bit
To: Richard Jones <rich at annexia.org>
Cc: lablgtk at kaba.or.jp
Subject: Re: Exception handling bug in GMain.Main (was: Re: Trapping exceptions at the top level? (repost))
In-Reply-To: <20030919082312.GA32760 at redhat.com>
References: <20030912101328J.garrigue at kurims.kyoto-u.ac.jp>
	<20030918182103.GA26041@redhat.com>
	<16234.5256.398860.836871@karryall.dnsalias.org>
	<20030919082312.GA32760@redhat.com>


--m5tGbNX+B5
Content-Type: text/plain; charset=us-ascii
Content-Description: message body and .signature
Content-Transfer-Encoding: 7bit

 Richard Jones [Friday 19 September 2003] :
 >
 > On Thu, Sep 18, 2003 at 10:24:40PM +0200, Olivier Andrieu wrote:
 > > | let _ = GtkSignal.user_exn_handler := my_exn_handler
 > 
 > user_exn_handler is something you added?

Yes, here's a patch. But maybe Jacques has a better solution than just
trapping every exception.

-- 
   Olivier

--m5tGbNX+B5
Content-Type: text/plain
Content-Disposition: attachment
Content-Transfer-Encoding: 7bit

Index: gtkSignal.ml
===================================================================
RCS file: /staff2/garrigue/repos/lablgtk/src/gtkSignal.ml,v
retrieving revision 1.12
diff -u -u -r1.12 gtkSignal.ml
--- gtkSignal.ml	24 Jun 2003 09:20:03 -0000	1.12
+++ gtkSignal.ml	19 Sep 2003 08:39:57 -0000
@@ -27,6 +27,14 @@
   !exit_callback ();
   res
 
+let default_handler = 
+    (fun exn -> 
+      Printf.eprintf "caught exn: '%s'" (Printexc.to_string exn) ;
+      flush stderr)
+let user_exn_handler = ref default_handler
+let exn_handler exn =
+  try !user_exn_handler exn with _ -> ()
+
 external connect_by_name :
   'a obj -> name:string -> callback:g_closure -> after:bool -> id
   = "ml_g_signal_connect_closure"
@@ -40,7 +48,7 @@
       with exn -> Some exn
     in
     if pop_callback old then emit_stop_by_name obj ~name:sgn.name;
-    Gaux.may ~f:raise exn
+    Gaux.may ~f:exn_handler exn
   in
   connect_by_name obj ~name:sgn.name ~callback:(Closure.create callback) ~after
 external handler_block : 'a obj -> id -> unit
Index: gtkSignal.mli
===================================================================
RCS file: /staff2/garrigue/repos/lablgtk/src/gtkSignal.mli,v
retrieving revision 1.8
diff -u -u -r1.8 gtkSignal.mli
--- gtkSignal.mli	24 Jun 2003 09:20:03 -0000	1.8
+++ gtkSignal.mli	19 Sep 2003 08:39:57 -0000
@@ -15,6 +15,9 @@
        Be careful about where you use it, since the concept of current
        signal may be tricky. *)
 
+val default_handler  : exn -> unit
+val user_exn_handler : (exn -> unit) ref
+
 val connect :
   sgn:('a, 'b) t -> callback:'b -> ?after:bool -> 'a obj -> id
     (* You may use [stop_emit] inside the callback *)

--m5tGbNX+B5--