X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=gtk%2Fgtk.misc.lisp;h=19c97208dfd4c90eb18647d8ad91498c93464990;hb=47b0bf2bfd057e9b409957e8e5cb2241e2fa6573;hp=8d7bdf29b090bd9995e4fe6751ce7a38226cadcf;hpb=ca504defb1fba77e974b84ba6df2468aa59242de;p=cl-gtk2.git

diff --git a/gtk/gtk.misc.lisp b/gtk/gtk.misc.lisp
index 8d7bdf2..19c9720 100644
--- a/gtk/gtk.misc.lisp
+++ b/gtk/gtk.misc.lisp
@@ -3,4 +3,56 @@
 (defcallback stable-pointer-free-destroy-notify-callback :void ((data :pointer))
   (free-stable-pointer data))
 
-(defcfun gtk-get-current-event-time :uint32)
\ No newline at end of file
+(defcfun (get-clipboard "gtk_clipboard_get") g-object
+  (selection gdk-atom-as-string))
+
+(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))
+  (ensure-gtk-main))
+
+(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)))
+
+(export 'within-main-loop)
+
+#+thread-support
+(defmacro with-main-loop (&body body)
+  `(progn
+     (ensure-gtk-main)
+     (within-main-loop ,@body)))
+
+#-thread-support
+(defmacro with-main-loop (&body body)
+  `(progn
+     ,@body
+     (ensure-gtk-main)))
+
+(export 'with-main-loop)
\ No newline at end of file