From abaf786e18ebc8dde225e05927c9f2d032ee30fd Mon Sep 17 00:00:00 2001
From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Mon, 25 Jan 2010 04:54:07 +0300
Subject: [PATCH] Refactor gtk-main; rename join-main-thread to join-gtk-main;
 make join-gtk-main usefully work on multithreaded lisps

---
 doc/gtk.main_loop.texi        |   23 ++++++++++---
 gtk/gtk.main_loop_events.lisp |   71 +++++++++++++++++++++++------------------
 2 files changed, 59 insertions(+), 35 deletions(-)

diff --git a/doc/gtk.main_loop.texi b/doc/gtk.main_loop.texi
index c298388..506114d 100644
--- a/doc/gtk.main_loop.texi
+++ b/doc/gtk.main_loop.texi
@@ -24,13 +24,28 @@ This function causes the main loop to terminate and causes @ref{gtk-main} to ret
 @lisp
 (ensure-gtk-main)
 @end lisp
-This function ensures that the Gtk+ main loop is started in background thread. If the loop has not been started or if had been terminated, restarts the background thread.
+This function ensures that the Gtk+ main loop is started.
 
-@RFunction join-main-thread
+If your Lisp supports multithreading, it starts the main loop in background thread (if it had not been started) and immediately returns. If your Lisp does not support multithreading, the main loop is started and waits for it to complete.
+
+Calls to @ref{ensure-gtk-main} must be paired by calls to @ref{leave-gtk-main}. When the @ref{leave-gtk-main} is called the same number of time as @ref{ensure-gtk-main} is called then the main loop quits (e.g., main loops are nested).
+
+It is also useful to call @ref{join-gtk-main} after @ref{ensure-gtk-main} to wait for main loop to quit.
+
+@RFunction leave-gtk-main
+@lisp
+(leave-gtk-main)
+@end lisp
+This function terminates the gtk main loop.
+
+Calls to @ref{ensure-gtk-main} must be paired by calls to @ref{leave-gtk-main}. When the @ref{leave-gtk-main} is called the same number of time as @ref{ensure-gtk-main} is called then the main loop quits (e.g., main loops are nested).
+
+
+@RFunction join-gtk-main
 @lisp
-(join-main-thread)
+(join-gtk-thread)
 @end lisp
-This function waits for the background thread that runs the Gtk+ main loop to quit.
+This function waits for the background thread that runs the Gtk+ main loop to quit. See @ref{ensure-gtk-main}.
 
 @RFunction gtk-main-iteration
 @lisp
diff --git a/gtk/gtk.main_loop_events.lisp b/gtk/gtk.main_loop_events.lisp
index 6b5b9eb..244a7d7 100644
--- a/gtk/gtk.main_loop_events.lisp
+++ b/gtk/gtk.main_loop_events.lisp
@@ -25,44 +25,53 @@
   (with-gdk-threads-lock (%gtk-main)))
 
 #+thread-support
-(defvar *main-thread* nil)
-
-#+thread-support
-(at-finalize ()
-  (when (and *main-thread* (bt:thread-alive-p *main-thread*))
-    (bt:destroy-thread *main-thread*)
-    (setf *main-thread* nil)))
-
-#+thread-support
-(defun ensure-gtk-main ()
-  (when (and *main-thread* (not (bt:thread-alive-p *main-thread*)))
-    (setf *main-thread* nil))
-  (unless *main-thread*
-    (setf *main-thread* (bt:make-thread (lambda () (gtk-main)) :name "cl-gtk2 main thread"))))
-
-#+thread-support
-(defun join-main-thread ()
-  (when *main-thread*
-    (bt:join-thread *main-thread*)))
-
-#+thread-support
-(export 'join-main-thread)
+(progn
+  (defvar *main-thread* nil)
+  (defvar *main-thread-level* nil)
+  (defvar *main-thread-lock* (bt:make-lock "*main-thread* lock"))
+
+  (at-finalize ()
+    (when (and *main-thread* (bt:thread-alive-p *main-thread*))
+      (bt:destroy-thread *main-thread*)
+      (setf *main-thread* nil)))
+
+  (defun ensure-gtk-main ()
+    (bt:with-lock-held (*main-thread-lock*)
+      (when (and *main-thread* (not (bt:thread-alive-p *main-thread*)))
+        (setf *main-thread* nil))
+      (unless *main-thread*
+        (setf *main-thread* (bt:make-thread (lambda () (gtk-main)) :name "cl-gtk2 main thread")
+              *main-thread-level* 0))
+      (incf *main-thread-level*))
+    (values))
+
+  (defun join-gtk-main ()
+    (when *main-thread*
+      (bt:join-thread *main-thread*)))
+
+  (defun leave-gtk-main ()
+    (bt:with-lock-held (*main-thread-lock*)
+      (decf *main-thread-level*)
+      (when (zerop *main-thread-level*)
+        (gtk-main-quit)))))
 
 #-thread-support
-(defun ensure-gtk-main ()
-  (gtk-main))
-
-(export 'ensure-gtk-main)
+(progn
+  (defun ensure-gtk-main ()
+    (gtk-main)
+    (values))
 
-#+thread-support
-(defun leave-gtk-main ()) ;noop on multithreading
+  (defun leave-gtk-main ()
+    (gtk-main-quit))
+  
+  (defun join-gtk-main ()))
 
-#-thread-support
-(defun leave-gtk-main ()
-  (gtk-main-quit))
+(export 'ensure-gtk-main)
 
 (export 'leave-gtk-main)
 
+(export 'join-gtk-main)
+
 (defcfun gtk-main-level :uint)
 
 (defcfun gtk-main-quit :void)
-- 
1.7.10.4