gtk/sbcl.lisp

   1 (in-package :gtk)
   2
   3 #+thread-support
   4 (progn
   5   (defun stop-main-thread-on-save ()
   6     (when (and *main-thread* (bt:thread-alive-p *main-thread*))
   7       (within-main-loop-and-wait (gtk-main-quit))
   8       (bt:destroy-thread *main-thread*)
   9       (setf *main-thread* nil)))
  10   (defun cl-gtk2-sbcl-init ()
  11     (gtk-init))
  12   (pushnew 'cl-gtk2-sbcl-init sb-ext:*init-hooks*)
  13   (pushnew 'stop-main-thread-on-save sb-ext:*save-hooks*))
  14