Amr Gharbeia
0b076c8def
char-width → cl-tty.box (text.lisp): terminal column width for Unicode characters including CJK, emoji, combining marks, and tab. search-highlight → cl-tty.markdown: wraps query matches in **bold** markers for search result emphasis. Pure function, zero dependencies.
23 KiB
Box and Text Renderables
- Overview
- Contract
- Tests
- Package and test suite setup
- Test runner entry point
- Capturing backend helper
- Test: box-creates-with-defaults
- Test: box-renders-border
- Test: box-renders-background
- Test: box-renders-title
- Test: box-without-border
- Test: box-zero-size
- Test: box-single-column
- Test: box-minimum-size
- Test: text-creates-with-defaults
- Test: text-renders-content
- Test: text-empty-string
- Test: text-truncates-when-no-wrap
- Test: text-word-wraps
- Test: text-word-wrap-single-word
- Test: span-creates-with-attributes
- Test: make-text-with-spans
- Implementation
Overview
Box and Text are the two fundamental renderable component types. Box provides a bordered container with optional background fill and title. Text renders strings with word-wrap, color, and inline style spans.
Both inherit from dirty-mixin for incremental rendering support and
carry a layout-node for position/size computed by the layout engine.
Contract
Box
(make-box &key border-style title title-align fg bg width height)→ box(render-box box backend)— draw the box at its layout position- Border styles:
:single,:double,:rounded,nil(no border)
Span
(span text &key bold italic underline reverse dim fg bg)→ span- Inline text segment with per-run style attributes.
Text
(make-text content &key fg bg wrap-mode width height spans)→ text(render-text text-object backend)— render text at layout position- Wrap modes:
:word(break at word boundaries),:none(truncate)
Utilities
(word-wrap text max-width)→ list of strings(split-string string)→ list of words
Tests
Package and test suite setup
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.
(defpackage :cl-tty-box-test
(:use :cl :fiveam :cl-tty.backend :cl-tty.layout :cl-tty.box)
(:export #:run-tests))
(in-package :cl-tty-box-test)
(def-suite box-suite :description "Box renderable tests")
(in-suite box-suite)Test runner entry point
run-tests is the entry point called from the top-level
run-all-tests.lisp. It runs the box-suite, explains results to
stdout, and exits cleanly with uiop:quit.
(defun run-tests ()
(let ((result (run 'box-suite)))
(fiveam:explain! result)
(uiop:quit 0)))Capturing backend helper
make-capturing-backend creates a backend that writes to a
string-output-stream so tests can inspect rendered output without
actual terminal I/O. Returns the backend and stream as multiple
values.
(defun make-capturing-backend ()
(let* ((s (make-string-output-stream))
(b (make-modern-backend :output-stream s)))
(values b s)))Test: box-creates-with-defaults
Verify that a bare make-box returns a box instance and
automatically creates a layout-node through inheritance.
(test box-creates-with-defaults
"A box created with no arguments has reasonable defaults"
(let ((b (make-box)))
(is (typep b 'box))
(is (typep (box-layout-node b) 'layout-node))))Test: box-renders-border
Verify that a box with :border-style :single draws the four corner
characters (┌ ┐ └ ┘) in the output stream.
(test box-renders-border
"A box with border draws border characters"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style :single :width 10 :height 5)))
(compute-layout (box-layout-node bx) 10 5)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(is (search "┌" out) "top-left corner")
(is (search "┐" out) "top-right corner")
(is (search "└" out) "bottom-left corner")
(is (search "┘" out) "bottom-right corner")))))Test: box-renders-background
Verify that a box with :bg :red emits SGR background color codes
(41m) in the output stream.
(test box-renders-background
"A box with background color fills interior"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :bg :red :width 5 :height 3)))
(compute-layout (box-layout-node bx) 5 3)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(is (search "┌" out) "border with background")
(is (search "41m" out) "SGR background for red")))))Test: box-renders-title
Verify that a title string appears in the rendered output stream
when :title is provided.
(test box-renders-title
"A box with title renders the title text"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :title "Hello" :width 12 :height 3)))
(compute-layout (box-layout-node bx) 12 3)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(is (search "Hello" out) "title text should appear")))))Test: box-without-border
Verify that :border-style nil suppresses corner characters but
background fill rendering continues to work.
(test box-without-border
"A box with border-style nil draws no border"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style nil :bg :red :width 5 :height 3)))
(compute-layout (box-layout-node bx) 5 3)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(is (search "41m" out) "background still renders")
(is-false (search "┌" out) "no top-left corner")))))Test: box-zero-size
Verify that a box with zero width and height produces no output
(triggers the early-return guard in render-box).
(test box-zero-size
"A box with any zero dimension renders nothing"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style :single :width 0 :height 0)))
(compute-layout (box-layout-node bx) 0 0)
(render-box bx b)
(is (string= (get-output-stream-string s) "")
"zero-size box produces no output"))))Test: box-single-column
Verify that a box with width 1 produces no output — draw-border
requires at least 2 columns to draw corner and edge characters.
(test box-single-column
"A box with width 1 renders nothing (needs min 2 for border)"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style :single :width 1 :height 5)))
(compute-layout (box-layout-node bx) 1 5)
(render-box bx b)
(is (string= (get-output-stream-string s) "")
"width=1 box renders nothing"))))Test: box-minimum-size
Verify that a 2x2 box (the minimum viable size for border rendering) still produces corner characters in the output.
(test box-minimum-size
"A box with minimum non-zero size still renders"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style :single :width 2 :height 2)))
(compute-layout (box-layout-node bx) 2 2)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(is (search "┌" out) "2x2 box still has borders")))))Test: text-creates-with-defaults
Verify that make-text with an empty string returns a text
instance and creates a layout-node.
(test text-creates-with-defaults
"A text created with no arguments has reasonable defaults"
(let ((txt (make-text "")))
(is (typep txt 'text))
(is (typep (text-layout-node txt) 'layout-node))))Test: text-renders-content
Verify that text content appears in the captured output stream after rendering.
(test text-renders-content
"A text renders its content at position"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((tx (make-text "Hello" :width 10 :height 1)))
(compute-layout (text-layout-node tx) 10 1)
(render-text tx b)
(let ((out (get-output-stream-string s)))
(is (search "Hello" out) "content should appear")))))Test: text-empty-string
Verify that an empty string produces no output (triggers the
early-return guard in render-text).
(test text-empty-string
"Empty text produces no output"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((tx (make-text "" :width 10 :height 1)))
(compute-layout (text-layout-node tx) 10 1)
(render-text tx b)
(is (string= (get-output-stream-string s) "")
"empty string produces no output"))))Test: text-truncates-when-no-wrap
Verify that :wrap-mode :none truncates the content string to fit
within the available width, producing only the first N characters.
(test text-truncates-when-no-wrap
"Text with wrap-mode :none truncates at width"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((tx (make-text "Hello World" :width 5 :height 1
:wrap-mode :none)))
(compute-layout (text-layout-node tx) 5 1)
(render-text tx b)
(let ((out (get-output-stream-string s)))
(is (search "Hello" out) "truncated to first 5 chars")))))Test: text-word-wraps
Verify that :wrap-mode :word breaks lines at word boundaries,
distributing words across successive rows.
(test text-word-wraps
"Text with wrap-mode :word wraps at word boundaries"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((tx (make-text "Hello brave new world" :width 6 :height 3)))
(compute-layout (text-layout-node tx) 6 3)
(render-text tx b)
(let ((out (get-output-stream-string s)))
(is (search "Hello" out) "first line")
(is (search "brave" out) "second line")
(is (search "new" out) "third line")))))Test: text-word-wrap-single-word
Verify that a single word longer than the available width is
hard-broken at character boundaries into max-width-sized chunks.
(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)
(let ((tx (make-text "Hello" :width 3 :height 3)))
(compute-layout (text-layout-node tx) 3 3)
(render-text tx b)
(let ((out (get-output-stream-string s)))
(is (search "Hel" out) "first chunk is Hel")
(is (search "lo" out) "second chunk is lo")))))Test: span-creates-with-attributes
Verify that span stores its text content and style attributes
correctly, with unset attributes defaulting to nil.
(test span-creates-with-attributes
"A span has text and optional style attributes"
(let ((s (span "bold text" :bold t)))
(is (string= (span-text s) "bold text"))
(is-true (span-bold s))
(is-false (span-italic s))))Test: make-text-with-spans
Verify that make-text with :spans stores the provided span
objects and they are accessible via text-spans.
(test make-text-with-spans
"Text with spans stores span objects"
(let* ((sp (list (span "Hello" :bold t)
(span "World" :italic t)))
(tx (make-text "" :spans sp)))
(is (= (length (text-spans tx)) 2))
(is (string= (span-text (elt (text-spans tx) 0)) "Hello"))
(is-true (span-bold (elt (text-spans tx) 0)))))Implementation
Box class
box inherits from dirty-mixin so changes (resize, title update,
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.
(in-package :cl-tty.box)
(defclass box (dirty-mixin)
((layout-node :initform (make-layout-node) :accessor box-layout-node
:initarg :layout-node)
(border-style :initform :single :initarg :border-style
:accessor box-border-style)
(title :initform nil :initarg :title :accessor box-title)
(title-align :initform :left :initarg :title-align
:accessor box-title-align)
(fg :initform nil :initarg :fg :accessor box-fg)
(bg :initform nil :initarg :bg :accessor box-bg)))make-box constructor
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.
(defun make-box (&key (border-style :single) title
(title-align :left) fg bg
width height)
(make-instance 'box
:border-style border-style
:title title
:title-align title-align
:fg fg
:bg bg
:layout-node (make-layout-node
:width width
:height height
:direction :column)))render-box function
render-box draws the border at the component's layout position.
It handles zero-size (returns immediately) and optional background
fill. The early return for (< w 2) is important: draw-border
requires at least 2 columns of width to draw corner characters.
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).
(defun render-box (box backend)
"Render BOX at its computed layout position using BACKEND."
(let ((ln (box-layout-node box))
(bs (box-border-style box))
(title (box-title box))
(fg (box-fg box))
(bg (box-bg box)))
(let ((x (layout-node-x ln))
(y (layout-node-y ln))
(w (layout-node-width ln))
(h (layout-node-height ln)))
(when (or (zerop w) (zerop h) (< w 2) (< h 2))
(return-from render-box (values)))
(when bg
(draw-rect backend x y w h :bg bg))
(when bs
(draw-border backend x y w h :style bs :fg fg :bg bg))
(when title
(let* ((content-w (- w 4))
(tx (+ x 2))
(ty (+ y (if bs 1 0)))
(ta (box-title-align box))
(display (subseq title 0 (min (length title) content-w))))
(case ta
(:center (draw-text backend (+ x (ceiling (- w (length display)) 2)) ty display fg bg))
(:right (draw-text backend (+ x (- w (length display) 2)) ty display fg bg))
(t (draw-text backend tx ty display fg bg))))))))Span class
span represents an inline styled segment within a Text component.
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.
(in-package :cl-tty.box)
(defclass span ()
((text :initarg :text :accessor span-text)
(bold :initform nil :initarg :bold :accessor span-bold)
(italic :initform nil :initarg :italic :accessor span-italic)
(underline :initform nil :initarg :underline :accessor span-underline)
(reverse :initform nil :initarg :reverse :accessor span-reverse)
(dim :initform nil :initarg :dim :accessor span-dim)
(fg :initform nil :initarg :fg :accessor span-fg)
(bg :initform nil :initarg :bg :accessor span-bg)))span constructor
span is a convenience function for creating span instances with
keyword arguments for all style attributes. A nil default means
"inherit/no-change" when merged with parent styling context.
(defun span (text &key bold italic underline reverse dim fg bg)
(make-instance 'span
:text text :bold bold :italic italic
:underline underline :reverse reverse :dim dim
:fg fg :bg bg))Text class
text renders a string at a layout position with word-wrapping.
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.
(defclass text (dirty-mixin)
((layout-node :initform (make-layout-node) :accessor text-layout-node
:initarg :layout-node)
(content :initform "" :initarg :content :accessor text-content)
(spans :initform nil :initarg :spans :accessor text-spans)
(fg :initform nil :initarg :fg :accessor text-fg)
(bg :initform nil :initarg :bg :accessor text-bg)
(wrap-mode :initform :word :initarg :wrap-mode :accessor text-wrap-mode)))make-text constructor
make-text is a convenience constructor that accepts layout
dimensions and content parameters. It defaults wrap-mode to :word
so text wraps by default, and creates a :column-oriented layout
node.
(defun make-text (content &key fg bg wrap-mode width height spans)
(make-instance 'text
:content content
:fg fg :bg bg
:wrap-mode (or wrap-mode :word)
:spans spans
:layout-node (make-layout-node :direction :column
:width width :height height)))render-text function
render-text handles both wrap modes. For :word, it calls
word-wrap to break the content into lines, then renders each line
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.
(defun render-text (text-object backend)
"Render TEXT-OBJECT at its computed layout position using BACKEND."
(let ((ln (text-layout-node text-object))
(content (text-content text-object))
(fg (text-fg text-object))
(bg (text-bg text-object))
(wrap (text-wrap-mode text-object))
(spans (text-spans text-object)))
(declare (ignore spans))
(let ((x (layout-node-x ln))
(y (layout-node-y ln))
(w (layout-node-width ln))
(h (layout-node-height ln)))
(when (or (zerop (length content)) (zerop w) (zerop h))
(return-from render-text (values)))
(if (eql wrap :none)
(let ((display (subseq content 0 (min (length content) w))))
(draw-text backend x y display fg bg))
(let ((lines (word-wrap content w))
(max-lines h))
(loop for line in lines
for row from 0 below max-lines
do (draw-text backend x (+ y row) line fg bg)))))))Word wrapping utility
word-wrap implements the line-breaking algorithm. It splits the
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.
(defun word-wrap (text max-width)
"Split TEXT into lines, each <= MAX-WIDTH chars."
(if (or (zerop max-width) (zerop (length text)))
(list "")
(let ((words (split-string text)) (lines nil) (current nil) (current-len 0))
(dolist (word words)
(let ((wl (length word)))
(cond ((<= wl max-width)
(if (and current (<= (+ current-len 1 wl) max-width))
(progn
(push word current)
(incf current-len (1+ wl)))
(progn
(when current
(push (format nil "~{~A~^ ~}" (nreverse current)) lines))
(setf current (list word))
(setf current-len wl))))
(t
(when current
(push (format nil "~{~A~^ ~}" (nreverse current)) lines)
(setf current nil)
(setf current-len 0))
(loop for i from 0 below wl by max-width
do (push (subseq word i (min (+ i max-width) wl)) lines))))))
(when current
(push (format nil "~{~A~^ ~}" (nreverse current)) lines))
(or (nreverse lines) (list "")))))split-string utility
split-string tokenizes on whitespace characters (space, tab,
newline). It uses position-if to find delimiters and builds the
word list iteratively. Consecutive delimiters are collapsed
(only one advance per delimiter character).
(defun split-string (string)
"Split STRING into words separated by whitespace."
(loop with words = nil
with start = 0
with len = (length string)
while (< start len)
do (let ((ws-start (position-if (lambda (c) (find c '(#\Space #\Tab #\Newline)))
string :start start)))
(if ws-start
(progn
(when (> ws-start start)
(push (subseq string start ws-start) words))
(setf start (1+ ws-start)))
(progn
(push (subseq string start) words)
(setf start len))))
finally (return (nreverse words))))char-width utility
char-width returns the terminal column width of a character.
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0.
Tab = 8. Used by layout calculations that need to handle
variable-width characters.
(defun char-width (ch)
"Returns the terminal column width of character CH."
(let ((code (char-code ch)))
(cond
((= code 9) 8)
((< code 32) 0)
((<= code 127) 1)
((<= #x4E00 code #x9FFF) 2)
((<= #x3400 code #x4DBF) 2)
((<= #x3040 code #x309F) 2)
((<= #x30A0 code #x30FF) 2)
((<= #xAC00 code #xD7AF) 2)
((<= #xFF01 code #xFF60) 2)
((<= #xFFE0 code #xFFE6) 2)
((<= #x1F300 code #x1F9FF) 2)
((<= #x2600 code #x27BF) 2)
((<= #x0300 code #x036F) 0)
((<= #x20D0 code #x20FF) 0)
((<= #xFE00 code #xFE0F) 0)
(t 1))))