v0.8.0: tangle to XDG (~/.local/share/cl-tty/), remove stale memex .lisp files

This commit is contained in:
2026-05-18 13:04:10 -04:00
parent e3415cee73
commit af572d5a8c
67 changed files with 518 additions and 6301 deletions

View File

@@ -107,7 +107,7 @@ FiveAM requires a test package with :use of :fiveam and the system
under test. The suite name ~backend-suite~ is referenced by the
multi-suite runner in ~run-all-tests.lisp~.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(defpackage :cl-tty-backend-test
(:use :cl :fiveam :cl-tty.backend)
(:export #:run-tests))
@@ -124,7 +124,7 @@ creates a simple-backend pointed at a string output stream and
returns both the backend and the stream. The test can then call
~get-output-stream-string~ after the operation.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(defun make-capturing-backend ()
"Create a simple-backend that writes to a string stream."
(let* ((s (make-string-output-stream))
@@ -138,7 +138,7 @@ The ~run-tests~ function is an alternative entry point for
interactive use or for downstream scripts that want to run only the
backend suite. It prints results with FiveAM's explainer.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(defun run-tests ()
"Run all backend tests."
(let ((result (run 'backend-suite)))
@@ -153,7 +153,7 @@ shut down without errors. Also confirms that the capability query
returns nil for truecolor — the defining characteristic of the
simple backend.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test simple-backend-lifecycle
"simple-backend can be created and shut down"
(let ((b (make-simple-backend)))
@@ -172,7 +172,7 @@ and position. It merely appends the text string to the output stream.
This test confirms that passing style keywords does not change the
output — the captured stream should contain exactly the string "hello".
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test simple-backend-draw-text
"simple-backend renders text at position, ignoring style"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -190,7 +190,7 @@ Border rendering on the simple backend uses ASCII characters:
This test checks that the top edge contains "+---+" and a middle
row shows "| |" with pipe-separated empty space.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test simple-backend-draw-border
"simple-backend draws ASCII border with +-| characters"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -209,7 +209,7 @@ falls back to the same ASCII characters. This test verifies that
requesting ~:rounded~ produces the same output as ~:single~,
confirming the graceful fallback.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test simple-backend-draw-rounded
"simple-backend falls back to straight edges for rounded style"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -227,7 +227,7 @@ Hyperlinks are meaningless on a simple terminal output. The simple
backend's ~draw-link~ should output only the visible text and
completely ignore the URL parameter.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test simple-backend-draw-link
"simple-backend renders link as plain text"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -244,7 +244,7 @@ Truncation markers are rendered as three literal dots on the simple
backend. This test checks that ~draw-ellipsis~ outputs exactly "..."
at the specified position.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test simple-backend-draw-ellipsis
"simple-backend renders ... for ellipsis"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -262,7 +262,7 @@ backend. This comprehensive check iterates every feature keyword
to ensure the simple backend makes no false claims about its
capabilities.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test capable-p-known-features
"capable-p returns nil for all features on simple-backend"
(let ((b (make-simple-backend)))
@@ -281,7 +281,7 @@ representing columns and lines. This test verifies the return types
and a minimum size threshold (10 columns, 3 lines) for any
terminal-like environment.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test backend-size-returns-integers
"backend-size returns two integer values"
(let ((b (make-simple-backend)))
@@ -302,7 +302,7 @@ test calls ~cursor-hide~, ~cursor-show~, ~cursor-style~,
~begin-sync~, and ~end-sync~ and confirms none of them produce
multiple return values.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test default-methods-are-no-ops
"Default backend methods don't error"
(let ((b (make-simple-backend)))
@@ -322,7 +322,7 @@ output. This test verifies that wrapping a draw-text call between
~begin-sync~ and ~end-sync~ produces exactly the same output as
draw-text alone — no extra escape sequences are emitted.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test sync-is-noop-on-simple
"begin-sync and end-sync produce no output on simple-backend"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -342,7 +342,7 @@ colors. Since the simple backend emits no escape sequences,
~draw-rect~ should produce zero output regardless of the fill
color requested.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test draw-rect-fills-area-correctly
"draw-rect with background writes nothing to output (simple-backend no-op)"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -359,7 +359,7 @@ The ~detect-backend~ function must return a backend instance
suitable for the current environment. This test verifies that the
returned value is of type ~backend~ (satisfying the protocol).
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test detection-returns-backend-instance
"detect-backend returns a valid backend instance"
(let ((be (cl-tty.backend:detect-backend)))
@@ -373,7 +373,7 @@ subsequent calls are cheap. This test clears the cache, calls
detect-backend, and verifies that the special variable is no longer
nil.
#+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/tests.lisp
(test detection-caches-result
"detect-backend caches the result in *detected-backend*"
(let ((*detected-backend* nil))
@@ -395,7 +395,7 @@ The package also exports internal symbols (~sgr-fg~, ~hex-to-24bit~,
etc.) for testing. These let the test suite verify escape sequence
construction without actually rendering to a terminal.
#+BEGIN_SRC lisp :tangle ../src/backend/package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/package.lisp
(defpackage :cl-tty.backend
(:use :cl)
(:export
@@ -445,7 +445,7 @@ actually support.
An empty base class. There are no slots because backends manage
their own state (e.g., output streams) directly.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(in-package :cl-tty.backend)
(defclass backend () ())
@@ -457,7 +457,7 @@ Sets up terminal raw mode and enables features. The default method
returns the backend instance unchanged — subclasses that need setup
override this.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric initialize-backend (backend)
(:method ((b backend)) b))
#+END_SRC
@@ -468,7 +468,7 @@ Restores terminal to cooked mode, resets colors, shows cursor.
Must be called on exit. The default method is a no-op returning
multiple values; subclasses with terminal state override this.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric shutdown-backend (backend)
(:method ((b backend)) (values)))
#+END_SRC
@@ -478,7 +478,7 @@ multiple values; subclasses with terminal state override this.
Returns terminal dimensions as two values: columns and lines.
The default of 80x24 is a safe fallback that works everywhere.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric backend-size (backend)
(:method ((b backend))
(values 80 24)))
@@ -490,7 +490,7 @@ Writes a raw string to the terminal output. Has no default method
because every backend must provide its own output mechanism — there
is no reasonable universal behavior.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric backend-write (backend string))
#+END_SRC
@@ -500,7 +500,7 @@ Clears the entire screen and resets the cursor to (0,0). The default
method sends the ANSI escape sequence ~ESC[2J~ (clear entire screen)
followed by ~ESC[H~ (cursor home).
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric backend-clear (backend)
(:method ((b backend))
(backend-write b (format nil "~C[2J~C[H" #\Esc #\Esc))))
@@ -514,7 +514,7 @@ it lets individual backend methods accept keyword arguments they
don't use without signaling an error. The simple backend ignores
styles; the modern backend processes them.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric draw-text (backend x y string fg bg &key
bold italic underline reverse dim blink
&allow-other-keys))
@@ -526,7 +526,7 @@ Draws a border rectangle with optional title. Style is one of
~:single~, ~:double~, or ~:rounded~. The default method has no
implementation — each backend provides its own border rendering.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric draw-border (backend x y width height
&key style fg bg title title-align))
#+END_SRC
@@ -537,7 +537,7 @@ Fills a rectangular area with a background color. On the simple
backend this is a no-op; on the modern backend it writes space
characters with the appropriate SGR background color.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric draw-rect (backend x y width height &key bg))
#+END_SRC
@@ -547,7 +547,7 @@ Renders a clickable hyperlink using OSC 8 escape sequences. The
default is a protocol declaration only — modern-backend implements
the actual escape sequences, simple-backend falls back to plain text.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric draw-link (backend x y string url &key fg bg))
#+END_SRC
@@ -557,7 +557,7 @@ Renders a "..." truncation marker at position (x, y). This is used
when text exceeds the available width. Each backend positions the
marker according to its own coordinate system.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric draw-ellipsis (backend x y width &key fg bg))
#+END_SRC
@@ -566,7 +566,7 @@ marker according to its own coordinate system.
Moves the cursor to absolute position (x, y). The default method
is a no-op — backends that support cursor positioning override this.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric cursor-move (backend x y)
(:method ((b backend) x y) (declare (ignore x y)) (values)))
#+END_SRC
@@ -576,7 +576,7 @@ is a no-op — backends that support cursor positioning override this.
Hides the terminal cursor. The default method is a no-op so that
backends that lack cursor control still work safely.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric cursor-hide (backend)
(:method ((b backend)) (values)))
#+END_SRC
@@ -586,7 +586,7 @@ backends that lack cursor control still work safely.
Shows the terminal cursor after a hide. Always paired with
~cursor-hide~. Default is a no-op.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric cursor-show (backend)
(:method ((b backend)) (values)))
#+END_SRC
@@ -597,7 +597,7 @@ Sets the cursor shape and blink behavior. Shape is ~:block~,
~:bar~, or ~:underline~. Default is a no-op for backends that
don't support cursor styling.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric cursor-style (backend shape &key blink)
(:method ((b backend) shape &key blink) (values)))
#+END_SRC
@@ -607,7 +607,7 @@ don't support cursor styling.
Starts a synchronized update (DECICM). All subsequent output is
buffered by the terminal until ~end-sync~. Default is a no-op.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric begin-sync (backend)
(:method ((b backend)) (values)))
#+END_SRC
@@ -617,7 +617,7 @@ buffered by the terminal until ~end-sync~. Default is a no-op.
Flushes the synchronized update buffer so the entire frame appears
at once. Always paired with ~begin-sync~. Default is a no-op.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric end-sync (backend)
(:method ((b backend)) (values)))
#+END_SRC
@@ -628,7 +628,7 @@ Reads the next input event from the terminal. Blocks until an event
arrives or the timeout expires. Returns (values keyword event-data).
The default method returns ~(values nil nil)~ — no events available.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric read-event (backend &key timeout)
(:method ((b backend) &key timeout) (values nil nil)))
#+END_SRC
@@ -639,7 +639,7 @@ Enables SGR mouse tracking so mouse click and motion events are
reported as input. Default is a no-op on backends that don't
support mouse input.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric enable-mouse (backend)
(:method ((b backend)) (values)))
#+END_SRC
@@ -649,7 +649,7 @@ support mouse input.
Enables bracketed paste mode so the application can distinguish
pasted text from typed input. Default is a no-op.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric enable-bracketed-paste (backend)
(:method ((b backend)) (values)))
#+END_SRC
@@ -661,7 +661,7 @@ keywords include ~:truecolor~, ~:osc8~, ~:sync~, ~:mouse~,
~:bracketed-paste~, ~:kitty-keyboard~, ~:sixel~, and
~:cursor-style~. The default method returns ~nil~ for all features.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(defgeneric capable-p (backend feature)
(:method ((b backend) feature)
(declare (ignore feature))
@@ -675,7 +675,7 @@ application receives SIGTSTP (suspend) or SIGCONT (resume) signals.
The default methods are no-ops; backends with terminal state override
these to restore cooked mode on suspend and raw mode on resume.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(in-package :cl-tty.backend)
(defgeneric suspend-backend (backend)
@@ -705,7 +705,7 @@ Arguments:
lines captured after initialization.
- ~&body body~ — executed with the above bindings.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/classes.lisp
(in-package :cl-tty.backend)
(defmacro with-terminal ((backend-var &optional cols-var rows-var)
@@ -754,7 +754,7 @@ the ~:output-stream~ initarg — the key extensibility point. Tests
use ~make-string-output-stream~ to capture output, while production
uses ~*standard-output*~.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(in-package :cl-tty.backend)
(defclass simple-backend (backend)
@@ -770,7 +770,7 @@ Constructor function that creates a ~simple-backend~ instance. Uses
~*standard-output*~. This function is exported rather than exposing
~make-instance~ directly to provide a stable API surface.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defun make-simple-backend (&key output-stream)
(make-instance 'simple-backend
:output-stream (or output-stream *standard-output*)))
@@ -782,7 +782,7 @@ Simple backend initialization is a no-op — there is no terminal
state to configure. Returns the backend instance to satisfy the
protocol contract.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defmethod initialize-backend ((b simple-backend))
b)
#+END_SRC
@@ -792,7 +792,7 @@ protocol contract.
Simple backend shutdown is a no-op — there is no terminal state to
restore. Returns multiple values to satisfy the protocol contract.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defmethod shutdown-backend ((b simple-backend))
(values))
#+END_SRC
@@ -801,7 +801,7 @@ restore. Returns multiple values to satisfy the protocol contract.
No-op — simple backend has no terminal state to save.
#+begin_src lisp :tangle ../src/backend/simple.lisp
#+begin_src lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defmethod suspend-backend ((b simple-backend))
(values))
#+end_src
@@ -810,7 +810,7 @@ No-op — simple backend has no terminal state to save.
No-op — simple backend has no terminal state to restore.
#+begin_src lisp :tangle ../src/backend/simple.lisp
#+begin_src lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defmethod resume-backend ((b simple-backend))
(values))
#+end_src
@@ -825,7 +825,7 @@ a hard-coded 80x24 at the end:
3. **ioctl on ~/dev/tty~** — fallback when stdin/stdout are pipes.
4. **~(values 80 24)~** — last resort.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defmethod backend-size ((b simple-backend))
;; Try ioctl on fd 0 (stdin), then stdout, then /dev/tty, then 80x24.
;; Use multiple-value-bind/values to preserve both cols and rows
@@ -883,7 +883,7 @@ Writes a string to the backend's output stream and returns its length.
Does NOT flush — explicit sync points (~initialize-backend~,
~end-sync~, etc.) call ~finish-output~ as needed.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defmethod backend-write ((b simple-backend) string)
(let ((stream (backend-output-stream b)))
(write-string string stream)
@@ -897,7 +897,7 @@ completely. It appends only the string content to the output stream.
This means simple backends are always a "scroll and dump" mode —
no cursor positioning, no escape sequences.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defmethod draw-text ((b simple-backend) x y string fg bg
&key bold italic underline reverse dim blink
&allow-other-keys)
@@ -912,7 +912,7 @@ corners use ~#\+~, horizontal edges use ~#\-~, and vertical edges
use ~#\|~. No style distinction — single, double, and rounded are
identical in ASCII output.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defun %simple-border-char (pos)
"Return ASCII border character at POS.
POS is :top-left, :top-right, :bottom-left, :bottom-right,
@@ -931,7 +931,7 @@ The title rendering supports ~:left~ and ~:center~ alignment,
placing the title inside the top border line with horizontal
dashes filling the remaining space.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defmethod draw-border ((b simple-backend) x y width height
&key style fg bg title title-align)
(declare (ignore style fg bg))
@@ -987,7 +987,7 @@ dashes filling the remaining space.
Background fill is impossible without escape sequences. This method
is a no-op — it discards all arguments and returns ~(values)~.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defmethod draw-rect ((b simple-backend) x y width height
&key bg)
(declare (ignore x y width height bg))
@@ -1001,7 +1001,7 @@ Hyperlinks fall back to plain text on the simple backend. The URL
parameter is discarded entirely; the visible text is rendered via
~draw-text~ with no styling.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defmethod draw-link ((b simple-backend) x y string url
&key fg bg)
(declare (ignore url fg bg))
@@ -1014,7 +1014,7 @@ Renders "..." using the simple backend's positioning pattern:
newlines to reach the target row, spaces to reach the target column,
then the literal three dots. No escape sequences are used.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/simple.lisp
(defmethod draw-ellipsis ((b simple-backend) x y width
&key fg bg)
(declare (ignore width fg bg))

View File

@@ -43,7 +43,7 @@ The test package exports ~run-tests~ so it can be invoked from the
top-level test runner. ~fiveam~ imports directly for declarative
~test~ and ~is~ forms. The ~box-suite~ collects all box/text tests.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(defpackage :cl-tty-box-test
(:use :cl :fiveam :cl-tty.backend :cl-tty.layout :cl-tty.box)
(:export #:run-tests))
@@ -59,7 +59,7 @@ top-level test runner. ~fiveam~ imports directly for declarative
~run-all-tests.lisp~. It runs the ~box-suite~, explains results to
stdout, and exits cleanly with ~uiop:quit~.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(defun run-tests ()
(let ((result (run 'box-suite)))
(fiveam:explain! result)
@@ -73,7 +73,7 @@ stdout, and exits cleanly with ~uiop:quit~.
actual terminal I/O. Returns the backend and stream as multiple
values.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(defun make-capturing-backend ()
(let* ((s (make-string-output-stream))
(b (make-modern-backend :output-stream s)))
@@ -85,7 +85,7 @@ values.
Verify that a bare ~make-box~ returns a ~box~ instance and
automatically creates a ~layout-node~ through inheritance.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test box-creates-with-defaults
"A box created with no arguments has reasonable defaults"
(let ((b (make-box)))
@@ -98,7 +98,7 @@ automatically creates a ~layout-node~ through inheritance.
Verify that a box with ~:border-style :single~ draws the four corner
characters (┌ ┐ └ ┘) in the output stream.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test box-renders-border
"A box with border draws border characters"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -117,7 +117,7 @@ characters (┌ ┐ └ ┘) in the output stream.
Verify that a box with ~:bg :red~ emits SGR background color codes
(41m) in the output stream.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test box-renders-background
"A box with background color fills interior"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -134,7 +134,7 @@ Verify that a box with ~:bg :red~ emits SGR background color codes
Verify that a title string appears in the rendered output stream
when ~:title~ is provided.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test box-renders-title
"A box with title renders the title text"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -150,7 +150,7 @@ when ~:title~ is provided.
Verify that ~:border-style nil~ suppresses corner characters but
background fill rendering continues to work.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test box-without-border
"A box with border-style nil draws no border"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -167,7 +167,7 @@ background fill rendering continues to work.
Verify that a box with zero width and height produces no output
(triggers the early-return guard in ~render-box~).
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test box-zero-size
"A box with any zero dimension renders nothing"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -183,7 +183,7 @@ Verify that a box with zero width and height produces no output
Verify that a box with width 1 produces no output — ~draw-border~
requires at least 2 columns to draw corner and edge characters.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test box-single-column
"A box with width 1 renders nothing (needs min 2 for border)"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -199,7 +199,7 @@ requires at least 2 columns to draw corner and edge characters.
Verify that a 2x2 box (the minimum viable size for border rendering)
still produces corner characters in the output.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test box-minimum-size
"A box with minimum non-zero size still renders"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -215,7 +215,7 @@ still produces corner characters in the output.
Verify that ~make-text~ with an empty string returns a ~text~
instance and creates a ~layout-node~.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test text-creates-with-defaults
"A text created with no arguments has reasonable defaults"
(let ((txt (make-text "")))
@@ -228,7 +228,7 @@ instance and creates a ~layout-node~.
Verify that text content appears in the captured output stream after
rendering.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test text-renders-content
"A text renders its content at position"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -244,7 +244,7 @@ rendering.
Verify that an empty string produces no output (triggers the
early-return guard in ~render-text~).
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test text-empty-string
"Empty text produces no output"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -260,7 +260,7 @@ early-return guard in ~render-text~).
Verify that ~:wrap-mode :none~ truncates the content string to fit
within the available width, producing only the first N characters.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test text-truncates-when-no-wrap
"Text with wrap-mode :none truncates at width"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -277,7 +277,7 @@ within the available width, producing only the first N characters.
Verify that ~:wrap-mode :word~ breaks lines at word boundaries,
distributing words across successive rows.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test text-word-wraps
"Text with wrap-mode :word wraps at word boundaries"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -295,7 +295,7 @@ distributing words across successive rows.
Verify that a single word longer than the available width is
hard-broken at character boundaries into ~max-width~-sized chunks.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test text-word-wrap-single-word
"A word longer than width is hard-broken at max-width"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -312,7 +312,7 @@ hard-broken at character boundaries into ~max-width~-sized chunks.
Verify that ~span~ stores its text content and style attributes
correctly, with unset attributes defaulting to ~nil~.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test span-creates-with-attributes
"A span has text and optional style attributes"
(let ((s (span "bold text" :bold t)))
@@ -326,7 +326,7 @@ correctly, with unset attributes defaulting to ~nil~.
Verify that ~make-text~ with ~:spans~ stores the provided span
objects and they are accessible via ~text-spans~.
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
(test make-text-with-spans
"Text with spans stores span objects"
(let* ((sp (list (span "Hello" :bold t)
@@ -346,7 +346,7 @@ color change) trigger incremental re-render. The ~layout-node~ slot
holds the computed position and size from the layout engine. Border
style, title, alignment, and colors are all configurable slots.
#+BEGIN_SRC lisp :tangle ../src/components/box.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box.lisp
(in-package :cl-tty.box)
(defclass box (dirty-mixin)
@@ -367,7 +367,7 @@ The constructor wraps ~make-instance~ and passes layout parameters
through to the layout node. Width and height are optional; when
omitted the layout engine will compute them from parent constraints.
#+BEGIN_SRC lisp :tangle ../src/components/box.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box.lisp
(defun make-box (&key (border-style :single) title
(title-align :left) fg bg
width height)
@@ -393,7 +393,7 @@ Title rendering supports ~:left~, ~:center~, and ~:right~ alignment
with automatic truncation when the title is wider than available
content area (width-4 when border is present).
#+BEGIN_SRC lisp :tangle ../src/components/box.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box.lisp
(defun render-box (box backend)
"Render BOX at its computed layout position using BACKEND."
(let ((ln (box-layout-node box))
@@ -430,7 +430,7 @@ Multiple spans let a single Text contain bold, colored, or italicized
runs. Each style attribute is a separate slot so consumers can
inspect and apply them individually.
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
(in-package :cl-tty.box)
(defclass span ()
@@ -450,7 +450,7 @@ inspect and apply them individually.
keyword arguments for all style attributes. A ~nil~ default means
"inherit/no-change" when merged with parent styling context.
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
(defun span (text &key bold italic underline reverse dim fg bg)
(make-instance 'span
:text text :bold bold :italic italic
@@ -465,7 +465,7 @@ Spans are stored for future per-run styling but the current
implementation renders all content as plain text. It inherits from
~dirty-mixin~ so content, color, or size changes trigger re-render.
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
(defclass text (dirty-mixin)
((layout-node :initform (make-layout-node) :accessor text-layout-node
:initarg :layout-node)
@@ -483,7 +483,7 @@ dimensions and content parameters. It defaults ~wrap-mode~ to ~:word~
so text wraps by default, and creates a ~:column~-oriented layout
node.
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
(defun make-text (content &key fg bg wrap-mode width height spans)
(make-instance 'text
:content content
@@ -502,7 +502,7 @@ at successive row positions. For ~:none~, it truncates the content to
fit the width in a single line. Empty content or zero dimensions
triggers an early return.
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
(defun render-text (text-object backend)
"Render TEXT-OBJECT at its computed layout position using BACKEND."
(let ((ln (text-layout-node text-object))
@@ -535,7 +535,7 @@ input into words, then packs them into lines respecting ~max-width~.
Words that exceed ~max-width~ are hard-broken at character boundaries
in chunks of ~max-width~ to ensure no line exceeds the limit.
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
(defun word-wrap (text max-width)
"Split TEXT into lines, each <= MAX-WIDTH chars."
(if (or (zerop max-width) (zerop (length text)))
@@ -572,7 +572,7 @@ newline). It uses ~position-if~ to find delimiters and builds the
word list iteratively. Consecutive delimiters are collapsed
(only one advance per delimiter character).
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
(defun split-string (string)
"Split STRING into words separated by whitespace."
(loop with words = nil

View File

@@ -107,7 +107,7 @@ that point. The current scope favors simplicity and co-location.
* Package Definition
#+BEGIN_SRC lisp :tangle ../src/components/container-package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/container-package.lisp
(defpackage :cl-tty.container
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export

View File

@@ -80,7 +80,7 @@ Using a global variable rather than a closure or class slot keeps the detection
path stateless and trivially resettable for testing: binding ~*detected-backend*~
to ~nil~ forces a fresh detection run.
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
(in-package :cl-tty.backend)
(defvar *detected-backend* nil
@@ -98,7 +98,7 @@ sequence queries.
Case-insensitive matching via ~char-equal~ handles variances across platforms
(GNOME Terminal uses ~truecolor~, some Windows builds use ~24bit~).
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
(defun detect-backend-by-env ()
"Check COLORTERM environment variable for modern terminal support.
Returns :modern if COLORTERM contains 'truecolor' or '24bit', nil otherwise."
@@ -119,7 +119,7 @@ further (I/O-dependent) probes. Must happen before ~detect-backend-by-da1~.
Testing this predicate first also avoids wasting time on DA1 queries when the
output is consumed by a test runner, CI pipeline, or pipe.
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
(defun detect-backend-by-tty ()
"Check if stdout is a real terminal (not a pipe/redirect).
Returns T if stdout is interactive, nil otherwise."
@@ -140,7 +140,7 @@ bytes arrive within the timeout without blocking. The ~0.1~ second default
strikes a balance between responsiveness and reliability: fast enough to avoid
noticeable delay in interactive use, long enough for most terminals to reply.
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
(defun query-terminal (query &optional (timeout 0.1))
"Send QUERY string to terminal and return any response received within
TIMEOUT seconds. Returns the response string, or nil if no response."
@@ -168,7 +168,7 @@ This probe is best-effort: many terminals do not respond within the timeout,
and some return different codes for the same capabilities. A ~nil~ result from
this function should never prevent fallback detection via environment variables.
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
(defun detect-backend-by-da1 ()
"Send DA1 (ESC[c) query and check for kitty terminal response code.
Returns T if terminal reports kitty compatibility codes."
@@ -193,7 +193,7 @@ returns nil, the expensive DA1 query never runs. If ~detect-backend-by-env~
returns ~:modern~, the DA1 query is skipped. The result is cached in
~*detected-backend*~ so subsequent calls are effectively free.
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/detection.lisp
(defun detect-backend ()
"Auto-detect the appropriate backend for the current terminal.
Returns a backend instance (modern-backend or simple-backend).

View File

@@ -50,7 +50,7 @@ duration. They stack in the top-right corner.
The ~cl-tty.dialog~ package uses the backend, input, and select
subsystems. All public symbols are exported for user convenience.
#+BEGIN_SRC lisp :tangle ../src/components/dialog-package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog-package.lisp
;;; dialog-package.lisp — Package definition for cl-tty.dialog
(defpackage :cl-tty.dialog
@@ -87,7 +87,7 @@ The active dialog stack. ~push-dialog~ conses onto this list;
should bind its own instance so multiple screens can have independent
dialog states.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(in-package :cl-tty.dialog)
(defvar *dialog-stack* nil
@@ -100,7 +100,7 @@ List of active toast notifications. ~toast~ pushes, ~dismiss-toast~
removes by identity. The render loop walks this list to draw toasts in
the top-right corner.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defvar *toasts* nil
"List of active toast notifications.")
#+END_SRC
@@ -111,7 +111,7 @@ The core dialog class stores a title, a size preset, the content
component to render inside the panel, and an optional ~:on-dismiss~
callback invoked when the dialog is popped.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defclass dialog ()
((title :initarg :title :accessor dialog-title)
(size :initarg :size :initform :medium :accessor dialog-size)
@@ -125,7 +125,7 @@ Converts a size keyword (~:small~, ~:medium~, ~:large~) to pixel
dimensions. Accepts optional ~max-w~ / ~max-h~ to clamp the result to
terminal bounds, preventing off-screen overflow (fixed in v1.0.0).
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun dialog-size-pixels (size &optional (max-w 80) (max-h 24))
(multiple-value-bind (dw dh)
(case size
@@ -142,7 +142,7 @@ Renders a dialog: draws a dimmed full-screen backdrop using
~draw-rect~, then draws the bordered dialog panel centered on screen.
Content is rendered via ~draw-text~ inside the panel area.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun render-dialog (dialog screen w h)
(multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog) w h)
(let ((x (floor (- w dw) 2))
@@ -163,7 +163,7 @@ Content is rendered via ~draw-text~ inside the panel area.
Pushes a dialog onto =*dialog-stack*=. Returns the dialog for chaining.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun push-dialog (dialog)
(push dialog *dialog-stack*)
dialog)
@@ -174,7 +174,7 @@ Pushes a dialog onto =*dialog-stack*=. Returns the dialog for chaining.
Pops the top dialog from the stack. If an ~:on-dismiss~ callback is
set on the dialog, it is called before returning.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun pop-dialog ()
(when *dialog-stack*
(let ((dialog (pop *dialog-stack*)))
@@ -194,7 +194,7 @@ Simple alert with title, message, and an OK button. The button is a
~select~ with a single "OK" option. Dismissing fires ~pop-dialog~ on
both selection and backdrop dismiss.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun alert-dialog (title message)
(make-instance 'dialog
:title title
@@ -210,7 +210,7 @@ both selection and backdrop dismiss.
Confirm dialog with Yes/No buttons. Returns ~:yes~ or ~:no~ via the
~on-yes~/~on-no~ callbacks. The dialog auto-dismisses on selection.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun confirm-dialog (title message &key on-yes on-no)
(make-instance 'dialog
:title title
@@ -230,7 +230,7 @@ Confirm dialog with Yes/No buttons. Returns ~:yes~ or ~:no~ via the
Modal wrapper around the ~select~ component. Presents a list of options
and calls ~on-select~ with the chosen value after dismissing.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun select-dialog (title options &key on-select)
(make-instance 'dialog
:title title
@@ -247,7 +247,7 @@ and calls ~on-select~ with the chosen value after dismissing.
Modal wrapper around ~text-input~. Shows a text input field inside the
dialog and calls ~on-submit~ with the entered value after dismissing.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun prompt-dialog (title &key on-submit)
(make-instance 'dialog
:title title
@@ -268,7 +268,7 @@ has a message and a variant that determines its color (~:info~,
Lightweight class storing the message text and variant keyword.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defclass toast ()
((message :initarg :message :accessor toast-message)
(variant :initarg :variant :initform :info :accessor toast-variant)))
@@ -280,7 +280,7 @@ Draws a toast in the top-right corner of the screen. The message is
truncated to 60 columns with an ellipsis if necessary. The background
color reflects the variant.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun render-toast (toast screen w)
(let* ((msg (toast-message toast))
(variant (toast-variant toast))
@@ -302,7 +302,7 @@ Fire-and-forget toast notification. Creates a ~toast~ instance, pushes
it onto =*toasts*~, and optionally schedules auto-dismissal via
~dismiss-toast~ when ~duration~ is positive.
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun toast (message &key (variant :info) (duration 0))
(let ((toast (make-instance 'toast :message message :variant variant)))
(push toast *toasts*)
@@ -315,7 +315,7 @@ it onto =*toasts*~, and optionally schedules auto-dismissal via
Removes a toast from =*toasts*~ by identity (~remove~ with default
~:test #'eql~ compares by pointer for CLOS objects).
#+BEGIN_SRC lisp :tangle ../src/components/dialog.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun dismiss-toast (toast)
(setf *toasts* (remove toast *toasts*)))
#+END_SRC
@@ -327,7 +327,7 @@ interaction.
** Test package and suite
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
;;; dialog-tests.lisp — Tests for cl-tty.dialog
(defpackage :cl-tty-dialog-test
@@ -343,7 +343,7 @@ interaction.
Basic dialog instantiation — verifies ~make-instance~ and accessors.
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
(def-test dialog-create ()
(let ((d (make-instance 'dialog :title "Test")))
(is-true (typep d 'dialog))
@@ -354,7 +354,7 @@ Basic dialog instantiation — verifies ~make-instance~ and accessors.
~dialog-size-pixels~ returns the correct dimensions for ~:small~.
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
(def-test dialog-size-small ()
(multiple-value-bind (w h) (dialog-size-pixels :small)
(is (= 40 w))
@@ -365,7 +365,7 @@ Basic dialog instantiation — verifies ~make-instance~ and accessors.
~dialog-size-pixels~ returns the correct dimensions for ~:medium~.
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
(def-test dialog-size-medium ()
(multiple-value-bind (w h) (dialog-size-pixels :medium)
(is (= 60 w))
@@ -377,7 +377,7 @@ Basic dialog instantiation — verifies ~make-instance~ and accessors.
Verifies stack operations: push adds to =*dialog-stack*~, pop removes
the top element.
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
(def-test dialog-push-pop ()
(let ((*dialog-stack* nil))
(push-dialog (make-instance 'dialog :title "D1"))
@@ -392,7 +392,7 @@ the top element.
Verifies that ~toast~ pushes onto =*toasts*~.
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
(def-test toast-create ()
(let ((*toasts* nil))
(toast "Hello" :variant :info :duration 0)
@@ -403,7 +403,7 @@ Verifies that ~toast~ pushes onto =*toasts*~.
Verifies that ~dismiss-toast~ removes the toast from =*toasts*~.
#+BEGIN_SRC lisp :tangle ../tests/dialog-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/dialog-tests.lisp
(def-test toast-dismiss ()
(let ((*toasts* (list (make-instance 'toast :message "T" :variant :info))))
(dismiss-toast (first *toasts*))

View File

@@ -47,7 +47,7 @@ with ~dirty~ set to ~t~. This is the core invariant of the dirty tracking
system — without this, the first render pass would skip new components,
making them invisible until something explicitly marked them dirty.
#+BEGIN_SRC lisp :tangle ../src/components/dirty-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty-tests.lisp
(in-package :cl-tty-box-test)
(in-suite box-suite)
@@ -65,7 +65,7 @@ signaling that it is up-to-date and does not need re-render until the
next change. Without this, every component would be re-rendered every
frame.
#+BEGIN_SRC lisp :tangle ../src/components/dirty-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty-tests.lisp
(in-package :cl-tty-box-test)
(in-suite box-suite)
@@ -83,7 +83,7 @@ re-marked as dirty via ~mark-dirty~. This exercises the full lifecycle:
new (dirty) → render (mark-clean) → state change (mark-dirty) → render
again. It ensures the dirty flag is not a one-shot toggle.
#+BEGIN_SRC lisp :tangle ../src/components/dirty-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty-tests.lisp
(in-package :cl-tty-box-test)
(in-suite box-suite)
@@ -102,7 +102,7 @@ choice: make this a separate mixin rather than part of the base
~component~ class. This lets non-UI objects (layout nodes, render
commands) opt into dirty tracking without inheriting from component.
#+BEGIN_SRC lisp :tangle ../src/components/dirty.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty.lisp
(in-package :cl-tty.box)
;; ── Dirty Tracking ─────────────────────────────────────────────
@@ -116,7 +116,7 @@ the first render pass doesn't skip them. If this default were ~nil~,
new components would be invisible until something explicitly marked
them dirty.
#+BEGIN_SRC lisp :tangle ../src/components/dirty.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty.lisp
(defgeneric mark-clean (component)
(:method ((c dirty-mixin))
(setf (dirty-p c) nil)))
@@ -126,7 +126,7 @@ them dirty.
method (for non-dirty-mixin components) is a no-op — they have no
dirty state to clear.
#+BEGIN_SRC lisp :tangle ../src/components/dirty.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dirty.lisp
(defgeneric mark-dirty (component)
(:method ((c dirty-mixin))
(setf (dirty-p c) t)))

View File

@@ -188,7 +188,7 @@ framebuffer backend class, constructor, diff/flush utilities, scissor macro,
and frame-inspection functions. It depends on ~:cl-tty.backend~ for the
~backend~ base class and protocol methods.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defpackage :cl-tty.rendering
(:use :cl :cl-tty.backend)
(:export
@@ -206,7 +206,7 @@ and frame-inspection functions. It depends on ~:cl-tty.backend~ for the
Switch to the ~cl-tty.rendering~ package for all subsequent definitions.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(in-package :cl-tty.rendering)
#+END_SRC
@@ -218,7 +218,7 @@ compared by value during diffing. All fields have sensible defaults so that
~make-cell~ with no arguments produces a blank space cell. The ~link-url~
slot enables OSC-8 hyperlink support for clickable text.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defstruct cell
"A single terminal cell — character, colors, and attributes."
(char #\space :type character)
@@ -239,7 +239,7 @@ columns. Using ~:initial-element (make-cell)~ ensures every cell is a fresh
struct instance (not shared). The ~:element-type~ declaration is a hint for
potential optimizations.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defun make-framebuffer (width height)
"Create a 2D array of CELL with dimensions HEIGHT x WIDTH."
(make-array (list height width)
@@ -253,13 +253,13 @@ Accessors that return the dimensions of a framebuffer array. These guard
against non-array values (returning 0) so that callers don't crash on nil or
uninitialized framebuffer slots.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defun framebuffer-width (fb)
"Return the width (columns) of framebuffer FB."
(if (arrayp fb) (array-dimension fb 1) 0))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defun framebuffer-height (fb)
"Return the height (rows) of framebuffer FB."
(if (arrayp fb) (array-dimension fb 0) 0))
@@ -274,7 +274,7 @@ plus scissor-clipping state. All drawing methods on this backend write to the
cell array instead of emitting escape sequences. The scissor coordinates are
used by ~%in-scissor-p~ to clip drawing during component rendering.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defclass framebuffer-backend (backend)
((framebuffer :initform nil :accessor fb-framebuffer)
(scissor-x :initform 0 :accessor fb-scissor-x)
@@ -289,7 +289,7 @@ Constructor that creates a ~framebuffer-backend~ instance and initializes its
framebuffer array to the given dimensions (defaulting to 80x24, a common
terminal size).
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defun make-framebuffer-backend (&key (width 80) (height 24))
"Create a framebuffer-backend with a fresh framebuffer."
(let ((fb (make-instance 'framebuffer-backend)))
@@ -306,7 +306,7 @@ scissor rectangle. If either scissor dimension is nil (meaning no scissor is
set), the corresponding axis check is skipped, effectively treating the entire
framebuffer as the drawable area.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defun %in-scissor-p (fb cx cy)
"Check if (CX, CY) falls within the current scissor rectangle."
(let ((sx (fb-scissor-x fb)) (sy (fb-scissor-y fb))
@@ -323,7 +323,7 @@ ultimately lands, ensuring consistent clipping behavior across all drawing
operations. Only cells within both the framebuffer dimensions and the active
scissor rectangle are written.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defun %set-cell (fb x y char &key fg bg bold italic underline link-url)
"Set cell (X, Y) if within bounds and scissor."
(let ((cells (fb-framebuffer fb)))
@@ -346,7 +346,7 @@ clipping apply automatically. The ~&allow-other-keys~ permits passing
style-related keyword arguments that other backends may use but the framebuffer
does not need (e.g., reverse, dim, blink).
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defmethod draw-text ((fb framebuffer-backend) x y string fg bg
&key bold italic underline reverse dim blink
(link-url nil link-url-p)
@@ -365,7 +365,7 @@ Direct rendering onto a raw 2D framebuffer array (the type returned by
~make-framebuffer~). This lets application code call ~draw-text~ directly on a
framebuffer without wrapping it in a ~framebuffer-backend~.
#+begin_src lisp :tangle ../src/rendering/framebuffer.lisp
#+begin_src lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defmethod draw-text ((fb array) x y string fg bg
&key bold italic underline reverse dim blink
&allow-other-keys)
@@ -387,7 +387,7 @@ framebuffer without wrapping it in a ~framebuffer-backend~.
Allow clearing a raw 2D framebuffer array directly (same type as returned by
~make-framebuffer~). Resets all cells to blank defaults.
#+begin_src lisp :tangle ../src/rendering/framebuffer.lisp
#+begin_src lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defmethod backend-clear ((fb array))
(dotimes (y (array-dimension fb 0))
(dotimes (x (array-dimension fb 1))
@@ -401,7 +401,7 @@ color. This is used for clearing areas and rendering background fills for
panels and widgets. Iterates row by row, column by column, using ~%set-cell~ so
scissor clipping is respected.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defmethod draw-rect ((fb framebuffer-backend) x y w h &key bg)
(dotimes (row h)
(dotimes (col w)
@@ -415,7 +415,7 @@ string at the top edge. Supports three border styles: :single, :double, and
:rounded, each using different corner and line characters. The title is drawn
starting two cells from the left edge, overwriting top-edge characters.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defmethod draw-border ((fb framebuffer-backend) x y w h &key (style :single) title title-align fg bg)
(let* ((chars (case style
(:single '(#\+ #\- #\|))
@@ -447,7 +447,7 @@ Clears every cell in the framebuffer to a fresh default cell (space, no style).
This is the ~backend-clear~ protocol method specialized on ~framebuffer-backend~,
providing a full-frame reset used between render passes.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defmethod backend-clear ((fb framebuffer-backend))
(let ((cells (fb-framebuffer fb)))
(dotimes (y (framebuffer-height cells))
@@ -464,7 +464,7 @@ stores the URL in the cell's ~link-url~ slot for later retrieval (e.g., on
mouse click). The actual OSC-8 escape sequence rendering is deferred to the
real backend during flush.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defmethod draw-link ((fb framebuffer-backend) x y string url &key fg bg)
;; OSC 8 links are not rendered in framebuffer — store as text
(draw-text fb x y string fg bg :link-url url))
@@ -475,7 +475,7 @@ real backend during flush.
Renders a horizontal ellipsis (up to 3 periods) starting at position (X, Y).
Width is capped at 3 characters to prevent overflow into adjacent cells.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defmethod draw-ellipsis ((fb framebuffer-backend) x y width &key fg bg)
(dotimes (i (min 3 width))
(%set-cell fb (+ x i) y #\. :fg fg :bg bg)))
@@ -490,7 +490,7 @@ same visual output. Uses ~eql~ for characters, symbols, and booleans, and
~equal~ for string comparison of ~link-url~. This predicate drives the diff
algorithm — only cells that differ are flushed.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defun cells-equal-p (a b)
"Return T if two cells have identical content and style."
(and (eql (cell-char a) (cell-char b))
@@ -509,7 +509,7 @@ framebuffers and collect a list of (X Y CELL) triples for every cell that
changed. Using ~nreverse~ at the end ensures stable ordering (top-to-bottom,
left-to-right) without consing during accumulation.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defun diff-framebuffers (prev curr)
"Compare PREV and CURR framebuffers. Return list of (X Y CELL) for changes."
(let ((changes nil)
@@ -533,7 +533,7 @@ minimal cursor movement (tracking the current row to avoid redundant cursor
positioning). Returns the count of changed cells so callers can monitor
rendering overhead.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defun flush-framebuffer (prev-fb curr-fb backend)
"Diff PREV-FB and CURR-FB and flush changes to BACKEND.
Returns the number of changed cells."
@@ -564,7 +564,7 @@ Retrieves the hyperlink URL stored at cell position (X, Y) in a framebuffer
array. Returns nil if the cell is out of bounds or has no link. This enables
click-to-open-link functionality in the TUI.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defun fb-cell-link-url (fb x y)
"Return the link URL at (X Y) in framebuffer FB, or nil."
(when (and (arrayp fb) (>= y 0) (< y (array-dimension fb 0))
@@ -580,7 +580,7 @@ mouse selection and clipboard operations. Normalizes coordinate order (so the
user can drag in any direction) and appends newlines between rows for natural
multi-line text.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defun extract-text (fb x1 y1 x2 y2)
"Extract visible text from the rectangle between (X1,Y1) and (X2,Y2)."
(let ((x-min (max 0 (min x1 x2))) (x-max (max 0 (max x1 x2)))
@@ -604,7 +604,7 @@ for the duration of BODY. Saves and restores previous scissor state via
~unwind-protect~ for proper cleanup even on non-local exits. Using gensyms for
the state variables ensures no variable capture issues.
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/rendering/framebuffer.lisp
(defmacro with-scissor ((fb x y w h) &body body)
"Clip all drawing on FB to rectangle (X Y W H)."
(let ((old-x (gensym)) (old-y (gensym))
@@ -632,7 +632,7 @@ Setting up the test package with FiveAM, importing the rendering and backend
packages for use in all subsequent tests. This block tangles to the test file
that is loaded by the test runner.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(defpackage :cl-tty-framebuffer-test
(:use :cl :fiveam :cl-tty.rendering :cl-tty.backend))
(in-package :cl-tty-framebuffer-test)
@@ -647,7 +647,7 @@ Verify that the framebuffer constructor produces an array with the expected
dimensions. Height should match the first dimension (rows), width the second
dimension (columns).
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test make-framebuffer-creates-correct-size
(let ((fb (make-framebuffer 80 24)))
(is (= 24 (framebuffer-height fb)))
@@ -659,7 +659,7 @@ dimension (columns).
Cells created via MAKE-CELL with no arguments should default to a space
character with nil foreground and background — a blank, unstyled cell.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test cell-defaults-are-space
(let ((cell (aref (make-framebuffer 10 10) 0 0)))
(is (eql #\space (cell-char cell)))
@@ -673,7 +673,7 @@ Drawing a string into the framebuffer backend should set the character and
foreground color at each cell position. Characters should appear at the expected
(x, y) offsets.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test draw-text-on-fb-sets-cells
(let ((fb (make-framebuffer-backend)))
(draw-text fb 2 3 "abc" :red nil)
@@ -690,7 +690,7 @@ When drawing text that extends past the right edge of the framebuffer, cells
beyond the width should remain unchanged (space characters). This prevents
buffer overflow and undefined memory access.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test draw-text-clips-at-bounds
(let ((fb (make-framebuffer-backend :width 10 :height 5)))
(draw-text fb 8 2 "hello" nil nil)
@@ -705,7 +705,7 @@ buffer overflow and undefined memory access.
Two framebuffers with identical cells should produce no changes. The diff
engine must short-circuit when no cells differ.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test diff-identical-fbs-returns-empty
(let ((fb1 (make-framebuffer 80 24))
(fb2 (make-framebuffer 80 24)))
@@ -717,7 +717,7 @@ engine must short-circuit when no cells differ.
After modifying a single cell in one framebuffer, the diff engine should return
exactly one change with the correct coordinates and cell data.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test diff-changed-fb-returns-changes
(let* ((fb1 (make-framebuffer 10 10))
(fb2 (make-framebuffer 10 10)))
@@ -735,7 +735,7 @@ exactly one change with the correct coordinates and cell data.
When a scissor rectangle is active, drawing operations outside the rectangle
should be clipped away. Operations inside the rectangle should proceed normally.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test with-scissor-clips-drawing
(let ((fb (make-framebuffer-backend :width 20 :height 10)))
(with-scissor (fb 5 5 3 3)
@@ -753,7 +753,7 @@ should be diffed. This test verifies correct behavior at both the smaller and
larger end of the size mismatch — ensuring edge cells in the non-overlapping
region are ignored.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test flush-different-sized-fbs-handles-edge-cells
(let* ((small-fb (make-framebuffer 5 5))
(large-fb (make-framebuffer 10 10))
@@ -775,7 +775,7 @@ region are ignored.
After drawing on a framebuffer backend and flushing to a real backend, at least
one cell change should be detected and forwarded to the output backend.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test flush-fb-copies-to-backend
(let* ((real-be (make-simple-backend :output-stream (make-string-output-stream)))
(fb (make-framebuffer-backend)))
@@ -789,7 +789,7 @@ one cell change should be detected and forwarded to the output backend.
A cell without a hyperlink should return nil from ~fb-cell-link-url~, ensuring
the default state is correct and no spurious URL is reported.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test fb-cell-link-url-returns-nil-for-blank-cell
(let ((fb (make-framebuffer 10 10)))
(is (null (fb-cell-link-url fb 5 5)))))
@@ -801,7 +801,7 @@ After drawing text with a link-url, the corresponding cell should return that
URL. Cells at other positions should still return nil. This validates that
link metadata is stored per-cell and correctly retrievable.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test fb-cell-link-url-finds-link-url
(let ((fb (make-framebuffer-backend)))
(draw-text fb 0 0 "click" nil nil :link-url "https://example.com")
@@ -815,7 +815,7 @@ Querying a cell position outside the framebuffer dimensions should gracefully
return nil rather than erroring, which prevents crashes during mouse event
processing at the edges of the terminal.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test fb-cell-link-url-out-of-bounds-returns-nil
(let ((fb (make-framebuffer 5 5)))
(is (null (fb-cell-link-url fb 10 10)))))
@@ -827,7 +827,7 @@ Extracting text from a single row of the framebuffer should return the
characters in that row as a contiguous string, preserving order and including
only visible characters.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test extract-text-single-row
(let ((fb (make-framebuffer-backend)))
(draw-text fb 0 0 "hello" nil nil)
@@ -841,7 +841,7 @@ Extracting text from a rectangle spanning multiple rows should concatenate
rows with newline separators. This matches the expected behavior for clipboard
copy of rectangular selections in the TUI.
#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/framebuffer-tests.lisp
(test extract-text-multi-row
(let ((fb (make-framebuffer-backend)))
(draw-text fb 0 0 "abc" nil nil)

View File

@@ -39,7 +39,7 @@ The run-all-tests.lisp loader references this suite by name
(~\"INTEGRATION-SUITE\"~) and looks it up via ~find-symbol~ in the
package, so the symbol must be interned and accessible.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
;;; integration-tests.lisp — Full pipeline integration tests for cl-tty
;;;
;;; Composes all major components through the rendering pipeline onto a
@@ -75,7 +75,7 @@ The framebuffer stores cells in a 2D array indexed as ~(aref cells y x)~.
Cells are structs with a ~cell-char~ slot holding the character. We
iterate horizontally and collect each ~cell-char~ into a string.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(defun fb-string (fb x y &optional (len 1))
"Read a string of LEN characters from framebuffer FB starting at (X,Y)."
(let* ((cells (fb-framebuffer fb))
@@ -95,7 +95,7 @@ Extracts all rows from the framebuffer as a list of strings. Each row is
the full width of the framebuffer converted via ~fb-string~. Optional
~start-row~ and ~end-row~ keywords let callers inspect a sub-region.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(defun fb-lines (fb &key (start-row 0) (end-row nil))
"Extract all lines from framebuffer FB as a list of strings."
(let* ((cells (fb-framebuffer fb))
@@ -116,7 +116,7 @@ newlines and runs ~search~.
This is the most commonly used assertion helper — it lets tests check for
the presence of rendered text without specifying exact coordinates.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(defun fb-contains (fb text)
"Return T if framebuffer FB contains TEXT anywhere."
(let ((all-text (format nil "~{~a~^~%~}" (fb-lines fb))))
@@ -135,7 +135,7 @@ The title is rendered starting at column 2 of row 1 (just inside the
top border). We check ~fb-string~ at those exact coordinates for the
title text, and ~fb-contains~ for the border characters.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(test box-title-renders-on-fb
"A Box with a title draws border and title text on framebuffer."
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
@@ -160,7 +160,7 @@ Word-wrap mode ~:word~ preserves word boundaries — it only wraps between
words, never in the middle of one. The framebuffer is 20 columns wide, so
each row holds roughly 2-3 words.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(test text-component-on-fb
"Text component renders word-wrapped content on framebuffer."
(let* ((fb (make-framebuffer-backend :width 20 :height 6))
@@ -186,7 +186,7 @@ Direct cell access (~aref~ on the framebuffer array) is necessary because
the cursor block is a single character that ~fb-contains~ could match
ambiguously.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(test textinput-value-on-fb
"TextInput renders its value and cursor on framebuffer."
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
@@ -213,7 +213,7 @@ The placeholder must disappear once a value is set — that behavior is
tested indirectly here by verifying the placeholder text appears on an
empty input.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(test textinput-placeholder-on-fb
"TextInput with empty value shows placeholder text."
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
@@ -236,7 +236,7 @@ with ~scroll-y=2~ and a viewport height of 8. Lines 1-2 should be
scrolled out, while Lines 3-8 should be visible. We check both presence
(visible lines) and absence (scrolled-out lines).
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(test scrollbox-children-on-fb
"ScrollBox renders visible children offset by scroll position."
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
@@ -276,7 +276,7 @@ The ~make-select~ function takes a list of plists with ~:title~ and
~:value~ keys. The render method iterates over options and draws each
title.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(test select-options-on-fb
"Select renders option titles on framebuffer."
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
@@ -304,7 +304,7 @@ global stack, renders it, and checks for the title and ASCII border
characters. The backdrop is a dimming overlay applied across the full
framebuffer area.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(test dialog-appears-on-fb
"Dialog renders a dimmed backdrop and dialog panel with title."
(let* ((fb (make-framebuffer-backend :width 80 :height 24))
@@ -331,7 +331,7 @@ verifies that only the top dialog (\"Dialog Two\") renders, then pops it
and verifies that \"Dialog One\" appears after clearing and re-rendering.
This exercises the full push-pop-render cycle.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(test dialog-push-pop-render
"Dialog push/pop cycle works with rendering."
(let* ((fb (make-framebuffer-backend :width 80 :height 24))
@@ -359,7 +359,7 @@ in the list, verifies the message text appears, and then dismisses it to
clean up. The ~duration~ is set to 0 so the toast does not auto-dismiss
during the test.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(test toast-appears-on-fb
"Toast notification renders with colored background."
(let* ((fb (make-framebuffer-backend :width 80 :height 24)))
@@ -380,7 +380,7 @@ This test creates a simple tree with a single Box, calls
appear. This validates that the pipeline dispatches correctly from root
through the component hierarchy.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(test render-screen-pipeline
"render-screen processes a component tree through the full pipeline."
(let* ((fb (make-framebuffer-backend :width 40 :height 12))
@@ -410,7 +410,7 @@ Each component is positioned manually via ~layout-node-x~ and
~layout-node-y~ to simulate a composed screen. All components must coexist
without overwriting each other's output.
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/integration-tests.lisp
(test full-composition-via-fb
"All components compose correctly on a single framebuffer."
(let* ((fb (make-framebuffer-backend :width 60 :height 24)))

View File

@@ -47,7 +47,7 @@ unnecessary — ~200 lines of CL math suffices.
The test package uses ~:fiveam~ for the test framework and imports
all exported symbols from ~cl-tty.layout~.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(defpackage :cl-tty-layout-test
(:use :cl :fiveam :cl-tty.layout)
(:export #:run-tests))
@@ -59,7 +59,7 @@ all exported symbols from ~cl-tty.layout~.
~fiveam~ suites collect related tests under a descriptive name for
batch execution.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(def-suite layout-suite :description "Layout engine tests")
(in-suite layout-suite)
#+END_SRC
@@ -69,7 +69,7 @@ batch execution.
~run-tests~ provides a convenient entry point that prints results and
exits cleanly for CI or batch runs.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(defun run-tests ()
(let ((result (run 'layout-suite)))
(fiveam:explain! result)
@@ -81,7 +81,7 @@ exits cleanly for CI or batch runs.
Verify that a node created with no arguments has the correct default
direction ~:column~ and is of type ~layout-node~.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test make-layout-node-defaults
(let ((n (make-layout-node)))
(is (typep n 'layout-node))
@@ -93,7 +93,7 @@ direction ~:column~ and is of type ~layout-node~.
Verify that passing ~:direction :row~ produces a node whose direction
slot reflects that choice.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test make-layout-node-row
(let ((n (make-layout-node :direction :row)))
(is (eql (layout-node-direction n) :row))))
@@ -104,7 +104,7 @@ slot reflects that choice.
Children must have their ~parent~ back-pointer set when added, and
the parent's ~children~ list must contain the child.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test add-child-sets-parent
(let ((parent (make-layout-node)) (child (make-layout-node)))
(layout-node-add-child parent child)
@@ -117,7 +117,7 @@ the parent's ~children~ list must contain the child.
Removing a child should clear its parent reference and remove it
from the parent's ~children~ list.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test remove-child-clears-parent
(let ((parent (make-layout-node)) (child (make-layout-node)))
(layout-node-add-child parent child)
@@ -131,7 +131,7 @@ from the parent's ~children~ list.
In a column layout, children stack top-to-bottom. The first child
starts at y=0; the second starts below the first.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test column-two-children-vertical
(let* ((root (make-layout-node :direction :column))
(c1 (make-layout-node :height 3))
@@ -147,7 +147,7 @@ starts at y=0; the second starts below the first.
In a row layout, children stack left-to-right. The first child starts
at x=0; the second starts to the right of the first.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test row-two-children-horizontal
(let* ((root (make-layout-node :direction :row))
(c1 (make-layout-node :width 10))
@@ -164,7 +164,7 @@ When children have different ~grow~ values, remaining space is
divided in proportion to those values. A child with grow=2 gets
twice as much extra space as a child with grow=1.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test flex-grow-distributes-space
(let* ((root (make-layout-node :direction :row :width 20))
(c1 (make-layout-node :width 4 :grow 1))
@@ -179,7 +179,7 @@ twice as much extra space as a child with grow=1.
A single flexible child with ~grow~ set should expand to fill all
available space in the container.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test flex-grow-single-child
(let* ((root (make-layout-node :direction :row :width 20))
(c (make-layout-node :width 5 :grow 1)))
@@ -193,7 +193,7 @@ available space in the container.
When children exceed the container size, each child shrinks in
proportion to its ~shrink~ value.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test flex-shrink-reduces-overflow
(let* ((root (make-layout-node :direction :row :width 10))
(c1 (make-layout-node :width 8 :shrink 1))
@@ -208,7 +208,7 @@ proportion to its ~shrink~ value.
Padding insets the child rendering area. Children are offset by the
padding values and sized to the remaining space.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test padding-reduces-content-area
(let* ((root (make-layout-node :direction :column :padding '(:top 1 :left 1 :bottom 1 :right 1)))
(c (make-layout-node :height 3)))
@@ -223,7 +223,7 @@ padding values and sized to the remaining space.
The ~gap~ property inserts spacing between consecutive children
without adding space before the first or after the last.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test gap-between-children
(let* ((root (make-layout-node :direction :column :gap 2))
(c1 (make-layout-node :height 3))
@@ -239,7 +239,7 @@ The ~vbox~ macro creates a column-direction container and adds
children in one expression. The second child's y-offset should be
the sum of the first child's height plus gap.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test vbox-macro
(let ((r (vbox () (make-layout-node :height 3) (make-layout-node :height 5))))
(compute-layout r 20 20)
@@ -252,7 +252,7 @@ the sum of the first child's height plus gap.
The ~hbox~ macro creates a row-direction container. The second
child's x-offset should equal the first child's width.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test hbox-macro
(let ((r (hbox () (make-layout-node :width 5) (make-layout-node :width 3))))
(compute-layout r 20 10)
@@ -266,7 +266,7 @@ The ~spacer~ macro creates a flexible node that pushes siblings
apart. With two fixed-width children and a spacer between them, the
spacer absorbs all remaining width.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test spacer-takes-grow
(let ((r (hbox (:width 20) (make-layout-node :width 5) (spacer :grow 1) (make-layout-node :width 5))))
(compute-layout r 20 10)
@@ -279,7 +279,7 @@ spacer absorbs all remaining width.
Nesting a column layout inside a row layout exercises the recursive
solver. Sidebar gets fixed width; main content stretches.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test nested-vbox-in-hbox
(let* ((sidebar (vbox (:width 5 :height 10) (make-layout-node :height 3) (make-layout-node :height 7)))
(main (vbox (:grow 1 :height 10) (make-layout-node :height 2) (make-layout-node :grow 1)))
@@ -297,7 +297,7 @@ solver. Sidebar gets fixed width; main content stretches.
Layout must gracefully handle containers with no children, returning
valid integer dimensions.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test empty-container-does-not-crash
(let ((r (make-layout-node)))
(compute-layout r 20 20)
@@ -310,7 +310,7 @@ valid integer dimensions.
A column with one child positions it at the origin and sizes it to
its requested height. Width is inherited from the container.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test single-child-in-column
(let* ((r (make-layout-node :direction :column :width 10 :height 20))
(c (make-layout-node :height 5)))
@@ -325,7 +325,7 @@ its requested height. Width is inherited from the container.
When available space is zero, the solver must still produce valid
integer coordinates without crashing or producing NaN/infinite values.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test zero-size-container
(let* ((r (make-layout-node :direction :column))
(c (make-layout-node :height 5)))
@@ -340,7 +340,7 @@ integer coordinates without crashing or producing NaN/infinite values.
Three levels of nested vboxes ensure that layout is computed
correctly for deeply nested subtrees.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test deep-nesting-three-levels
(let* ((out (vbox ()
(vbox (:grow 1)
@@ -356,7 +356,7 @@ correctly for deeply nested subtrees.
Substantial padding on all sides should offset children inward by the
full padding amount.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test large-padding-leaves-room
(let* ((r (make-layout-node :direction :column
:padding '(:top 5 :left 5 :bottom 5 :right 5)))
@@ -372,7 +372,7 @@ full padding amount.
A negative ~grow~ value should not cause layout errors. The solver
treats it as zero for distribution purposes and produces valid output.
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/tests.lisp
(test negative-grow-is-clamped
(let* ((r (make-layout-node :direction :row :width 10))
(c (make-layout-node :width 5 :grow -1)))
@@ -390,7 +390,7 @@ and manipulating layout trees. Internal accessors like
~layout-node-parent~ and helpers like ~normalize-box~ are also
exported for testing.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defpackage :cl-tty.layout
(:use :cl)
(:export
@@ -417,7 +417,7 @@ exported for testing.
plist. This normalisation layer means users can pass ~:padding 2~ or
~:padding '(:top 1 :left 2)~ interchangeably throughout the API.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defun normalize-box (spec)
(cond ((null spec) (list :top 0 :right 0 :bottom 0 :left 0))
((numberp spec) (list :top spec :right spec :bottom spec :left spec))
@@ -432,7 +432,7 @@ plist. This normalisation layer means users can pass ~:padding 2~ or
~box-edge~ extracts the value for a specific edge keyword from a
canonical box plist, defaulting to zero if the key is not present.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defun box-edge (box edge)
(or (getf box edge) 0))
#+END_SRC
@@ -446,7 +446,7 @@ and input constraints (~direction~, ~grow~, ~shrink~, ~padding~,
~margin~, ~gap~, ~position-type~, ~position-offset~, ~fixed-width~,
~fixed-height~).
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defclass layout-node ()
((parent :initform nil :accessor layout-node-parent)
(children :initform nil :accessor layout-node-children)
@@ -472,7 +472,7 @@ and input constraints (~direction~, ~grow~, ~shrink~, ~padding~,
keyword arguments through ~normalize-box~ for padding/margin, fills
defaults for missing values, and delegates to ~make-instance~.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defun make-layout-node (&key direction grow shrink padding margin gap
position-type position-offset width height)
(make-instance 'layout-node
@@ -493,7 +493,7 @@ defaults for missing values, and delegates to ~make-instance~.
child's parent back-pointer and appending to the parent's children
list. Returns the child for convenience in chaining or ~let~ forms.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defun layout-node-add-child (parent child)
(setf (layout-node-parent child) parent)
(setf (layout-node-children parent)
@@ -507,7 +507,7 @@ list. Returns the child for convenience in chaining or ~let~ forms.
back-pointer and removing it from the parent's children list.
Returns the child.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defun layout-node-remove-child (parent child)
(setf (layout-node-parent child) nil)
(setf (layout-node-children parent)
@@ -524,7 +524,7 @@ gap. Each child starts from its fixed size. Remaining space is
distributed by grow ratio; overflow is reduced by shrink ratio.
Rounding errors are amortized across the first N children.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defun distribute-sizes (children avail gap horizontal)
(let* ((n (length children))
(gap-total (* gap (max 0 (1- n))))
@@ -563,7 +563,7 @@ within given dimensions. It positions each child at the correct
inner ~labels~ form ~place-children~ handles the recursive descent,
adjusting for padding and direction at each level.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defun compute-layout (root available-width available-height)
(labels ((place-children (node x y max-w max-h)
(let* ((children (layout-node-children node))
@@ -628,7 +628,7 @@ adjusting for padding and direction at each level.
properties and adds all children via ~layout-node-add-child~. The
~gensym~ ensures no variable capture in the expansion.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defmacro vbox ((&key grow shrink padding margin gap width height) &body children)
(let ((n (gensym)))
`(let ((,n (make-layout-node :direction :column
@@ -648,7 +648,7 @@ properties and adds all children via ~layout-node-add-child~. The
~hbox~ creates a row-direction container, structurally identical to
~vbox~ except the ~:direction~ is ~:row~.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defmacro hbox ((&key grow shrink padding margin gap width height) &body children)
(let ((n (gensym)))
`(let ((,n (make-layout-node :direction :row
@@ -668,7 +668,7 @@ properties and adds all children via ~layout-node-add-child~. The
~spacer~ creates a minimal flex-grow node that fills remaining space,
defaulting to ~grow 1~ when no keyword is given.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/layout/layout.lisp
(defmacro spacer (&key grow)
`(make-layout-node :grow ,(or grow 1)))
#+END_SRC

View File

@@ -11,7 +11,7 @@ and diff rendering. Self-contained in ~cl-tty.markdown~ package.
** Package
#+BEGIN_SRC lisp :tangle ../src/components/markdown-package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown-package.lisp
(defpackage :cl-tty.markdown
(:use :cl)
(:export
@@ -30,7 +30,7 @@ comment indicating the file's purpose. This block is the first to
target ~markdown.lisp~ and thus overwrites any previous content;
all subsequent blocks append.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
;;; markdown.lisp — Markdown + Code + Diff rendering for cl-tty
(in-package :cl-tty.markdown)
@@ -51,7 +51,7 @@ symbol and optional keyword arguments for ~children~, ~properties~,
~content~, and ~url~. Only non-nil slots are stored, keeping the
plist compact.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun make-md-node (type &key children properties content url)
(let ((node (list :type type)))
(when children (setf (getf node :children) children))
@@ -67,7 +67,7 @@ Predicate that checks whether a value is an AST node by verifying it
is a list and has a ~:type~ property. This uses plist access which
bypasses the need for ~typep~ or class-based dispatch.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun md-node-p (thing)
(and (listp thing) (getf thing :type)))
#+END_SRC
@@ -80,7 +80,7 @@ node tree. The ~:link~ type formats as ~text (url)~; ~:text~ and
concatenate their children's text. This is useful for summarisation
and testing.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun md-node-text (node)
(let ((type (getf node :type)))
(cond ((eql type :text) (or (getf node :content) ""))
@@ -107,7 +107,7 @@ Handles ~CRLF~, ~LF~, and missing trailing newline uniformly.
Returns a ~vector~ for fast indexed access by line number during
parsing. Returns an empty vector for ~nil~ input.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun split-string-into-lines (string)
(unless string (return-from split-string-into-lines (coerce nil 'vector)))
(let ((result nil) (start 0))
@@ -130,7 +130,7 @@ markers, unordered/ordered list items, diff headers, diff lines, and
fenced code-block starts — and returns a ~(cons type data)~ pair.
Everything else is treated as a paragraph continuation line.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun classify-line (line)
(cond
((string= line "") (cons :blank nil))
@@ -188,7 +188,7 @@ Scans for a literal marker string starting from position ~start~,
escaping backslash-escaped markers. This is shared by inline
emphasis, code span, and link parsing. Returns the position or ~nil~.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun find-closing-marker (text start marker)
(let ((marker-len (length marker)) (len (length text)))
(loop for j from start to (- len marker-len)
@@ -206,7 +206,7 @@ into a single ~:paragraph~ node. Stops at a blank line or any
non-paragraph classification. Lines are joined with spaces before
inline parsing.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun parse-paragraph (lines start)
(let ((text-parts nil) (i start))
(loop while (< i (length lines))
@@ -233,7 +233,7 @@ Like ~parse-paragraph~ but collects ~:blockquote~ lines and strips the
leading ~>~ marker. The collected text is then inline-parsed to
support bold, italic, code, and links inside quotes.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun parse-blockquote (lines start)
(let ((text-parts nil) (i start))
(loop while (< i (length lines))
@@ -262,7 +262,7 @@ loose lists), but a blank line followed by a non-list line terminates
the list. Returns multiple nodes because each top-level list item
becomes its own ~:list-item~ or ~:ordered-item~ node.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun parse-list (lines start)
(let ((items nil) (i start))
(loop while (< i (length lines))
@@ -297,7 +297,7 @@ match in character and be at least as long. The language (if any) is
taken from the info string on the opening fence. Produces a single
~:code-block~ node.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun parse-code-block (lines start lang)
(let ((code-lines nil)
(i (1+ start))
@@ -333,7 +333,7 @@ single ~:diff-block~ node. The raw lines are preserved in a ~:lines~
property for coloured rendering later. Diff blocks are delimited by
blank lines.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun parse-diff-block (lines start)
(let ((diff-lines nil) (i start))
(loop while (< i (length lines))
@@ -363,7 +363,7 @@ Handles blank lines, thematic breaks, headings, paragraphs,
blockquotes, lists, code blocks, and diff blocks. Returns ~nil~ for
~nil~ input.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun parse-blocks (text)
(unless text (return-from parse-blocks nil))
(let ((lines (split-string-into-lines text)) (nodes nil) (i 0))
@@ -416,7 +416,7 @@ triggers inline code; ~[~ triggers links; everything else is
accumulated as plain ~:text~ nodes. Consecutive plain text is merged
into single nodes for efficiency.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun parse-inline (text)
(unless (and text (> (length text) 0)) (return-from parse-inline nil))
(let ((nodes nil) (i 0) (len (length text)))
@@ -462,7 +462,7 @@ node, otherwise it falls back to single-star ~:italic~. If neither
closes, returns ~nil~ to let the caller treat the character as literal
text.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun parse-star-emphasis (text i len)
(when (>= i len) (return-from parse-star-emphasis (values nil i)))
(if (and (< (1+ i) len) (char= (char text (1+ i)) #\*))
@@ -486,7 +486,7 @@ opens after whitespace or at the start of text, and single-underscore
italic only closes before whitespace or punctuation. This avoids false
positives in identifiers like ~foo_bar~.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun parse-underscore-emphasis (text i len)
(when (>= i len) (return-from parse-underscore-emphasis (values nil i)))
(when (and (> i 0) (not (find (char text (1- i)) " \t\n\r")))
@@ -512,7 +512,7 @@ Parses backtick-delimited inline code spans. Supports up to three
backticks as delimiters (so single backticks inside double-backtick
spans work). The matched pair's backtick count must be equal.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun parse-inline-code (text i len)
(when (or (>= i len) (not (char= (char text i) #\`)))
(return-from parse-inline-code (values nil i)))
@@ -534,7 +534,7 @@ matching via ~find-closing-marker~. The text portion is inline-parsed
to support formatting inside link text. Returns ~nil~ if the syntax
is incomplete, letting the caller render the ~[~ as literal text.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun parse-link (text i len)
(when (or (>= i len) (not (char= (char text i) #\[)))
(return-from parse-link (values nil i)))
@@ -568,7 +568,7 @@ the caller to fall back to plain rendering. The assoc list uses
~string=~ for matching on the language tag, and each entry uses a
dotted-pair format ~(\"language\" . plist)~.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun get-highlighter (lang)
(cdr (assoc lang
'(("lisp" . (:comment (";" "#|" ";;") :string ("\"")
@@ -665,7 +665,7 @@ provides the patterns for comment delimiters, string delimiters,
keywords, and builtins. Words immediately followed by ~(~ are
classified as ~:function~ calls.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun tokenize-line (line highlighter)
(let ((tokens nil) (i 0) (len (length line))
(comment-chars (getf highlighter :comment))
@@ -742,7 +742,7 @@ returns a flat list of ~(token . category)~ pairs with newline
separators between lines. Returns ~nil~ for empty input or a single
~:plain~ pair if no highlighter is found for the language.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun highlight-code (code language)
(unless code (return-from highlight-code nil))
(let ((highlighter (get-highlighter (and language (string-downcase language)))))
@@ -763,7 +763,7 @@ category. Keywords get colour 33 (yellow), builtins 36 (cyan),
functions 34 (blue), comments 2 (dim), strings 32 (green), numbers
35 (magenta). Unrecognised categories render as plain text.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun apply-highlight-token (token category)
(let ((code (case category
(:keyword "33") (:builtin "36")
@@ -778,7 +778,7 @@ Coerces an adjustable character vector (accumulated during line
rendering) back into a string. This is a thin wrapper that exists
for potential future customisation of style application.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun apply-highlight-style (char-vector)
(coerce char-vector 'string))
#+END_SRC
@@ -793,7 +793,7 @@ colourised output.
Utility predicate that checks whether ~string~ starts with ~prefix~.
Avoids reimplementing this inline in multiple diff classifiers.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun string-prefix-p (prefix string)
(and (>= (length string) (length prefix))
(string= prefix (subseq string 0 (length prefix)))))
@@ -806,7 +806,7 @@ Classifies a single diff line into a semantic category: ~:file-header~
(for ~+~ lines), ~:removed~ (for ~-~ lines), or ~:context~ (for
everything else). This powers colourised diff rendering.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun classify-diff-line (line)
(cond ((string-prefix-p "+++ " line) :file-header)
((string-prefix-p "--- " line) :file-header)
@@ -830,7 +830,7 @@ string. Supports both keyword (e.g. ~:bold~) and string (e.g.
bold, italic, dim, code, link, underline, and the full set of 16
terminal colours. Unrecognised styles return the text unchanged.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun apply-style (style text)
(let ((code (cond
((eql style :bold) "1") ((eql style :italic) "3")
@@ -870,7 +870,7 @@ Renders a list of inline child nodes into a single string. Handles
types. Links render the text styled as link followed by the URL in
parentheses styled as url.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun render-inline (children)
(if (null children) ""
(with-output-to-string (s)
@@ -897,7 +897,7 @@ level determines the number of ~#~ characters (capped at 6) and the
colour: level 1 uses bright-cyan, level 2 uses bright-yellow, and
deeper levels use bright-white.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun render-heading (node)
(let* ((level (or (getf (getf node :properties) :level) 1))
(prefix (make-string (min level 6) :initial-element #\#))
@@ -912,7 +912,7 @@ deeper levels use bright-white.
Renders a paragraph node by inline-rendering its children. The
result is a single-element list containing the rendered text.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun render-paragraph (node)
(list (render-inline (getf node :children))))
#+END_SRC
@@ -922,7 +922,7 @@ result is a single-element list containing the rendered text.
Renders a blockquote node with a dimmed ~> ~ prefix before the
inline-rendered content.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun render-blockquote (node)
(list (apply-style :dim (concatenate 'string "> " (render-inline (getf node :children))))))
#+END_SRC
@@ -934,7 +934,7 @@ highlighter supports it, the code is syntax-highlighted with ANSI
colours. Otherwise it is rendered in plain ~:code~ style. A dimmed
language header line is shown when a language is present.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun render-code-block (node)
(let* ((language (or (getf (getf node :properties) :language) ""))
(content (or (getf node :content) ""))
@@ -971,7 +971,7 @@ colour: added lines in green (32), removed in red (31), hunk headers
in cyan (36), file headers in bold-cyan (1;36), and context lines
unstyled.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun render-diff-block (node)
(let* ((lines (getf (getf node :properties) :lines)) (result nil))
(dolist (line (or lines
@@ -993,7 +993,7 @@ unstyled.
Renders a thematic break as a dimmed horizontal rule using
Unicode box-drawing characters.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun render-thematic-break (node)
(declare (ignore node))
(list (apply-style :dim "──────────────────────────────────────────────")))
@@ -1004,7 +1004,7 @@ Unicode box-drawing characters.
Renders a list item node. Ordered items get ~ 1.~ prefix,
unordered items get ~ * ~ prefix. The content is inline-rendered.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun render-list-item (node)
(list (concatenate 'string
(if (eql (getf node :type) :ordered-item) " 1." " * ")
@@ -1017,7 +1017,7 @@ Dispatcher function that routes a single AST node to the correct
renderer based on its ~:type~. Each type-specific renderer returns a
list of strings (multiple lines), which ~render-md~ concatenates.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun render-md-node (node)
(let ((type (getf node :type)))
(case type
@@ -1038,7 +1038,7 @@ Renders a list of AST nodes (the output of ~parse-blocks~) into a
flat list of output lines by calling ~render-md-node~ on each node
and concatenating the results.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun render-md (nodes)
(let ((lines nil))
(dolist (node nodes) (setf lines (nconc lines (render-md-node node))))
@@ -1051,7 +1051,7 @@ Top-level convenience function that parses a Markdown string and
renders it to a single output string with newline-separated lines.
Returns an empty string for ~nil~ input.
#+BEGIN_SRC lisp :tangle ../src/components/markdown.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun render-markdown (text)
(unless text (return-from render-markdown ""))
(let ((nodes (parse-blocks text)) (parts nil))
@@ -1077,7 +1077,7 @@ This block must be first because ~tests/markdown-tests.lisp~ does not
exist yet — the tangle script creates it by writing this block's content.
All later blocks append.
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
;;; markdown-tests.lisp — Tests for cl-tty.markdown
(defpackage :cl-tty-markdown-test
@@ -1098,7 +1098,7 @@ Edge cases guard against crashes on ~nil~ input, very long lines, blank-only
input, and unclosed fenced blocks. These come first because they exercise the
defensive gate checks at the top of each parsing function.
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
;; ─── Parser edge cases ─────────────────────────────────────────
@@ -1183,7 +1183,7 @@ defensive gate checks at the top of each parsing function.
ATX headings from level 1 through 6, including headings with inline
formatting inside the heading text.
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
;; ─── Parser tests ─────────────────────────────────────────────────────────────
@@ -1215,7 +1215,7 @@ formatting inside the heading text.
Single-line and multi-line paragraphs. Multi-line paragraphs are joined
with spaces before inline parsing.
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
(def-test paragraph-parsing ( )
(let* ((result (parse-blocks "This is a paragraph.")) (node (first result)))
@@ -1231,7 +1231,7 @@ with spaces before inline parsing.
Bold, italic, combined bold+italic, inline code, and link parsing. Each
test verifies both structure (node types) and content (text/url values).
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
(def-test bold-parsing ( )
(let* ((children (parse-inline "hello **world** here"))
@@ -1275,7 +1275,7 @@ test verifies both structure (node types) and content (text/url values).
Fenced code blocks with and without a language annotation. Verifies the
presence/absence of the ~:language~ property on the resulting node.
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
(def-test code-block-parsing ( )
(let* ((lines '("```lisp" "(defun hello ())" " (print \"hi\")" "```"))
@@ -1299,7 +1299,7 @@ Verifies that blockquote markers, unordered list items, ordered list
items, and thematic breaks (---) are correctly classified and produce
the expected node types.
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
(def-test blockquote-parsing ( )
(let* ((result (parse-blocks "> This is a quote")) (node (first result)))
@@ -1323,7 +1323,7 @@ the expected node types.
Tests ~classify-diff-line~ with each diff line variant: added (+),
removed (-), hunk header (@@), and context (neither).
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
;; ─── Diff tests ───────────────────────────────────────────────────────────────
@@ -1346,7 +1346,7 @@ Verifies that ~highlight-code~ returns categorised tokens for Lisp
keywords, builtins, comments, and falls back to plain tokens for
unknown languages.
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
;; ─── Syntax highlighting tests ────────────────────────────────────────────────
(def-test highlight-lisp-keyword ( )
@@ -1377,7 +1377,7 @@ Verifies that each node type produces output via ~render-md-node~.
Heading, paragraph, thematic-break, code-block, and diff-block are
all exercised to ensure the render dispatcher routes correctly.
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
;; ─── Render tests ─────────────────────────────────────────────────────────────
@@ -1422,7 +1422,7 @@ A full parse-and-render integration test exercises the pipeline end-to-end.
The ~md-node-text~ utility tests verify both simple and nested node
traversal.
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/markdown-tests.lisp
;; ─── Integration tests ────────────────────────────────────────────────────────

View File

@@ -53,7 +53,7 @@ covers one logical behavior.
The test package uses =cl-tty.backend= to access internal symbols for
white-box testing of escape generation.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(defpackage :cl-tty-modern-backend-test
(:use :cl :fiveam :cl-tty.backend)
(:export #:run-tests))
@@ -64,7 +64,7 @@ white-box testing of escape generation.
A single suite groups all modern backend tests.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(def-suite modern-backend-suite :description "Modern backend tests")
(in-suite modern-backend-suite)
#+END_SRC
@@ -73,7 +73,7 @@ A single suite groups all modern backend tests.
The =run-tests= entry point is called by the CI test harness.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(defun run-tests ()
(let ((result (run 'modern-backend-suite)))
(fiveam:explain! result)
@@ -85,7 +85,7 @@ The =run-tests= entry point is called by the CI test harness.
Verifies that =make-modern-backend= returns an instance of the correct
class. This is the most basic smoke test for the backend factory.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test make-modern-backend-creates
"make-modern-backend returns a modern-backend instance"
(let ((b (make-modern-backend)))
@@ -97,7 +97,7 @@ class. This is the most basic smoke test for the backend factory.
Ensures a 6-digit hex string produces the correct 24-bit foreground
escape sequence with red, green, and blue components in the right order.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test sgr-truecolor-foreground
"SGR truecolor foreground escape is correct"
(is (equal (cl-tty.backend::sgr-fg "#FFD700")
@@ -108,7 +108,7 @@ escape sequence with red, green, and blue components in the right order.
Same as foreground but uses the =48= background prefix instead of =38=.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test sgr-truecolor-background
"SGR truecolor background escape is correct"
(is (equal (cl-tty.backend::sgr-bg "#1a1b26")
@@ -120,7 +120,7 @@ Same as foreground but uses the =48= background prefix instead of =38=.
Verifies that keyword symbols like =:red= and =:blue= resolve to the
standard 8-color SGR codes (=31= foreground, =44= background).
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test sgr-named-colors
"SGR named colors resolve to 8-color codes"
(is (equal (cl-tty.backend::sgr-fg :red)
@@ -134,7 +134,7 @@ standard 8-color SGR codes (=31= foreground, =44= background).
Each attribute keyword (=:bold=, =:italic=, =:underline=, =:reset=)
should map to the correct SGR number.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test sgr-bold-italic
"SGR attribute escapes are correct"
(is (equal (cl-tty.backend::sgr-attr :bold) (format nil "~C[1m" #\Esc)))
@@ -148,7 +148,7 @@ should map to the correct SGR number.
Verifies that =cursor-move-escape= produces a CSI =H= sequence with
1-indexed row and column.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test cursor-move-escape
"cursor-move generates correct CSI escape"
(let ((b (make-modern-backend)))
@@ -160,7 +160,7 @@ Verifies that =cursor-move-escape= produces a CSI =H= sequence with
Verifies the DECSTR escape for a block cursor without blinking (code 2).
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test cursor-style-block
"cursor-style :block generate correct escape"
(let ((b (make-modern-backend)))
@@ -172,7 +172,7 @@ Verifies the DECSTR escape for a block cursor without blinking (code 2).
Verifies the DECSTR escape for a bar cursor without blinking (code 6).
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test cursor-style-bar
"cursor-style :bar generate correct escape"
(let ((b (make-modern-backend)))
@@ -185,7 +185,7 @@ Verifies the DECSTR escape for a bar cursor without blinking (code 6).
Verifies that =:underline= with =blink=t= produces code 5 (underline
blinking), which is base 4 + blink offset 1.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test cursor-style-underline-blink
"cursor-style :underline with blink"
(let ((b (make-modern-backend)))
@@ -198,7 +198,7 @@ blinking), which is base 4 + blink offset 1.
Confirms that =decicm-begin= and =decicm-end= produce =?2026h= and
=?2026l= respectively.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test decicm-escapes
"DECICM synchronized update escapes"
(is (equal (cl-tty.backend::decicm-begin) (format nil "~C[?2026h" #\Esc)))
@@ -211,7 +211,7 @@ Verifies the full OSC 8 wrapping: opening sequence with URL, the text,
and the closing sequence. The FORMAT string uses ~~ for literal tilde
and ~\\ for literal backslash.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test osc8-escape
"OSC 8 hyperlink escape wraps text"
(is (equal (cl-tty.backend::osc8-link "http://example.com" "click here")
@@ -223,7 +223,7 @@ and ~\\ for literal backslash.
Verifies that ="#FFD700"= parses to (255, 215, 0).
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test hex-color-parsing
"hex-to-rgb parses valid hex colors"
(multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#FFD700")
@@ -236,7 +236,7 @@ Verifies that ="#FFD700"= parses to (255, 215, 0).
Verifies all-zero parsing.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test hex-color-black
"hex-to-rgb parses black"
(multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#000000")
@@ -249,7 +249,7 @@ Verifies all-zero parsing.
Verifies that ="#F00"= expands to ="#FF0000"= = (255, 0, 0).
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test hex-color-short-form
"hex-to-rgb parses 3-digit hex"
(multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#F00")
@@ -263,7 +263,7 @@ Verifies that ="#F00"= expands to ="#FF0000"= = (255, 0, 0).
Confirms that =:rounded= style maps to the Unicode box-drawing
characters for the four corners and edges.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test border-char-rounded
"modern-border-char returns Unicode box-drawing for rounded style"
(is (equal (cl-tty.backend::border-char :rounded :top-left) "╭"))
@@ -276,7 +276,7 @@ characters for the four corners and edges.
Confirms that =:double= style maps to double-line box-drawing characters.
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test border-char-double
"modern-border-char returns double-line chars"
(is (equal (cl-tty.backend::border-char :double :top-left) "╔"))
@@ -289,7 +289,7 @@ Confirms that =:double= style maps to double-line box-drawing characters.
Verifies that suspend-backend and resume-backend are no-ops when called
on a backend not attached to a real terminal (no errors, return nil).
#+BEGIN_SRC lisp :tangle ../src/backend/modern-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern-tests.lisp
(test suspend-resume-noop
"suspend-backend and resume-backend are no-ops in test context"
(let ((b (make-modern-backend)))
@@ -307,7 +307,7 @@ on a backend not attached to a real terminal (no errors, return nil).
both 6-digit (fully specified) and 3-digit (shorthand) formats. The
3-digit form expands each hexit by duplicating it (=#F00= => =#FF0000=).
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(in-package :cl-tty.backend)
(defun hex-to-rgb (hex)
@@ -331,7 +331,7 @@ Maps keyword color names to 8-color SGR index values. Used as the
primary lookup in =sgr-fg= and =sgr-bg= before falling back to the
theme colors hash table.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defparameter *named-colors*
'((:black . 0) (:red . 1) (:green . 2) (:yellow . 3)
(:blue . 4) (:magenta . 5) (:cyan . 6) (:white . 7)))
@@ -344,7 +344,7 @@ Populated by the theme system's =load-preset=. When a keyword is not in
=*named-colors*=, =sgr-fg= and =sgr-bg= consult this table as a
fallback, enabling user themes to define custom color roles.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defvar *theme-colors* (make-hash-table :test 'eq)
"Hash table mapping theme keywords to hex color strings.
Populated by the theme system's load-preset. Checked by sgr-fg/sgr-bg
@@ -357,7 +357,7 @@ as a fallback when a keyword is not in *named-colors*.")
hex string => named color => semantic theme role => empty string if
unresolved. Truecolor uses =38;2;R;G;B=, named colors use =3n=.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defun sgr-fg (color)
"Return SGR foreground escape for COLOR."
(if (null color) ""
@@ -381,7 +381,7 @@ unresolved. Truecolor uses =38;2;R;G;B=, named colors use =3n=.
~sgr-bg~ produces the SGR background escape. Same resolution chain as
=sgr-fg= but uses =48;2;R;G;B= for truecolor and =4n= for named colors.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defun sgr-bg (color)
"Return SGR background escape for COLOR."
(if (null color) ""
@@ -405,7 +405,7 @@ unresolved. Truecolor uses =38;2;R;G;B=, named colors use =3n=.
Maps attribute keywords to SGR parameter numbers. Covers bold, dim,
italic, underline, blink, reverse video, and reset.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defparameter *sgr-attr-codes*
'((:bold . 1) (:dim . 2) (:italic . 3) (:underline . 4)
(:blink . 5) (:reverse . 7) (:reset . 0)))
@@ -416,7 +416,7 @@ italic, underline, blink, reverse video, and reset.
~sgr-attr~ looks up the keyword in =*sgr-attr-codes*= and produces the
matching SGR escape.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defun sgr-attr (attr)
"Return SGR attribute escape for ATTR keyword."
(let ((code (cdr (assoc attr *sgr-attr-codes*))))
@@ -432,7 +432,7 @@ matching SGR escape.
Produces a CSI =H= (CUP) sequence to position the cursor. Coordinates
are 1-indexed: =cursor-move-escape 0 0= moves to row 1, column 1.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defun cursor-move-escape (x y)
"Return CSI escape to move cursor to (x, y), 1-indexed."
(format nil "~C[~d;~dH" #\Esc (1+ y) (1+ x)))
@@ -444,7 +444,7 @@ Produces a DECSTR sequence (=CSI Ps q=) to set the cursor shape.
Base codes: block=2, underline=4, bar=6. When =blink= is true the code
is incremented by 1 (e.g. blinking block = code 3).
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defun cursor-style-escape (shape blink)
"Return DECSTR escape for cursor shape."
(let* ((base (case shape
@@ -462,7 +462,7 @@ Enables DEC private mode 2026 (synchronized updates). All output
between =begin= and =end= is buffered by the terminal and rendered
atomically.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defun decicm-begin ()
"Return escape to enable synchronized updates."
(format nil "~C[?2026h" #\Esc))
@@ -473,7 +473,7 @@ atomically.
Disables DEC private mode 2026, flushing the buffered frame to the
display.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defun decicm-end ()
"Return escape to disable synchronized updates."
(format nil "~C[?2026l" #\Esc))
@@ -485,7 +485,7 @@ Wraps text in an OSC 8 hyperlink. The opening sequence carries the URL,
the closing sequence (=ESC]8;;ESC\)=) terminates the link. This
allows clickable text in terminals that support the protocol.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defun osc8-link (url text)
"Wrap TEXT in an OSC 8 hyperlink to URL."
(format nil "~C]8;;~A~C\\~A~C]8;;~C\\"
@@ -500,7 +500,7 @@ Lookup alist mapping =(style position)= pairs to Unicode box-drawing
characters. Covers single, double, and rounded styles with all four
corners plus horizontal and vertical connectors.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defparameter *border-chars*
'(((:single :top-left) . "┌") ((:single :top-right) . "┐")
((:single :bottom-left) . "└") ((:single :bottom-right) . "┘")
@@ -520,7 +520,7 @@ horizontal/vertical lines (=U+2500=, =U+2502=) if the style is unknown
for edge positions, or =+= for corners --- ensuring the UI never shows
a blank gap.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defun border-char (style pos)
"Return the Unicode box-drawing character for STYLE at POS."
(let ((char (cdr (assoc (list style pos) *border-chars* :test #'equal))))
@@ -537,7 +537,7 @@ Subclasses the abstract =backend= class. =output-stream= is where escape
sequences are written; =in-sync-p= tracks whether we are inside a
DECICM synchronized update block.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defclass modern-backend (backend)
((output-stream :initform *standard-output*
:initarg :output-stream
@@ -552,7 +552,7 @@ optional =output-stream=; defaults to =*standard-output*=. The
=color-palette= argument is ignored in favor of the dynamic
=*theme-colors*= hash table.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defun make-modern-backend (&key color-palette output-stream)
(declare (ignore color-palette))
(make-instance 'modern-backend :output-stream (or output-stream *standard-output*)))
@@ -567,7 +567,7 @@ drag + SGR), bracketed paste mode, and the Kitty keyboard protocol.
Hides the cursor and flushes the stream. Returns the backend instance
for chaining.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod initialize-backend ((b modern-backend))
(backend-write b (format nil "~C[?1049h" #\Esc)) ; alt screen
(backend-write b (format nil "~C[?1000h" #\Esc)) ; mouse basic
@@ -586,7 +586,7 @@ Restores the terminal: shows the cursor, disables the Kitty keyboard
protocol, bracketed paste, SGR mouse, drag, basic mouse, and finally
leaves the alternate screen. Returns =nil= (via =(values)=).
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod shutdown-backend ((b modern-backend))
(cursor-show b)
(backend-write b (format nil "~C[?u" #\Esc))
@@ -611,7 +611,7 @@ kitty keyboard — those would add ~100ms of overhead on every
suspend/resume cycle and are harmless while suspended (the terminal
just ignores the escape sequences).
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod suspend-backend ((b modern-backend))
(cursor-show b)
(backend-write b (format nil "~C[?1049l" #\Esc)) ; normal screen
@@ -629,7 +629,7 @@ Re-enters the alternate screen buffer and re-enables all input
features (mouse, bracketed paste, kitty keyboard). The application
is responsible for redrawing the full screen after resume.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod resume-backend ((b modern-backend))
(backend-write b (format nil "~C[?1049h" #\Esc)) ; alt screen
(backend-write b (format nil "~C[?1000h" #\Esc)) ; mouse basic
@@ -649,7 +649,7 @@ is responsible for redrawing the full screen after resume.
Uses ioctl (TIOCGWINSZ = 21523) to query actual terminal dimensions
from the kernel, with a ~/dev/tty~ fallback and 80x24 last resort.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod backend-size ((b modern-backend))
;; Try ioctl on stdout, fall back to /dev/tty, then 80x24.
;; Each arm uses multiple-value-bind/values to preserve both cols and rows
@@ -695,7 +695,7 @@ caller is responsible for calling ~finish-output~ at appropriate sync
points (frame boundaries via ~end-sync~, initialization, shutdown).
Returns the string length for protocol compatibility.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod backend-write ((b modern-backend) string)
(let ((stream (backend-output-stream b)))
(write-string string stream)
@@ -708,7 +708,7 @@ Advertises which features this backend supports. =modern-backend=
supports truecolor, OSC 8 hyperlinks, DECICM sync, SGR mouse,
bracketed paste, cursor style control, and the Kitty keyboard protocol.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod capable-p ((b modern-backend) feature)
(member feature '(:truecolor :osc8 :sync :mouse
:bracketed-paste :cursor-style
@@ -724,7 +724,7 @@ itself, and a reset into a single concatenated string. Minimizes output
calls --- one =backend-write= per draw operation --- by packing everything
into one buffer.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod draw-text ((b modern-backend) x y string fg bg
&key bold italic underline reverse dim blink
&allow-other-keys)
@@ -748,7 +748,7 @@ title, repeated mid sections, bottom) and writes them with minimal
output calls. The title can be left-aligned or centered within the top
border line. Uses the border character lookup for the chosen style.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod draw-border ((b modern-backend) x y width height
&key style fg bg title title-align)
(let* ((s (or style :single))
@@ -810,7 +810,7 @@ the cursor and writes a filled line. This is simpler than =draw-border=
because it has no border characters --- just spaces with a background
color.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod draw-rect ((b modern-backend) x y width height &key bg)
(let* ((bg-esc (sgr-bg bg))
(reset (sgr-attr :reset))
@@ -830,7 +830,7 @@ positioning, optional fg/bg colors, the OSC 8 link wrapper around the
text, and a reset. This lets the user click the text to open the URL
in terminals that support OSC 8.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod draw-link ((b modern-backend) x y string url
&key fg bg)
(let ((parts (list (cursor-move-escape x y)
@@ -846,7 +846,7 @@ Draws a three-dot ellipsis at the given position. The =width= parameter
is ignored since dots have a fixed visual length; delegates to
=draw-text= for uniform rendering.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod draw-ellipsis ((b modern-backend) x y width
&key fg bg)
(declare (ignore width))
@@ -861,7 +861,7 @@ is ignored since dots have a fixed visual length; delegates to
Delegates to =cursor-move-escape= and writes the resulting CSI sequence
to the output stream.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod cursor-move ((b modern-backend) x y)
(backend-write b (cursor-move-escape x y)))
#+END_SRC
@@ -870,7 +870,7 @@ to the output stream.
Sends the DECTCEM private mode =?25l= to hide the cursor.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod cursor-hide ((b modern-backend))
(backend-write b (format nil "~C[?25l" #\Esc)))
#+END_SRC
@@ -879,7 +879,7 @@ Sends the DECTCEM private mode =?25l= to hide the cursor.
Sends =?25h= to restore the cursor visibility.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod cursor-show ((b modern-backend))
(backend-write b (format nil "~C[?25h" #\Esc)))
#+END_SRC
@@ -889,7 +889,7 @@ Sends =?25h= to restore the cursor visibility.
Sets the cursor shape (block/underline/bar, optionally blinking) by
delegating to =cursor-style-escape=.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod cursor-style ((b modern-backend) shape &key blink)
(backend-write b (cursor-style-escape shape blink)))
#+END_SRC
@@ -900,7 +900,7 @@ Enables basic mouse tracking, button-event tracking (drag), and SGR
extended mouse mode. These three modes together give full mouse
support while staying compatible with modern terminal emulators.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod enable-mouse ((b modern-backend))
(backend-write b (format nil "~C[?1000h" #\Esc))
(backend-write b (format nil "~C[?1002h" #\Esc))
@@ -914,7 +914,7 @@ Enables bracketed paste mode, where the terminal wraps pasted text in
=ESC[200~= and =ESC[201~= delimiters. This allows the application to
distinguish user input from pasted content.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod enable-bracketed-paste ((b modern-backend))
(backend-write b (format nil "~C[?2004h" #\Esc))
(finish-output (backend-output-stream b)))
@@ -925,7 +925,7 @@ distinguish user input from pasted content.
Begins a synchronized update frame using DECICM. Sets the =in-sync-p=
slot so other methods can check whether we are inside a sync block.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod begin-sync ((b modern-backend))
(setf (in-sync-p b) t)
(backend-write b (decicm-begin)))
@@ -936,7 +936,7 @@ slot so other methods can check whether we are inside a sync block.
Ends the synchronized update frame and flushes the output, causing the
terminal to render the buffered changes atomically.
#+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/backend/modern.lisp
(defmethod end-sync ((b modern-backend))
(setf (in-sync-p b) nil)
(backend-write b (decicm-end))

View File

@@ -32,7 +32,7 @@ implementation. It re-exports the public API symbols that consumers
(~cl-tty.core~, user applications) rely on without pulling in
implementation details.
#+BEGIN_SRC lisp :tangle ../src/components/mouse-package.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse-package.lisp :noweb no
(defpackage :cl-tty.mouse
(:use :cl :cl-tty.layout :cl-tty.input :cl-tty.box :cl-tty.rendering)
(:export
@@ -51,7 +51,7 @@ implementation details.
Standard boilerplate to enter the package defined above.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(in-package :cl-tty.mouse)
#+END_SRC
@@ -63,7 +63,7 @@ that want mouse support simply inherit from ~mouse-mixin~ alongside
their primary superclass. Each slot stores a closure invoked when the
corresponding event fires; ~nil~ means "no handler."
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defclass mouse-mixin ()
((on-mouse-down :initarg :on-mouse-down :initform nil :accessor on-mouse-down)
(on-mouse-up :initarg :on-mouse-up :initform nil :accessor on-mouse-up)
@@ -79,7 +79,7 @@ function dispatch because the mapping is one-to-one and never needs
CLOS multiple-dispatch. Returns ~nil~ when no handler is bound (the
caller can decide whether to bubble the event up).
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defun handle-mouse-event (component event)
(let* ((type (mouse-event-type event))
(handler (case type
@@ -98,7 +98,7 @@ innermost matching component wins (front-most in rendering order).
yet (no ~layout-node~ bound). This makes hit-testing safe to call
mid-render when the tree is partially constructed.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defun hit-test (root x y)
"Find the deepest component at (X, Y) by testing layout-node bounds.
Recurses into component-children to find the innermost match.
@@ -131,7 +131,7 @@ process without threading it through the entire component tree. This
keeps the API simple for now; a future refactor could store the
selection on a per-frame or per-window basis if needed.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defvar *selection* nil)
#+END_SRC
@@ -143,7 +143,7 @@ avoiding name collisions. Using a struct (vs. a class) gives inline
accessors and no CLOS overhead, which matters when the selection is
read on every render frame.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defstruct (selection (:conc-name sel-))
(start-x 0) (start-y 0) (end-x 0) (end-y 0) (text ""))
#+END_SRC
@@ -153,7 +153,7 @@ read on every render frame.
Simple accessor that returns nil when nothing is selected (rather than
an empty string), making it easy for callers to test with ~when~.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defun get-selection ()
(when *selection* (sel-text *selection*)))
#+END_SRC
@@ -168,7 +168,7 @@ Darwin uses ~pbcopy~. The approach avoids build-time feature detection
the common case of a single SBCL binary used across X11 and Wayland
sessions.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defun copy-to-clipboard (text)
#+linux
(cond
@@ -187,7 +187,7 @@ should draw a highlight overlay. A global flag (rather than threading
the drag state through event handlers) mirrors the simplicity of
~*selection*~ and makes it trivial to check in rendering code.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defvar *selection-active* nil
"T when a drag selection is in progress.")
#+END_SRC
@@ -198,7 +198,7 @@ Stored as a cons cell ~(X . Y)~ of the mouse-down position. Using a
cons (vs. a struct) keeps the imperative mutation simple — ~setf~ with
~cons~ is a single expression.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defvar *selection-start* nil
"Cons (X . Y) of mouse-down position during drag.")
#+END_SRC
@@ -209,7 +209,7 @@ Updated on every mouse-move during a drag so the rendering loop can
draw the live highlight rectangle between ~*selection-start*~ and
~*selection-end*~.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defvar *selection-end* nil
"Cons (X . Y) of current mouse position during drag.")
#+END_SRC
@@ -220,7 +220,7 @@ Initializes all three drag state variables in one call. Both start and
end are set to the same position so that before the first mouse-move
the "selection" is a zero-width region (which renders as nothing).
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defun start-selection (x y)
"Begin a drag selection at (X Y)."
(setf *selection-start* (cons x y)
@@ -234,7 +234,7 @@ Called on every mouse-move event while dragging. Only updates the end
position; the start remains fixed from the original mouse-down. The
rendering loop reads both globals to draw the highlight rectangle.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defun update-selection (x y)
"Update the drag selection end position to (X Y)."
(setf *selection-end* (cons x y)))
@@ -246,7 +246,7 @@ Encapsulates the global flag behind a function so that callers don't
need to know the variable name. Returning ~*selection-active*~
directly works because it is always ~nil~ or ~T~.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defun selection-active-p ()
"Return T if a drag selection is in progress."
*selection-active*)
@@ -260,7 +260,7 @@ framebuffer via ~cl-tty.rendering:extract-text~, stores the result in
~*selection*~, and returns the extracted string. The ~fb~ parameter
must be the current framebuffer at the time of release.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defun finalize-selection (fb)
"End the drag selection and extract text from the framebuffer."
(setf *selection-active* nil)
@@ -283,7 +283,7 @@ Delegates to the rendering layer's ~fb-cell-link-url~ to look up the
cell metadata. This indirection keeps mouse code independent of the
framebuffer's internal storage format.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defun cell-link-at (fb x y)
"Return the link URL at (X Y) in framebuffer FB, or nil."
(cl-tty.rendering:fb-cell-link-url fb x y))
@@ -296,7 +296,7 @@ If ~cell-link-at~ finds a URL, open it with the OS default handler
the caller can log or react to the result. The ~:wait nil~ avoids
blocking the TTY UI while the browser launches.
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/mouse.lisp :noweb no
(defun open-link-at (fb x y)
"If there is a link URL at (X Y) in FB, open it via xdg-open."
(let ((url (cell-link-at fb x y)))
@@ -314,7 +314,7 @@ Isolates test symbols in their own package to avoid polluting the
production namespace. FiveAM's ~def-suite~ groups all mouse tests
under a single name for convenient batch execution.
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
(defpackage :cl-tty-mouse-test (:use :cl :cl-tty.mouse :fiveam))
(in-package :cl-tty-mouse-test)
@@ -328,7 +328,7 @@ Verifies that the mixin class can be instantiated and passes a basic
typep check. This guards against missing ~:initform~ values or
superclass chain issues.
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
(def-test mouse-mixin-create ()
(let ((m (make-instance 'mouse-mixin)))
(is-true (typep m 'mouse-mixin))))
@@ -340,7 +340,7 @@ superclass chain issues.
for any coordinates. This tests the ~ignore-errors~ guard path in the
hit-testing logic.
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
(def-test mouse-hit-test-point ()
"hit-test returns nil when no component has position slots bound"
(let ((obj (make-instance 'mouse-mixin)))
@@ -354,7 +354,7 @@ Sets ~*selection*~ directly (simulating a completed drag) and checks
that ~get-selection~ returns the expected text. This validates the
~selection~ struct accessor chain end-to-end.
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
(def-test selection-set-and-get ()
(setf cl-tty.mouse::*selection* (make-selection :text "hello"))
(is (equal "hello" (get-selection))))
@@ -367,7 +367,7 @@ that ~get-selection~ returns the expected text. This validates the
resets globals to avoid cross-test contamination (FiveAM does not
automatically reset special variables between tests).
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
(def-test start-selection-initializes-state ()
(start-selection 5 10)
(is-true (selection-active-p))
@@ -384,7 +384,7 @@ After ~start-selection~, calling ~update-selection~ must update
~*selection-end*~ while leaving ~*selection-start*~ unchanged. This
validates the drag-tracking update path.
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
(def-test update-selection-moves-end ()
(start-selection 0 0)
(update-selection 3 7)
@@ -401,7 +401,7 @@ simulates a drag selection, and verifies that ~finalize-selection~
extracts the correct multi-line string. This exercises the full chain
from framebuffer cell storage through coordinate normalization.
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/mouse-tests.lisp :noweb no
(def-test finalize-selection-extracts-text ()
(let* ((fb-be (cl-tty.rendering:make-framebuffer-backend))
(fb (cl-tty.rendering:fb-framebuffer fb-be)))

View File

@@ -53,7 +53,7 @@ computation. We export it separately from the rendering symbols
because it is also needed by code that walks the component tree
without triggering a full render.
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
(defpackage :cl-tty.box
(:use :cl :cl-tty.backend :cl-tty.layout)
(:export
@@ -75,7 +75,7 @@ properties without pulling in the internal representation. We keep
the accessor list flat (no grouping macro) to make the package
surface easy to grep and to keep the API browser-friendly.
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
;; Span
#:span
#:span-text #:span-bold #:span-italic #:span-underline
@@ -97,7 +97,7 @@ separate ~cl-tty.text~ package to keep inter-component references
trivial — boxes can hold text children, and text can be nested inside
other components, all without cross-package imports.
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
;; Text
#:text #:make-text
#:text-layout-node #:text-content #:text-spans
@@ -113,7 +113,7 @@ exported specifically so the test suite can unit-test them in
isolation. They are not part of the public component API and should
not be relied upon by application code outside of tests.
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
;; Utilities (for tests)
#:word-wrap #:split-string
#+END_SRC
@@ -131,7 +131,7 @@ dirty-p)~) makes it easy for subclasses to add side effects on dirty
transitions — for example, invalidating a cached bitmap or
recomputing string metrics.
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
;; Dirty tracking
#:dirty-mixin #:dirty-p #:mark-clean #:mark-dirty
#+END_SRC
@@ -151,7 +151,7 @@ Collecting these under a single "Rendering pipeline" group signals to
readers that they form a coherent subsystem — if you override one,
you likely need to understand all of them.
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
;; Rendering pipeline
#:render #:render-screen #:render-node
#:component-layout-node #:component-children #:component-parent
@@ -172,7 +172,7 @@ boxes and text reference theme colors by name at render time, and the
theme object is passed in from the application level. This separation
means themes can be swapped without touching component instances.
#+BEGIN_SRC lisp :tangle ../src/components/package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
;; Theme engine
#:theme #:make-theme #:theme-mode
#:theme-color #:load-preset #:define-preset))

View File

@@ -72,7 +72,7 @@ to a string stream instead of writing to the real terminal. This helper
creates a ~modern-backend~ with a ~string-output-stream~ and returns
both, so tests can inspect what was rendered.
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
(in-package :cl-tty-box-test)
(in-suite box-suite)
@@ -90,7 +90,7 @@ generic dispatch works for the box type and that the border rendering
pipeline is intact. A regression here would mean ~render-box~ is not
being called or produces no output.
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
(test render-generic-dispatches-box
"render dispatches to render-box for box instances"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -108,7 +108,7 @@ dispatch works for the text type and that text content is correctly
emitted to the backend. A regression would mean ~render-text~ is not
being called.
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
(test render-generic-dispatches-text
"render dispatches to render-text for text instances"
(multiple-value-bind (b s) (make-capturing-backend)
@@ -127,7 +127,7 @@ return a ~layout-node~ instance from their ~component-layout-node~
method. A failure here means a component type is missing its method or
the slot accessor is wrong.
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
(test component-layout-node-works
"component-layout-node returns the right slot for each type"
(let ((bx (make-box)) (tx (make-text "")))
@@ -143,7 +143,7 @@ nor text accidentally inherits or defines a method that returns
non-nil, which would break the tree-walk in ~render-node~ by causing
infinite recursion or rendering phantom children.
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
(test component-children-returns-nil
"Leaf components have no children"
(let ((bx (make-box)) (tx (make-text "")))
@@ -160,7 +160,7 @@ test verifies that calling ~propagate-dirty~ on a clean component sets
it dirty. Without this, components that mutate would never trigger a
re-render and the display would become stale.
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
(test propagate-dirty-marks-component
"propagate-dirty marks the component dirty"
(let ((c (make-box)))
@@ -180,7 +180,7 @@ computation. This matters because container components use
~available-width~ to position children — getting a sensible default
prevents division-by-zero or garbled layouts during initialization.
#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render-tests.lisp
(test available-width-defaults
"available-width returns 0 for components without explicit width"
(let ((c (make-box)))
@@ -203,7 +203,7 @@ rendering must have a layout node — it stores the computed position and
size after layout passes. The generic is defined with two specific
methods for the built-in component types.
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
(in-package :cl-tty.box)
;; ── Component Protocol ────────────────────────────────────────
@@ -215,7 +215,7 @@ methods for the built-in component types.
Each component type returns its internal layout node slot. This method
specializes on ~box~ and returns the ~box-layout-node~ slot value.
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
(defmethod component-layout-node ((bx box))
(box-layout-node bx))
#+END_SRC
@@ -224,7 +224,7 @@ The ~text~ component stores its layout node in the ~text-layout-node~
slot. Both methods return the same type (~layout-node~), so the layout
engine can operate uniformly regardless of component type.
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
(defmethod component-layout-node ((tx text))
(text-layout-node tx))
#+END_SRC
@@ -236,7 +236,7 @@ Leaf components (~box~, ~text~) have no children. Container components
default method on ~t~ returns ~nil~, so new component types are
automatically treated as leaves unless they explicitly override.
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
(defgeneric component-children (component)
(:documentation "Return the children of COMPONENT, or nil.")
(:method ((c t)) nil))
@@ -250,7 +250,7 @@ used by ~propagate-dirty~ to walk up the tree. The default method on
recursive dirty walk — when ~component-parent~ returns ~nil~, we've
reached the root.
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
(defgeneric component-parent (component)
(:documentation "Return the parent of COMPONENT, or nil.")
(:method ((c t)) nil))
@@ -266,7 +266,7 @@ pipeline. Every component type that can be drawn defines a method on
objects (or components still under development) don't cause errors
when the tree walk reaches them.
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
;; ── Rendering Pipeline ────────────────────────────────────────
(defgeneric render (component backend)
@@ -282,7 +282,7 @@ Boxes are rendered with border characters. The ~render~ method
delegates to the ~render-box~ function defined in ~box.lisp~, which
handles the actual drawing of border lines and corners.
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
(defmethod render ((bx box) backend)
(render-box bx backend))
#+END_SRC
@@ -293,7 +293,7 @@ Text components render their content string at the computed position.
The ~render~ method delegates to ~render-text~ from ~text.lisp~, which
writes the string with appropriate escape sequences for positioning.
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
(defmethod render ((tx text) backend)
(render-text tx backend))
#+END_SRC
@@ -313,7 +313,7 @@ The pipeline is: (1) query backend pixel/dimension size, (2) begin
sync, (3) compute layout at the root, (4) walk the tree rendering each
node, (5) end sync.
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
(defun render-screen (root backend)
"Render the component tree ROOT using BACKEND.
Computes layout at the root level, then traverses children
@@ -334,7 +334,7 @@ are available from its ~layout-node~. The recursion is depth-first:
parents are drawn before children, which matters for z-ordering (the
parent's background is drawn first, children overlay on top).
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
(defun render-node (node backend)
"Render a component NODE and its children.
Layout is computed once at the root by render-screen, so children
@@ -354,7 +354,7 @@ reflects the actual allocated space — not the requested width. The
fallback of 80 matches the default terminal width when no layout node
exists (during initialization or testing without a backend).
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
(defun available-width (component)
"Return the available width for COMPONENT (or 80 as default)."
(let ((ln (component-layout-node component)))
@@ -369,7 +369,7 @@ fallback of 24 matches the default terminal height. These accessors
provide a clean API for components that need to know their allocated
space during rendering, avoiding direct access to layout nodes.
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
(defun available-height (component)
"Return the available height for COMPONENT (or 24 as default)."
(let ((ln (component-layout-node component)))
@@ -391,7 +391,7 @@ immediately for clean components (handled in each component's render,
not here). The recursion terminates when ~component-parent~ returns
~nil~ (the root component has no parent).
#+BEGIN_SRC lisp :tangle ../src/components/render.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/render.lisp
;; ── Dirty Propagation ─────────────────────────────────────────
(defun propagate-dirty (component)

View File

@@ -45,7 +45,7 @@ Defining this as a class (rather than a struct) lets us integrate with
the CLOS-based component protocol — ~render~ dispatches on the class,
and dirty-mixin provides the marking machinery used by the refresh loop.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(in-package #:cl-tty.container)
(defclass scroll-box (dirty-mixin)
@@ -69,7 +69,7 @@ value explicitly passed as ~:sticky-scroll-p nil~ needs to be
preserved). Using a function instead of making the user call
~make-instance~ directly keeps the API ergonomic and hides CLOS plumbing.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun make-scroll-box (&key (children nil) (scroll-y 0) (scroll-x 0)
sticky-scroll-p)
(make-instance 'scroll-box
@@ -87,7 +87,7 @@ delegating to the ~scroll-box-children~ accessor, we keep the protocol
implementation thin — just an indirection that makes ~scroll-box~
participate polymorphically alongside other container types.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defmethod component-children ((sb scroll-box))
(scroll-box-children sb))
#+END_SRC
@@ -99,7 +99,7 @@ uses to position the ScrollBox itself within its parent. Each ScrollBox
creates its own layout node at construction time via ~make-layout-node~,
so this method simply returns that stored node.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defmethod component-layout-node ((sb scroll-box))
(scroll-box-layout-node sb))
#+END_SRC
@@ -113,7 +113,7 @@ content dimensions from the content-size helpers, then clamps both
scroll offsets with ~max~/~min~ to ensure they never go below 0 or
beyond the scrollable range.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun clamp-scroll (sb)
"Clamp scroll offsets to valid range."
(let* ((ln (scroll-box-layout-node sb))
@@ -137,7 +137,7 @@ the component dirty so the render loop picks up the change. This is
the primary API entry point for programmatic scrolling (from keyboard
input or mouse wheel events).
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun scroll-by (sb dy dx)
"Scroll by DY rows and DX columns. Clamps to valid range."
(incf (scroll-box-scroll-y sb) dy)
@@ -154,7 +154,7 @@ layout node, with a minimum of 1 row (even zero-height children get a
floor so they don't collapse the layout). This is used by
~clamp-scroll~, scrollbar rendering, and sticky-scroll logic.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun scroll-box-content-height (sb)
"Total height of all children."
(reduce #'+ (scroll-box-children sb)
@@ -171,7 +171,7 @@ since horizontal scrolling follows the widest child rather than summing
widths. Like the height counterpart, it floors child widths at 1 so
empty children don't zero out the measurement.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun scroll-box-content-width (sb)
"Maximum width among children."
(reduce #'max (scroll-box-children sb)
@@ -198,7 +198,7 @@ position.
After child rendering, it delegates to ~draw-scrollbars~ for the
scrollbar overlay.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defmethod render ((sb scroll-box) backend)
"Render visible children with scroll offset applied.
Delegates to each child's `render` method, temporarily offsetting
@@ -241,7 +241,7 @@ viewport-h 1)~) so minor content changes don't cause jitter. The sticky
flag is reset to nil when the user manually scrolls up (handled by
callers of ~scroll-by~).
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun update-sticky-scroll (sb)
"If sticky-scroll-p is active and at bottom, keep at bottom."
(when (sticky-scroll-p sb)
@@ -262,7 +262,7 @@ it returns 0.0 (no scrolling possible). This normalized value is used
by ~draw-scrollbars~ to compute the pixel/character position of the
thumb.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun scrollbar-thumb (scroll-pos viewport-size content-size)
"Return the thumb position for a scrollbar (0.0 to 1.0)."
(if (> content-size viewport-size)
@@ -283,7 +283,7 @@ the bottom edge. Both account for the scrollbox's own position within
the layout tree (~ox~, ~oy~) so nested scrollboxes render scrollbars at
the correct screen coordinates.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun draw-scrollbars (sb backend viewport-w viewport-h)
"Draw scrollbars if content exceeds viewport."
(let* ((content-h (scroll-box-content-height sb))
@@ -342,7 +342,7 @@ along with the base ~:cl~ language and ~:fiveam~ itself.
unconditionally; it runs the ~scrollbox-suite~ and prints results via
~fiveam:explain!~ before exiting.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(defpackage :cl-tty-scrollbox-test
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.container)
(:export #:run-tests))
@@ -363,7 +363,7 @@ Confirms a bare ~make-scroll-box~ returns a ~scroll-box~ instance with
default scroll offsets of 0 and no children. This establishes that the
class definition and constructor are wired up correctly.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-creates
"A ScrollBox can be created with defaults."
(let ((sb (make-scroll-box)))
@@ -379,7 +379,7 @@ Verifies that the ~:children~ initarg is accepted and that
~scroll-box-children~ returns the list. A ScrollBox with one child
should report length 1.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-with-children
"A ScrollBox can have children."
(let ((sb (make-scroll-box :children (list (make-text "hello")))))
@@ -393,7 +393,7 @@ scroll-y is non-negative after the operation. Combined with
~scrollbox-scroll-clamp~ below, this covers both the normal and
boundary behavior of the scroll mechanic.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-scroll-by
"ScrollBy adjusts offset clamped to valid range."
(let ((sb (make-scroll-box :scroll-y 0)))
@@ -408,7 +408,7 @@ same child list that ~scroll-box-children~ does. This ensures the
protocol indirection works and that the rendering pipeline will see the
correct children.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-component-children
"Component protocol: children are accessible."
(let* ((child (make-text "hello"))
@@ -423,7 +423,7 @@ The test passes if no errors are signaled — this guards against nil
layout nodes or unbound slots causing problems during the render
pipeline's initial traversal.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-render-noop
"Rendering a ScrollBox with no children does not error."
(let* ((stream (make-string-output-stream))
@@ -439,7 +439,7 @@ Confirms a bare ~make-tab-bar~ returns a ~tab-bar~ instance with no
active tab and no tabs. This validates the TabBar class definition and
constructor.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-creates
"A TabBar can be created with defaults."
(let ((tb (make-tab-bar)))
@@ -454,7 +454,7 @@ Tests that ~tab-bar-add~ returns the supplied ID, adds a tab to the
internal list, and stores the title correctly. Each tab is stored as a
plist, so the test checks both list length and the ~:title~ property.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-add-tab
"Adding a tab returns the id and updates tabs."
(let ((tb (make-tab-bar)))
@@ -469,7 +469,7 @@ plist, so the test checks both list length and the ~:title~ property.
Verifies that ~(setf tab-bar-active)~ correctly selects a tab by ID and
that ~tab-bar-active~ returns that ID afterward.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-active-tab
"Setting active tab works."
(let ((tb (make-tab-bar)))
@@ -486,7 +486,7 @@ a string-output-stream backend to confirm the render method doesn't
error. A TabBar must draw its tab strip without crashing even when
disconnected from a real terminal.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-render-noop
"Rendering a TabBar does not error."
(let* ((stream (make-string-output-stream))
@@ -507,7 +507,7 @@ wrapping around past the first. This is the core keyboard interaction
for tabbed UIs and must handle edge cases (empty bar, single tab, etc.)
gracefully.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-next-prev
"TabBar next/prev wraps around through tabs."
(let ((tb (make-tab-bar)))
@@ -531,7 +531,7 @@ gracefully.
next/prev navigation). This test verifies that selecting ~:tab2~ from a
three-tab bar correctly sets the active tab.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-select
"TabBar select activates the specified tab."
(let ((tb (make-tab-bar)))
@@ -548,7 +548,7 @@ three-tab bar correctly sets the active tab.
This tests the bridge between the input event system and the TabBar
navigation API.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-handle-key
"TabBar handle-key dispatches left/right."
(let ((tb (make-tab-bar)))
@@ -568,7 +568,7 @@ values (negative and extremely large) and confirming they get clamped
back to 0. With no children, content size is 0 so the max scroll is
also 0 — this exercises the degenerate case.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-scroll-clamp
"ScrollBox clamp prevents scrolling past bounds."
(let ((sb (make-scroll-box :scroll-y 5 :scroll-x 3)))

View File

@@ -47,19 +47,19 @@ by the select widget tests — FiveAM itself, the backend/box/layout/input infra
and the ~cl-tty.select~ package under test. ~run-tests~ is the entry point for
CI and interactive use.
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(defpackage :cl-tty-select-test
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.select)
(:export #:run-tests))
(in-package #:cl-tty-select-test)
#+END_SRC
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(def-suite select-suite :description "Select widget tests")
(in-suite select-suite)
#+END_SRC
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(defun run-tests ()
(let ((result (run 'select-suite)))
(fiveam:explain! result)
@@ -72,7 +72,7 @@ Verifies that a select widget can be constructed with default values. The
~selected-index~ should start at 0, and both ~options~ and ~filter~ should
be nil. This establishes the baseline contract for the default constructor.
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(test select-creates
"A Select can be created with defaults."
(let ((sel (make-select)))
@@ -87,7 +87,7 @@ be nil. This establishes the baseline contract for the default constructor.
Ensures that passing ~:options~ to ~make-select~ stores them correctly. The
length check is the simplest invariant — two options in, two options out.
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(test select-with-options
"A Select stores options."
(let ((sel (make-select :options '((:title "Red" :value :red)
@@ -102,7 +102,7 @@ match \"Blue\" but not \"Red\" or \"Green\". The return value is an alist of
~(display-index original-index option)~, so we dig into the third element
to check the ~:value~.
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(test select-filtered-exact
"Filter returns case-insensitive substring matches."
(let ((sel (make-select
@@ -121,7 +121,7 @@ When the filter is nil ~select-filtered-options~ must return every option
unchanged. This is the unfiltered/identity case and the most common state
when the user hasn't typed anything.
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(test select-filtered-all
"Nil filter returns all options."
(let ((sel (make-select
@@ -137,7 +137,7 @@ Exercises ~select-next~ and ~select-prev~ through a three-item list,
confirming that forward and backward movement works and that both directions
wrap around at list boundaries.
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(test select-navigation
"Select-next and select-prev navigate through options."
(let ((sel (make-select
@@ -162,7 +162,7 @@ navigation — ~select-next~ and ~select-prev~ skip over them. This test
sets up a list with two category headers interleaved and verifies they
are transparent to movement.
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(test select-navigation-skips-categories
"Navigation skips category header options."
(let ((sel (make-select
@@ -186,7 +186,7 @@ Validates that ~select-handle-key~ dispatches correctly: Down moves forward,
Up moves backward, and Enter invokes the ~on-select~ callback with the
currently highlighted option's plist.
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(test select-handle-key
"Select handle-key dispatches navigation and selection."
(let* ((result (list nil))
@@ -207,7 +207,7 @@ Ctrl+N and Ctrl+P are Emacs-compatible alternatives to Down/Up. They must
produce identical navigation behavior. This test confirms the control-key
dispatch paths.
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(test select-handle-key-ctrl
"Ctrl+N and Ctrl+P navigate like down/up."
(let ((sel (make-select
@@ -224,7 +224,7 @@ dispatch paths.
height. This test creates 20 options, sets the layout height to 5, and
asserts the visible subset fits within that constraint.
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(test select-visible-count
"Visible options respects viewport height."
(let* ((ln (make-layout-node))
@@ -242,7 +242,7 @@ When exact substring matching fails, the filter falls back to character-set
Jaccard similarity. ~\"nrd\"~ should match ~\"Nord\"~ because the character
overlap (n, o, r, d → 3 of 4) exceeds the 0.3 threshold.
#+BEGIN_SRC lisp :tangle ../tests/select-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/select-tests.lisp
(test select-fuzzy-fallback
"Fuzzy filter catches near-misses."
(let ((sel (make-select
@@ -265,7 +265,7 @@ and input subsystems. The exported symbols cover the public API: the
handling, rendering, and the fuzzy matching predicate (exposed for
testing and extensibility).
#+BEGIN_SRC lisp :tangle ../src/components/select-package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select-package.lisp
(defpackage :cl-tty.select
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export
@@ -292,7 +292,7 @@ currently highlighted option. ~filter~ is a string (or nil for
unfiltered). ~on-select~ is a callback receiving the selected option
plist. ~layout-node~ positions the widget in the window.
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
(in-package #:cl-tty.select)
(defclass select (dirty-mixin)
@@ -314,7 +314,7 @@ A convenience constructor that wraps ~make-instance~ with keyword
arguments. Defaults to nil for all optional parameters, matching the
~defclass~ initforms.
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
(defun make-select (&key options filter on-select)
(make-instance 'select
:options (or options nil)
@@ -330,7 +330,7 @@ The layout engine needs a uniform way to access a component's position.
~component-layout-node~ is part of the component protocol; this method
for ~select~ simply delegates to the ~select-layout-node~ accessor.
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
(defmethod component-layout-node ((sel select))
(select-layout-node sel))
#+END_SRC
@@ -352,7 +352,7 @@ Internally, the filter first checks for exact substring containment via
character-set ~fuzzy-match-p~ predicate. Category headers short-circuit
so they always pass through the filter.
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
(defun select-filtered-options (sel)
"Return list of options matching the current filter, in display order.
Each item: (display-index original-index option-plist)."
@@ -424,7 +424,7 @@ query and target exceeds 0.3. The character-set approach is simpler
and cheaper than trigrams while still catching common typos and
near-misses like ~\"nrd\"~ for ~\"Nord\"~.
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
(defun fuzzy-match-p (query target)
"T if character-set Jaccard similarity exceeds threshold (0.3)."
(let* ((q-chars (remove-duplicates (coerce (string-downcase query) 'list)))
@@ -443,7 +443,7 @@ index may point beyond the filtered list. ~select-clamp-index~ ensures
the index stays within valid bounds. If the list is empty the index
resets to 0.
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
(defun select-clamp-index (sel)
"Ensure selected-index is valid. Wraps if empty."
(let* ((filtered (select-filtered-options sel))
@@ -461,7 +461,7 @@ through the filtered list starting from the current index, wrapping
around at the end. Each candidate is checked for ~:category t~ and
skipped. Marks the widget dirty so the render pass picks up the change.
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
(defun select-next (sel)
"Move selection to next non-category option. Wraps at end."
(let* ((filtered (select-filtered-options sel))
@@ -483,7 +483,7 @@ Moves the selection backward to the previous non-category option.
Mirrors ~select-next~ but decrements the index (with modular arithmetic
for wrap-around). Category headers are skipped identically.
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
(defun select-prev (sel)
"Move selection to previous non-category option. Wraps at start."
(let* ((filtered (select-filtered-options sel))
@@ -512,7 +512,7 @@ Dispatches keyboard events:
Returns T if the key was handled (consumed), NIL otherwise so the
caller knows not to propagate the event further.
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
(defun select-handle-key (sel event)
"Handle a key-event. Returns T if handled."
(let ((key (key-event-key event))
@@ -545,7 +545,7 @@ hundreds of items when the viewport shows only 10. The window is
centered around the currently selected index so the user always sees
context around their cursor.
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
(defun select-visible-options (sel)
"Return filtered options that fit within the viewport."
(let* ((ln (select-layout-node sel))
@@ -569,7 +569,7 @@ background. Category headers are rendered dimmed (~:text-muted~) and
visually distinct from selectable items. Long titles are truncated with
an ellipsis character to fit the viewport width.
#+BEGIN_SRC lisp :tangle ../src/components/select.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/select.lisp
(defmethod render ((sel select) backend)
(let* ((ln (select-layout-node sel))
(x (if ln (layout-node-x ln) 0))

View File

@@ -50,7 +50,7 @@ same slot with conflicting mode specifications.
The package provides the public API and exports all slot system symbols.
Clients :use this package or refer to symbols qualified.
#+BEGIN_SRC lisp :tangle ../src/components/slot-package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot-package.lisp
(defpackage :cl-tty.slot
(:use :cl)
(:export
@@ -73,7 +73,7 @@ case-insensitive lookup via ~equal~). Each value is a plist:
The ~:test #'equal~ ensures that ~:sidebar~ and ~"sidebar"~ map to the
same key.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
(in-package :cl-tty.slot)
(defvar *slots* (make-hash-table :test 'equal)
@@ -97,7 +97,7 @@ The mode parameter is validated on first call via ~assert~ and then
frozen for subsequent calls. This prevents a later registration from
changing the slot's semantics out from under earlier registrations.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
(defun defslot (name &key (order 0) render-fn (mode :stack))
(let* ((key (string name))
(slot (gethash key *slots*)))
@@ -143,7 +143,7 @@ changing the slot's semantics out from under earlier registrations.
Returns ~nil~ if the slot has no registrations or if the handler is nil.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
(defun slot-render (slot-name &rest args)
(let ((slot (gethash (string slot-name) *slots*)))
(when slot
@@ -169,7 +169,7 @@ 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
canonical Common Lisp idiom for testing hash-table membership.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
(defun slot-p (slot-name)
(nth-value 1 (gethash (string slot-name) *slots*)))
#+END_SRC
@@ -180,7 +180,7 @@ Calls ~remhash~ to delete the slot's entry from the hash table
entirely. After this call ~slot-p~ returns false and ~slot-render~
returns nil for the given slot name.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
(defun clear-slot (slot-name)
(remhash (string slot-name) *slots*))
#+END_SRC
@@ -191,7 +191,7 @@ 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)
appear in the result.
#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/slot.lisp
(defun list-slots ()
(loop for key being the hash-keys of *slots* collect key))
#+END_SRC
@@ -203,7 +203,7 @@ including mode-specific behavior.
*** Test Package and Suite
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
(defpackage :cl-tty-slot-test (:use :cl :cl-tty.slot :fiveam))
(in-package :cl-tty-slot-test)
@@ -213,7 +213,7 @@ including mode-specific behavior.
*** defslot-register: Registering a slot makes it visible
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
(def-test defslot-register ()
(clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "hello"))
@@ -225,7 +225,7 @@ including mode-specific behavior.
Verifies that ~:stack~ mode preserves multiple registrations and calls
them in ascending order sequence.
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
(def-test slot-render-calls ()
(clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "a"))
@@ -235,7 +235,7 @@ them in ascending order sequence.
*** slot-render-empty: Unregistered slot returns nil
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
(def-test slot-render-empty ()
(clear-slot :ghost)
(is-false (slot-render :ghost)))
@@ -243,7 +243,7 @@ them in ascending order sequence.
*** clear-slot-removes: Clearing a slot makes it absent
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
(def-test clear-slot-removes ()
(clear-slot :test-slot)
(defslot :test-slot :order 1 :render-fn (lambda () "x"))
@@ -256,7 +256,7 @@ them in ascending order sequence.
Verifies that ~:stack~ mode (default) accumulates entries across
multiple ~defslot~ calls.
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
(def-test stack-mode-multiple-entries ()
(clear-slot :stack-test)
(defslot :stack-test :order 1 :render-fn (lambda () "first"))
@@ -270,7 +270,7 @@ multiple ~defslot~ calls.
Verifies that ~:replace~ mode discards previous entries on each new
~defslot~ call.
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/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"))
@@ -282,7 +282,7 @@ Verifies that ~:replace~ mode discards previous entries on each new
Verifies that ~:single-winner~ mode ignores subsequent registrations.
#+BEGIN_SRC lisp :tangle ../tests/slot-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
(def-test single-winner-mode-first-wins ()
(clear-slot :winner-test)
(defslot :winner-test :mode :single-winner :order 1
@@ -297,7 +297,7 @@ Verifies that ~:single-winner~ mode ignores subsequent registrations.
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
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/slot-tests.lisp
(def-test clear-slot-removes-mode ()
(clear-slot :mode-test)
(defslot :mode-test :mode :replace :render-fn (lambda () "only"))

View File

@@ -32,7 +32,7 @@ other container components (scrollbox, box, slot, etc.). This keeps
the symbol namespace clean and avoids accidental collisions with
user-level code.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
(in-package #:cl-tty.container)
#+END_SRC
@@ -48,7 +48,7 @@ The ~tabs~ slot is a simple plist list rather than a hash table or
alist because the total number of tabs in a UI is typically small
(< 20) and we need ordered iteration for rendering.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
(defclass tab-bar (dirty-mixin)
((tabs :initform nil :initarg :tabs
:accessor tab-bar-tabs :type list)
@@ -65,7 +65,7 @@ Convenience constructor that forwards keyword arguments to
~make-instance~ everywhere gives us a single place to add
defaulting, validation, or initialization hooks in the future.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
(defun make-tab-bar (&key tabs active)
(make-instance 'tab-bar :tabs (or tabs nil) :active active))
#+END_SRC
@@ -79,7 +79,7 @@ tab becomes active automatically — this ensures there is always a
sensible default when the first tab is created. Returns the ~id~ so
callers can chain or store it.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
(defun tab-bar-add (tb id title)
"Add a tab with ID and TITLE. Sets as active if first tab."
(setf (tab-bar-tabs tb)
@@ -95,7 +95,7 @@ Returns the layout node so the layout engine can position and size
the tab bar within its parent. Every component that participates in
automatic layout must implement this method.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
(defmethod component-layout-node ((tb tab-bar))
(tab-bar-layout-node tb))
#+END_SRC
@@ -110,7 +110,7 @@ The lookup strategy — mapcar ids, position, mod — is O(n) but
acceptable since tab lists are small. A hash-based index would be
premature optimization at this scale.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
(defun tab-bar-next (tb)
"Move to next tab."
(let* ((tabs (tab-bar-tabs tb))
@@ -130,7 +130,7 @@ incrementing it. ~mod~ handles negative wrap-around correctly in
Common Lisp (returns a non-negative remainder), so ~(mod (1- 0) 3)~
produces 2 rather than 1.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
(defun tab-bar-prev (tb)
"Move to previous tab."
(let* ((tabs (tab-bar-tabs tb))
@@ -150,7 +150,7 @@ cyclic navigation. This is used when a user clicks a tab (via mouse
binding), when a programmatic action needs to switch views, or when
activating a tab from outside the keyboard flow. Always marks dirty.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
(defun tab-bar-select (tb id)
"Select a tab by ID."
(setf (tab-bar-active tb) id)
@@ -165,7 +165,7 @@ consumed and ~nil~ otherwise, which lets the keybinding system fall
through to other handlers — important for composable UIs where a tab
bar lives alongside other focusable elements.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
(defun tab-bar-handle-key (tb event)
"Handle a key-event on a TabBar. Returns T if handled."
(case (key-event-key event)
@@ -186,7 +186,7 @@ exceeds the available space, tabs are truncated and an ellipsis
~...~ is drawn at the overflow point. This prevents the tab bar from
breaking the layout on narrow terminals.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/tabbar.lisp
(defmethod render ((tb tab-bar) backend)
(let* ((ln (tab-bar-layout-node tb))
(x (if ln (layout-node-x ln) 0))

View File

@@ -178,7 +178,7 @@ start avoids package redefinition churn. The current system does not yet call
raw mode from within the input module; consumers manage raw mode themselves
via ~sb-posix~ directly.
#+BEGIN_SRC lisp :tangle ../src/components/input-package.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input-package.lisp
(defpackage :cl-tty.input
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout)
(:export
@@ -243,7 +243,7 @@ textarea line splitting — a blank document has one empty line.
This is the first block tangling to input.lisp, so it includes the
~in-package~ form that all subsequent blocks share.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(in-package #:cl-tty.input)
(defun %split-string (string separator)
@@ -262,12 +262,12 @@ application's main loop. Widget ~render~ methods use them to draw themselves.
Defining them here rather than in the rendering module keeps the dependency
clean — input widgets depend on rendering, not the other way around.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defvar *current-backend* nil
"The active backend used for rendering.")
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defvar *current-theme* nil
"The active theme used for semantic color resolution.")
#+END_SRC
@@ -299,7 +299,7 @@ or lowercase, but ~code~ preserves the actual code point. The
~handle-text-input~ function uses ~code-char~ on the code slot to get the
true character for insertion.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defstruct key-event
(key nil :type (or keyword null))
(ctrl nil :type boolean)
@@ -323,7 +323,7 @@ field is :press, :release, or :drag, determined by whether the button
code includes the motion bit (bit 5). Coordinates are 1-indexed from
the terminal; no adjustment is performed here.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defstruct mouse-event
(type nil :type (or keyword null))
(button nil :type (or keyword null))
@@ -342,7 +342,7 @@ the modern xterm format, as opposed to the single-letter terminators used
by VT100-style sequences (~ESC[H~ = Home, ~ESC[F~ = End). Modern terminal
emulators emit the tilde form for most keys; we handle both.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defparameter *csi-tilde-table*
'((1 . :home) (2 . :insert) (3 . :delete) (4 . :end)
(5 . :page-up) (6 . :page-down)
@@ -363,7 +363,7 @@ emitted by most terminal emulators in "normal" (non-application) cursor
key mode. The ~:back-tab~ mapping for Z handles Shift+Tab, which some
emulators report as ~ESC[Z~.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defparameter *csi-key-table*
'((#\A . :up) (#\B . :down) (#\C . :right) (#\D . :left)
(#\F . :end) (#\H . :home)
@@ -391,7 +391,7 @@ Modifier encoding follows the xterm convention: Shift=1, Alt=2, Ctrl=4.
The extended parameter vector carries the raw parameter bytes for
sequences where modifiers appear in a non-standard position.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defun parse-csi-params (params terminator extended)
(let* ((key (if (find terminator '(#\~ #\u))
(cdr (assoc (first params) *csi-tilde-table*))
@@ -440,7 +440,7 @@ and read directly into the backing storage. This avoids alien allocation
and manual ~free-alien~ while keeping the GC from moving the buffer
during the ~unix-read~ syscall.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defun read-raw-byte (&key timeout)
(let* ((buf (make-array 1 :element-type '(unsigned-byte 8)))
(fd 0)
@@ -481,7 +481,7 @@ The SS3 path handles shifted cursor keys that some emulators report as
~ESC O A~ through ~ESC O D~ (shifted up/down/right/left). These use a
different byte prefix from the CSI form ~ESC [ A~ through ~ESC [ D~.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defun %read-escape-sequence ()
(flet ((read-next (&optional (timeout nil))
(let ((b (read-raw-byte :timeout timeout)))
@@ -536,7 +536,7 @@ non-digit byte, handling an optional list of initial bytes that were
already consumed by the caller. Returns the parsed integer and the
terminator byte.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defun %read-digits (&optional (initial-bytes nil))
"Read bytes until a non-digit is encountered.
Returns (values number terminator-byte)."
@@ -564,7 +564,7 @@ a ~mouse-event~ struct with proper button and type classification.
Coordinates are converted from 1-based (terminal protocol) to 0-based
(framebuffer convention) by subtracting 1 from both x and y.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defun %parse-sgr-mouse ()
"Parse SGR mouse escape sequence: ESC [ < Cb ; Cx ; Cy M/m
Returns a mouse-event struct."
@@ -609,7 +609,7 @@ the modifier appears after the primary parameter in an extended format
(e.g., ~ESC [ 1 ; 5 A~ where 5 encodes Ctrl+Shift). This array is passed
to ~parse-csi-params~ for modifier extraction.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defun parse-csi-sequence ()
(flet ((read-param (next-fn) (let ((acc nil))
(loop for b = (funcall next-fn)
@@ -655,7 +655,7 @@ Overlong sequences (e.g., encoding ASCII in 2+ bytes) are rejected because
the range checks on the leading byte exclude them: a 2-byte sequence with
b0=0xC0 would have ~(= #xc2 b0 #xdf)~ fail since 0xC0 < 0xC2.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defun utf8-decode (bytes)
(case (length bytes)
(2 (let ((b0 (first bytes)) (b1 (second bytes)))
@@ -703,7 +703,7 @@ streamed in real time from the terminal; if we're too aggressive, we
might cut off a multi-byte character during a slow paste or network
connection. The 500ms gives the terminal ample time to deliver all bytes.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defun %read-event (&key timeout)
(multiple-value-bind (b reason) (read-raw-byte :timeout timeout)
(unless b (return-from %read-event (if (eq reason :eof) :eof nil)))
@@ -754,11 +754,11 @@ call and, if set, query the new terminal dimensions and redraw. The
flag is not automatically cleared — the consumer must set it to ~nil~
after handling the resize.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defvar *terminal-resized-p* nil)
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
#+sbcl
(eval-when (:load-toplevel :execute)
(require :sb-posix)
@@ -775,7 +775,7 @@ input). SBCL's ~SB-POSIX:WITH-RAW-TERMINAL~ is not available in all builds
(e.g. Debian-packaged SBCL 2.5.x). This implementation uses ~stty~ for
portability.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defun %raw-mode-on ()
(uiop:run-program '("stty" "raw" "-echo" "-echoe" "-echok" "-onlcr")
:output nil :error-output nil :ignore-error-status t))
@@ -806,7 +806,7 @@ This method is deliberately simple: it's a thin wrapper that adapts the
~%read-event~ API to the backend protocol's ~read-event~ generic function.
All the complexity lives in ~%read-event~ and its callees.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defmethod read-event ((b cl-tty.backend:backend) &key timeout)
;; Check for pending terminal resize before reading input.
;; The SIGWINCH handler sets *terminal-resized-p* asynchronously.
@@ -851,7 +851,7 @@ shift out when full) keeps memory bounded.
This is the first block tangling to textarea.lisp, so it includes the
~in-package~ form.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(in-package #:cl-tty.input)
(defclass textarea (dirty-mixin)
@@ -878,7 +878,7 @@ The constructor is a separate function rather than a ~:constructor~
option on ~defclass~ because it needs to normalize the value argument
~(or value "")~ — a pattern that would clutter the class definition.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun make-textarea (&key value on-submit)
(make-instance 'textarea
:value (or value "")
@@ -895,13 +895,13 @@ line, which is the correct representation of a blank document.
~textarea-line-count~ is a simple wrapper for the number of lines.
It's used by cursor movement functions to clamp the cursor row.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun textarea-lines (ta)
"Split value into lines."
(%split-string (textarea-value ta) #\Newline))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun textarea-line-count (ta)
"Number of lines in value."
(length (textarea-lines ta)))
@@ -919,7 +919,7 @@ that change line structure (newline, backspace joining lines). It
also marks the widget dirty, ensuring the renderer picks up the
cursor position change.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun textarea-ensure-cursor (ta)
"Clamp cursor to valid range."
(let ((lines (textarea-lines ta)))
@@ -942,7 +942,7 @@ the textarea code work with different representations — ~textarea-lines~
returns a list, but the insertion/backspace code operates on vectors
for efficient element replacement.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun %join-lines (lines)
"Join a sequence of strings with newlines."
(with-output-to-string (s)
@@ -969,7 +969,7 @@ within the current line. The algorithm:
The function updates ~cursor-col~ by 1 after insertion and marks the
widget dirty.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun textarea-insert-char (ta char)
"Insert CHAR at the cursor position."
(textarea-push-undo ta)
@@ -1010,7 +1010,7 @@ Algorithm:
6. If the cursor row is beyond the last line, simply append a newline.
7. Mark dirty.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun textarea-newline (ta)
"Insert a newline at the cursor."
(textarea-push-undo ta)
@@ -1056,7 +1056,7 @@ line, removing the newline character between them.
All paths push undo state before modifying the value.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun textarea-backspace (ta)
"Delete character before cursor."
(textarea-push-undo ta)
@@ -1106,13 +1106,13 @@ on a long line and moves up to a shorter 5-character line, the column
clamps to 5. This matches how most editors handle column preservation
— the column "remembers" its position but is constrained by line length.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun textarea-move-up (ta)
(decf (textarea-cursor-row ta))
(textarea-ensure-cursor ta))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun textarea-move-down (ta)
(incf (textarea-cursor-row ta))
(textarea-ensure-cursor ta))
@@ -1143,7 +1143,7 @@ discarded because the edit graph has branched. Implementing a full tree
undo would be significantly more complex and is unnecessary for a TUI
textarea.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun textarea-push-undo (ta)
"Save current value on undo stack."
(let ((stack (textarea-undo-stack ta)))
@@ -1155,7 +1155,7 @@ textarea.
(setf (fill-pointer (textarea-redo-stack ta)) 0)))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun textarea-undo (ta)
(let ((stack (textarea-undo-stack ta)))
(when (plusp (length stack))
@@ -1166,7 +1166,7 @@ textarea.
(mark-dirty ta)))))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun textarea-redo (ta)
(let ((stack (textarea-redo-stack ta)))
(when (plusp (length stack))
@@ -1203,7 +1203,7 @@ rather than looking at ~key-event-key~. This is because ~key-event-key~
is always an uppercase keyword (~:a~ for both 'a' and 'A'), but the
code preserves the actual character.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defun handle-textarea-input (ta event)
"Process a key-event on a textarea widget."
(cond
@@ -1277,7 +1277,7 @@ Cursor rendering is handled by the focus/selection rendering layer,
not by this method. This keeps the render method simple — it just
paints text.
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
(defmethod render ((ta textarea) (backend t))
"Render textarea lines at layout position."
(let* ((ln (textarea-layout-node ta))
@@ -1321,7 +1321,7 @@ tracking. Slots:
This is the first block tangling to text-input.lisp, so it includes the
~in-package~ form.
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(in-package #:cl-tty.input)
(defclass text-input (dirty-mixin)
@@ -1350,7 +1350,7 @@ The ~(or value "")~ pattern ensures the value is always a string,
even if the caller passes nil. This eliminates a class of nil-pointer
errors in string operations downstream.
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(defun make-text-input (&key value cursor placeholder max-length on-submit)
(make-instance 'text-input
:value (or value "")
@@ -1376,7 +1376,7 @@ This is a pure insert — it does not replace the character at the cursor;
it shifts subsequent characters right. For overwrite behavior, the caller
would need a different function.
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(defun text-input-insert (input char)
(let* ((val (text-input-value input))
(pos (text-input-cursor input))
@@ -1396,7 +1396,7 @@ The algorithm concatenates the prefix (up to one before cursor) with
the suffix (from cursor onward), effectively removing the character
at cursor-1. The cursor is decremented by 1.
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(defun text-input-backspace (input)
(let* ((val (text-input-value input)) (pos (text-input-cursor input)))
(when (zerop pos) (return-from text-input-backspace))
@@ -1417,7 +1417,7 @@ moving the cursor position.
This contrasts with backspace, which removes the character before
cursor and decrements the cursor.
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(defun text-input-delete (input)
(let* ((val (text-input-value input)) (pos (text-input-cursor input)))
(when (>= pos (length val)) (return-from text-input-delete))
@@ -1434,13 +1434,13 @@ one character position, clamped to [0, length]. Left movement stops at
Each movement function marks the widget dirty so the renderer redraws
the cursor position.
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(defun text-input-move-left (input)
(when (plusp (text-input-cursor input)) (decf (text-input-cursor input)))
(mark-dirty input))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(defun text-input-move-right (input)
(when (< (text-input-cursor input) (length (text-input-value input))) (incf (text-input-cursor input)))
(mark-dirty input))
@@ -1454,13 +1454,13 @@ the cursor position.
These are the programmatic equivalents of the Home and End keys and
are also used by the Ctrl+A and Ctrl+E keybindings.
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(defun text-input-move-home (input)
(setf (text-input-cursor input) 0)
(mark-dirty input))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(defun text-input-move-end (input)
(setf (text-input-cursor input) (length (text-input-value input)))
(mark-dirty input))
@@ -1485,7 +1485,7 @@ A "word" here is defined as a run of non-space characters. This matches
the shell/Emacs convention for Ctrl+W rather than an English word boundary
(which would involve punctuation handling).
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(defun text-input-delete-word-before (input)
(let* ((val (text-input-value input)) (pos (text-input-cursor input)))
(when (zerop pos) (return-from text-input-delete-word-before))
@@ -1523,7 +1523,7 @@ visible characters (letters, digits, punctuation, symbols) are
inserted. Control characters and spaces are handled by their specific
key bindings.
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(defun handle-text-input (input event)
(cond
((key-event-ctrl event)
@@ -1569,7 +1569,7 @@ The cursor is a solid block ("█") drawn at the cursor column offset
from the text start. If the cursor is beyond the truncated display
width, it's clamped to the last visible position.
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
(defmethod render ((in text-input) (backend t))
(let* ((ln (text-input-layout-node in))
(x (if ln (layout-node-x ln) 0)) (y (if ln (layout-node-y ln) 0))
@@ -1608,7 +1608,7 @@ polymorphism is handled by the dispatch function.
This is the first block tangling to keybindings.lisp, so it includes
the ~in-package~ form.
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
(in-package #:cl-tty.input)
(defstruct keymap
@@ -1628,11 +1628,11 @@ chord support (e.g., ~(:ctrl+x :ctrl+s)~). Currently only single-key
specs work; the timeout and list-of-lists spec syntax are placeholders
for the eventual chord implementation.
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
(defparameter *keymaps* (make-hash-table :test #'equal))
#+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
(defparameter *chord-timeout* 0.5)
#+END_SRC
@@ -1657,7 +1657,7 @@ The modifier matching uses ~string=?~ on the modifier part because
on the keyword would make them different specifiers, which is unexpected
for users writing ~:ctrl+p~ in their keymaps.
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
(defun key-match-p (spec event)
"T if SPEC matches EVENT. Spec is :ctrl+p (modifier+key keyword)
or (:ctrl+p) for single-spec in a list, or (:ctrl+x :ctrl+s) for chords."
@@ -1716,7 +1716,7 @@ Chords ~((:ctrl+x :ctrl+s))~ are not yet supported; only single
key specs work. The ~*chord-timeout*~ variable and list-of-lists syntax
are reserved for future implementation.
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
(defun dispatch-key-event (event &key component)
(labels ((try-keymap (km)
(when km
@@ -1738,7 +1738,7 @@ are reserved for future implementation.
~defkeymap~ is a convenience macro that registers a keymap in the global
~*keymaps*~ hash table. Syntax:
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
(defmacro defkeymap (name &body bindings)
`(setf (gethash ',name *keymaps*)
(make-keymap :name ',name
@@ -1759,7 +1759,7 @@ This generic function allows the dispatch system to query any object for
its keymap, enabling per-component keybinding customization without
requiring components to inherit from a specific base class.
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
;;; --- Component protocol integration ---
(defgeneric component-keymap (component)
(:method ((c t)) nil))
@@ -1780,7 +1780,7 @@ The test suite is tangled to ~../tests/input-tests.lisp~ and covers:
key-spec matching with all modifiers, list-form specs, return values,
empty keymap, local-over-global, multiple bindings, defkeymap macro)
#+BEGIN_SRC lisp :tangle ../tests/input-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/input-tests.lisp
(defpackage :cl-tty-input-test
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export #:run-tests))

View File

@@ -49,7 +49,7 @@ and the backend's ~*theme-colors*~ for SGR resolution.
Package declaration and test suite registration.
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme-tests.lisp
(in-package :cl-tty-box-test)
(in-suite box-suite)
#+END_SRC
@@ -60,7 +60,7 @@ 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 ../src/components/theme-tests.lisp
#+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)))
@@ -73,7 +73,7 @@ class with ~:dark~ as the initial mode.
Verifies explicit ~:light~ mode works. Both modes must produce themes
ready to accept color role assignments.
#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp
#+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)))
@@ -86,7 +86,7 @@ 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 ../src/components/theme-tests.lisp
#+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)))
@@ -100,7 +100,7 @@ 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 ../src/components/theme-tests.lisp
#+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)))
@@ -113,7 +113,7 @@ 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 ../src/components/theme-tests.lisp
#+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)))
@@ -129,7 +129,7 @@ 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 ../src/components/theme-tests.lisp
#+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)))
@@ -144,7 +144,7 @@ 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 ../src/components/theme-tests.lisp
#+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)))
@@ -159,7 +159,7 @@ 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 ../src/components/theme-tests.lisp
#+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)))
@@ -173,7 +173,7 @@ 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 ../src/components/theme-tests.lisp
#+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)))
@@ -200,7 +200,7 @@ 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 ../src/components/theme.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
(in-package :cl-tty.box)
(defclass theme ()
@@ -215,7 +215,7 @@ 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 ../src/components/theme.lisp
#+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
@@ -229,7 +229,7 @@ Reads a semantic role from the theme's roles hash table. Uses
degrade gracefully rather than crashing. The backend treats ~nil~ as
"use default."
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
#+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)))
@@ -241,7 +241,7 @@ 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 ../src/components/theme.lisp
#+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))
@@ -258,7 +258,7 @@ table keeps preset data inline and readable.
Global storage for preset definitions. The ~eq~ test matches keyword
identity, which is the fastest hash test for keywords.
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/theme.lisp
(defparameter *presets* (make-hash-table :test #'eq))
#+END_SRC
@@ -269,7 +269,7 @@ Registers a preset by name (~keyword~) at macro-expansion time. The
~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 ../src/components/theme.lisp
#+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)."
@@ -292,7 +292,7 @@ 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 ../src/components/theme.lisp
#+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
@@ -320,7 +320,7 @@ Two presets are built in:
Gold/accent palette on dark navy background. The light variant
inverts to warm tones on near-white.
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
#+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"
@@ -351,7 +351,7 @@ inverts to warm tones on near-white.
Cool blue palette inspired by Arctic Studio's Nord theme. Softer
contrast than default, designed for reduced eye strain.
#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp
#+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"