cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

allow / check for :quit action to stop a background service (task)

Browse source
This commit is contained in:
Helmut Merz 2025-02-15 16:57:53 +01:00
parent c90d953f2b
commit 0da989d73a
1 changed files with 6 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
core/core.lisp
View file

@ -84,7 +84,7 @@
(defgeneric do-listen (ctx) (defgeneric do-listen (ctx)
(:method ((ctx service)) (:method ((ctx service))
(do ((r (do-step ctx) (do-step ctx))) (do ((r (do-step ctx) (do-step ctx)))
((not r))))) ((eql r '(:quit))))))
(defgeneric do-step (ctx) (defgeneric do-step (ctx)
(:method ((ctx service)) (:method ((ctx service))
@ -120,7 +120,6 @@
(progn (progn
(setup-services cfg) (setup-services cfg)
(do-listen *root*)) (do-listen *root*))
;(lpq:pop-queue *quit-queue*))
(shutdown))) (shutdown)))
(defun add-action (ctx pat hdlr) (defun add-action (ctx pat hdlr)
@ -138,22 +137,17 @@
(dolist (a (config:actions cfg)) (dolist (a (config:actions cfg))
(add-action child (car a) (cadr a))) (add-action child (car a) (cadr a)))
(setf (gethash (config:name cfg) services) child) (setf (gethash (config:name cfg) services) child)
(do-start child) (do-start child)))))
))))
(defgeneric handle-message (ctx msg) (defgeneric handle-message (ctx msg)
(:method ((ctx base-context) msg) (:method ((ctx base-context) msg)
(cond (do-actions ctx msg)))
((do-actions ctx msg) t)
(t (util:lgw "no action selected" msg)))))
(defun do-actions (ctx msg &optional (acts #'actions)) (defun do-actions (ctx msg &optional (acts #'actions))
(let ((hdlrs (select msg (funcall acts ctx)))) (let ((hdlrs (select msg (funcall acts ctx))))
(when hdlrs (if hdlrs
(dolist (hdlr hdlrs) (mapcar #'(lambda (hdlr) (funcall hdlr ctx msg)) hdlrs)
(funcall hdlr ctx msg)) (util:lgw "no action selected" msg))))
t)))
;;;; some simple predefined actions ;;;; some simple predefined actions