X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=gtk%2Fgtk.main_loop_events.lisp;h=244a7d770f3c8fc5b617a6f9d24ac8673e75d6a4;hb=c36dad68c5724171792b032fe56d6d531fc2571a;hp=d2bdb9c23683f1707d19b4b90e61ec8db996450f;hpb=246031be275ccb404e6344461f516a874ba88341;p=cl-gtk2.git diff --git a/gtk/gtk.main_loop_events.lisp b/gtk/gtk.main_loop_events.lisp index d2bdb9c..244a7d7 100644 --- a/gtk/gtk.main_loop_events.lisp +++ b/gtk/gtk.main_loop_events.lisp @@ -17,44 +17,61 @@ (error "Cannot initialize Gtk+")) (foreign-free (mem-ref argv '(:pointer :string)))))) -(gtk-init) +(at-init () (gtk-init)) -(defcfun gtk-test-register-all-types :void) +(defcfun (%gtk-main "gtk_main") :void) -(gtk-test-register-all-types) - -(defcfun gtk-events-pending :boolean) - -(defcfun gtk-main :void) - -#+thread-support -(defvar *main-thread* nil) - -#+thread-support -(defun ensure-gtk-main () - (unless *main-thread* - (setf *main-thread* (bt:make-thread (lambda () (gtk:gtk-main)) :name "cl-gtk2 main thread")))) +(defun gtk-main () + (with-gdk-threads-lock (%gtk-main))) #+thread-support -(defun join-main-thread () - (when *main-thread* - (bt:join-thread *main-thread*))) +(progn + (defvar *main-thread* nil) + (defvar *main-thread-level* nil) + (defvar *main-thread-lock* (bt:make-lock "*main-thread* lock")) + + (at-finalize () + (when (and *main-thread* (bt:thread-alive-p *main-thread*)) + (bt:destroy-thread *main-thread*) + (setf *main-thread* nil))) + + (defun ensure-gtk-main () + (bt:with-lock-held (*main-thread-lock*) + (when (and *main-thread* (not (bt:thread-alive-p *main-thread*))) + (setf *main-thread* nil)) + (unless *main-thread* + (setf *main-thread* (bt:make-thread (lambda () (gtk-main)) :name "cl-gtk2 main thread") + *main-thread-level* 0)) + (incf *main-thread-level*)) + (values)) + + (defun join-gtk-main () + (when *main-thread* + (bt:join-thread *main-thread*))) + + (defun leave-gtk-main () + (bt:with-lock-held (*main-thread-lock*) + (decf *main-thread-level*) + (when (zerop *main-thread-level*) + (gtk-main-quit))))) #-thread-support -(defun ensure-gtk-main () - (gtk-main)) +(progn + (defun ensure-gtk-main () + (gtk-main) + (values)) -(export 'ensure-gtk-main) - -#+thread-support -(defun leave-gtk-main ()) ;noop on multithreading + (defun leave-gtk-main () + (gtk-main-quit)) + + (defun join-gtk-main ())) -#-thread-support -(defun leave-gtk-main () - (gtk-main-quit)) +(export 'ensure-gtk-main) (export 'leave-gtk-main) +(export 'join-gtk-main) + (defcfun gtk-main-level :uint) (defcfun gtk-main-quit :void)