[mcclim-cvs] CVS mcclim/Apps/Listener

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener
In directory clnet:/tmp/cvs-serv21697/Apps/Listener

Modified Files:
	dev-commands.lisp 
Log Message:
In the Listener, handle abort gesture properly even if the eval-thread
is in the debugger.


--- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/05/20 16:16:02	1.57
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/05/27 15:30:32	1.58
@@ -1540,21 +1540,25 @@
             (if clim-sys:*multiprocessing-p*
                 (catch 'done
                   (let* ((orig-process (clim-sys:current-process))
+                         (evaluating t)
                          (eval-process
                           (clim-sys:make-process
                            #'(lambda ()
                                (let ((result (evaluate)))
-                                 (clim-sys:process-interrupt orig-process
-                                                             #'(lambda ()
-                                                                 (throw 'done result))))))))
-                    (handler-case (loop for gesture = (read-gesture)
-                                        when (and (typep gesture 'keyboard-event)
-                                                  (eq (keyboard-event-key-name gesture) :pause))
-                                        do (clim-sys:process-interrupt eval-process #'break))
-                      (abort-gesture ()
-                        (clim-sys:destroy-process eval-process)
-                        (cons :abort (/ (- (get-internal-real-time) start-time)
-                                        internal-time-units-per-second))))))
+                                 (when evaluating
+                                   (clim-sys:process-interrupt orig-process
+                                                               #'(lambda ()
+                                                                   (throw 'done result)))))))))
+                    (unwind-protect
+                         (handler-case (loop for gesture = (read-gesture)
+                                             when (and (typep gesture 'keyboard-event)
+                                                       (eq (keyboard-event-key-name gesture) :pause))
+                                             do (clim-sys:process-interrupt eval-process #'break))
+                           (abort-gesture ()
+                             (clim-sys:destroy-process eval-process)
+                             (cons :abort (/ (- (get-internal-real-time) start-time)
+                                             internal-time-units-per-second))))
+                      (setf evaluating nil))))
                 (evaluate))
           (ecase result
             (:values