Re: [bugreport] lablgtk un{st,us}able

[Sven Luther <luther@dpt-info.u-strasbg.fr>]

On Thu, Jan 23, 2003 at 10:47:04AM +0100, Claudio Sacerdoti Coen wrote:
>  Hi Sven,
> 
> > Yes, i will add such a think to the package, i have to rebuild it
> > anyway, since :
> 
>  Since you are going to rebuild it anyway, can you also apply the
>  patch Jacques sent a couple of days ago to close my bug-report
>  about thread unsafety of GToolbox? It was sent on the m.l. of lablgtk.

This one (posted on January 22) ?

Index: src/gtkMain.ml
===================================================================
RCS file: /staff2/garrigue/repos/lablgtk/src/gtkMain.ml,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- src/gtkMain.ml	2002/07/16 07:54:05	1.18
+++ src/gtkMain.ml	2003/01/22 01:07:13	1.19
@@ -37,12 +37,14 @@
     locale
   open Glib
   let loops = ref [] 
-  let main () =
+  let default_main () =
     let loop = (Main.create true) in
     loops := loop :: !loops;
     while Main.is_running loop do Main.iteration true done;
     if !loops <> [] then loops := List.tl !loops
-  and quit () = if !loops <> [] then Main.quit (List.hd !loops)
+  let main_func = ref default_main
+  let main () = !main_func ()
+  let quit () = if !loops <> [] then Main.quit (List.hd !loops)
   external get_version : unit -> int * int * int = "ml_gtk_get_version"
   let version = get_version ()
 end
Index: src/gtkThread.ml
===================================================================
RCS file: /staff2/garrigue/repos/lablgtk/src/gtkThread.ml,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- src/gtkThread.ml	2002/08/08 10:03:40	1.10
+++ src/gtkThread.ml	2003/01/22 01:07:13	1.11
@@ -38,7 +38,7 @@
 (* We check first whether there are some event pending, and run
    some iterations. We then need to delay, thus focing a thread switch. *)
 
-let main () =
+let thread_main () =
   let old_id = !loop_id in
   try
     let loop = (Glib.Main.create true) in
@@ -59,6 +59,10 @@
     Main.loops := List.tl !Main.loops;
     loop_id := old_id;
     raise exn
+
+let main () =
+  GtkMain.Main.main_func := thread_main;
+  thread_main ()
       
 let start = Thread.create main
 
Index: src/gtkThread.mli
===================================================================
RCS file: /staff2/garrigue/repos/lablgtk/src/gtkThread.mli,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- src/gtkThread.mli	2002/08/08 10:03:40	1.2
+++ src/gtkThread.mli	2003/01/22 01:07:13	1.3
@@ -2,10 +2,14 @@
 
 (* Basic functions *)
 
-(** The main loop to use with threads. GMain.main does not work! *)
+(** The main loop to use with threads. [GMain.main] does not work!
+    This changes [GMain.main] to call [threaded_main] rather than
+    [GtkMain.Main.default_main], so subsequent calls will work. *)
 val main : unit -> unit
 (** Start the main loop in another thread. *)
 val start : unit -> Thread.t
+(** The real main function *)
+val thread_main : unit -> unit
 
 (* Jobs are needed for windows, as you cannot do GTK work from
    another thread.