From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Fri, 28 Aug 2009 22:04:22 +0000 (+0400)
Subject: Added timeouts
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8db173e3df82074b8ca96d00304c4e63b499f598;p=cl-gtk2.git

Added timeouts
---

diff --git a/glib/glib.lisp b/glib/glib.lisp
index 29cd6e4..df8af72 100644
--- a/glib/glib.lisp
+++ b/glib/glib.lisp
@@ -23,7 +23,9 @@
            #:+g-priority-default-idle+
            #:+g-priority-low+
            #:g-idle-add-full
-           #:g-idle-add)
+           #:g-idle-add
+           #:g-timeout-add-full
+           #:g-source-remove)
   (:documentation
    "Cl-gtk2-glib is wrapper for @a[http://library.gnome.org/devel/glib/]{GLib}."))
 
diff --git a/gtk/gtk.misc.lisp b/gtk/gtk.misc.lisp
index fbfaa77..1dfa2cb 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)))
 
diff --git a/gtk/gtk.package.lisp b/gtk/gtk.package.lisp
index f67b460..cd4ee40 100644
--- a/gtk/gtk.package.lisp
+++ b/gtk/gtk.package.lisp
@@ -20,7 +20,8 @@
            #:tree-node-insert-at
            #:tree-node-remove-at
            #:tree-node-child-at
-           #:tree-lisp-store-add-column))
+           #:tree-lisp-store-add-column
+           #:gtk-main-add-timeout))
 
 (defpackage :gtk-examples
   (:use :cl :gtk :gdk :gobject)