Amr Gharbeia
de1864bd94
The OR pattern inside backend-size used (or (multiple-value-bind ...) ...), but multiple-value-bind only returns the primary value of its body. When the env-var shortcut was removed, both calls to backend-size (the cols nth-value 0 and rows nth-value 1) returned the same primary value, making rows always nil. Restructure with nested multiple-value-bind/values chains so both return values propagate correctly through all fallback stages. Also remove MY_TERM_COLS/ROWS env-var pre-check — it returned stale startup dimensions after terminal resize.
33 KiB
Modern Backend
- Overview
- Contract
- Tests
- Package and setup
- Suite definition
- Test runner
- Constructor test
- SGR truecolor foreground escape
- SGR truecolor background escape
- SGR named color resolution
- SGR attribute escapes
- Cursor move escape
- Cursor style block
- Cursor style bar
- Cursor style underline with blink
- DECICM synchronized update escapes
- OSC 8 hyperlink escape
- Hex color parsing (gold)
- Hex color parsing (black)
- Hex color parsing (3-digit short form)
- Border characters — rounded style
- Border characters — double style
- Suspend/resume backend
- Implementation
Overview
The modern backend provides full-featured terminal rendering using raw escape sequences. It supports truecolor 24-bit color, OSC 8 hyperlinks, DECICM synchronized updates, SGR mouse tracking, kitty keyboard protocol, and Unicode box-drawing characters (single, double, rounded).
All rendering functions produce CSI/OSC escape sequences directly — no
ncurses, no terminfo, no FFI. Color resolution handles named colors
(:red, :blue, etc.), hex strings ("#FFD700"), and semantic theme
roles (:accent, :error) via the *theme-colors* hash table.
Contract
Color and attribute helpers
(hex-to-rgb hex)(r g b) — parse "#RRGGBB" or "#RGB"(sgr-fg color)escape string — foreground color escape(sgr-bg color)escape string — background color escape(sgr-attr attr)escape string — attribute escape (bold, italic, etc.)
Cursor helpers
(cursor-move-escape x y)escape string — CSI cursor position(cursor-style-escape shape blink)escape string — DECSTR cursor shape
Sync and link helpers
(decicm-begin)escape string — enable synchronized updates(decicm-end)escape string — disable synchronized updates(osc8-link url text)escape string — OSC 8 hyperlink wrapper
Border helpers
(border-char style pos)string — Unicode box-drawing character
Modern backend class
(make-modern-backend &key output-stream)modern-backend- Implements all
backendprotocol methods with escape sequences
Tests
The test suite lives in modern-tests.lisp and uses FiveAM. Each test
covers one logical behavior.
Package and setup
The test package uses cl-tty.backend to access internal symbols for
white-box testing of escape generation.
(defpackage :cl-tty-modern-backend-test
(:use :cl :fiveam :cl-tty.backend)
(:export #:run-tests))
(in-package :cl-tty-modern-backend-test)Suite definition
A single suite groups all modern backend tests.
(def-suite modern-backend-suite :description "Modern backend tests")
(in-suite modern-backend-suite)Test runner
The run-tests entry point is called by the CI test harness.
(defun run-tests ()
(let ((result (run 'modern-backend-suite)))
(fiveam:explain! result)
(uiop:quit 0)))Constructor test
Verifies that make-modern-backend returns an instance of the correct
class. This is the most basic smoke test for the backend factory.
(test make-modern-backend-creates
"make-modern-backend returns a modern-backend instance"
(let ((b (make-modern-backend)))
(is (typep b 'cl-tty.backend::modern-backend))))SGR truecolor foreground escape
Ensures a 6-digit hex string produces the correct 24-bit foreground escape sequence with red, green, and blue components in the right order.
(test sgr-truecolor-foreground
"SGR truecolor foreground escape is correct"
(is (equal (cl-tty.backend::sgr-fg "#FFD700")
(format nil "~C[38;2;255;215;0m" #\Esc))))SGR truecolor background escape
Same as foreground but uses the 48 background prefix instead of 38.
(test sgr-truecolor-background
"SGR truecolor background escape is correct"
(is (equal (cl-tty.backend::sgr-bg "#1a1b26")
(format nil "~C[48;2;26;27;38m" #\Esc))))SGR named color resolution
Verifies that keyword symbols like :red and :blue resolve to the
standard 8-color SGR codes (31 foreground, 44 background).
(test sgr-named-colors
"SGR named colors resolve to 8-color codes"
(is (equal (cl-tty.backend::sgr-fg :red)
(format nil "~C[31m" #\Esc)))
(is (equal (cl-tty.backend::sgr-bg :blue)
(format nil "~C[44m" #\Esc))))SGR attribute escapes
Each attribute keyword (:bold, :italic, :underline, :reset)
should map to the correct SGR number.
(test sgr-bold-italic
"SGR attribute escapes are correct"
(is (equal (cl-tty.backend::sgr-attr :bold) (format nil "~C[1m" #\Esc)))
(is (equal (cl-tty.backend::sgr-attr :italic) (format nil "~C[3m" #\Esc)))
(is (equal (cl-tty.backend::sgr-attr :underline) (format nil "~C[4m" #\Esc)))
(is (equal (cl-tty.backend::sgr-attr :reset) (format nil "~C[0m" #\Esc))))Cursor move escape
Verifies that cursor-move-escape produces a CSI H sequence with
1-indexed row and column.
(test cursor-move-escape
"cursor-move generates correct CSI escape"
(let ((b (make-modern-backend)))
(is (equal (cl-tty.backend::cursor-move-escape 5 10)
(format nil "~C[11;6H" #\Esc)))))Cursor style block
Verifies the DECSTR escape for a block cursor without blinking (code 2).
(test cursor-style-block
"cursor-style :block generate correct escape"
(let ((b (make-modern-backend)))
(is (equal (cl-tty.backend::cursor-style-escape :block nil)
(format nil "~C[2 q" #\Esc)))))Cursor style bar
Verifies the DECSTR escape for a bar cursor without blinking (code 6).
(test cursor-style-bar
"cursor-style :bar generate correct escape"
(let ((b (make-modern-backend)))
(is (equal (cl-tty.backend::cursor-style-escape :bar nil)
(format nil "~C[6 q" #\Esc)))))Cursor style underline with blink
Verifies that :underline with blink=t produces code 5 (underline
blinking), which is base 4 + blink offset 1.
(test cursor-style-underline-blink
"cursor-style :underline with blink"
(let ((b (make-modern-backend)))
(is (equal (cl-tty.backend::cursor-style-escape :underline t)
(format nil "~C[5 q" #\Esc)))))DECICM synchronized update escapes
Confirms that decicm-begin and decicm-end produce ?2026h and
?2026l respectively.
(test decicm-escapes
"DECICM synchronized update escapes"
(is (equal (cl-tty.backend::decicm-begin) (format nil "~C[?2026h" #\Esc)))
(is (equal (cl-tty.backend::decicm-end) (format nil "~C[?2026l" #\Esc))))OSC 8 hyperlink escape
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.
(test osc8-escape
"OSC 8 hyperlink escape wraps text"
(is (equal (cl-tty.backend::osc8-link "http://example.com" "click here")
(format nil "~C]8;;http://example.com~C\\click here~C]8;;~C\\"
#\Esc #\Esc #\Esc #\Esc))))Hex color parsing (gold)
Verifies that "#FFD700" parses to (255, 215, 0).
(test hex-color-parsing
"hex-to-rgb parses valid hex colors"
(multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#FFD700")
(is (= r 255))
(is (= g 215))
(is (= b 0))))Hex color parsing (black)
Verifies all-zero parsing.
(test hex-color-black
"hex-to-rgb parses black"
(multiple-value-bind (r g b) (cl-tty.backend::hex-to-rgb "#000000")
(is (= r 0))
(is (= g 0))
(is (= b 0))))Hex color parsing (3-digit short form)
Verifies that "#F00" expands to "#FF0000" = (255, 0, 0).
(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")
(is (= r 255))
(is (= g 0))
(is (= b 0))))Border characters — rounded style
Confirms that :rounded style maps to the Unicode box-drawing
characters for the four corners and edges.
(test border-char-rounded
"modern-border-char returns Unicode box-drawing for rounded style"
(is (equal (cl-tty.backend::border-char :rounded :top-left) "╭"))
(is (equal (cl-tty.backend::border-char :rounded :horizontal) "─"))
(is (equal (cl-tty.backend::border-char :rounded :vertical) "│"))
(is (equal (cl-tty.backend::border-char :rounded :bottom-right) "╯")))Border characters — double style
Confirms that :double style maps to double-line box-drawing characters.
(test border-char-double
"modern-border-char returns double-line chars"
(is (equal (cl-tty.backend::border-char :double :top-left) "╔"))
(is (equal (cl-tty.backend::border-char :double :horizontal) "═"))
(is (equal (cl-tty.backend::border-char :double :vertical) "║")))Suspend/resume backend
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).
(test suspend-resume-noop
"suspend-backend and resume-backend are no-ops in test context"
(let ((b (make-modern-backend)))
(is (null (multiple-value-list (suspend-backend b))))
(is (null (multiple-value-list (resume-backend b))))))Implementation
Color and attribute helpers
hex-to-rgb
hex-to-rgb parses hex color strings into (r g b) triplets. Handles
both 6-digit (fully specified) and 3-digit (shorthand) formats. The
3-digit form expands each hexit by duplicating it (#F00 > =#FF0000).
(in-package :cl-tty.backend)
(defun hex-to-rgb (hex)
"Parse a hex color string like \"#FFD700\" into (values r g b).
Also handles 3-digit hex like \"#F00\" (expands to \"#FF0000\")."
(let ((clean (string-trim '(#\# #\Space) hex)))
(if (= (length clean) 3)
;; Expand 3-digit: #F00 -> #FF0000
(let* ((r (parse-integer (subseq clean 0 1) :radix 16 :junk-allowed t))
(g (parse-integer (subseq clean 1 2) :radix 16 :junk-allowed t))
(b (parse-integer (subseq clean 2 3) :radix 16 :junk-allowed t)))
(values (+ r (* r 16)) (+ g (* g 16)) (+ b (* b 16))))
(values (parse-integer (subseq clean 0 2) :radix 16 :junk-allowed t)
(parse-integer (subseq clean 2 4) :radix 16 :junk-allowed t)
(parse-integer (subseq clean 4 6) :radix 16 :junk-allowed t)))))named-colors
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.
(defparameter *named-colors*
'((:black . 0) (:red . 1) (:green . 2) (:yellow . 3)
(:blue . 4) (:magenta . 5) (:cyan . 6) (:white . 7)))theme-colors
Hash table mapping semantic theme role keywords to hex color strings.
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.
(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
as a fallback when a keyword is not in *named-colors*.")sgr-fg
sgr-fg produces the SGR foreground escape sequence. Resolution chain:
hex string > named color => semantic theme role => empty string if
unresolved. Truecolor uses =38;2;R;G;B, named colors use 3n.
(defun sgr-fg (color)
"Return SGR foreground escape for COLOR."
(if (null color) ""
(cond ((and (stringp color) (char= (char color 0) #\#))
(multiple-value-bind (r g b) (hex-to-rgb color)
(format nil "~C[38;2;~d;~d;~dm" #\Esc r g b)))
((keywordp color)
(let ((index (cdr (assoc color *named-colors*))))
(if index
(format nil "~C[~dm" #\Esc (+ 30 index))
(let ((hex (gethash color *theme-colors*)))
(if hex
(multiple-value-bind (r g b) (hex-to-rgb hex)
(format nil "~C[38;2;~d;~d;~dm" #\Esc r g b))
"")))))
(t ""))))sgr-bg
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.
(defun sgr-bg (color)
"Return SGR background escape for COLOR."
(if (null color) ""
(cond ((and (stringp color) (char= (char color 0) #\#))
(multiple-value-bind (r g b) (hex-to-rgb color)
(format nil "~C[48;2;~d;~d;~dm" #\Esc r g b)))
((keywordp color)
(let ((index (cdr (assoc color *named-colors*))))
(if index
(format nil "~C[~dm" #\Esc (+ 40 index))
(let ((hex (gethash color *theme-colors*)))
(if hex
(multiple-value-bind (r g b) (hex-to-rgb hex)
(format nil "~C[48;2;~d;~d;~dm" #\Esc r g b))
"")))))
(t ""))))sgr-attr-codes
Maps attribute keywords to SGR parameter numbers. Covers bold, dim, italic, underline, blink, reverse video, and reset.
(defparameter *sgr-attr-codes*
'((:bold . 1) (:dim . 2) (:italic . 3) (:underline . 4)
(:blink . 5) (:reverse . 7) (:reset . 0)))sgr-attr
sgr-attr looks up the keyword in *sgr-attr-codes* and produces the
matching SGR escape.
(defun sgr-attr (attr)
"Return SGR attribute escape for ATTR keyword."
(let ((code (cdr (assoc attr *sgr-attr-codes*))))
(if code
(format nil "~C[~dm" #\Esc code)
"")))Cursor escapes
cursor-move-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.
(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)))cursor-style-escape
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).
(defun cursor-style-escape (shape blink)
"Return DECSTR escape for cursor shape."
(let* ((base (case shape
(:block 2) (:underline 4) (:bar 6)
(t 2)))
(code (if blink (1+ base) base)))
(format nil "~C[~d q" #\Esc code)))Sync and link escapes
decicm-begin
Enables DEC private mode 2026 (synchronized updates). All output
between begin and end is buffered by the terminal and rendered
atomically.
(defun decicm-begin ()
"Return escape to enable synchronized updates."
(format nil "~C[?2026h" #\Esc))decicm-end
Disables DEC private mode 2026, flushing the buffered frame to the display.
(defun decicm-end ()
"Return escape to disable synchronized updates."
(format nil "~C[?2026l" #\Esc))osc8-link
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.
(defun osc8-link (url text)
"Wrap TEXT in an OSC 8 hyperlink to URL."
(format nil "~C]8;;~A~C\\~A~C]8;;~C\\"
#\Esc url #\Esc text #\Esc #\Esc))Border characters
border-chars
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.
(defparameter *border-chars*
'(((:single :top-left) . "┌") ((:single :top-right) . "┐")
((:single :bottom-left) . "└") ((:single :bottom-right) . "┘")
((:single :horizontal) . "─") ((:single :vertical) . "│")
((:double :top-left) . "╔") ((:double :top-right) . "╗")
((:double :bottom-left) . "╚") ((:double :bottom-right) . "╝")
((:double :horizontal) . "═") ((:double :vertical) . "║")
((:rounded :top-left) . "╭") ((:rounded :top-right) . "╮")
((:rounded :bottom-left) . "╰") ((:rounded :bottom-right) . "╯")
((:rounded :horizontal) . "─") ((:rounded :vertical) . "│")))border-char
Looks up a border character by style and position. Falls back to
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.
(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))))
(or char (if (member pos '(:horizontal :vertical))
(case pos (:horizontal "─") (:vertical "│"))
"+"))))Modern backend class
modern-backend (class)
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.
(defclass modern-backend (backend)
((output-stream :initform *standard-output*
:initarg :output-stream
:accessor backend-output-stream)
(in-sync-p :initform nil :accessor in-sync-p)))make-modern-backend
Factory function that creates a modern-backend instance. Accepts an
optional output-stream; defaults to *standard-output*. The
color-palette argument is ignored in favor of the dynamic
*theme-colors* hash table.
(defun make-modern-backend (&key color-palette output-stream)
(declare (ignore color-palette))
(make-instance 'modern-backend :output-stream (or output-stream *standard-output*)))Lifecycle
initialize-backend
Enters the alternate screen buffer, enables mouse tracking (basic + drag + SGR), bracketed paste mode, and the Kitty keyboard protocol. Hides the cursor and flushes the stream. Returns the backend instance for chaining.
(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
(backend-write b (format nil "~C[?1002h" #\Esc)) ; mouse drag
(backend-write b (format nil "~C[?1006h" #\Esc)) ; SGR mouse
(backend-write b (format nil "~C[?2004h" #\Esc)) ; bracketed paste
(backend-write b (format nil "~C[?u" #\Esc)) ; kitty keyboard
(cursor-hide b)
(finish-output (backend-output-stream b))
b)shutdown-backend
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)).
(defmethod shutdown-backend ((b modern-backend))
(cursor-show b)
(backend-write b (format nil "~C[?u" #\Esc))
(backend-write b (format nil "~C[?2004l" #\Esc))
(backend-write b (format nil "~C[?1006l" #\Esc))
(backend-write b (format nil "~C[?1002l" #\Esc))
(backend-write b (format nil "~C[?1000l" #\Esc))
(backend-write b (format nil "~C[?1049l" #\Esc)) ; normal screen
(finish-output (backend-output-stream b))
(values))Suspend backend (temporary)
Temporarily suspends the modern backend, restoring the terminal to a
usable state so the shell (or parent process) can take over. Called
before SIGTSTP or similar process suspension.
Shows the cursor and exits the alternate screen buffer so the user sees the normal terminal content. Does NOT disable mouse modes or 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).
(defmethod suspend-backend ((b modern-backend))
(cursor-show b)
(backend-write b (format nil "~C[?1049l" #\Esc)) ; normal screen
(cursor-move b 0 0)
(finish-output (backend-output-stream b))
(values))Resume backend (after suspend)
Re-initializes the modern backend after a suspension. Called after
SIGCONT or similar process resume.
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.
(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
(backend-write b (format nil "~C[?1002h" #\Esc)) ; mouse drag
(backend-write b (format nil "~C[?1006h" #\Esc)) ; SGR mouse
(backend-write b (format nil "~C[?2004h" #\Esc)) ; bracketed paste
(backend-write b (format nil "~C[?u" #\Esc)) ; kitty keyboard
(cursor-hide b)
(finish-output (backend-output-stream b))
(values))Backend-size via ioctl
backend-size
Uses ioctl (TIOCGWINSZ = 21523) to query actual terminal dimensions
from the kernel, with a /dev/tty fallback and 80x24 last resort.
(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
;; (or discards secondary values, so we avoid it for multi-value returns).
(multiple-value-bind (cols rows)
(ignore-errors
(let* ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4)))
(unwind-protect
(let ((ok (sb-unix:unix-ioctl
(sb-sys:fd-stream-fd (backend-output-stream b))
21523 (sb-alien:alien-sap winsize))))
(when ok
(values (sb-alien:deref winsize 1) ;; cols
(sb-alien:deref winsize 0)))) ;; rows
(sb-alien:free-alien winsize))))
(if (and cols rows (> cols 0) (> rows 0))
(values cols rows)
;; Direct ioctl on /dev/tty.
(multiple-value-bind (cols rows)
(ignore-errors
(let ((tty-fd (sb-unix:unix-open "/dev/tty" 0 0)))
(when (and tty-fd (numberp tty-fd) (> tty-fd 0))
(unwind-protect
(let* ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4)))
(let ((ok (sb-unix:unix-ioctl tty-fd 21523
(sb-alien:alien-sap winsize))))
(when ok
(let ((cols (sb-alien:deref winsize 1))
(rows (sb-alien:deref winsize 0)))
(values cols rows)))))
(sb-unix:unix-close tty-fd)))))
(if (and cols rows (> cols 0) (> rows 0))
(values cols rows)
(values 80 24))))))Capability query and write
backend-write
Writes a string to the backend's output stream. Does NOT flush — the
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.
(defmethod backend-write ((b modern-backend) string)
(let ((stream (backend-output-stream b)))
(write-string string stream)
(length string)))capable-p
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.
(defmethod capable-p ((b modern-backend) feature)
(member feature '(:truecolor :osc8 :sync :mouse
:bracketed-paste :cursor-style
:kitty-keyboard)))Drawing
draw-text
Combines cursor positioning, SGR colors, optional attributes, the text
itself, and a reset into a single concatenated string. Minimizes output
calls — one backend-write per draw operation — by packing everything
into one buffer.
(defmethod draw-text ((b modern-backend) x y string fg bg
&key bold italic underline reverse dim blink
&allow-other-keys)
(let ((parts (list (cursor-move-escape x y)
(sgr-fg fg) (sgr-bg bg)
(when bold (sgr-attr :bold))
(when italic (sgr-attr :italic))
(when underline (sgr-attr :underline))
(when reverse (sgr-attr :reverse))
(when dim (sgr-attr :dim))
(when blink (sgr-attr :blink))
string
(sgr-attr :reset))))
(backend-write b (apply #'concatenate 'string parts))))draw-border
Builds the full border as three distinct string parts (top with optional 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.
(defmethod draw-border ((b modern-backend) x y width height
&key style fg bg title title-align)
(let* ((s (or style :single))
(tl (border-char s :top-left))
(tr (border-char s :top-right))
(bl (border-char s :bottom-left))
(br (border-char s :bottom-right))
(h (border-char s :horizontal))
(v (border-char s :vertical))
(fg-esc (sgr-fg fg))
(bg-esc (sgr-bg bg))
(reset (sgr-attr :reset))
(inner-width (- width 2))
(hc (char h 0))
(top (if (and title (plusp (length title)))
(let* ((align (or title-align :left))
(max-tlen (- inner-width 2))
(tlen (min (length title) max-tlen))
(trunc-title (subseq title 0 tlen)))
(ecase align
(:left
(let ((right-hyphens (- inner-width tlen 2)))
(concatenate 'string
fg-esc bg-esc tl (string #\Space)
trunc-title (string #\Space)
(make-string (max 0 right-hyphens) :initial-element hc)
tr reset (string #\Newline))))
(:center
(let* ((total-pad (- inner-width tlen))
(left-pad (floor total-pad 2))
(right-pad (- total-pad left-pad)))
(concatenate 'string
fg-esc bg-esc tl
(make-string left-pad :initial-element hc)
trunc-title
(make-string right-pad :initial-element hc)
tr reset (string #\Newline))))))
(concatenate 'string
fg-esc bg-esc tl
(make-string inner-width :initial-element hc)
tr reset (string #\Newline))))
(mid (concatenate 'string
fg-esc bg-esc v
(make-string inner-width :initial-element #\Space)
v reset (string #\Newline)))
(bot (concatenate 'string
fg-esc bg-esc bl
(make-string inner-width :initial-element hc)
br reset)))
(backend-write b top)
(loop repeat (- height 2) do (backend-write b mid))
(backend-write b bot)))draw-rect
Fills a rectangular area with a background color. For each row, moves
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.
(defmethod draw-rect ((b modern-backend) x y width height &key bg)
(let* ((bg-esc (sgr-bg bg))
(reset (sgr-attr :reset))
(line (concatenate 'string
bg-esc
(make-string width :initial-element #\Space)
reset (string #\Newline))))
(loop :for row :from 0 :below height :do
(backend-write b (cursor-move-escape x (+ y row)))
(backend-write b line))))draw-link
Draws a hyperlinked text at position (x, y). Combines cursor 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.
(defmethod draw-link ((b modern-backend) x y string url
&key fg bg)
(let ((parts (list (cursor-move-escape x y)
(sgr-fg fg) (sgr-bg bg)
(osc8-link url string)
(sgr-attr :reset))))
(backend-write b (apply #'concatenate 'string parts))))draw-ellipsis
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.
(defmethod draw-ellipsis ((b modern-backend) x y width
&key fg bg)
(declare (ignore width))
(let ((dots "..."))
(draw-text b x y dots fg bg)))Cursor and input methods
cursor-move
Delegates to cursor-move-escape and writes the resulting CSI sequence
to the output stream.
(defmethod cursor-move ((b modern-backend) x y)
(backend-write b (cursor-move-escape x y)))cursor-hide
Sends the DECTCEM private mode ?25l to hide the cursor.
(defmethod cursor-hide ((b modern-backend))
(backend-write b (format nil "~C[?25l" #\Esc)))cursor-show
Sends ?25h to restore the cursor visibility.
(defmethod cursor-show ((b modern-backend))
(backend-write b (format nil "~C[?25h" #\Esc)))cursor-style
Sets the cursor shape (block/underline/bar, optionally blinking) by
delegating to cursor-style-escape.
(defmethod cursor-style ((b modern-backend) shape &key blink)
(backend-write b (cursor-style-escape shape blink)))enable-mouse
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.
(defmethod enable-mouse ((b modern-backend))
(backend-write b (format nil "~C[?1000h" #\Esc))
(backend-write b (format nil "~C[?1002h" #\Esc))
(backend-write b (format nil "~C[?1006h" #\Esc))
(finish-output (backend-output-stream b)))enable-bracketed-paste
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.
(defmethod enable-bracketed-paste ((b modern-backend))
(backend-write b (format nil "~C[?2004h" #\Esc))
(finish-output (backend-output-stream b)))begin-sync
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.
(defmethod begin-sync ((b modern-backend))
(setf (in-sync-p b) t)
(backend-write b (decicm-begin)))end-sync
Ends the synchronized update frame and flushes the output, causing the terminal to render the buffered changes atomically.
(defmethod end-sync ((b modern-backend))
(setf (in-sync-p b) nil)
(backend-write b (decicm-end))
(finish-output (backend-output-stream b)))