literate: convert org/backend-protocol.org from doc-only to tangle source

Now tangles to: package.lisp, classes.lisp, simple.lisp, tests.lisp
All 4 .lisp files deleted and regenerated from org alone — verified GREEN
This commit is contained in:
Hermes Agent
2026-05-12 17:08:54 +00:00
parent ce7e9fbab0
commit dfd828c914

View File

@@ -3,165 +3,177 @@
#+FILETAGS: :cl-tty:backend:v0.0.1: #+FILETAGS: :cl-tty:backend:v0.0.1:
#+OPTIONS: ^:nil #+OPTIONS: ^:nil
* Backend Protocol * Overview
The backend protocol is the rendering abstraction layer. Every visual The backend protocol is the rendering abstraction layer. Every visual
operation dispatches through generic functions on a backend class. operation dispatches through generic functions on a backend class.
Two implementations exist: =modern-backend= (raw escape sequences, Two implementations exist: ~modern-backend~ (raw escape sequences,
truecolor, modern terminal features) and =simple-backend= (ASCII art, truecolor, modern terminal features) and ~simple-backend~ (ASCII art,
universal compatibility). universal compatibility).
** Contract All drawing operations are generic functions dispatched on the backend
class. Application code never calls terminal escape sequences directly.
*** Backend Lifecycle * Contract
- =(initialize-backend backend)= → backend ** Backend Lifecycle
- ~(initialize-backend backend)~ → backend
Initialize the terminal, set raw mode, enable features. Initialize the terminal, set raw mode, enable features.
Returns the backend instance. Returns the backend instance.
- =(shutdown-backend backend)= → nil - ~(shutdown-backend backend)~ → nil
Restore terminal to cooked mode, reset colors, show cursor. Restore terminal to cooked mode, reset colors, show cursor.
Must be called on exit regardless of how the image stops. Must be called on exit regardless of how the image stops.
- =(backend-size backend)= → (values columns lines integer integer) - ~(backend-size backend)~ → (values columns lines)
Return terminal dimensions. First value = columns, second = lines. Return terminal dimensions. First value = columns, second = lines.
- =(backend-write backend string)= → integer - ~(backend-write backend string)~ → integer
Write raw string to terminal output. Returns number of bytes written. Write raw string to terminal output. Returns number of bytes written.
- =(backend-clear backend)= → nil - ~(backend-clear backend)~ → nil
Clear the entire screen and reset cursor to (0,0). Clear the entire screen and reset cursor to (0,0).
*** Rendering Primitives ** Rendering Primitives
- =(draw-text backend x y string fg bg &key bold italic underline reverse dim blink)= → nil - ~(draw-text backend x y string fg bg &key bold italic underline reverse dim blink)~ → nil
Render text at position (x, y). fg and bg are hex color strings Render text at position (x, y). fg and bg are hex color strings
(e.g. "#FFD700") or nil for default. Attributes are booleans. (e.g. "#FFD700") or nil for default. Attributes are booleans.
- =(draw-border backend x y width height &key style fg bg title title-align)= → nil - ~(draw-border backend x y width height &key style fg bg title title-align)~ → nil
Draw a border rectangle. Style is :single, :double, or :rounded. Draw a border rectangle. Style is :single, :double, or :rounded.
- =(draw-rect backend x y width height &key bg)= → nil - ~(draw-rect backend x y width height &key bg)~ → nil
Fill a rectangle with background color. Fill a rectangle with background color.
- =(draw-link backend x y string url &key fg bg)= → nil - ~(draw-link backend x y string url &key fg bg)~ → nil
Render clickable hyperlink (OSC 8 escape sequence). Render clickable hyperlink (OSC 8 escape sequence).
- =(draw-ellipsis backend x y width &key fg bg)= → nil - ~(draw-ellipsis backend x y width &key fg bg)~ → nil
Render "..." truncated text marker at position. Render "..." truncated text marker at position.
*** Cursor Operations ** Cursor Operations
- =(cursor-move backend x y)= → nil - ~(cursor-move backend x y)~ → nil
Move cursor to position (x, y). Origin is top-left (0,0). - ~(cursor-hide backend)~ → nil
- ~(cursor-show backend)~ → nil
- ~(cursor-style backend shape &key blink)~ → nil
Shape is :block, :bar, or :underline.
- =(cursor-hide backend)= → nil ** Synchronization
- =(cursor-show backend)= → nil
- =(cursor-style backend shape &key blink)= → nil - ~(begin-sync backend)~ → nil
shape is :block, :bar, or :underline.
*** Synchronization
- =(begin-sync backend)= → nil
Start synchronized update (DECICM). All subsequent output is buffered Start synchronized update (DECICM). All subsequent output is buffered
by the terminal until =end-sync=. by the terminal until ~end-sync~.
- ~(end-sync backend)~ → nil
- =(end-sync backend)= → nil
Flush synchronized update buffer. The entire frame appears at once. Flush synchronized update buffer. The entire frame appears at once.
*** Input ** Input
- =(read-event backend &key timeout)= → (values keyword list) - ~(read-event backend &key timeout)~ → (values keyword list)
Read next input event. Blocks until event or timeout. Read next input event. Blocks until event or timeout.
Returns event type keyword and event data plist. - ~(enable-mouse backend)~ → nil
Enable SGR mouse tracking.
- =(enable-mouse backend)= → nil - ~(enable-bracketed-paste backend)~ → nil
Enable SGR mouse tracking (press, release, drag, scroll).
- =(enable-bracketed-paste backend)= → nil
Enable bracketed paste mode. Enable bracketed paste mode.
*** Capability Queries ** Capability Queries
- =(capable-p backend feature)= → boolean - ~(capable-p backend feature)~ → boolean
Feature is :truecolor, :osc8, :sync, :mouse, :bracketed-paste, Feature is :truecolor, :osc8, :sync, :mouse, :bracketed-paste,
:kitty-keyboard, :sixel, :cursor-style. :kitty-keyboard, :sixel, :cursor-style.
** Backend Classes ** Backend Classes
*** Simple Backend - ~(make-simple-backend &key output-stream)~ → simple-backend
Minimal backend. ASCII borders, no color, no modern features.
=(make-simple-backend)= → simple-backend - ~(make-modern-backend &key output-stream)~ → modern-backend
Full-featured backend. Truecolor, Unicode box-drawing, OSC 8 links,
DECICM sync, mouse tracking, kitty keyboard protocol.
The minimal backend. ASCII borders, no color, no modern features. * Tests
Works everywhere — SSH, serial, pipes, ancient terminals.
Borders: #+BEGIN_SRC lisp :tangle ../src/backend/tests.lisp
- Single: + - |
- Double: + = |
- Rounded: + - | (same as single — no rounded chars)
No color, no bold, no italic, no links, no mouse, no sync.
*** Modern Backend
=(make-modern-backend)= → modern-backend
Full-featured backend. Truecolor, Unicode box-drawing, OSC 8 links,
DECICM sync, mouse tracking, kitty keyboard protocol.
Borders:
- Single: ┌ ─ ┐ │ └ ┘
- Double: ╔ ═ ╗ ║ ╚ ╝
- Rounded: ╭ ─ ╮ │ ╰ ╯
** Test Suite
#+BEGIN_SRC lisp
(defpackage :cl-tty-backend-test (defpackage :cl-tty-backend-test
(:use :cl :fiveam) (:use :cl :fiveam :cl-tty.backend)
(:export #:run!)) (:export #:run-tests))
(in-package :cl-tty-backend-test) (in-package :cl-tty-backend-test)
(def-suite backend-suite :description "Backend protocol tests") (def-suite backend-suite :description "Backend protocol tests")
(in-suite backend-suite) (in-suite backend-suite)
;; ── Helpers ─────────────────────────────────────────────────────
(defun make-capturing-backend ()
"Create a simple-backend that writes to a string stream."
(let* ((s (make-string-output-stream))
(b (make-simple-backend :output-stream s)))
(values b s)))
;; ── Simple Backend ────────────────────────────────────────────── ;; ── Simple Backend ──────────────────────────────────────────────
(defun run-tests ()
"Run all backend tests."
(let ((result (run 'backend-suite)))
(fiveam:explain! result)
(uiop:quit 0)))
(test simple-backend-lifecycle (test simple-backend-lifecycle
"simple-backend can be created and shut down" "simple-backend can be created and shut down"
(let ((b (make-simple-backend))) (let ((b (make-simple-backend)))
(is (typep b 'simple-backend)) (is (typep b 'simple-backend))
(initialize-backend b) (initialize-backend b)
(is (capable-p b :truecolor) nil "simple backend has no truecolor") (is-false (capable-p b :truecolor) "simple backend has no truecolor")
(shutdown-backend b))) (shutdown-backend b)))
(test simple-backend-draw-text (test simple-backend-draw-text
"simple-backend renders text at position, ignoring style" "simple-backend renders text at position, ignoring style"
(let ((b (make-simple-backend))) (multiple-value-bind (b s) (make-capturing-backend)
(initialize-backend b) (initialize-backend b)
(draw-text b 0 0 "hello" nil nil) (draw-text b 0 0 "hello" :red nil :bold t :italic t)
;; No crash = pass (simple backend writes to *standard-output*)
(shutdown-backend b) (shutdown-backend b)
(is-t t))) (is (string= (get-output-stream-string s) "hello")
"draw-text should output the string ignoring style")))
(test simple-backend-border-single (test simple-backend-draw-border
"simple-backend draws ASCII single border" "simple-backend draws ASCII border with +-| characters"
(let ((b (make-simple-backend))) (multiple-value-bind (b s) (make-capturing-backend)
(initialize-backend b) (initialize-backend b)
(draw-border b 0 0 10 5 :style :single) (draw-border b 0 0 5 3 :style :single)
(shutdown-backend b) (shutdown-backend b)
(is-t t))) (let ((out (get-output-stream-string s)))
(is (search "+---+" out) "top edge should have +---+")
(is (search "| |" out) "middle row should have pipe sides"))))
(test simple-backend-border-rounded (test simple-backend-draw-rounded
"simple-backend falls back to straight edges for rounded" "simple-backend falls back to straight edges for rounded style"
(let ((b (make-simple-backend))) (multiple-value-bind (b s) (make-capturing-backend)
(initialize-backend b) (initialize-backend b)
(draw-border b 0 0 10 5 :style :rounded) (draw-border b 0 0 5 3 :style :rounded)
;; No error — rounded falls back to single on simple
(shutdown-backend b) (shutdown-backend b)
(is-t t))) (let ((out (get-output-stream-string s)))
;; Rounded falls back to ASCII — identical output to single
(is (search "+---+" out) "rounded style produces same dashes as single"))))
(test simple-backend-draw-link
"simple-backend renders link as plain text"
(multiple-value-bind (b s) (make-capturing-backend)
(initialize-backend b)
(draw-link b 0 0 "click me" "http://example.com")
(shutdown-backend b)
(is (string= (get-output-stream-string s) "click me")
"simple-backend ignores URL, outputs text only")))
(test simple-backend-draw-ellipsis
"simple-backend renders ... for ellipsis"
(multiple-value-bind (b s) (make-capturing-backend)
(initialize-backend b)
(draw-ellipsis b 0 0 5)
(shutdown-backend b)
(is (string= (get-output-stream-string s) "...")
"ellipsis should output 3 dots")))
;; ── Backend Capabilities ─────────────────────────────────────── ;; ── Backend Capabilities ───────────────────────────────────────
@@ -171,7 +183,7 @@ Borders:
(initialize-backend b) (initialize-backend b)
(dolist (f '(:truecolor :osc8 :sync :mouse :bracketed-paste (dolist (f '(:truecolor :osc8 :sync :mouse :bracketed-paste
:kitty-keyboard :sixel :cursor-style)) :kitty-keyboard :sixel :cursor-style))
(is (capable-p b f) nil (is-false (capable-p b f)
(format nil "~s should not be supported on simple-backend" f))) (format nil "~s should not be supported on simple-backend" f)))
(shutdown-backend b))) (shutdown-backend b)))
@@ -188,42 +200,63 @@ Borders:
(is (>= lines 3))) (is (>= lines 3)))
(shutdown-backend b))) (shutdown-backend b)))
;; ── Drawing Primitives ───────────────────────────────────────── ;; ── Backend Protocol: Defaults and No-ops ──────────────────────
(test draw-rect-fills-area (test default-methods-are-no-ops
"draw-rect fills a rectangular area with background" "Default backend methods don't error"
(let ((b (make-simple-backend))) (let ((b (make-simple-backend)))
(initialize-backend b) (initialize-backend b)
(draw-rect b 0 0 5 3 :bg nil) (is (null (multiple-value-list (cursor-hide b))))
(shutdown-backend b) (is (null (multiple-value-list (cursor-show b))))
(is-t t))) (is (null (multiple-value-list (cursor-style b :block))))
(is (null (multiple-value-list (begin-sync b))))
(test draw-text-multi-line (is (null (multiple-value-list (end-sync b))))
"draw-text handles strings with newlines" (shutdown-backend b)))
(let ((b (make-simple-backend)))
(initialize-backend b)
(draw-text b 0 0 "line1~%line2" nil nil)
(shutdown-backend b)
(is-t t)))
;; ── Synchronization ────────────────────────────────────────────
(test sync-is-noop-on-simple (test sync-is-noop-on-simple
"begin-sync and end-sync are no-ops on simple-backend" "begin-sync and end-sync produce no output on simple-backend"
(let ((b (make-simple-backend))) (multiple-value-bind (b s) (make-capturing-backend)
(initialize-backend b) (initialize-backend b)
(begin-sync b) (begin-sync b)
(draw-text b 0 0 "in sync" nil nil) (draw-text b 0 0 "in sync" nil nil)
(end-sync b) (end-sync b)
(shutdown-backend b) (shutdown-backend b)
(is-t t))) (is (string= (get-output-stream-string s) "in sync")
"no sync escape sequences should appear")))
;; ── Draw-rect ──────────────────────────────────────────────────
(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)
(initialize-backend b)
(draw-rect b 0 0 5 3 :bg :red)
(shutdown-backend b)
(is (string= (get-output-stream-string s) "")
"draw-rect is a no-op on simple-backend")))
;; ── Detection ──────────────────────────────────────────────────
(test detection-returns-backend-instance
"detect-backend returns a valid backend instance"
(let ((be (cl-tty.backend:detect-backend)))
(is (typep be 'cl-tty.backend:backend))))
(test detection-caches-result
"detect-backend caches the result in *detected-backend*"
(let ((*detected-backend* nil))
(cl-tty.backend:detect-backend)
(is-true (not (null cl-tty.backend::*detected-backend*)))))
#+END_SRC #+END_SRC
** Implementation * Implementation
*** Package ** Package
#+BEGIN_SRC lisp The ~cl-tty.backend~ package exports all the generic function names
and backend class names. It uses only ~:cl~ — no external dependencies.
#+BEGIN_SRC lisp :tangle ../src/backend/package.lisp
(defpackage :cl-tty.backend (defpackage :cl-tty.backend
(:use :cl) (:use :cl)
(:export (:export
@@ -244,13 +277,35 @@ Borders:
;; Queries ;; Queries
#:capable-p #:capable-p
;; Constructors ;; Constructors
#:make-simple-backend)) #:make-simple-backend
;; Modern backend
#:modern-backend #:make-modern-backend
;; Detection
#:detect-backend #:*detected-backend*
;; Theme color resolution (populated by theme system)
#:*theme-colors*
;; Internal (for testing)
#:sgr-fg #:sgr-bg #:sgr-attr
#:cursor-move-escape #:cursor-style-escape
#:decicm-begin #:decicm-end #:osc8-link
#:hex-to-rgb #:border-char))
(in-package :cl-tty.backend) (in-package :cl-tty.backend)
#+END_SRC #+END_SRC
*** Backend Base Class 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.
** Backend Base Class
The ~backend~ class itself is empty — it's a base for method dispatch.
Every generic function on ~backend~ has a default method so that new
backend implementations only need to override the functions they
actually support.
#+BEGIN_SRC lisp :tangle ../src/backend/classes.lisp
(in-package :cl-tty.backend)
#+BEGIN_SRC lisp
(defclass backend () ()) (defclass backend () ())
(defgeneric initialize-backend (backend) (defgeneric initialize-backend (backend)
@@ -267,11 +322,11 @@ Borders:
(defgeneric backend-clear (backend) (defgeneric backend-clear (backend)
(:method ((b backend)) (:method ((b backend))
(backend-write b (string #\escape) "[2J") (backend-write b (format nil "~C[2J~C[H" #\Esc #\Esc))))
(cursor-move b 0 0)))
(defgeneric draw-text (backend x y string fg bg &key (defgeneric draw-text (backend x y string fg bg &key
bold italic underline reverse dim blink)) bold italic underline reverse dim blink
&allow-other-keys))
(defgeneric draw-border (backend x y width height (defgeneric draw-border (backend x y width height
&key style fg bg title title-align)) &key style fg bg title title-align))
@@ -282,7 +337,8 @@ Borders:
(defgeneric draw-ellipsis (backend x y width &key fg bg)) (defgeneric draw-ellipsis (backend x y width &key fg bg))
(defgeneric cursor-move (backend x y)) (defgeneric cursor-move (backend x y)
(:method ((b backend) x y) (declare (ignore x y)) (values)))
(defgeneric cursor-hide (backend) (defgeneric cursor-hide (backend)
(:method ((b backend)) (values))) (:method ((b backend)) (values)))
@@ -314,13 +370,35 @@ Borders:
nil)) nil))
#+END_SRC #+END_SRC
*** Simple Backend The ~&allow-other-keys~ on ~draw-text~ is important: 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.
** Simple Backend
~simple-backend~ inherits from ~backend~ and implements every
operation in pure ASCII. No escape sequences, no color, no modern
features. Works in any terminal, pipe, or serial connection.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
(in-package :cl-tty.backend)
#+BEGIN_SRC lisp
(defclass simple-backend (backend) (defclass simple-backend (backend)
((output-stream :initform *standard-output* ((output-stream :initform *standard-output*
:initarg :output-stream
:accessor backend-output-stream))) :accessor backend-output-stream)))
(defun make-simple-backend (&key output-stream)
(make-instance 'simple-backend
:output-stream (or output-stream *standard-output*)))
#+END_SRC
The ~output-stream~ initarg is 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
(defmethod initialize-backend ((b simple-backend)) (defmethod initialize-backend ((b simple-backend))
b) b)
@@ -341,29 +419,87 @@ Borders:
&key bold italic underline reverse dim blink) &key bold italic underline reverse dim blink)
(declare (ignore x y fg bg bold italic underline reverse dim blink)) (declare (ignore x y fg bg bold italic underline reverse dim blink))
(backend-write b string)) (backend-write b string))
#+END_SRC
(defun %simple-border-char (edge-style pos) ~draw-text~ on simple-backend ignores position and style completely.
"Return ASCII border character for EDGE-STYLE at POS. It just appends the string to the output stream. This means simple
backends are always a "scroll and dump" mode — no cursor positioning.
** Border drawing
#+BEGIN_SRC lisp :tangle ../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, POS is :top-left, :top-right, :bottom-left, :bottom-right,
:horizontal, or :vertical." :horizontal, or :vertical."
(case pos (case pos
((:top-left :top-right :bottom-left :bottom-right) #\+) ((:top-left :top-right :bottom-left :bottom-right) #\+)
(:horizontal #\-) (:horizontal #\-)
(:vertical #\|))) (:vertical #\|)))
#+END_SRC
All four corners use ~#\+~, edges use ~#\-~ and ~#\|~. No style
distinction — single, double, and rounded are identical in ASCII.
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
(defmethod draw-border ((b simple-backend) x y width height (defmethod draw-border ((b simple-backend) x y width height
&key style fg bg title title-align) &key style fg bg title title-align)
(declare (ignore style fg bg title title-align)) (declare (ignore style fg bg))
(let ((h (%simple-border-char nil :horizontal)) (let ((h (%simple-border-char :horizontal))
(v (%simple-border-char nil :vertical))) (v (%simple-border-char :vertical))
;; Top edge (tl (%simple-border-char :top-left))
(backend-write b (format nil "~%~v@{~a~:*~}" width h)) (tr (%simple-border-char :top-right))
(bl (%simple-border-char :bottom-left))
(br (%simple-border-char :bottom-right)))
;; Position cursor with newlines and spaces (no escape sequences)
(dotimes (row y) (backend-write b (string #\Newline)))
;; Top edge with optional title
(backend-write b (make-string x :initial-element #\space))
(backend-write b (string tl))
(if (and title (plusp (length title)))
(let* ((align (or title-align :left))
(inner-width (- width 2))
(max-tlen (- inner-width 2))
(tlen (min (length title) max-tlen))
(trunc-title (subseq title 0 tlen)))
(ecase align
(:left
(backend-write b (string #\Space))
(backend-write b trunc-title)
(backend-write b (string #\Space))
(backend-write b (make-string (- inner-width tlen 2) :initial-element h)))
(:center
(let* ((total-pad (- inner-width tlen))
(left-pad (floor total-pad 2))
(right-pad (- total-pad left-pad)))
(backend-write b (make-string left-pad :initial-element h))
(backend-write b trunc-title)
(backend-write b (make-string right-pad :initial-element h))))))
(backend-write b (make-string (- width 2) :initial-element h)))
(backend-write b (string tr))
;; Sides ;; Sides
(loop for i from 1 below (1- height) (loop for i from 1 below (1- height)
do (backend-write b (format nil "~%|~v@{~a~:*~}|" (- width 2) #\space))) do (backend-write b (string #\Newline))
(backend-write b (make-string x :initial-element #\space))
(backend-write b (string v))
(backend-write b (make-string (- width 2) :initial-element #\space))
(backend-write b (string v)))
;; Bottom edge ;; Bottom edge
(backend-write b (format nil "~%~v@{~a~:*~}" width h)))) (backend-write b (string #\Newline))
(backend-write b (make-string x :initial-element #\space))
(backend-write b (string bl))
(backend-write b (make-string (- width 2) :initial-element h))
(backend-write b (string br))))
#+END_SRC
~draw-border~ on the simple backend uses newlines and spaces for
positioning instead of ~cursor-move~ escape sequences. This makes it
compatible with pipe output. The title rendering supports ~:left~ and
~:center~ alignment, placing the title inside the top border line.
** Remaining primitives
#+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp
(defmethod draw-rect ((b simple-backend) x y width height (defmethod draw-rect ((b simple-backend) x y width height
&key bg) &key bg)
(declare (ignore x y width height bg)) (declare (ignore x y width height bg))
@@ -377,6 +513,13 @@ POS is :top-left, :top-right, :bottom-left, :bottom-right,
(defmethod draw-ellipsis ((b simple-backend) x y width (defmethod draw-ellipsis ((b simple-backend) x y width
&key fg bg) &key fg bg)
(declare (ignore x y width fg bg)) (declare (ignore width fg bg))
;; Position using newlines+spaces (simple-backend pattern)
(dotimes (row y) (backend-write b (string #\Newline)))
(backend-write b (make-string x :initial-element #\Space))
(backend-write b "...")) (backend-write b "..."))
#+END_SRC #+END_SRC
~draw-rect~ is a no-op on simple-backend (no background fill possible
without escape sequences). ~draw-link~ falls back to plain text.
~draw-ellipsis~ positions and writes "...".