From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Sat, 28 Mar 2009 15:29:34 +0000 (+0300)
Subject: Added within-main-loop and call-from-main-loop macros; ensured single initialization... 
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=9f7be1143bc6087d6eb607a12f99b062663b33dd;p=cl-gtk2.git

Added within-main-loop and call-from-main-loop macros; ensured single initialization of glib threads
---

diff --git a/glib/glib.lisp b/glib/glib.lisp
index f3788d6..b7a132c 100644
--- a/glib/glib.lisp
+++ b/glib/glib.lisp
@@ -15,7 +15,13 @@
            #:g-strdup
            #:g-string
            #:gslist
-           #:g-quark))
+           #:g-quark
+           #:+g-priority-high+
+           #:+g-priority-default+
+           #:+g-priority-high-idle+
+           #:+g-priority-default-idle+
+           #:+g-priority-low+
+           #:g-idle-add-full))
 
 (in-package :glib)
 
@@ -342,7 +348,11 @@
 (defcfun (g-thread-init "g_thread_init") :void
   (vtable :pointer))
 
-(g-thread-init (null-pointer))
+(defvar *threads-initialized-p* nil)
+
+(unless *threads-initialized-p*
+  (g-thread-init (null-pointer))
+  (setf *threads-initialized-p* t))
 
 (defcenum g-thread-priority
   :g-thread-priority-low
diff --git a/gtk/gtk.misc.lisp b/gtk/gtk.misc.lisp
index 0c8cff1..81dd06d 100644
--- a/gtk/gtk.misc.lisp
+++ b/gtk/gtk.misc.lisp
@@ -6,4 +6,24 @@
 (defcfun (get-clipboard "gtk_clipboard_get") g-object
   (selection gdk-atom-as-string))
 
-(export 'get-clipboard)
\ No newline at end of file
+(export 'get-clipboard)
+
+(defcallback call-from-main-loop-callback :boolean
+    ((data :pointer))
+  (restart-case
+      (progn (funcall (get-stable-pointer-value data))
+             nil)
+    (return-from-callback () nil)))
+
+(defun call-from-gtk-main-loop (function &key (priority +g-priority-default-idle+))
+  (g-idle-add-full priority
+                   (callback call-from-main-loop-callback)
+                   (allocate-stable-pointer function)
+                   (callback stable-pointer-free-destroy-notify-callback)))
+
+(export 'call-from-gtk-main-loop)
+
+(defmacro within-main-loop (&body body)
+  `(call-from-gtk-main-loop (lambda () ,@body)))
+
+(export 'within-main-loop)
\ No newline at end of file