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
This commit is contained in:
14
cl-tty.asd
14
cl-tty.asd
@@ -2,7 +2,7 @@
|
|||||||
(asdf:defsystem :cl-tty
|
(asdf:defsystem :cl-tty
|
||||||
:description "Reusable Common Lisp Terminal UI Framework"
|
:description "Reusable Common Lisp Terminal UI Framework"
|
||||||
:author "Amr Gharbeia"
|
:author "Amr Gharbeia"
|
||||||
:version "0.10.0"
|
:version "0.11.0"
|
||||||
:license "TBD"
|
:license "TBD"
|
||||||
:depends-on (:fiveam :sb-posix)
|
:depends-on (:fiveam :sb-posix)
|
||||||
:components
|
:components
|
||||||
@@ -44,7 +44,10 @@
|
|||||||
(:file "dialog" :depends-on ("dialog-package" "dirty" "select" "text-input"))
|
(:file "dialog" :depends-on ("dialog-package" "dirty" "select" "text-input"))
|
||||||
;; Mouse support (v0.10.0)
|
;; Mouse support (v0.10.0)
|
||||||
(:file "mouse-package" :depends-on ("package" "input-package"))
|
(: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))))
|
:in-order-to ((test-op (test-op :cl-tty-tests))))
|
||||||
|
|
||||||
(asdf:defsystem :cl-tty-tests
|
(asdf:defsystem :cl-tty-tests
|
||||||
@@ -68,7 +71,8 @@
|
|||||||
(:file "select-tests" :pathname "../../tests/select-tests.lisp")
|
(:file "select-tests" :pathname "../../tests/select-tests.lisp")
|
||||||
(:file "markdown-tests" :pathname "../../tests/markdown-tests.lisp")
|
(:file "markdown-tests" :pathname "../../tests/markdown-tests.lisp")
|
||||||
(:file "dialog-tests" :pathname "../../tests/dialog-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)
|
:perform (test-op (o c)
|
||||||
(let ((run (find-symbol "RUN" :fiveam))
|
(let ((run (find-symbol "RUN" :fiveam))
|
||||||
(explain (find-symbol "EXPLAIN!" :fiveam)))
|
(explain (find-symbol "EXPLAIN!" :fiveam)))
|
||||||
@@ -78,7 +82,9 @@
|
|||||||
(:cl-tty-scrollbox-test "SCROLLBOX-SUITE")
|
(:cl-tty-scrollbox-test "SCROLLBOX-SUITE")
|
||||||
(:cl-tty-select-test "SELECT-SUITE")
|
(:cl-tty-select-test "SELECT-SUITE")
|
||||||
(:cl-tty-markdown-test "MARKDOWN-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)))
|
(let* ((pkg (find-package (first suite)))
|
||||||
(s (and pkg (find-symbol (second suite) pkg))))
|
(s (and pkg (find-symbol (second suite) pkg))))
|
||||||
(when s
|
(when s
|
||||||
|
|||||||
97
org/slot.org
Normal file
97
org/slot.org
Normal file
@@ -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
|
||||||
9
src/components/slot-package.lisp
Normal file
9
src/components/slot-package.lisp
Normal file
@@ -0,0 +1,9 @@
|
|||||||
|
(defpackage :cl-tty.slot
|
||||||
|
(:use :cl)
|
||||||
|
(:export
|
||||||
|
#:defslot
|
||||||
|
#:slot-render
|
||||||
|
#:slot-p
|
||||||
|
#:clear-slot
|
||||||
|
#:list-slots
|
||||||
|
#:*slots*))
|
||||||
27
src/components/slot.lisp
Normal file
27
src/components/slot.lisp
Normal file
@@ -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))
|
||||||
26
tests/slot-tests.lisp
Normal file
26
tests/slot-tests.lisp
Normal file
@@ -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)))
|
||||||
Reference in New Issue
Block a user