gtk/gtk.misc.lisp

   1 (in-package :gtk)
   2
   3 (defcallback stable-pointer-free-destroy-notify-callback :void ((data :pointer))
   4   (free-stable-pointer data))
   5
   6 (defcfun (get-clipboard "gtk_clipboard_get") g-object
   7   (selection gdk-atom-as-string))
   8
   9 (export 'get-clipboard)
  10
  11 (defcallback call-from-main-loop-callback :boolean
  12     ((data :pointer))
  13   (restart-case
  14       (progn (funcall (get-stable-pointer-value data))
  15              nil)
  16     (return-from-callback () nil)))
  17
  18 (defun call-from-gtk-main-loop (function &key (priority +g-priority-default-idle+))
  19   (g-idle-add-full priority
  20                    (callback call-from-main-loop-callback)
  21                    (allocate-stable-pointer function)
  22                    (callback stable-pointer-free-destroy-notify-callback))
  23   (ensure-gtk-main))
  24
  25 (export 'call-from-gtk-main-loop)
  26
  27 (defmacro within-main-loop (&body body)
  28   `(call-from-gtk-main-loop (lambda () ,@body)))
  29
  30 (export 'within-main-loop)
  31
  32 #+thread-support
  33 (defmacro with-main-loop (&body body)
  34   `(progn
  35      (ensure-gtk-main)
  36      (within-main-loop ,@body)))
  37
  38 #-thread-support
  39 (defmacro with-main-loop (&body body)
  40   `(progn
  41      ,@body
  42      (gtk-main)))
  43
  44 (export 'with-main-loop)