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 (defcallback call-timeout-from-main-loop-callback :boolean
  28     ((data :pointer))
  29   (restart-case
  30       (progn (funcall (get-stable-pointer-value data)))
  31     (return-from-callback () nil)))
  32
  33 (defun gtk-main-add-timeout (milliseconds function &key (priority +g-priority-default+))
  34   (g-timeout-add-full priority milliseconds
  35                       (callback call-timeout-from-main-loop-callback)
  36                       (allocate-stable-pointer function)
  37                       (callback stable-pointer-free-destroy-notify-callback)))
  38
  39 (export 'gtk-main-add-timeout)
  40
  41 (defmacro within-main-loop (&body body)
  42   `(call-from-gtk-main-loop (lambda () ,@body)))
  43
  44 (export 'within-main-loop)
  45
  46 #+thread-support
  47 (defmacro with-main-loop (&body body)
  48   `(progn
  49      (ensure-gtk-main)
  50      (within-main-loop ,@body)))
  51
  52 #-thread-support
  53 (defmacro with-main-loop (&body body)
  54   `(progn
  55      ,@body
  56      (gtk-main)))
  57
  58 (export 'with-main-loop)