gtk/gtk.main_loop_events.lisp

   1 (in-package :gtk)
   2
   3 (defcfun gtk-init-check :boolean
   4   (argc (:pointer :int))
   5   (argv (:pointer (:pointer :string))))
   6
   7 (defun gtk-init ()
   8   (gtk-init-check (foreign-alloc :int :initial-element 0)
   9                   (foreign-alloc :string :initial-contents '("/usr/bin/sbcl")))
  10   #+ (and sbcl (not win32))
  11   (sb-unix::enable-interrupt sb-unix:sigpipe #'sb-unix::sigpipe-handler)
  12   #+nil(with-foreign-objects ((argc :int)
  13                          (argv '(:pointer :string) 1))
  14     (setf (mem-ref argc :int) 0
  15           (mem-ref argv '(:pointer :string)) (foreign-alloc :string :count 1
  16                                                             :initial-element "/usr/bin/sbcl"))
  17     (unwind-protect
  18          (unless (gtk-init-check argc argv)
  19            (error "Cannot initialize Gtk+"))
  20       (foreign-free (mem-ref argv '(:pointer :string))))))
  21
  22 (at-init () (gtk-init))
  23
  24 (defcfun (%gtk-main "gtk_main") :void)
  25
  26 (defun gtk-main ()
  27   (with-gdk-threads-lock (%gtk-main)))
  28
  29 #+thread-support
  30 (progn
  31   (defvar *main-thread* nil)
  32   (defvar *main-thread-level* nil)
  33   (defvar *main-thread-lock* (bt:make-lock "*main-thread* lock"))
  34
  35   (at-finalize ()
  36     (when (and *main-thread* (bt:thread-alive-p *main-thread*))
  37       (bt:destroy-thread *main-thread*)
  38       (setf *main-thread* nil)))
  39
  40   (defun ensure-gtk-main ()
  41     (bt:with-lock-held (*main-thread-lock*)
  42       (when (and *main-thread* (not (bt:thread-alive-p *main-thread*)))
  43         (setf *main-thread* nil))
  44       (unless *main-thread*
  45         (setf *main-thread* (bt:make-thread (lambda () (gtk-main)) :name "cl-gtk2 main thread")
  46               *main-thread-level* 0))
  47       (incf *main-thread-level*))
  48     (values))
  49
  50   (defun join-gtk-main ()
  51     (when *main-thread*
  52       (bt:join-thread *main-thread*)))
  53
  54   (defun leave-gtk-main ()
  55     (bt:with-lock-held (*main-thread-lock*)
  56       (decf *main-thread-level*)
  57       (when (zerop *main-thread-level*)
  58         (gtk-main-quit)))))
  59
  60 #-thread-support
  61 (progn
  62   (defun ensure-gtk-main ()
  63     (gtk-main)
  64     (values))
  65
  66   (defun leave-gtk-main ()
  67     (gtk-main-quit))
  68
  69   (defun join-gtk-main ()))
  70
  71 (export 'ensure-gtk-main)
  72
  73 (export 'leave-gtk-main)
  74
  75 (export 'join-gtk-main)
  76
  77 (defcfun gtk-main-level :uint)
  78
  79 (defcfun gtk-main-quit :void)
  80
  81 (defcfun gtk-grab-add :void
  82   (widget g-object))
  83
  84 (defcfun gtk-grab-get-current g-object)
  85
  86 (defcfun gtk-grab-remove :void
  87   (widget g-object))