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

get red of default-actions

Browse source
This commit is contained in:
Helmut Merz 2025-02-15 10:01:27 +01:00
parent 7628cd7e49
commit dc37f7778a
2 changed files with 8 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
core/core.lisp
View file

@ -8,7 +8,7 @@
(:util :scopes/util) (:util :scopes/util)
(:alx :alexandria)) (:alx :alexandria))
(:export #:action-spec #:define-actions (:export #:action-spec #:define-actions
#:*root* #:default-setup #:default-actions #:*root* #:default-setup #:actions
#:find-service #:run-services #:setup-services #:shutdown #:find-service #:run-services #:setup-services #:shutdown
#:base-context #:context #:add-action #:config #:name #:send #:base-context #:context #:add-action #:config #:name #:send
#:handle-message #:handle-message
@ -56,14 +56,14 @@
(defvar *root* nil) (defvar *root* nil)
;;; check / fix:
(defvar *quit-queue* (lparallel.queue:make-queue :fixed-capacity 1)) (defvar *quit-queue* (lparallel.queue:make-queue :fixed-capacity 1))
(defun quit-handler (sig) (defun quit-handler (sig)
(format t "~%quit-handler: got signal ~s~%" sig) (format t "~%quit-handler: got signal ~s~%" sig)
(lparallel.queue:push-queue sig)) (lparallel.queue:push-queue sig))
(defclass base-context () (defclass base-context ()
((actions :accessor actions :initform nil) ((actions :accessor actions :initform nil)))
(default-actions :reader default-actions :initform nil)))
(defclass context (base-context) (defclass context (base-context)
((config :reader config :initarg :config) ((config :reader config :initarg :config)
@ -93,6 +93,7 @@
(unwind-protect (unwind-protect
(progn (progn
(setup-services cfg) (setup-services cfg)
;(do-listen)
(lparallel.queue:pop-queue *quit-queue*)) (lparallel.queue:pop-queue *quit-queue*))
(shutdown))) (shutdown)))
@ -110,7 +111,9 @@
(when child (when child
(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)
))))
(defgeneric send (rcvr msg) (defgeneric send (rcvr msg)
(:method ((rcvr base-context) msg) (:method ((rcvr base-context) msg)
@ -120,7 +123,6 @@
(:method ((ctx base-context) msg) (:method ((ctx base-context) msg)
(cond (cond
((do-actions ctx msg) t) ((do-actions ctx msg) t)
((do-actions ctx msg #'default-actions) t)
(t (util:lgw "no action selected" msg))))) (t (util:lgw "no action selected" msg)))))
(defun do-actions (ctx msg &optional (acts #'actions)) (defun do-actions (ctx msg &optional (acts #'actions))

2
web/response.lisp
View file

@ -30,7 +30,7 @@
;;; interaction class and methods ;;; interaction class and methods
(defclass interaction (core:base-context) (defclass interaction (core:base-context)
((core:default-actions :initform *interaction-default-actions*) ((core:actions :initform *interaction-default-actions*)
(response :reader response :initarg :response) (response :reader response :initarg :response)
(messages :accessor messages :initform nil))) (messages :accessor messages :initform nil)))