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

provide (and use) add-action method for service-config

Browse source
This commit is contained in:
Helmut Merz 2024-06-19 08:55:33 +02:00
parent e6b3567e10
commit 0eeabb4321
2 changed files with 9 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
core/core.lisp
View file

@ -4,7 +4,7 @@
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:config :scopes/config) (:local-nicknames (:config :scopes/config)
(:message :scopes/core/message)) (:message :scopes/core/message))
(:export #:root-config #:add-config (:export #:root-config #:add-config #:add-action
#:default-start #:default-start
#:context #:*root* #:setup #:find-service #:config #:name #:send #:context #:*root* #:setup #:find-service #:config #:name #:send
#:printer)) #:printer))
@ -21,12 +21,16 @@
(defclass service-config (config:base) (defclass service-config (config:base)
((name :reader name :initarg :name) ((name :reader name :initarg :name)
(start :reader start :initarg :start :initform #'default-start) (start :reader start :initarg :start :initform #'default-start)
(actions :reader actions :initarg :actions :initform nil))) (actions :accessor actions :initarg :actions :initform nil)))
(defun add-config (parent name start &rest actions) (defun add-config (parent name start &rest actions)
(make-instance 'service-config :parent parent :name name :start start (make-instance 'service-config :parent parent :name name :start start
:actions actions)) :actions actions))
(defgeneric add-action (container pattern handler)
(:method ((cfg service-config) pattern handler)
(push (list pattern handler) (actions cfg))))
;;;; actions ;;;; actions
(defclass action-spec () (defclass action-spec ()
@ -76,7 +80,7 @@
(dolist (c (config:children cfg)) (dolist (c (config:children cfg))
(add-service *root* c))) (add-service *root* c)))
(defun add-action (ctx pat hdlr) (defmethod add-action ((ctx context) pat hdlr)
(let* ((acts (actions ctx)) (let* ((acts (actions ctx))
(act (find-action pat acts))) (act (find-action pat acts)))
(if act (if act

5
test/etc/config-core.lisp
View file

@ -4,6 +4,5 @@
(setf *config* (core:root-config)) (setf *config* (core:root-config))
(core:add-config *config* :test-receiver #'start (let ((cfg (core:add-config *config* :test-receiver #'start)))
'((:test) check-message) (core:add-action cfg '(:test) #'check-message))
)