2 files changed, 14 insertions, 11 deletions
diff --git a/otherlibs/labltk/support/tkthread.ml b/otherlibs/labltk/support/tkthread.ml
index 0336afe3c0..8a77eb49e3 100644
--- a/otherlibs/labltk/support/tkthread.ml
+++ b/otherlibs/labltk/support/tkthread.ml
@@ -20,20 +20,18 @@ let with_jobs f =
   Mutex.lock m; let y = f jobs in Mutex.unlock m; y
 
 let loop_id = ref None
-let reset () = loop_id := None
-let cannot_sync () =
-  match !loop_id with None -> true
-  | Some id -> Thread.id (Thread.self ()) = id
-
 let gui_safe () =
-  not (Sys.os_type = "Win32") || !loop_id = Some(Thread.id (Thread.self ()))
+  !loop_id = Some(Thread.id (Thread.self ()))
+let running () =
+  !loop_id <> None
 
 let has_jobs () = not (with_jobs Queue.is_empty)
 let n_jobs () = with_jobs Queue.length
 let do_next_job () = with_jobs Queue.take ()
 let async j x = with_jobs (Queue.add (fun () -> j x))
 let sync f x =
-  if cannot_sync () then f x else
+  if !loop_id = None then failwith "Tkthread.sync";
+  if gui_safe () then f x else
   let m = Mutex.create () in
   let res = ref None in
   Mutex.lock m;
@@ -62,6 +60,8 @@ let thread_main () =
     raise exn
 
 let start () =
-  Thread.create thread_main ()
+  let th = Thread.create thread_main () in
+  loop_id := Some (Thread.id th);
+  th
 
 let top = Widget.default_toplevel
diff --git a/otherlibs/labltk/support/tkthread.mli b/otherlibs/labltk/support/tkthread.mli
index ae031e3a47..52b1a76ceb 100644
--- a/otherlibs/labltk/support/tkthread.mli
+++ b/otherlibs/labltk/support/tkthread.mli
@@ -18,7 +18,7 @@
 
 (** Start the main loop in a new GUI thread. Do not use recursively. *) 
 val start : unit -> Thread.t
-(** The actual function executed in the new thread *)
+(** The actual function executed in the GUI thread *)
 val thread_main : unit -> unit
 (** The toplevel widget (an alias of [Widget.default_toplevel]) *)
 val top : Widget.toplevel Widget.widget
@@ -32,10 +32,13 @@ val top : Widget.toplevel Widget.widget
    With sync, beware of deadlocks!
 *)
 
-(** Add an asynchronous job (to do in the main thread) *)
+(** Add an asynchronous job (to do in the GUI thread) *)
 val async : ('a -> unit) -> 'a -> unit
-(** Add a synchronous job (to do in the main thread) *)
+(** Add a synchronous job (to do in the GUI thread).
+    Raise [Failure "Tkthread.sync"] if there is no such thread. *)
 val sync : ('a -> 'b) -> 'a -> 'b
 (** Whether it is safe to call most Tk functions directly from
     the current thread *)
 val gui_safe : unit -> bool
+(** Whether a GUI thread is running *)
+val running : unit -> bool