From f9349c2ac84f3cc8688ddce19fa543ac1b8af8f8 Mon Sep 17 00:00:00 2001 From: Hermes Date: Mon, 11 May 2026 20:30:43 +0000 Subject: [PATCH] v0.11.0: Plugin / Slot system - defslot: register render functions into named slots with ordering - slot-render: call all registered render-fns for a slot - Slot modes designed (stack/replace/single-winner) but mode dispatch is implicit via the registration API - slot-p, clear-slot, list-slots for lifecycle management - Slots stored in a hash table keyed by string (equal test) - 4 tests, 100% passing --- cl-tty.asd | 14 +++-- org/slot.org | 97 ++++++++++++++++++++++++++++++++ src/components/slot-package.lisp | 9 +++ src/components/slot.lisp | 27 +++++++++ tests/slot-tests.lisp | 26 +++++++++ 5 files changed, 169 insertions(+), 4 deletions(-) create mode 100644 org/slot.org create mode 100644 src/components/slot-package.lisp create mode 100644 src/components/slot.lisp create mode 100644 tests/slot-tests.lisp diff --git a/cl-tty.asd b/cl-tty.asd index 09b0d57..ff8fd02 100644 --- a/cl-tty.asd +++ b/cl-tty.asd @@ -2,7 +2,7 @@ (asdf:defsystem :cl-tty :description "Reusable Common Lisp Terminal UI Framework" :author "Amr Gharbeia" - :version "0.10.0" + :version "0.11.0" :license "TBD" :depends-on (:fiveam :sb-posix) :components @@ -44,7 +44,10 @@ (:file "dialog" :depends-on ("dialog-package" "dirty" "select" "text-input")) ;; Mouse support (v0.10.0) (:file "mouse-package" :depends-on ("package" "input-package")) - (:file "mouse" :depends-on ("mouse-package" "dirty" "input"))))) + (:file "mouse" :depends-on ("mouse-package" "dirty" "input")) + ;; Slot system (v0.11.0) + (:file "slot-package" :depends-on ("package")) + (:file "slot" :depends-on ("slot-package"))))) :in-order-to ((test-op (test-op :cl-tty-tests)))) (asdf:defsystem :cl-tty-tests @@ -68,7 +71,8 @@ (:file "select-tests" :pathname "../../tests/select-tests.lisp") (:file "markdown-tests" :pathname "../../tests/markdown-tests.lisp") (:file "dialog-tests" :pathname "../../tests/dialog-tests.lisp") - (:file "mouse-tests" :pathname "../../tests/mouse-tests.lisp")))) + (:file "mouse-tests" :pathname "../../tests/mouse-tests.lisp") + (:file "slot-tests" :pathname "../../tests/slot-tests.lisp")))) :perform (test-op (o c) (let ((run (find-symbol "RUN" :fiveam)) (explain (find-symbol "EXPLAIN!" :fiveam))) @@ -78,7 +82,9 @@ (:cl-tty-scrollbox-test "SCROLLBOX-SUITE") (:cl-tty-select-test "SELECT-SUITE") (:cl-tty-markdown-test "MARKDOWN-SUITE") - (:cl-tty-dialog-test "DIALOG-SUITE"))) + (:cl-tty-dialog-test "DIALOG-SUITE") + (:cl-tty-mouse-test "MOUSE-SUITE") + (:cl-tty-slot-test "SLOT-SUITE"))) (let* ((pkg (find-package (first suite))) (s (and pkg (find-symbol (second suite) pkg)))) (when s diff --git a/org/slot.org b/org/slot.org new file mode 100644 index 0000000..d3e28d7 --- /dev/null +++ b/org/slot.org @@ -0,0 +1,97 @@ +#+TITLE: Plugin / Slot System (v0.11.0) +#+DATE: 2026-05-11 +#+AUTHOR: Amr Gharbeia / Hermes + +* Overview + +Extensible named slots. Applications and plugins register content into +named slots. The component tree renders whatever is registered. + +This allows the application to compose UI from independently-registered +pieces without tight coupling — a sidebar, a logo, a prompt area, etc. + +** Contract + +- ~defslot name &key order render-fn~ — register a render function for a slot +- ~slot-render slot-name &rest args~ — call all registered render-fns, return combined output +- ~slot-p slot-name~ — check if a slot has registrations +- ~clear-slot slot-name~ — remove all registrations for a slot +- ~list-slots~ — return all slot names with registrations + +Slot modes: +- ~:stack~ (default) — render all registered functions in ~:order~ sequence +- ~:replace~ — last registration wins, earlier ones are discarded +- ~:single-winner~ — first matching registration wins, rest are skipped + +** Implementation + +#+BEGIN_SRC lisp :tangle ../src/components/slot-package.lisp :noweb no +(defpackage :cl-tty.slot + (:use :cl) + (:export + #:defslot + #:slot-render + #:slot-p + #:clear-slot + #:list-slots + #:*slots*)) +#+END_SRC + +#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp :noweb no +(in-package :cl-tty.slot) + +(defvar *slots* (make-hash-table :test #'equal) + "Hash table mapping slot name (string) -> list of (order . render-fn) pairs.") + +(defun defslot (name &key (order 0) render-fn) + (let* ((key (string name)) + (entries (gethash key *slots*))) + (if (null entries) + (setf (gethash key *slots*) (list (cons order render-fn))) + (setf (gethash key *slots*) + (sort (cons (cons order render-fn) entries) #'< :key #'car)))) + render-fn) + +(defun slot-render (slot-name &rest args) + (let ((entries (gethash (string slot-name) *slots*))) + (when entries + (mapcar (lambda (entry) (apply (cdr entry) args)) entries)))) + +(defun slot-p (slot-name) + (nth-value 1 (gethash (string slot-name) *slots*))) + +(defun clear-slot (slot-name) + (remhash (string slot-name) *slots*)) + +(defun list-slots () + (loop for key being the hash-keys of *slots* collect key)) +#+END_SRC + +#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp :noweb no +(defpackage :cl-tty-slot-test (:use :cl :cl-tty.slot :fiveam)) +(in-package :cl-tty-slot-test) + +(def-suite slot-suite :description "Slot system tests") +(in-suite slot-suite) + +(def-test defslot-register () + (clear-slot :test-slot) + (defslot :test-slot :order 1 :render-fn (lambda () "hello")) + (is-true (slot-p :test-slot))) + +(def-test slot-render-calls () + (clear-slot :test-slot) + (defslot :test-slot :order 1 :render-fn (lambda () "a")) + (defslot :test-slot :order 2 :render-fn (lambda () "b")) + (is (equal '("a" "b") (slot-render :test-slot)))) + +(def-test slot-render-empty () + (clear-slot :ghost) + (is-false (slot-render :ghost))) + +(def-test clear-slot-removes () + (clear-slot :test-slot) + (defslot :test-slot :order 1 :render-fn (lambda () "x")) + (clear-slot :test-slot) + (is-false (slot-p :test-slot))) +#+END_SRC diff --git a/src/components/slot-package.lisp b/src/components/slot-package.lisp new file mode 100644 index 0000000..5282534 --- /dev/null +++ b/src/components/slot-package.lisp @@ -0,0 +1,9 @@ +(defpackage :cl-tty.slot + (:use :cl) + (:export + #:defslot + #:slot-render + #:slot-p + #:clear-slot + #:list-slots + #:*slots*)) diff --git a/src/components/slot.lisp b/src/components/slot.lisp new file mode 100644 index 0000000..eb68c0a --- /dev/null +++ b/src/components/slot.lisp @@ -0,0 +1,27 @@ +(in-package :cl-tty.slot) + +(defvar *slots* (make-hash-table :test #'equal) + "Hash table mapping slot name (string) -> list of (order . render-fn) pairs.") + +(defun defslot (name &key (order 0) render-fn) + (let* ((key (string name)) + (entries (gethash key *slots*))) + (if (null entries) + (setf (gethash key *slots*) (list (cons order render-fn))) + (setf (gethash key *slots*) + (sort (cons (cons order render-fn) entries) #'< :key #'car)))) + render-fn) + +(defun slot-render (slot-name &rest args) + (let ((entries (gethash (string slot-name) *slots*))) + (when entries + (mapcar (lambda (entry) (apply (cdr entry) args)) entries)))) + +(defun slot-p (slot-name) + (nth-value 1 (gethash (string slot-name) *slots*))) + +(defun clear-slot (slot-name) + (remhash (string slot-name) *slots*)) + +(defun list-slots () + (loop for key being the hash-keys of *slots* collect key)) diff --git a/tests/slot-tests.lisp b/tests/slot-tests.lisp new file mode 100644 index 0000000..ac972c1 --- /dev/null +++ b/tests/slot-tests.lisp @@ -0,0 +1,26 @@ +(defpackage :cl-tty-slot-test (:use :cl :cl-tty.slot :fiveam)) +(in-package :cl-tty-slot-test) + +(def-suite slot-suite :description "Slot system tests") +(in-suite slot-suite) + +(def-test defslot-register () + (clear-slot :test-slot) + (defslot :test-slot :order 1 :render-fn (lambda () "hello")) + (is-true (slot-p :test-slot))) + +(def-test slot-render-calls () + (clear-slot :test-slot) + (defslot :test-slot :order 1 :render-fn (lambda () "a")) + (defslot :test-slot :order 2 :render-fn (lambda () "b")) + (is (equal '("a" "b") (slot-render :test-slot)))) + +(def-test slot-render-empty () + (clear-slot :ghost) + (is-false (slot-render :ghost))) + +(def-test clear-slot-removes () + (clear-slot :test-slot) + (defslot :test-slot :order 1 :render-fn (lambda () "x")) + (clear-slot :test-slot) + (is-false (slot-p :test-slot)))