amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

implement: slot modes (:stack, :replace, :single-winner)

Browse Source 
Add :mode parameter to defslot with three behaviors:
- :stack (default) — accumulate all registrations, render in order
- :replace — each registration replaces previous entries
- :single-winner — first registration wins, rest ignored

Mode is set on first defslot call and frozen for subsequent calls
to prevent conflicting mode specifications from different plugins.

Store slot data as plist (:mode <keyword> :entries <list>) instead
of bare entries list.

Add 5 new tests covering mode-specific behavior. All 9 slot tests
pass. All 13 suites pass at 100%.
This commit is contained in:
Hermes Agent
2026-05-12 19:17:24 +00:00
parent a9670a5cd7
commit 6cd045ff59
3 changed files with 249 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

240
org/slot.org
View File

@@ -1,6 +1,7 @@
#+TITLE: Plugin / Slot System (v0.11.0) #+TITLE: Plugin / Slot System (v0.11.0)
#+DATE: 2026-05-11 #+DATE: 2026-05-11
#+AUTHOR: Amr Gharbeia / Hermes #+AUTHOR: Amr Gharbeia / Hermes
#+STARTUP: content
* Overview * Overview
@@ -12,23 +13,44 @@ pieces without tight coupling — a sidebar, a logo, a prompt area, etc.
** Contract ** Contract
- ~defslot name &key order render-fn~ — register a render function for a slot - ~defslot name &key order render-fn mode~ — register a render function for a slot
- ~slot-render slot-name &rest args~ — call all registered render-fns, return combined output - ~slot-render slot-name &rest args~ — call all registered render-fns, return combined output
- ~slot-p slot-name~ — check if a slot has registrations - ~slot-p slot-name~ — check if a slot has registrations
- ~clear-slot slot-name~ — remove all registrations for a slot - ~clear-slot slot-name~ — remove all registrations for a slot
- ~list-slots~ — return all slot names with registrations - ~list-slots~ — return all slot names with registrations
Slot modes: ** 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 - ~:stack~ (default) — render all registered functions in ~:order~ sequence.
Each ~defslot~ adds to the list. ~slot-render~ calls every function and
returns a list of results. Use this for composable slots where multiple
plugins contribute content (e.g., toolbar buttons, status bar segments).
- ~:replace~ — last registration wins, previous ones are discarded.
Each ~defslot~ replaces the slot's entire entry list with the new
registration. ~slot-render~ calls only the most recently registered
function. Use this for exclusive slots where only one renderer should
be active at a time (e.g., main content area, active panel).
- ~:single-winner~ — first registration wins, subsequent ones are ignored.
Once a slot has an entry, further ~defslot~ calls for the same slot are
no-ops. ~slot-render~ calls only the first (lowest-order) registered
function. Use this for slots where the first plugin to register should
own the spot (e.g., logo area, command palette).
The mode is set on the first ~defslot~ call for a slot. Subsequent calls
for the same slot ignore the ~:mode~ argument and use the established
mode — this prevents confusion when multiple plugins register into the
same slot with conflicting mode specifications.
* Implementation
** Package
The package provides the public API and exports all slot system symbols. The package provides the public API and exports all slot system symbols.
Clients :use this package or refer to symbols qualified. Clients :use this package or refer to symbols qualified.
#+BEGIN_SRC lisp :tangle ../src/components/slot-package.lisp :noweb no #+BEGIN_SRC lisp :tangle ../src/components/slot-package.lisp
(defpackage :cl-tty.slot (defpackage :cl-tty.slot
(:use :cl) (:use :cl)
(:export (:export
@@ -40,101 +62,144 @@ Clients :use this package or refer to symbols qualified.
#:*slots*)) #:*slots*))
#+END_SRC #+END_SRC
*** Slot Storage: *slots* ** Slot Storage: *slots*
The central registry is a hash table keyed by slot name (strings, for The central registry is a hash table keyed by slot name (strings, for
case-insensitive lookup via ~equal~). Each value is a list of case-insensitive lookup via ~equal~). Each value is a plist:
~(order . render-fn)~ cons cells, sorted by order on insertion. The
~:test #'equal~ ensures that ~:sidebar~ and ~\"sidebar\"~ map to the - ~:mode~ — the slot's mode keyword (~:stack~, ~:replace~, ~:single-winner~)
- ~:entries~ — list of ~(order . render-fn)~ cons cells, sorted by order
The ~:test #'equal~ ensures that ~:sidebar~ and ~"sidebar"~ map to the
same key. same key.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp :noweb no #+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
(in-package :cl-tty.slot) (in-package :cl-tty.slot)
(defvar *slots* (make-hash-table :test #'equal) (defvar *slots* (make-hash-table :test 'equal)
"Hash table mapping slot name (string) -> list of (order . render-fn) pairs.") "Hash table mapping slot name (string) -> plist of slot data.
Each entry: (:mode <mode> :entries <(order . render-fn) list>).")
#+END_SRC #+END_SRC
*** defslot: Register a Render Function ** defslot: Register a Render Function
~defslot~ inserts a new ~(order . render-fn)~ entry into the slot's ~defslot~ inserts a new ~(order . render-fn)~ entry into the slot's
entry list. If the slot has no previous entries a fresh list is entry list. The behavior depends on the slot's mode, which is set on
created; otherwise the new entry is consed onto the existing list and the first call and frozen for subsequent calls:
the whole list is sorted by ~order~ ascending. The ~render-fn~ itself
is returned so callers can use it inline or store it.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp :noweb no - ~:stack~ — merge into existing entries, sorted by order
(defun defslot (name &key (order 0) render-fn) - ~:replace~ — clear all previous entries, keep only the new one
- ~:single-winner~ — no-op if the slot already has entries
The ~render-fn~ itself is returned so callers can use it inline.
The mode parameter is accepted but only respected on the first
registration for a slot. This prevents a later registration from
changing the slot's semantics out from under earlier registrations.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
(defun defslot (name &key (order 0) render-fn (mode :stack))
(let* ((key (string name)) (let* ((key (string name))
(entries (gethash key *slots*))) (slot (gethash key *slots*)))
(if (null entries) (if (null slot)
(setf (gethash key *slots*) (list (cons order render-fn))) ;; First registration — set mode and create entry
(setf (gethash key *slots*) (setf (gethash key *slots*)
(sort (cons (cons order render-fn) entries) #'< :key #'car)))) (list :mode mode
:entries (list (cons order render-fn))))
;; Existing slot — respect frozen mode
(let ((entries (getf slot :entries)))
(ecase (getf slot :mode)
(:stack
(setf (getf slot :entries)
(sort (cons (cons order render-fn) entries)
#'< :key #'car)))
(:replace
(setf (getf slot :entries)
(list (cons order render-fn))))
(:single-winner
;; First registration already present — no-op
(values))))))
render-fn) render-fn)
#+END_SRC #+END_SRC
*** slot-render: Invoke All Render Functions ** slot-render: Invoke Render Functions Per Mode
Iterates over the slot's registered entries and calls each non-nil ~slot-render~ dispatches on the slot's mode:
render function with the supplied ~args~. Entries with a nil handler
are silently skipped — this is important because ~defslot~ accepts an
optional ~:render-fn~ keyword that defaults to ~nil~, and we must
guard against calling ~apply~ on nil (a type error in Common Lisp).
Returns a list of results, one per non-nil render function. Returns - ~:stack~ — call every non-nil render function in order, return a list
~nil~ (via ~when~) if the slot has no registrations at all. of results. This is the most flexible mode, supporting multiple
contributors per slot.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp :noweb no - ~:replace~ — call only the single registered function (the last one
registered, since :replace clears earlier entries). Returns a single
value, not a list.
- ~:single-winner~ — call only the first registered function (lowest
order). Subsequent registrations were silently dropped during defslot.
Returns ~nil~ if the slot has no registrations or if the handler is nil.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
(defun slot-render (slot-name &rest args) (defun slot-render (slot-name &rest args)
(let ((entries (gethash (string slot-name) *slots*))) (let ((slot (gethash (string slot-name) *slots*)))
(when entries (when slot
(mapcar (lambda (entry) (let ((mode (getf slot :mode))
(let ((fn (cdr entry))) (entries (getf slot :entries)))
(when fn (apply fn args)))) (ecase mode
entries)))) (:stack
(mapcar (lambda (entry)
(let ((fn (cdr entry)))
(when fn (apply fn args))))
entries))
(:replace
(let ((fn (cdar (last entries))))
(when fn (apply fn args))))
(:single-winner
(let ((fn (cdar entries)))
(when fn (apply fn args)))))))))
#+END_SRC #+END_SRC
*** slot-p: Check Slot Existence ** slot-p: Check Slot Existence
Uses ~nth-value 1~ of ~gethash~ which returns ~t~ if the key is Uses ~nth-value 1~ of ~gethash~ which returns ~t~ if the key is
present (even if the value is ~nil~) or ~nil~ if absent. This is the present (even if the value is ~nil~) or ~nil~ if absent. This is the
canonical Common Lisp idiom for testing hash-table membership. canonical Common Lisp idiom for testing hash-table membership.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp :noweb no #+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
(defun slot-p (slot-name) (defun slot-p (slot-name)
(nth-value 1 (gethash (string slot-name) *slots*))) (nth-value 1 (gethash (string slot-name) *slots*)))
#+END_SRC #+END_SRC
*** clear-slot: Remove All Registrations ** clear-slot: Remove All Registrations
Calls ~remhash~ to delete the slot's entry from the hash table Calls ~remhash~ to delete the slot's entry from the hash table
entirely. After this call ~slot-p~ returns false and ~slot-render~ entirely. After this call ~slot-p~ returns false and ~slot-render~
returns nil for the given slot name. returns nil for the given slot name.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp :noweb no #+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
(defun clear-slot (slot-name) (defun clear-slot (slot-name)
(remhash (string slot-name) *slots*)) (remhash (string slot-name) *slots*))
#+END_SRC #+END_SRC
*** list-slots: Enumerate Registered Slots ** list-slots: Enumerate Registered Slots
Iterates over all hash keys in ~*slots*~ and returns them as a list. Iterates over all hash keys in ~*slots*~ and returns them as a list.
Only slots that have been registered (i.e. have at least one entry) Only slots that have been registered (i.e. have at least one entry)
appear in the result. appear in the result.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp :noweb no #+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
(defun list-slots () (defun list-slots ()
(loop for key being the hash-keys of *slots* collect key)) (loop for key being the hash-keys of *slots* collect key))
#+END_SRC #+END_SRC
*** Tests ** Tests
The test suite uses FiveAM and exercises each public function. The test suite uses FiveAM and exercises each public function,
including mode-specific behavior.
**** Test Package and Suite *** Test Package and Suite
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp :noweb no #+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
(defpackage :cl-tty-slot-test (:use :cl :cl-tty.slot :fiveam)) (defpackage :cl-tty-slot-test (:use :cl :cl-tty.slot :fiveam))
(in-package :cl-tty-slot-test) (in-package :cl-tty-slot-test)
@@ -142,18 +207,21 @@ The test suite uses FiveAM and exercises each public function.
(in-suite slot-suite) (in-suite slot-suite)
#+END_SRC #+END_SRC
**** defslot-register: Registering a slot makes it visible *** defslot-register: Registering a slot makes it visible
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp :noweb no #+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
(def-test defslot-register () (def-test defslot-register ()
(clear-slot :test-slot) (clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "hello")) (defslot :test-slot :order 1 :render-fn (lambda () "hello"))
(is-true (slot-p :test-slot))) (is-true (slot-p :test-slot)))
#+END_SRC #+END_SRC
**** slot-render-calls: Registered functions are called in order *** slot-render-calls: Stack mode calls all functions in order
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp :noweb no Verifies that ~:stack~ mode preserves multiple registrations and calls
them in ascending order sequence.
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
(def-test slot-render-calls () (def-test slot-render-calls ()
(clear-slot :test-slot) (clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "a")) (defslot :test-slot :order 1 :render-fn (lambda () "a"))
@@ -161,20 +229,76 @@ The test suite uses FiveAM and exercises each public function.
(is (equal '("a" "b") (slot-render :test-slot)))) (is (equal '("a" "b") (slot-render :test-slot))))
#+END_SRC #+END_SRC
**** slot-render-empty: Unregistered slot returns nil *** slot-render-empty: Unregistered slot returns nil
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp :noweb no #+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
(def-test slot-render-empty () (def-test slot-render-empty ()
(clear-slot :ghost) (clear-slot :ghost)
(is-false (slot-render :ghost))) (is-false (slot-render :ghost)))
#+END_SRC #+END_SRC
**** clear-slot-removes: Clearing a slot makes it absent *** clear-slot-removes: Clearing a slot makes it absent
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp :noweb no #+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
(def-test clear-slot-removes () (def-test clear-slot-removes ()
(clear-slot :test-slot) (clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "x")) (defslot :test-slot :order 1 :render-fn (lambda () "x"))
(clear-slot :test-slot) (clear-slot :test-slot)
(is-false (slot-p :test-slot))) (is-false (slot-p :test-slot)))
#+END_SRC #+END_SRC
*** stack-mode-multiple-entries: Stack keeps all registrations
Verifies that ~:stack~ mode (default) accumulates entries across
multiple ~defslot~ calls.
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
(def-test stack-mode-multiple-entries ()
(clear-slot :stack-test)
(defslot :stack-test :order 1 :render-fn (lambda () "first"))
(defslot :stack-test :order 2 :render-fn (lambda () "second"))
(defslot :stack-test :order 3 :render-fn (lambda () "third"))
(is (equal '("first" "second" "third") (slot-render :stack-test))))
#+END_SRC
*** replace-mode-last-wins: Replace keeps only the last registration
Verifies that ~:replace~ mode discards previous entries on each new
~defslot~ call.
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
(def-test replace-mode-last-wins ()
(clear-slot :replace-test)
(defslot :replace-test :mode :replace :order 1 :render-fn (lambda () "old"))
(defslot :replace-test :mode :replace :order 2 :render-fn (lambda () "new"))
(is (equal "new" (slot-render :replace-test))))
#+END_SRC
*** single-winner-mode-first-wins: Single-winner keeps only the first
Verifies that ~:single-winner~ mode ignores subsequent registrations.
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
(def-test single-winner-mode-first-wins ()
(clear-slot :winner-test)
(defslot :winner-test :mode :single-winner :order 1
:render-fn (lambda () "alpha"))
(defslot :winner-test :mode :single-winner :order 2
:render-fn (lambda () "beta"))
(is (equal "alpha" (slot-render :winner-test))))
#+END_SRC
*** clear-slot-removes-mode: Clearing resets mode, allowing new mode
Verifies that clearing a slot removes the mode lock, so a subsequent
~defslot~ can set a new mode.
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
(def-test clear-slot-removes-mode ()
(clear-slot :mode-test)
(defslot :mode-test :mode :replace :render-fn (lambda () "only"))
(clear-slot :mode-test)
(defslot :mode-test :mode :stack :render-fn (lambda () "fresh"))
(is-true (slot-p :mode-test))
(is (equal '("fresh") (slot-render :mode-test))))
#+END_SRC

51
src/components/slot.lisp
View File

@@ -1,24 +1,49 @@
(in-package :cl-tty.slot) (in-package :cl-tty.slot)
(defvar *slots* (make-hash-table :test #'equal) (defvar *slots* (make-hash-table :test 'equal)
"Hash table mapping slot name (string) -> list of (order . render-fn) pairs.") "Hash table mapping slot name (string) -> plist of slot data.
Each entry: (:mode <mode> :entries <(order . render-fn) list>).")
(defun defslot (name &key (order 0) render-fn) (defun defslot (name &key (order 0) render-fn (mode :stack))
(let* ((key (string name)) (let* ((key (string name))
(entries (gethash key *slots*))) (slot (gethash key *slots*)))
(if (null entries) (if (null slot)
(setf (gethash key *slots*) (list (cons order render-fn))) ;; First registration — set mode and create entry
(setf (gethash key *slots*) (setf (gethash key *slots*)
(sort (cons (cons order render-fn) entries) #'< :key #'car)))) (list :mode mode
:entries (list (cons order render-fn))))
;; Existing slot — respect frozen mode
(let ((entries (getf slot :entries)))
(ecase (getf slot :mode)
(:stack
(setf (getf slot :entries)
(sort (cons (cons order render-fn) entries)
#'< :key #'car)))
(:replace
(setf (getf slot :entries)
(list (cons order render-fn))))
(:single-winner
;; First registration already present — no-op
(values))))))
render-fn) render-fn)
(defun slot-render (slot-name &rest args) (defun slot-render (slot-name &rest args)
(let ((entries (gethash (string slot-name) *slots*))) (let ((slot (gethash (string slot-name) *slots*)))
(when entries (when slot
(mapcar (lambda (entry) (let ((mode (getf slot :mode))
(let ((fn (cdr entry))) (entries (getf slot :entries)))
(when fn (apply fn args)))) (ecase mode
entries)))) (:stack
(mapcar (lambda (entry)
(let ((fn (cdr entry)))
(when fn (apply fn args))))
entries))
(:replace
(let ((fn (cdar (last entries))))
(when fn (apply fn args))))
(:single-winner
(let ((fn (cdar entries)))
(when fn (apply fn args)))))))))
(defun slot-p (slot-name) (defun slot-p (slot-name)
(nth-value 1 (gethash (string slot-name) *slots*))) (nth-value 1 (gethash (string slot-name) *slots*)))

29
tests/slot-tests.lisp
View File

@@ -24,3 +24,32 @@
(defslot :test-slot :order 1 :render-fn (lambda () "x")) (defslot :test-slot :order 1 :render-fn (lambda () "x"))
(clear-slot :test-slot) (clear-slot :test-slot)
(is-false (slot-p :test-slot))) (is-false (slot-p :test-slot)))
(def-test stack-mode-multiple-entries ()
(clear-slot :stack-test)
(defslot :stack-test :order 1 :render-fn (lambda () "first"))
(defslot :stack-test :order 2 :render-fn (lambda () "second"))
(defslot :stack-test :order 3 :render-fn (lambda () "third"))
(is (equal '("first" "second" "third") (slot-render :stack-test))))
(def-test replace-mode-last-wins ()
(clear-slot :replace-test)
(defslot :replace-test :mode :replace :order 1 :render-fn (lambda () "old"))
(defslot :replace-test :mode :replace :order 2 :render-fn (lambda () "new"))
(is (equal "new" (slot-render :replace-test))))
(def-test single-winner-mode-first-wins ()
(clear-slot :winner-test)
(defslot :winner-test :mode :single-winner :order 1
:render-fn (lambda () "alpha"))
(defslot :winner-test :mode :single-winner :order 2
:render-fn (lambda () "beta"))
(is (equal "alpha" (slot-render :winner-test))))
(def-test clear-slot-removes-mode ()
(clear-slot :mode-test)
(defslot :mode-test :mode :replace :render-fn (lambda () "only"))
(clear-slot :mode-test)
(defslot :mode-test :mode :stack :render-fn (lambda () "fresh"))
(is-true (slot-p :mode-test))
(is (equal '("fresh") (slot-render :mode-test))))