Files
cl-tty/org/slot.org

113 lines
3.6 KiB
Org Mode

#+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)
#+END_SRC
*** Bug Fixes (v1.0.0): nil handler guard in slot-render
~slot-render~ called ~(apply (cdr entry) args)~ unconditionally, but
~defslot~ stores ~(order . render-fn)~ pairs where ~render-fn~ can be
~nil~ (if called without ~:render-fn~). This caused a type error when
~apply~ received ~nil~ as the function argument.
Fix: Check ~(when fn)~ before calling ~apply~. Entries with a nil
handler are silently skipped.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp :noweb no
(defun slot-render (slot-name &rest args)
(let ((entries (gethash (string slot-name) *slots*)))
(when entries
(mapcar (lambda (entry)
(let ((fn (cdr entry)))
(when fn (apply fn 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