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.
624 lines
23 KiB
Org Mode
624 lines
23 KiB
Org Mode
#+TITLE: Box and Text Renderables
|
|
#+STARTUP: content
|
|
#+FILETAGS: :cl-tty:components:
|
|
|
|
* 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.
|
|
|
|
#+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))
|
|
(in-package :cl-tty-box-test)
|
|
|
|
(def-suite box-suite :description "Box renderable tests")
|
|
(in-suite box-suite)
|
|
#+END_SRC
|
|
|
|
** 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~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box-tests.lisp
|
|
(defun run-tests ()
|
|
(let ((result (run 'box-suite)))
|
|
(fiveam:explain! result)
|
|
(uiop:quit 0)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+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)))
|
|
(values b s)))
|
|
#+END_SRC
|
|
|
|
** Test: box-creates-with-defaults
|
|
|
|
Verify that a bare ~make-box~ returns a ~box~ instance and
|
|
automatically creates a ~layout-node~ through inheritance.
|
|
|
|
#+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)))
|
|
(is (typep b 'box))
|
|
(is (typep (box-layout-node b) 'layout-node))))
|
|
#+END_SRC
|
|
|
|
** Test: box-renders-border
|
|
|
|
Verify that a box with ~:border-style :single~ draws the four corner
|
|
characters (┌ ┐ └ ┘) in the output stream.
|
|
|
|
#+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)
|
|
(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")))))
|
|
#+END_SRC
|
|
|
|
** Test: box-renders-background
|
|
|
|
Verify that a box with ~:bg :red~ emits SGR background color codes
|
|
(41m) in the output stream.
|
|
|
|
#+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)
|
|
(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")))))
|
|
#+END_SRC
|
|
|
|
** Test: box-renders-title
|
|
|
|
Verify that a title string appears in the rendered output stream
|
|
when ~:title~ is provided.
|
|
|
|
#+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)
|
|
(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")))))
|
|
#+END_SRC
|
|
|
|
** Test: box-without-border
|
|
|
|
Verify that ~:border-style nil~ suppresses corner characters but
|
|
background fill rendering continues to work.
|
|
|
|
#+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)
|
|
(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")))))
|
|
#+END_SRC
|
|
|
|
** Test: box-zero-size
|
|
|
|
Verify that a box with zero width and height produces no output
|
|
(triggers the early-return guard in ~render-box~).
|
|
|
|
#+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)
|
|
(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"))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+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)
|
|
(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"))))
|
|
#+END_SRC
|
|
|
|
** Test: box-minimum-size
|
|
|
|
Verify that a 2x2 box (the minimum viable size for border rendering)
|
|
still produces corner characters in the output.
|
|
|
|
#+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)
|
|
(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")))))
|
|
#+END_SRC
|
|
|
|
** Test: text-creates-with-defaults
|
|
|
|
Verify that ~make-text~ with an empty string returns a ~text~
|
|
instance and creates a ~layout-node~.
|
|
|
|
#+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 "")))
|
|
(is (typep txt 'text))
|
|
(is (typep (text-layout-node txt) 'layout-node))))
|
|
#+END_SRC
|
|
|
|
** Test: text-renders-content
|
|
|
|
Verify that text content appears in the captured output stream after
|
|
rendering.
|
|
|
|
#+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)
|
|
(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")))))
|
|
#+END_SRC
|
|
|
|
** Test: text-empty-string
|
|
|
|
Verify that an empty string produces no output (triggers the
|
|
early-return guard in ~render-text~).
|
|
|
|
#+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)
|
|
(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"))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+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)
|
|
(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")))))
|
|
#+END_SRC
|
|
|
|
** Test: text-word-wraps
|
|
|
|
Verify that ~:wrap-mode :word~ breaks lines at word boundaries,
|
|
distributing words across successive rows.
|
|
|
|
#+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)
|
|
(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")))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+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)
|
|
(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")))))
|
|
#+END_SRC
|
|
|
|
** Test: span-creates-with-attributes
|
|
|
|
Verify that ~span~ stores its text content and style attributes
|
|
correctly, with unset attributes defaulting to ~nil~.
|
|
|
|
#+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)))
|
|
(is (string= (span-text s) "bold text"))
|
|
(is-true (span-bold s))
|
|
(is-false (span-italic s))))
|
|
#+END_SRC
|
|
|
|
** Test: make-text-with-spans
|
|
|
|
Verify that ~make-text~ with ~:spans~ stores the provided span
|
|
objects and they are accessible via ~text-spans~.
|
|
|
|
#+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)
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
* 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/box.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+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)
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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).
|
|
|
|
#+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))
|
|
(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))))))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+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
|
|
:underline underline :reverse reverse :dim dim
|
|
:fg fg :bg bg))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+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)
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+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
|
|
:fg fg :bg bg
|
|
:wrap-mode (or wrap-mode :word)
|
|
:spans spans
|
|
:layout-node (make-layout-node :direction :column
|
|
:width width :height height)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+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))
|
|
(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)))))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+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)))
|
|
(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 "")))))
|
|
#+END_SRC
|
|
|
|
** 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).
|
|
|
|
#+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
|
|
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))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
|
|
(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))))
|
|
#+END_SRC
|