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

core/core.lisp

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

test/etc/config-core.lisp

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