async:listen: handle sigint using handler-bind or handler-case
This commit is contained in:
parent
7d612bf823
commit
05cb9908dd
1 changed files with 26 additions and 14 deletions
|
@ -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
|
||||
(handler-case
|
||||
(loop for msg = (lpq:pop-queue mb)
|
||||
until (eq msg +quit-message+)
|
||||
do (funcall handle-message tsk msg))
|
||||
(sb-sys:interactive-interrupt (condition)
|
||||
(util:lgi condition)))
|
||||
(data tsk)))
|
||||
(setf (status tsk) :done)
|
||||
(funcall teardown tsk))))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(funcall startup tsk)
|
||||
(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 (mailbox tsk))
|
||||
until (eq msg +quit-message+)
|
||||
do (funcall handle-message tsk msg))
|
||||
(sb-sys:interactive-interrupt (condition)
|
||||
(util:lgi condition))))
|
||||
|
||||
;;;; task class and related functions / methods
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue