async:listen: handle sigint using handler-bind or handler-case

util/async.lisp

@@ -28,20 +28,32 @@
 (defun noop (&rest params))
 
 (defun standard-job (tsk &key (startup #'noop) (teardown #'noop) handle-message)
-  (let ((mb (mailbox tsk)))
   (unwind-protect
     (progn
       (funcall startup tsk)
-        (when mb
+      (when (mailbox tsk)
+        (do-listen-hc tsk handle-message))
+      (data tsk))
+    (setf (status tsk) :done)
+    (funcall teardown tsk)))
+
+(defun do-listen (tsk handle-message)
+  (handler-bind 
+    ((sb-sys:interactive-interrupt
+      (lambda (condition) 
+        (util:lgi condition)
+        (return-from do-listen))))
+    (loop for msg = (lpq:pop-queue (mailbox tsk))
+          until (eq msg +quit-message+)
+          do (funcall handle-message tsk msg))))
+
+(defun do-listen-hc (tsk handle-message)
   (handler-case
-              (loop for msg = (lpq:pop-queue mb)
+    (loop for msg = (lpq:pop-queue (mailbox tsk))
           until (eq msg +quit-message+)
           do (funcall handle-message tsk msg))
     (sb-sys:interactive-interrupt (condition) 
-              (util:lgi condition)))
+      (util:lgi condition))))
-          (data tsk)))
-      (setf (status tsk) :done)
-      (funcall teardown tsk))))
 
 ;;;; task class and related functions / methods