cl-tty/org/slot.org

Plugin / Slot System (v0.11.0)

• Overview
  • Contract
  • Implementation

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

(defpackage :cl-tty.slot
  (:use :cl)
  (:export
   #:defslot
   #:slot-render
   #:slot-p
   #:clear-slot
   #:list-slots
   #:*slots*))

(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))

(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)))