Amr Gharbeia
4c3f5fe65a
The theme system (theme class, define-preset, load-preset, theme-color) was part of the bloated cl-tty.box package even though it had nothing to do with boxes, spans, or component rendering. It only used cl-tty.backend for the *theme-colors* hash table. Changes: - added defpackage :cl-tty.theme as the first block in theme.lisp (inline defpackage avoids ASDF dependency ordering issues with separate package files) - removed theme exports from cl-tty.box defpackage - theme tests now run in their own THEME-SUITE (16 tests) instead of part of BOX-SUITE - box suite drops from 64 to 48 tests (16 moved to theme suite) - updated ASDF, run-all-tests.lisp All 15 test suites pass at 100%.
400 lines
15 KiB
Org Mode
400 lines
15 KiB
Org Mode
#+TITLE: Theme Engine
|
|
#+STARTUP: content
|
|
#+FILETAGS: :cl-tty:components:
|
|
|
|
* Overview
|
|
|
|
The theme engine provides semantic color tokens that decouple visual
|
|
design from implementation code. Instead of writing ~:bright-yellow~ or
|
|
~\"#FFD700\"~ everywhere, components use ~:accent~, ~:error~,
|
|
~:background~ — semantic roles that resolve to concrete hex values
|
|
through the current theme.
|
|
|
|
This means:
|
|
- Themes are swappable at runtime (default dark/light, nord, etc.)
|
|
- Components never reference hex values directly
|
|
- A single ~load-preset~ call changes the entire application's look
|
|
|
|
The engine is intentionally simple: a ~theme~ class holding a hash
|
|
table of role→hex mappings, a set of built-in presets defined via
|
|
~define-preset~, and ~load-preset~ which populates both the theme
|
|
and the backend's ~*theme-colors*~ for SGR resolution.
|
|
|
|
* Contract
|
|
|
|
** Theme class
|
|
|
|
- ~(make-theme &key mode)~ — create a theme in ~:dark~ or ~:light~ mode
|
|
- ~(theme-mode theme)~ — get current mode
|
|
- ~(theme-color theme role)~ → hex string or nil
|
|
- ~(setf (theme-color theme role) hex)~ — set a role
|
|
|
|
** Presets
|
|
|
|
- ~(define-preset name &key dark light)~ — register a preset with
|
|
dark and light plists of role→hex pairs
|
|
- ~(load-preset theme preset-name)~ — apply a preset to ~theme~.
|
|
Also populates ~cl-tty.backend:*theme-colors*~ so the backend can
|
|
resolve semantic colors to hex at render time.
|
|
- Unknown presets signal a ~warning~ (not an error).
|
|
|
|
** Built-in presets
|
|
|
|
- ~:default~ — gold/accent on dark blue-gray
|
|
- ~:nord~ — cool blue nord palette
|
|
|
|
* Package definition
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
|
(defpackage :cl-tty.theme
|
|
(:use :cl :cl-tty.backend)
|
|
(:export
|
|
#:theme #:make-theme #:theme-mode
|
|
#:theme-color #:load-preset #:define-preset))
|
|
(in-package :cl-tty.theme)
|
|
#+END_SRC
|
|
|
|
* Tests
|
|
|
|
** Test header
|
|
|
|
Package declaration and test suite registration.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
|
(defpackage :cl-tty-theme-test
|
|
(:use :cl :cl-tty.theme :fiveam)
|
|
(:export #:run-tests))
|
|
(in-package :cl-tty-theme-test)
|
|
|
|
(def-suite theme-suite :description "Theme engine tests")
|
|
(in-suite theme-suite)
|
|
|
|
(defun run-tests ()
|
|
(let ((result (run 'theme-suite)))
|
|
(fiveam:explain! result)
|
|
(uiop:quit 0)))
|
|
#+END_SRC
|
|
|
|
** Test: theme-create-default
|
|
|
|
Verifies basic construction of a theme with default ~:dark~ mode. The
|
|
~make-theme~ constructor should return an instance of the ~theme~
|
|
class with ~:dark~ as the initial mode.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
|
(test theme-create-default
|
|
"A theme can be created with default mode"
|
|
(let ((th (make-theme)))
|
|
(is (typep th 'theme))
|
|
(is (eql (theme-mode th) :dark))))
|
|
#+END_SRC
|
|
|
|
** Test: theme-create-light
|
|
|
|
Verifies explicit ~:light~ mode works. Both modes must produce themes
|
|
ready to accept color role assignments.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
|
(test theme-create-light
|
|
"A theme can be created in light mode"
|
|
(let ((th (make-theme :mode :light)))
|
|
(is (eql (theme-mode th) :light))))
|
|
#+END_SRC
|
|
|
|
** Test: theme-color-set-and-get
|
|
|
|
Confirms ~setf~ on ~theme-color~ stores a value and that reading it
|
|
back returns the same string. This is the core read/write contract
|
|
for the theme's role map.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
|
(test theme-color-set-and-get
|
|
"theme-color setf/get works"
|
|
(let ((th (make-theme)))
|
|
(setf (theme-color th :primary) "#FFD700")
|
|
(is (string= (theme-color th :primary) "#FFD700"))))
|
|
#+END_SRC
|
|
|
|
** Test: theme-color-unknown-returns-nil
|
|
|
|
Unassigned roles must return ~nil~ rather than signaling an error.
|
|
This allows components to degrade gracefully when a theme doesn't
|
|
define every possible role.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
|
(test theme-color-unknown-returns-nil
|
|
"Unknown roles return nil"
|
|
(let ((th (make-theme)))
|
|
(is (null (theme-color th :nonexistent)))))
|
|
#+END_SRC
|
|
|
|
** Test: load-default-dark-preset
|
|
|
|
Loading the ~:default~ preset in ~:dark~ mode must populate a set of
|
|
expected roles with their documented hex values. We spot-check
|
|
~:primary~, ~:background~, and ~:error~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
|
(test load-default-dark-preset
|
|
"Loading the default dark preset populates roles"
|
|
(let ((th (make-theme :mode :dark)))
|
|
(load-preset th :default)
|
|
(is (string= (theme-color th :primary) "#FFD700"))
|
|
(is (string= (theme-color th :background) "#1A1A2E"))
|
|
(is (string= (theme-color th :error) "#FF4444"))))
|
|
#+END_SRC
|
|
|
|
** Test: load-default-light-preset
|
|
|
|
The light variant of ~:default~ must produce different values (warm
|
|
tones on near-white). This validates the mode dispatch inside
|
|
~load-preset~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
|
(test load-default-light-preset
|
|
"Light variant has different colors"
|
|
(let ((th (make-theme :mode :light)))
|
|
(load-preset th :default)
|
|
(is (string= (theme-color th :primary) "#B8860B"))
|
|
(is (string= (theme-color th :background) "#F8F9FA"))))
|
|
#+END_SRC
|
|
|
|
** Test: load-nord-preset
|
|
|
|
The ~:nord~ preset must produce a distinct cool-blue palette,
|
|
different from the ~:default~ gold scheme. This validates independent
|
|
preset data.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
|
(test load-nord-preset
|
|
"Nord preset has different colors than default"
|
|
(let ((th (make-theme :mode :dark)))
|
|
(load-preset th :nord)
|
|
(is (string= (theme-color th :primary) "#88C0D0"))
|
|
(is (string= (theme-color th :background) "#2E3440"))))
|
|
#+END_SRC
|
|
|
|
** Test: load-preset-unknown-warns
|
|
|
|
An unknown preset name must signal a ~warning~ (not an ~error~) and
|
|
leave the theme's roles unpopulated. This ensures graceful degradation
|
|
when a preset is missing.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
|
(test load-preset-unknown-warns
|
|
"Unknown preset warns but doesn't error"
|
|
(let ((th (make-theme)))
|
|
(signals warning (load-preset th :nonexistent))
|
|
(is (null (theme-color th :primary)))))
|
|
#+END_SRC
|
|
|
|
** Test: preset-switch-mode
|
|
|
|
Switching the mode at runtime and re-loading the same preset must
|
|
produce the other variant's colors. This validates that ~load-preset~
|
|
reads the current ~theme-mode~ each time, not a cached value.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
|
|
(test preset-switch-mode
|
|
"Switching mode and reloading changes colors"
|
|
(let ((th (make-theme :mode :dark)))
|
|
(load-preset th :default)
|
|
(is (string= (theme-color th :background) "#1A1A2E"))
|
|
(setf (theme-mode th) :light)
|
|
(load-preset th :default)
|
|
(is (string= (theme-color th :background) "#F8F9FA"))))
|
|
#+END_SRC
|
|
|
|
* Implementation
|
|
|
|
** Theme class
|
|
|
|
The ~theme~ class holds a mode flag (~:dark~/~:light~) and a hash
|
|
table of role→hex mappings. The hash table gives O(1) lookups for
|
|
~theme-color~ and clean iteration for ~load-preset~.
|
|
|
|
*** defclass theme
|
|
|
|
The class has two slots: ~mode~ (defaulting to ~:dark~, with an
|
|
~:initarg~ and ~accessor~ for reads and writes) and ~roles~ (a hash
|
|
table storing role→hex mappings, lazily initialized to an empty
|
|
hash table). Using ~make-hash-table~ as the ~:initform~ ensures each
|
|
instance gets its own table instead of sharing one.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
|
(in-package :cl-tty.theme)
|
|
|
|
(defclass theme ()
|
|
((mode :initform :dark :initarg :mode :accessor theme-mode)
|
|
(roles :initform (make-hash-table) :accessor theme-roles)))
|
|
#+END_SRC
|
|
|
|
*** defun make-theme
|
|
|
|
A convenience constructor that delegates to ~make-instance~. Wrapping
|
|
this in a function lets us change the constructor signature without
|
|
breaking callers. Mode defaults to ~:dark~, suitable for dark-background
|
|
terminals; callers pass ~:mode :light~ for light backgrounds.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
|
(defun make-theme (&key (mode :dark))
|
|
(make-instance 'theme :mode mode))
|
|
#+END_SRC
|
|
|
|
** Color resolution
|
|
|
|
*** defun theme-color
|
|
|
|
Reads a semantic role from the theme's roles hash table. Uses
|
|
~gethash~ which returns ~nil~ for unknown roles — so missing roles
|
|
degrade gracefully rather than crashing. The backend treats ~nil~ as
|
|
"use default."
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
|
(defun theme-color (theme role)
|
|
"Resolve a semantic ROLE to a hex color string in THEME."
|
|
(gethash role (theme-roles theme)))
|
|
#+END_SRC
|
|
|
|
*** defun (setf theme-color)
|
|
|
|
The setter companion to ~theme-color~. Storing via ~setf~ writes
|
|
directly into the roles hash table. Uses ~setf~ on ~gethash~ which
|
|
creates the entry if it doesn't exist.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
|
(defun (setf theme-color) (hex theme role)
|
|
"Set the hex color for a semantic ROLE in THEME."
|
|
(setf (gethash role (theme-roles theme)) hex))
|
|
#+END_SRC
|
|
|
|
** Global preset registry
|
|
|
|
A hash table (keyed by ~eq~-comparable keywords) stores all registered
|
|
presets. Using ~#\\'~ (quoted list) instead of an alist or nested hash
|
|
table keeps preset data inline and readable.
|
|
|
|
*** defparameter *presets*
|
|
|
|
Global storage for preset definitions. The ~eq~ test matches keyword
|
|
identity, which is the fastest hash test for keywords.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
|
(defparameter *presets* (make-hash-table :test #'eq))
|
|
#+END_SRC
|
|
|
|
*** defmacro define-preset
|
|
|
|
Registers a preset by name (~keyword~) at macro-expansion time. The
|
|
~check-type~ enforces that names are keywords. The macro expands to a
|
|
~setf~ of ~gethash~, storing a plist of ~:dark~ and ~:light~ variants.
|
|
Using a quoted list (not an alist or hash) keeps the data compact.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
|
(defmacro define-preset (name &key dark light)
|
|
"Define a theme preset with DARK and LIGHT variants.
|
|
NAME should be a keyword (e.g., :default, :nord)."
|
|
(check-type name keyword)
|
|
`(setf (gethash ,name *presets*) '(:dark ,dark :light ,light)))
|
|
#+END_SRC
|
|
|
|
** Loading presets
|
|
|
|
*** defun load-preset
|
|
|
|
The central function that applies a named preset to a theme. Does
|
|
double duty: populates the theme's role map and the backend's
|
|
~*theme-colors*~. This second step is what makes semantic colors work
|
|
at the SGR level — when the backend renders ~:accent~, it looks up
|
|
~*theme-colors*~ to get the hex, then generates the escape sequence.
|
|
|
|
The ~loop for (role hex) on colors by #'cddr~ iterates the plist in
|
|
pairs, setting both the theme entry and the backend entry. If the
|
|
preset doesn't exist, ~warn~ is called instead of ~error~ — a missing
|
|
preset shouldn't crash the application.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
|
(defun load-preset (theme preset-name)
|
|
"Load PRESET-NAME colors into THEME.
|
|
Side-effect: populates cl-tty.backend:*theme-colors* so that semantic
|
|
color roles resolve to hex at SGR generation time."
|
|
(let ((preset (gethash preset-name *presets*)))
|
|
(if preset
|
|
(let* ((colors (if (eql (theme-mode theme) :dark)
|
|
(getf preset :dark)
|
|
(getf preset :light)))
|
|
;; Populate backend theme color map
|
|
(theme-map cl-tty.backend:*theme-colors*))
|
|
;; Set theme colors
|
|
(loop for (role hex) on colors by #'cddr
|
|
do (setf (theme-color theme role) hex)
|
|
(setf (gethash role theme-map) hex)))
|
|
(warn "Unknown preset: ~S" preset-name))))
|
|
#+END_SRC
|
|
|
|
** Built-in presets
|
|
|
|
Two presets are built in:
|
|
|
|
*** Default preset
|
|
|
|
Gold/accent palette on dark navy background. The light variant
|
|
inverts to warm tones on near-white.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
|
(define-preset :default
|
|
:dark (:primary "#FFD700" :secondary "#B8860B" :accent "#FFA500"
|
|
:error "#FF4444" :warning "#FF8800" :success "#44BB44" :info "#4488FF"
|
|
:text "#FFFFFF" :text-muted "#888888"
|
|
:background "#1A1A2E" :background-panel "#16213E" :background-element "#0F3460"
|
|
:border "#334155" :border-active "#FFD700"
|
|
:diff-added "#164B16" :diff-removed "#4B1616" :diff-context "#1A1A2E"
|
|
:markdown-heading "#FFD700" :markdown-code "#334155"
|
|
:markdown-link "#4488FF" :markdown-quote "#888888"
|
|
:syntax-keyword "#FF79C6" :syntax-function "#50FA7B"
|
|
:syntax-string "#F1FA8C" :syntax-number "#BD93F9"
|
|
:syntax-comment "#6272A4" :syntax-type "#8BE9FD")
|
|
:light (:primary "#B8860B" :secondary "#8B6914" :accent "#FF8C00"
|
|
:error "#CC0000" :warning "#CC6600" :success "#228B22" :info "#0055CC"
|
|
:text "#1A1A2E" :text-muted "#888888"
|
|
:background "#F8F9FA" :background-panel "#FFFFFF" :background-element "#E9ECEF"
|
|
:border "#DEE2E6" :border-active "#B8860B"
|
|
:diff-added "#DFD" :diff-removed "#FDD" :diff-context "#F8F9FA"
|
|
:markdown-heading "#B8860B" :markdown-code "#E9ECEF"
|
|
:markdown-link "#0055CC" :markdown-quote "#888888"
|
|
:syntax-keyword "#D63384" :syntax-function "#198754"
|
|
:syntax-string "#FFC107" :syntax-number "#6F42C1"
|
|
:syntax-comment "#6C757D" :syntax-type "#0DCAF0"))
|
|
#+END_SRC
|
|
|
|
*** Nord preset
|
|
|
|
Cool blue palette inspired by Arctic Studio's Nord theme. Softer
|
|
contrast than default, designed for reduced eye strain.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
|
|
(define-preset :nord
|
|
:dark (:primary "#88C0D0" :secondary "#81A1C1" :accent "#5E81AC"
|
|
:error "#BF616A" :warning "#D08770" :success "#A3BE8C" :info "#B48EAD"
|
|
:text "#ECEFF4" :text-muted "#616E88"
|
|
:background "#2E3440" :background-panel "#3B4252" :background-element "#434C5E"
|
|
:border "#4C566A" :border-active "#88C0D0"
|
|
:diff-added "#164B16" :diff-removed "#4B1616" :diff-context "#2E3440"
|
|
:markdown-heading "#88C0D0" :markdown-code "#3B4252"
|
|
:markdown-link "#81A1C1" :markdown-quote "#616E88"
|
|
:syntax-keyword "#81A1C1" :syntax-function "#A3BE8C"
|
|
:syntax-string "#EBCB8B" :syntax-number "#B48EAD"
|
|
:syntax-comment "#616E88" :syntax-type "#88C0D0")
|
|
:light (:primary "#5E81AC" :secondary "#81A1C1" :accent "#88C0D0"
|
|
:error "#BF616A" :warning "#D08770" :success "#A3BE8C" :info "#B48EAD"
|
|
:text "#2E3440" :text-muted "#8F9BB3"
|
|
:background "#ECEFF4" :background-panel "#FFFFFF" :background-element "#E5E9F0"
|
|
:border "#D8DEE9" :border-active "#5E81AC"
|
|
:diff-added "#DFD" :diff-removed "#FDD" :diff-context "#ECEFF4"
|
|
:markdown-heading "#5E81AC" :markdown-code "#E5E9F0"
|
|
:markdown-link "#81A1C1" :markdown-quote "#8F9BB3"
|
|
:syntax-keyword "#81A1C1" :syntax-function "#A3BE8C"
|
|
:syntax-string "#D08770" :syntax-number "#B48EAD"
|
|
:syntax-comment "#8F9BB3" :syntax-type "#88C0D0"))
|
|
#+END_SRC
|