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

core: minor improvements: intializations, exports, ...

Browse source
This commit is contained in:
Helmut Merz 2024-06-18 12:54:17 +02:00
parent e19b60bf9f
commit ae24fabee5
2 changed files with 8 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
core/core.lisp
View file

@ -4,11 +4,9 @@
(: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* #:setup #:find-service (:export #:config #:service-config
#:config #:service-config #:context #:*root* #:setup #:find-service
#:name #:start #:actions #:name #:send
#:context #:add-action #:add-service #:send
#:action-spec
#:printer)) #:printer))
(in-package :scopes/core) (in-package :scopes/core)
@ -19,7 +17,7 @@
(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 nil) (start :reader start :initarg :start :initform #'default-start)
(actions :reader actions :initarg :actions :initform nil))) (actions :reader actions :initarg :actions :initform nil)))
;;;; actions ;;;; actions
@ -56,7 +54,10 @@
(defclass context () (defclass context ()
((config :reader config :initarg :config) ((config :reader config :initarg :config)
(actions :accessor actions :initform nil) (actions :accessor actions :initform nil)
(services :accessor services :initform nil))) (services :initform (make-hash-table))))
(defun default-start (cfg)
(make-instance 'context :config cfg))
(defun find-service (name) (defun find-service (name)
(with-slots (services) *root* (with-slots (services) *root*
@ -78,9 +79,6 @@
(defun add-service (ctx cfg) (defun add-service (ctx cfg)
(with-slots (services) ctx (with-slots (services) ctx
(unless services
(setf services (make-hash-table)))
;(let ((child (make-instance 'context :config cfg)))
(let ((child (funcall (start cfg) cfg))) (let ((child (funcall (start cfg) cfg)))
(dolist (a (actions cfg)) (dolist (a (actions cfg))
(add-action child (car a) (cadr a))) (add-action child (car a) (cadr a)))

1
test/test-core.lisp
View file

@ -50,7 +50,6 @@
(t:*test-suite* (make-instance 'test-suite :name "core"))) (t:*test-suite* (make-instance 'test-suite :name "core")))
(log4cl:log-config :sane :daily (t:test-path "scopes-test.log" "log")) (log4cl:log-config :sane :daily (t:test-path "scopes-test.log" "log"))
(load (t:test-path "config-core" "etc")) (load (t:test-path "config-core" "etc"))
;(core:add-action rcvr '(:test) #'check-message)
(core:setup *config*) (core:setup *config*)
(setf (receiver t:*test-suite*) (core:find-service :test-receiver)) (setf (receiver t:*test-suite*) (core:find-service :test-receiver))
(test-send) (test-send)