X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=gtk%2Fgtk.misc.lisp;h=19c97208dfd4c90eb18647d8ad91498c93464990;hb=c5a046da8c5ca824b266ff48034a860790dc1aa3;hp=fbfaa776d21b9e9e2aad62ff7cdd7053cab62bdf;hpb=500d18cd286348c598c6644a31f7cd7867b37f98;p=cl-gtk2.git

diff --git a/gtk/gtk.misc.lisp b/gtk/gtk.misc.lisp
index fbfaa77..19c9720 100644
--- a/gtk/gtk.misc.lisp
+++ b/gtk/gtk.misc.lisp
@@ -24,6 +24,20 @@
 
 (export 'call-from-gtk-main-loop)
 
+(defcallback call-timeout-from-main-loop-callback :boolean
+    ((data :pointer))
+  (restart-case
+      (progn (funcall (get-stable-pointer-value data)))
+    (return-from-callback () nil)))
+
+(defun gtk-main-add-timeout (milliseconds function &key (priority +g-priority-default+))
+  (g-timeout-add-full priority milliseconds
+                      (callback call-timeout-from-main-loop-callback)
+                      (allocate-stable-pointer function)
+                      (callback stable-pointer-free-destroy-notify-callback)))
+
+(export 'gtk-main-add-timeout)
+
 (defmacro within-main-loop (&body body)
   `(call-from-gtk-main-loop (lambda () ,@body)))
 
@@ -39,6 +53,6 @@
 (defmacro with-main-loop (&body body)
   `(progn
      ,@body
-     (gtk-main)))
+     (ensure-gtk-main)))
 
 (export 'with-main-loop)
\ No newline at end of file