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