amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

restructure: move backend/ and layout/ into src/; convert README to org syntax; fix demo package conflict and alien-sap ioctl; update ROADMAP with v0.15.0; remove stale files

Browse Source 
- Move backend/ and layout/ directories into src/
- Update all path references in ASD, scripts, docs
- Convert README.org from Markdown syntax to proper Org-mode
- Fix demo.lisp use-package conflict (both backend and input export #:read-event)
- Fix modern-backend TIOCGWINSZ ioctl alien type (alien-sap wrapper)
- Add v0.15.0 section to ROADMAP, update line count to 5760
- Add known gaps (suspend/resume-backend, slot modes) to v1.0.0 checklist
- Remove docs/plans/, debug-layout.lisp, system-index.txt, ci-watchdog.sh
- Move tangle.py to Hermes skill (org-babel-tangle)
- Add .gitignore for fasl files
This commit is contained in:
Hermes Agent
2026-05-12 16:57:19 +00:00
parent 5f07c1fd76
commit 47094c48e5
31 changed files with 369 additions and 1390 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
.gitignore vendored Normal file
View File

@@ -0,0 +1,14 @@
# Compiled Lisp files
*.fasl
*.fasl.gz
*.lib
*.dx32fsl
*.dx64fsl
# System files
.DS_Store
Thumbs.db
# Python cache
__pycache__/
*.pyc

207
README.org
View File

@@ -1,17 +1,17 @@
# cl-tty — Terminal UI Framework for Common Lisp #+TITLE: cl-tty — Terminal UI Framework for Common Lisp
Pure CL terminal UI framework. No ncurses, no FFI, no external dependencies. Pure CL terminal UI framework. No ncurses, no FFI, no external dependencies.
```lisp #+BEGIN_SRC lisp
(ql:quickload :cl-tty) (ql:quickload :cl-tty)
``` #+END_SRC
## Quick start * Quick start
The simplest possible cl-tty program — detect the terminal, draw some text, The simplest possible cl-tty program — detect the terminal, draw some text,
read a key, and shut down: read a key, and shut down:
```lisp #+BEGIN_SRC lisp
(sb-posix:with-raw-terminal (sb-posix:with-raw-terminal
(let* ((be (cl-tty.backend:detect-backend)) (let* ((be (cl-tty.backend:detect-backend))
(w 80) (h 24)) (w 80) (h 24))
@@ -24,30 +24,30 @@ read a key, and shut down:
;; Read one key (blocks) ;; Read one key (blocks)
(cl-tty.input:read-event be)) (cl-tty.input:read-event be))
(cl-tty.backend:shutdown-backend be)))) (cl-tty.backend:shutdown-backend be))))
``` #+END_SRC
Or run the full interactive demo: Or run the full interactive demo:
```bash #+BEGIN_SRC bash
sbcl --script demo.lisp sbcl --script demo.lisp
``` #+END_SRC
## Architecture * Architecture
Two backends, one protocol: Two backends, one protocol:
- **modern-backend** — truecolor 24-bit, OSC 8 hyperlinks, DECICM sync, - *modern-backend* — truecolor 24-bit, OSC 8 hyperlinks, DECICM sync,
SGR mouse, kitty keyboard, bold/italic/underline, box-drawing chars SGR mouse, kitty keyboard, bold/italic/underline, box-drawing chars
- **simple-backend** — ASCII art, no color, universal compatibility (pipe-safe) - *simple-backend* — ASCII art, no color, universal compatibility (pipe-safe)
Everything is pure escape sequences (no curses, no terminfo, no FFI). Everything is pure escape sequences (no curses, no terminfo, no FFI).
### Backend protocol ** Backend protocol
Every drawing operation is a CLOS generic function dispatched on the backend Every drawing operation is a CLOS generic function dispatched on the backend
class. Programs never call terminal codes directly: class. Programs never call terminal codes directly:
```lisp #+BEGIN_SRC lisp
;; Lifecycle ;; Lifecycle
(initialize-backend backend) (initialize-backend backend)
(shutdown-backend backend) (shutdown-backend backend)
@@ -67,11 +67,11 @@ class. Programs never call terminal codes directly:
(cursor-hide backend) (cursor-hide backend)
(cursor-show backend) (cursor-show backend)
(cursor-style backend shape &key blink) ;; :bar :block :underline (cursor-style backend shape &key blink) ;; :bar :block :underline
``` #+END_SRC
### Event loop pattern ** Event loop pattern
```lisp #+BEGIN_SRC lisp
(let ((be (detect-backend))) (let ((be (detect-backend)))
(initialize-backend be) (initialize-backend be)
(loop with running = t (loop with running = t
@@ -89,48 +89,48 @@ class. Programs never call terminal codes directly:
)) ))
(when (eq event :eof) (setf running nil)))) (when (eq event :eof) (setf running nil))))
(shutdown-backend be)) (shutdown-backend be))
``` #+END_SRC
### Layout system ** Layout system
Pure CL flexbox layout engine. No C dependencies, no Yoga FFI. Pure CL flexbox layout engine. No C dependencies, no Yoga FFI.
```lisp #+BEGIN_SRC lisp
;; Macros build layout-trees: ;; Macros build layout-trees:
(vbox (:gap 1 :padding 1) (vbox (:gap 1 :padding 1)
(header "Title") (header "Title")
(hbox (:grow 1) (hbox (:grow 1)
(sidebar (:width 30) ...) (sidebar (:width 30) ...)
(content ...))) (content ...)))
``` #+END_SRC
Layout properties: `:direction` (`:row` / `:column`), `:grow`, `:shrink`, Layout properties: ~:direction~ (~:row~ / ~:column~), ~:grow~, ~:shrink~,
`:basis`, `:gap`, `:padding`, `:margin`, `:width`, `:height`, `:wrap`. ~:basis~, ~:gap~, ~:padding~, ~:margin~, ~:width~, ~:height~, ~:wrap~.
See `layout/layout.lisp` or `org/layout-engine.org` for the full API. See ~src/layout/layout.lisp~ or ~org/layout-engine.org~ for the full API.
### Rendering pipeline ** Rendering pipeline
Component trees render through a coordinated pipeline: Component trees render through a coordinated pipeline:
1. **Layout pass** — `compute-layout` traverses dirty branches, solves flex constraints 1. *Layout pass* — ~compute-layout~ traverses dirty branches, solves flex constraints
2. **Render dispatch** — `render` generic dispatches per component type 2. *Render dispatch* — ~render~ generic dispatches per component type
3. **Framebuffer** — (optional) `make-framebuffer-backend` captures to a cell array, 3. *Framebuffer* — (optional) ~make-framebuffer-backend~ captures to a cell array,
`diff-framebuffers` computes minimal changes, `flush-framebuffer` writes only ~diff-framebuffers~ computes minimal changes, ~flush-framebuffer~ writes only
changed cells changed cells
```lisp #+BEGIN_SRC lisp
;; Full pipeline with framebuffer ;; Full pipeline with framebuffer
(let* ((fb-be (make-framebuffer-backend :width 80 :height 24)) (let* ((fb-be (make-framebuffer-backend :width 80 :height 24))
(fb (fb-framebuffer fb-be))) (fb (fb-framebuffer fb-be)))
(render my-component fb-be) (render my-component fb-be)
(flush-framebuffer prev-fb fb real-backend)) (flush-framebuffer prev-fb fb real-backend))
``` #+END_SRC
## Components * Components
| Component | What it does | Status | | Component | What it does | Status |
|-------------|------------------------------------------------------|--------| |-------------+------------------------------------------------------+--------|
| Box | Bordered container with background, title | stable | | Box | Bordered container with background, title | stable |
| Text | Styled text with word-wrap, spans | stable | | Text | Styled text with word-wrap, spans | stable |
| ScrollBox | Scrollable viewport with scrollbars | stable | | ScrollBox | Scrollable viewport with scrollbars | stable |
@@ -146,7 +146,7 @@ Component trees render through a coordinated pipeline:
Each component follows a consistent pattern: Each component follows a consistent pattern:
```lisp #+BEGIN_SRC lisp
;; 1. Create — factory function returns instance ;; 1. Create — factory function returns instance
(let ((input (make-text-input :placeholder "Type here...")) (let ((input (make-text-input :placeholder "Type here..."))
(box (make-box :border-style :single :title "My Box"))) (box (make-box :border-style :single :title "My Box")))
@@ -160,135 +160,135 @@ Each component follows a consistent pattern:
;; 3. Render — dispatches through the component protocol ;; 3. Render — dispatches through the component protocol
(render my-component backend)) (render my-component backend))
``` #+END_SRC
### Box *** Box
Bordered container. Draws borders using Unicode box-drawing characters Bordered container. Draws borders using Unicode box-drawing characters
(modern) or ASCII `+`/`-`/`|` (simple). Supports background fill, titled (modern) or ASCII ~+~/~-~/~|~ (simple). Supports background fill, titled
borders. See `org/box-renderable.org`. borders. See ~org/box-renderable.org~.
```lisp #+BEGIN_SRC lisp
(make-box &key (border-style :single) title (title-align :left) fg bg width height) (make-box &key (border-style :single) title (title-align :left) fg bg width height)
``` #+END_SRC
### Text *** Text
Styled text with inline spans and word wrapping. Spans support per-run Styled text with inline spans and word wrapping. Spans support per-run
attributes (bold, italic, underline, fg, bg). See `org/box-renderable.org`. attributes (bold, italic, underline, fg, bg). See ~org/box-renderable.org~.
```lisp #+BEGIN_SRC lisp
(make-text content &key fg bg wrap-mode width height spans) (make-text content &key fg bg wrap-mode width height spans)
;; Span example: ;; Span example:
(span "hello" :bold t :fg :bright-yellow) (span "hello" :bold t :fg :bright-yellow)
``` #+END_SRC
### TextInput *** TextInput
Single-line text editor with emacs-style keybindings. Supports placeholder, Single-line text editor with emacs-style keybindings. Supports placeholder,
max-length, on-submit callback. See `org/text-input.org`. max-length, on-submit callback. See ~org/text-input.org~.
```lisp #+BEGIN_SRC lisp
(make-text-input &key value cursor placeholder max-length on-submit) (make-text-input &key value cursor placeholder max-length on-submit)
;; Widget logic (input-level, no backend needed): ;; Widget logic (input-level, no backend needed):
(handle-text-input input (make-key-event :key :a :code (char-code #\a))) (handle-text-input input (make-key-event :key :a :code (char-code #\a)))
``` #+END_SRC
### TextArea *** TextArea
Multi-line text editor. Supports undo/redo (Ctrl+Z/Y), cursor movement, Multi-line text editor. Supports undo/redo (Ctrl+Z/Y), cursor movement,
line joining on backspace. See `org/text-input.org`. line joining on backspace. See ~org/text-input.org~.
```lisp #+BEGIN_SRC lisp
(make-textarea &key value on-submit) (make-textarea &key value on-submit)
``` #+END_SRC
### ScrollBox *** ScrollBox
Scrollable viewport with a list of children. Only renders children Scrollable viewport with a list of children. Only renders children
intersecting the visible area (viewport culling). Scrollbars drawn intersecting the visible area (viewport culling). Scrollbars drawn
at the right/bottom edges. See `org/scrollbox-tabbar.org`. at the right/bottom edges. See ~org/scrollbox-tabbar.org~.
```lisp #+BEGIN_SRC lisp
(make-scroll-box &key children scroll-y scroll-x sticky-scroll-p) (make-scroll-box &key children scroll-y scroll-x sticky-scroll-p)
(scroll-by sb dy dx) (scroll-by sb dy dx)
``` #+END_SRC
### TabBar *** TabBar
Horizontal tab navigation. Renders tab labels, highlights active tab. Horizontal tab navigation. Renders tab labels, highlights active tab.
Left/right arrows cycle through tabs. See `org/scrollbox-tabbar.org`. Left/right arrows cycle through tabs. See ~org/scrollbox-tabbar.org~.
```lisp #+BEGIN_SRC lisp
(make-tab-bar &key tabs active) (make-tab-bar &key tabs active)
(tab-bar-add tb id title) (tab-bar-add tb id title)
(tab-bar-next tb) / (tab-bar-prev tb) (tab-bar-next tb) / (tab-bar-prev tb)
(tab-bar-handle-key tb event) (tab-bar-handle-key tb event)
``` #+END_SRC
### Select *** Select
Dropdown/filter widget. Options can have categories (rendered as Dropdown/filter widget. Options can have categories (rendered as
non-selectable headers). Fuzzy fallback: matching > 30% character non-selectable headers). Fuzzy fallback: matching > 30% character
overlap. Arrow keys navigate, Enter selects. See `org/select.org`. overlap. Arrow keys navigate, Enter selects. See ~org/select.org~.
```lisp #+BEGIN_SRC lisp
(make-select &key options filter on-select) (make-select &key options filter on-select)
;; Options format: (:title "Name" :category "Group") or (:title "Name") ;; Options format: (:title "Name" :category "Group") or (:title "Name")
``` #+END_SRC
### Markdown *** Markdown
Parsed markdown AST with rendering. Supports headings, paragraphs, Parsed markdown AST with rendering. Supports headings, paragraphs,
bold, italic, inline code, links, code blocks with syntax highlighting, bold, italic, inline code, links, code blocks with syntax highlighting,
diff blocks, blockquotes, lists, thematic breaks. See diff blocks, blockquotes, lists, thematic breaks. See
`org/markdown-renderer.org`. ~org/markdown-renderer.org~.
```lisp #+BEGIN_SRC lisp
(render-markdown "# Hello\n\nThis is **bold**.") (render-markdown "# Hello\n\nThis is **bold**.")
``` #+END_SRC
### Dialog + Toast *** Dialog + Toast
Modal dialog stack. `alert-dialog`, `confirm-dialog`, `select-dialog`, Modal dialog stack. ~alert-dialog~, ~confirm-dialog~, ~select-dialog~,
`prompt-dialog` are convenience constructors. Toasts are transient ~prompt-dialog~ are convenience constructors. Toasts are transient
notifications that auto-dismiss. See `org/dialog.org`. notifications that auto-dismiss. See ~org/dialog.org~.
```lisp #+BEGIN_SRC lisp
(push-dialog (make-instance 'dialog :size :medium)) (push-dialog (make-instance 'dialog :size :medium))
(alert-dialog "Notice" "Operation complete") (alert-dialog "Notice" "Operation complete")
(toast "Saved!" :variant :success) (toast "Saved!" :variant :success)
``` #+END_SRC
### Mouse *** Mouse
Mixin class providing mouse event handler slots. `hit-test` finds the Mixin class providing mouse event handler slots. ~hit-test~ finds the
deepest component at a coordinate. Text selection tracks drag gestures. deepest component at a coordinate. Text selection tracks drag gestures.
Scrollboxes integrate wheel events. See `org/mouse.org`. Scrollboxes integrate wheel events. See ~org/mouse.org~.
```lisp #+BEGIN_SRC lisp
(defclass my-panel (mouse-mixin) ...) (defclass my-panel (mouse-mixin) ...)
(handle-mouse-event component mouse-event) (handle-mouse-event component mouse-event)
(hit-test root x y) → deepest matching component (hit-test root x y) → deepest matching component
``` #+END_SRC
### Slot system *** Slot system
Plugin system for extensible rendering slots. Register named rendering Plugin system for extensible rendering slots. Register named rendering
functions, then render them by slot name. Useful for toolbars, status functions, then render them by slot name. Useful for toolbars, status
bars, and plugin architectures. bars, and plugin architectures.
```lisp #+BEGIN_SRC lisp
(defslot :status-bar :order 0 (defslot :status-bar :order 0
(lambda (&rest args) (lambda (&rest args)
(draw-text backend 0 0 "Ready" :text-muted nil))) (draw-text backend 0 0 "Ready" :text-muted nil)))
(slot-render :status-bar) (slot-render :status-bar)
``` #+END_SRC
## Backend features * Backend features
| Feature | modern | simple | | Feature | modern | simple |
|-------------------|--------|--------| |-------------------+--------+--------|
| Truecolor (24-bit)| Yes | No | | Truecolor (24-bit)| Yes | No |
| Bold/italic | Yes | No | | Bold/italic | Yes | No |
| OSC 8 hyperlinks | Yes | No | | OSC 8 hyperlinks | Yes | No |
@@ -298,16 +298,17 @@ bars, and plugin architectures.
| Box drawing chars | Unicode| ASCII | | Box drawing chars | Unicode| ASCII |
| Pipe-safe | No | Yes | | Pipe-safe | No | Yes |
Backend selection happens automatically via `detect-backend`. It checks: Backend selection happens automatically via ~detect-backend~. It checks:
1. Is stdout a TTY? (if not → simple-backend) 1. Is stdout a TTY? (if not → simple-backend)
2. Does `COLORTERM` contain "truecolor" or "24bit"? 2. Does ~COLORTERM~ contain "truecolor" or "24bit"?
3. Send DA1 query — does the terminal respond with modern feature codes? 3. Send DA1 query — does the terminal respond with modern feature codes?
Result is cached in `*detected-backend*`. Result is cached in ~*detected-backend*~.
## Development * Development
```bash #+BEGIN_SRC bash
# Run all tests (483 checks, 13 suites) # Run all tests (483 checks, 13 suites)
sbcl --script run-all-tests.lisp sbcl --script run-all-tests.lisp
@@ -315,29 +316,29 @@ sbcl --script run-all-tests.lisp
sbcl --script demo.lisp sbcl --script demo.lisp
# Tangle org files (regenerate .lisp from .org sources) # Tangle org files (regenerate .lisp from .org sources)
python3 scripts/tangle.py org/*.org python3 ~/.hermes/skills/software-development/org-babel-tangle/scripts/tangle.py org/*.org
``` #+END_SRC
Literate programming: `.org` files in `org/` are the source of truth for Literate programming: ~.org~ files in ~org/~ are the source of truth for
the input system, scrollbox/tabbar, dialog, mouse, select, slot, the input system, scrollbox/tabbar, dialog, mouse, select, slot,
framebuffer, and markdown modules. The backend (`modern.lisp`, framebuffer, and markdown modules. The backend (~modern.lisp~,
`simple.lisp`) and basic components (`box.lisp`, `text.lisp`, `render.lisp`, ~simple.lisp~) and basic components (~box.lisp~, ~text.lisp~, ~render.lisp~,
`theme.lisp`, `dirty.lisp`) are written directly. ~theme.lisp~, ~dirty.lisp~) are written directly.
Project structure: Project structure:
``` #+BEGIN_EXAMPLE
cl-tty/ cl-tty/
├── cl-tty.asd # ASDF system definition ├── cl-tty.asd # ASDF system definition
├── demo.lisp # Interactive demo ├── demo.lisp # Interactive demo
├── run-all-tests.lisp # Test runner ├── run-all-tests.lisp # Test runner
├── backend/ # Backend protocol + implementations ├── src/backend/ # Backend protocol + implementations
│ ├── package.lisp │ ├── package.lisp
│ ├── classes.lisp # Generic definitions │ ├── classes.lisp # Generic definitions
│ ├── simple.lisp # ASCII fallback backend │ ├── simple.lisp # ASCII fallback backend
│ ├── modern.lisp # Truecolor escape backend │ ├── modern.lisp # Truecolor escape backend
│ └── detection.lisp # Auto-detect backend from env │ └── detection.lisp # Auto-detect backend from env
├── layout/ # Flexbox layout engine ├── src/layout/ # Flexbox layout engine
│ └── layout.lisp │ └── layout.lisp
├── src/ ├── src/
│ ├── rendering/ # Framebuffer backend + diff + flush │ ├── rendering/ # Framebuffer backend + diff + flush
@@ -369,8 +370,8 @@ cl-tty/
└── docs/ └── docs/
├── ROADMAP.org # Versioned roadmap ├── ROADMAP.org # Versioned roadmap
└── ARCHITECTURE.org # Design docs └── ARCHITECTURE.org # Design docs
``` #+END_EXAMPLE
## License * License
GNU General Public License v3.0 GNU General Public License v3.0

8
cl-tty.asd
View File

@@ -6,14 +6,14 @@
:license "GPL-3.0" :license "GPL-3.0"
:depends-on (:sb-posix) :depends-on (:sb-posix)
:components :components
((:module "backend" ((:module "src/backend"
:components :components
((:file "package") ((:file "package")
(:file "classes" :depends-on ("package")) (:file "classes" :depends-on ("package"))
(:file "simple" :depends-on ("package" "classes")) (:file "simple" :depends-on ("package" "classes"))
(:file "modern" :depends-on ("package" "classes")) (:file "modern" :depends-on ("package" "classes"))
(:file "detection" :depends-on ("package" "classes")))) (:file "detection" :depends-on ("package" "classes"))))
(:module "layout" (:module "src/layout"
:components :components
((:file "layout"))) ((:file "layout")))
(:module "src/rendering" (:module "src/rendering"
@@ -58,11 +58,11 @@
:description "Test suite for cl-tty" :description "Test suite for cl-tty"
:depends-on (:cl-tty :fiveam) :depends-on (:cl-tty :fiveam)
:components :components
((:module "backend" ((:module "src/backend"
:components :components
((:file "tests") ((:file "tests")
(:file "modern-tests" :depends-on ("tests")))) (:file "modern-tests" :depends-on ("tests"))))
(:module "layout" (:module "src/layout"
:components :components
((:file "tests"))) ((:file "tests")))
(:module "src/components" (:module "src/components"

94
debug-layout.lisp
View File

@@ -1,94 +0,0 @@
(load "~/quicklisp/setup.lisp")
(ql:quickload :cl-tty :silent t)
(in-package :cl-tty.layout)
(defun trace-layout (root aw ah)
"Run compute-layout with detailed traces"
(labels ((p (node x y max-w max-h depth)
(let* ((children (layout-node-children node))
(is-row (eql (layout-node-direction node) :row))
(pl (box-edge (layout-node-padding node) :left))
(pt (box-edge (layout-node-padding node) :top))
(pr (box-edge (layout-node-padding node) :right))
(pb (box-edge (layout-node-padding node) :bottom))
(cw (max 0 (- max-w pl pr)))
(ch (max 0 (- max-h pt pb)))
(gap (layout-node-gap node))
(sizes (distribute-sizes children (if is-row cw ch) gap is-row)))
(format t "~v,0Tp~A: xy=~A,~A mw=~A mh=~A pl=~A pt=~A cw=~A ch=~A gap=~A sizes=~A~%"
(* depth 2) (if is-row 'ROW 'COL)
x y max-w max-h pl pt cw ch gap sizes)
(setf (layout-node-x node) (+ x pl)
(layout-node-y node) (+ y pt))
(loop :with pos = 0
:for child :in children
:for size :in sizes
:for i :from 0
:do (if is-row
(setf (layout-node-width child) size
(layout-node-x child) (+ x pl pos)
(layout-node-height child) ch
(layout-node-y child) (+ y pt))
(setf (layout-node-height child) size
(layout-node-y child) (+ y pt pos)
(layout-node-width child) cw
(layout-node-x child) (+ x pl)))
(format t "~v,0T~A#~D: placed pos=~A size=~A xy=~A,~A wh=~A,~A~%"
(* (1+ depth) 2) (if is-row 'H 'V) i pos size
(layout-node-x child) (layout-node-y child)
(layout-node-width child) (layout-node-height child))
(p child
(layout-node-x child) (layout-node-y child)
(if is-row size cw) (if is-row ch size)
(1+ depth))
(incf pos (+ size gap)))
(let ((last-child (car (last children))))
(if is-row
(setf (layout-node-width node)
(or (layout-node-fixed-width node)
(if last-child
(+ (layout-node-x node)
(layout-node-width last-child)
pr)
max-w))
(layout-node-height node)
max-h)
(setf (layout-node-height node)
(or (layout-node-fixed-height node)
(if last-child
(let ((last-y (layout-node-y last-child))
(last-h (layout-node-height last-child)))
(+ last-y last-h pb))
max-h))
(layout-node-width node)
max-w))
(format t "~v,0Tresult: node wh=~A,~A (fixed-w=~A fixed-h=~A)~%"
(* depth 2)
(layout-node-width node) (layout-node-height node)
(layout-node-fixed-width node) (layout-node-fixed-height node))))))
(p root 0 0 aw ah 0)
root))
(format t "~%=== 1. SINGLE-CHILD-IN-COLUMN ===~%~%")
(let* ((r (make-layout-node :direction :column :width 10 :height 20))
(c (make-layout-node :height 5)))
(layout-node-add-child r c)
(trace-layout r 10 20)
(format t "~%child final: x=~A (exp 0) y=~A (exp 0) w=~A h=~A (exp 5)~%~%"
(layout-node-x c) (layout-node-y c) (layout-node-width c) (layout-node-height c)))
(format t "=== 2. PADDING-REDUCES-CONTENT-AREA ===~%~%")
(let* ((r (make-layout-node :direction :column :padding '(:top 1 :left 1 :bottom 1 :right 1)))
(c (make-layout-node :height 3)))
(layout-node-add-child r c)
(trace-layout r 20 10)
(format t "~%child final: x=~A (exp 1) y=~A (exp 1)~%~%"
(layout-node-x c) (layout-node-y c)))
(format t "=== 3. FLEX-GROW-SINGLE-CHILD ===~%~%")
(let* ((root (make-layout-node :direction :row :width 20))
(c (make-layout-node :width 5 :grow 1)))
(layout-node-add-child root c)
(trace-layout root 20 10)
(format t "~%child final: w=~A (exp 20)~%~%"
(layout-node-width c)))

191
demo.lisp
View File

@@ -7,11 +7,16 @@
(push (truename ".") asdf:*central-registry*) (push (truename ".") asdf:*central-registry*)
(asdf:load-system :cl-tty) (asdf:load-system :cl-tty)
(use-package :cl-tty.backend) ;; Symbols use explicit package prefixes to avoid read-event
(use-package :cl-tty.input) ;; conflict between cl-tty.backend and cl-tty.input.
(use-package :cl-tty.box)
(use-package :cl-tty.layout) ;; Short aliases for readability
(use-package :cl-tty.rendering) (import '(cl-tty.input:make-text-input
cl-tty.input:text-input-value
cl-tty.input:handle-text-input
cl-tty.input:make-textarea
cl-tty.input:textarea-lines
cl-tty.input:handle-textarea-input))
;;; ─── Application state ─────────────────────────────────────────────────────── ;;; ─── Application state ───────────────────────────────────────────────────────
@@ -39,120 +44,148 @@
(defun render-tab-home (backend x y w h) (defun render-tab-home (backend x y w h)
"Welcome screen with version info." "Welcome screen with version info."
(declare (ignore h)) (declare (ignore h))
(draw-border backend x y w 18 :style :double :title " Welcome ") (cl-tty.backend:draw-border backend x y w 18 :style :double :title " Welcome ")
(draw-text backend (+ x 2) (+ y 2) "cl-tty — Pure CL Terminal UI Framework" :bright-white nil :bold t) (cl-tty.backend:draw-text backend (+ x 2) (+ y 2)
(draw-text backend (+ x 2) (+ y 4) " components: Box, Text, TextInput, TextArea, Select," nil nil) "cl-tty — Pure CL Terminal UI Framework" :bright-white nil :bold t)
(draw-text backend (+ x 2) (+ y 5) " ScrollBox, TabBar, Dialog, Toast, Markdown" nil nil) (cl-tty.backend:draw-text backend (+ x 2) (+ y 4)
(draw-text backend (+ x 2) (+ y 6) " features: 24-bit truecolor, OSC 8 links, SGR mouse," nil nil) " components: Box, Text, TextInput, TextArea, Select," nil nil)
(draw-text backend (+ x 2) (+ y 7) " DECICM sync, kitty keyboard, framebuffer" nil nil) (cl-tty.backend:draw-text backend (+ x 2) (+ y 5)
(draw-text backend (+ x 2) (+ y 8) " backend: modern-backend | simple-backend (pipe-safe)" nil nil) " ScrollBox, TabBar, Dialog, Toast, Markdown" nil nil)
(draw-text backend (+ x 2) (+ y 9) " tests: 392, 100% passing" :green nil :bold t) (cl-tty.backend:draw-text backend (+ x 2) (+ y 6)
(draw-text backend (+ x 2) (+ y 10) " deps: zero FFI, zero ncurses, pure CL" :bright-cyan nil) " features: 24-bit truecolor, OSC 8 links, SGR mouse," nil nil)
(draw-text backend (+ x 2) (+ y 12) "Controls" :bright-white nil :bold t) (cl-tty.backend:draw-text backend (+ x 2) (+ y 7)
(draw-text backend (+ x 2) (+ y 13) " Tab / arrows switch tabs" nil nil) " DECICM sync, kitty keyboard, framebuffer" nil nil)
(draw-text backend (+ x 2) (+ y 14) " Ctrl+C / Esc quit" nil nil) (cl-tty.backend:draw-text backend (+ x 2) (+ y 8)
(draw-text backend (+ x 2) (+ y 15) " mouse click/drag select text (test SGR mouse)" nil nil)) " backend: modern-backend | simple-backend (pipe-safe)" nil nil)
(cl-tty.backend:draw-text backend (+ x 2) (+ y 9)
" tests: 483, 100% passing" :green nil :bold t)
(cl-tty.backend:draw-text backend (+ x 2) (+ y 10)
" deps: zero FFI, zero ncurses, pure CL" :bright-cyan nil)
(cl-tty.backend:draw-text backend (+ x 2) (+ y 12)
"Controls" :bright-white nil :bold t)
(cl-tty.backend:draw-text backend (+ x 2) (+ y 13)
" Tab / arrows switch tabs" nil nil)
(cl-tty.backend:draw-text backend (+ x 2) (+ y 14)
" Ctrl+C / Esc quit" nil nil)
(cl-tty.backend:draw-text backend (+ x 2) (+ y 15)
" mouse click/drag select text (test SGR mouse)" nil nil))
(defun render-tab-widgets (backend x y w h input ta) (defun render-tab-widgets (backend x y w h input ta)
"Interactive widget demo." "Interactive widget demo."
(declare (ignore h)) (declare (ignore h))
(draw-border backend x y w 12 :style :single :title " Text Input ") (cl-tty.backend:draw-border backend x y w 12 :style :single :title " Text Input ")
(let ((val (text-input-value input))) (let ((val (text-input-value input)))
(draw-text backend (+ x 2) (+ y 1) "Value: " :text-muted nil) (cl-tty.backend:draw-text backend (+ x 2) (+ y 1) "Value: " :text-muted nil)
(draw-text backend (+ x 10) (+ y 1) (if (plusp (length val)) val "(empty)") :text nil)) (cl-tty.backend:draw-text backend (+ x 10) (+ y 1)
(draw-text backend (+ x 2) (+ y 3) "Placeholder: \"Type here...\"" :text-muted nil) (if (plusp (length val)) val "(empty)") :text nil))
(draw-text backend (+ x 2) (+ y 5) "Keys: type to insert, arrows to move," nil nil) (cl-tty.backend:draw-text backend (+ x 2) (+ y 3)
(draw-text backend (+ x 2) (+ y 6) "Enter to submit, Backspace to delete," nil nil) "Placeholder: \"Type here...\"" :text-muted nil)
(draw-text backend (+ x 2) (+ y 7) "Ctrl+A/E for home/end" nil nil) (cl-tty.backend:draw-text backend (+ x 2) (+ y 5)
"Keys: type to insert, arrows to move," nil nil)
(cl-tty.backend:draw-text backend (+ x 2) (+ y 6)
"Enter to submit, Backspace to delete," nil nil)
(cl-tty.backend:draw-text backend (+ x 2) (+ y 7)
"Ctrl+A/E for home/end" nil nil)
(when (plusp (length (text-input-value input))) (when (plusp (length (text-input-value input)))
(draw-text backend (+ x 2) (+ y 9) (format nil "Submitted: ~a" (text-input-value input)) :accent nil)) (cl-tty.backend:draw-text backend (+ x 2) (+ y 9)
(format nil "Submitted: ~a" (text-input-value input)) :accent nil))
(let ((y2 (+ y 13))) (let ((y2 (+ y 13)))
(draw-border backend x y2 w 10 :style :single :title " TextArea ") (cl-tty.backend:draw-border backend x y2 w 10 :style :single :title " TextArea ")
(draw-text backend (+ x 2) (+ y2 1) "Value:" :text-muted nil) (cl-tty.backend:draw-text backend (+ x 2) (+ y2 1) "Value:" :text-muted nil)
(let ((lines (textarea-lines ta))) (let ((lines (textarea-lines ta)))
(loop for line in lines (loop for line in lines
for row from 0 below (min (length lines) 6) for row from 0 below (min (length lines) 6)
do (draw-text backend (+ x 2) (+ y2 2 row) do (cl-tty.backend:draw-text backend (+ x 2) (+ y2 2 row)
(subseq (or line "") 0 (min (length line) (- w 4))) nil nil))))) (subseq (or line "") 0 (min (length line) (- w 4))) nil nil)))))
(defun render-tab-console (backend x y w h) (defun render-tab-console (backend x y w h)
"Event log / debug console." "Event log / debug console."
(draw-border backend x y w h :style :single :title " Event Log ") (cl-tty.backend:draw-border backend x y w h :style :single :title " Event Log ")
(draw-text backend (+ x 2) (+ y 1) "Last 50 keyboard and mouse events:" :text-muted nil) (cl-tty.backend:draw-text backend (+ x 2) (+ y 1)
"Last 50 keyboard and mouse events:" :text-muted nil)
(let ((lines *log*) (let ((lines *log*)
(max-rows (- h 3))) (max-rows (- h 3)))
(loop for line in (subseq lines 0 (min (length lines) max-rows)) (loop for line in (subseq lines 0 (min (length lines) max-rows))
for row from 0 below max-rows for row from 0 below max-rows
do (draw-text backend (+ x 2) (+ y 3 row) do (cl-tty.backend:draw-text backend (+ x 2) (+ y 3 row)
(subseq (or line "") 0 (min (length line) (- w 4))) nil nil)))) (subseq (or line "") 0 (min (length line) (- w 4))) nil nil))))
;;; ─── Main loop ────────────────────────────────────────────────────────────── ;;; ─── Main loop ──────────────────────────────────────────────────────────────
(defun handle-event (event) (defun handle-event (event)
"Process a key-event or mouse-event, returning t if consumed." "Process a key-event or mouse-event, returning t if consumed."
(typecase event (typecase event
(key-event (cl-tty.input:key-event
(let ((key (key-event-key event)) (let ((key (cl-tty.input:key-event-key event))
(ctrl (key-event-ctrl event))) (ctrl (cl-tty.input:key-event-ctrl event)))
(log-append "Key: ~a (ctrl=~a alt=~a shift=~a)" key ctrl (key-event-alt event) (key-event-shift event)) (log-append "Key: ~a (ctrl=~a alt=~a shift=~a)" key ctrl
(cl-tty.input:key-event-alt event)
(cl-tty.input:key-event-shift event))
(cond (cond
((or (and ctrl (eql key :|C|)) (eql key :escape)) ((or (and ctrl (eql key :|C|)) (eql key :escape))
(setf (getf *app* :running) nil) t) (setf (getf *app* :running) nil) t)
((eql key :tab) ((eql key :tab)
(incf (getf *app* :tab)) (incf (getf *app* :tab))
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t) (when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
;; Only arrow keys switch tabs when NOT on the Widgets tab. ;; Only arrow keys switch tabs when NOT on the Widgets tab.
;; On the Widgets tab (tab=1), Left/Right are forwarded to widgets ;; On the Widgets tab (tab=1), Left/Right are forwarded to widgets
;; for cursor navigation in text inputs. ;; for cursor navigation in text inputs.
((and (not (= (getf *app* :tab) 1)) ((and (not (= (getf *app* :tab) 1))
(eql key :left)) (eql key :left))
(decf (getf *app* :tab)) (decf (getf *app* :tab))
(when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t) (when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t)
((and (not (= (getf *app* :tab) 1)) ((and (not (= (getf *app* :tab) 1))
(eql key :right)) (eql key :right))
(incf (getf *app* :tab)) (incf (getf *app* :tab))
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t) (when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
;; Forward key to widgets only when on the Widgets tab ;; Forward key to widgets only when on the Widgets tab
(t (when (= (getf *app* :tab) 1) (t (when (= (getf *app* :tab) 1)
(handle-text-input (getf *app* :input) event) (handle-text-input (getf *app* :input) event)
(handle-textarea-input (getf *app* :textarea) event)) (handle-textarea-input (getf *app* :textarea) event))
t)))) t))))
(mouse-event (cl-tty.input:mouse-event
(log-append "Mouse: ~a btn=~a pos=(~d,~d)" (mouse-event-type event) (log-append "Mouse: ~a btn=~a pos=(~d,~d)"
(mouse-event-button event) (mouse-event-x event) (mouse-event-y event)) (cl-tty.input:mouse-event-type event)
(setf (getf *app* :mouse-x) (mouse-event-x event) (cl-tty.input:mouse-event-button event)
(getf *app* :mouse-y) (mouse-event-y event)) (cl-tty.input:mouse-event-x event)
(cl-tty.input:mouse-event-y event))
(setf (getf *app* :mouse-x) (cl-tty.input:mouse-event-x event)
(getf *app* :mouse-y) (cl-tty.input:mouse-event-y event))
t))) t)))
(defun run-demo () (defun run-demo ()
"Run the demo. Raw terminal mode should already be set by the "Run the demo. Raw terminal mode should already be set by the
./demo.sh shell wrapper." ./demo.sh shell wrapper."
(init-app-state) (init-app-state)
(let* ((backend (detect-backend)) (let* ((backend (cl-tty.backend:detect-backend))
(w (multiple-value-bind (cols rows) (backend-size backend) (w (multiple-value-bind (cols rows) (cl-tty.backend:backend-size backend)
(declare (ignore rows)) (declare (ignore rows))
cols)) cols))
(h (multiple-value-bind (cols rows) (backend-size backend) (h (multiple-value-bind (cols rows) (cl-tty.backend:backend-size backend)
(declare (ignore cols)) (declare (ignore cols))
rows))) rows)))
(initialize-backend backend) (cl-tty.backend:initialize-backend backend)
(unwind-protect (unwind-protect
(loop while (getf *app* :running) (loop while (getf *app* :running)
do do
(backend-clear backend) (cl-tty.backend:backend-clear backend)
;; Title bar ;; Title bar
(draw-border backend 2 1 (- w 4) 3 :style :double :title " cl-tty v0.15.0 ") (cl-tty.backend:draw-border backend 2 1 (- w 4) 3
(draw-text backend 4 2 "arrows/tab: tabs type: test input mouse: test SGR Esc/Ctrl+C: quit" :style :double :title " cl-tty v0.15.0 ")
:bright-white nil) (cl-tty.backend:draw-text backend 4 2
"arrows/tab: tabs type: test input mouse: test SGR Esc/Ctrl+C: quit"
:bright-white nil)
;; Tab bar ;; Tab bar
(loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2)) (loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2))
for x-pos = 4 then (+ x-pos label-len 2) for x-pos = 4 then (+ x-pos label-len 2)
for label-len = (length label) for label-len = (length label)
do (let ((active (eql idx (getf *app* :tab)))) do (let ((active (eql idx (getf *app* :tab))))
(if active (if active
(draw-text backend x-pos 4 label :bright-white :accent :bold t) (cl-tty.backend:draw-text backend x-pos 4 label
(draw-text backend x-pos 4 label :text-muted nil)))) :bright-white :accent :bold t)
(cl-tty.backend:draw-text backend x-pos 4 label
:text-muted nil))))
;; Content area ;; Content area
(case (getf *app* :tab) (case (getf *app* :tab)
(0 (render-tab-home backend 4 6 (- w 4) (- h 8))) (0 (render-tab-home backend 4 6 (- w 4) (- h 8)))
@@ -164,20 +197,20 @@
(let ((mx (getf *app* :mouse-x)) (let ((mx (getf *app* :mouse-x))
(my (getf *app* :mouse-y))) (my (getf *app* :mouse-y)))
(when (and (>= mx 0) (>= my 0)) (when (and (>= mx 0) (>= my 0))
(draw-text backend mx my "@" :bright-cyan nil))) (cl-tty.backend:draw-text backend mx my "@" :bright-cyan nil)))
;; Status bar ;; Status bar
(draw-rect backend 2 (- h 2) (- w 4) 1 :bg :blue) (cl-tty.backend:draw-rect backend 2 (- h 2) (- w 4) 1 :bg :blue)
(draw-text backend 4 (- h 2) (cl-tty.backend:draw-text backend 4 (- h 2)
(format nil " Tab ~d/3 | ~d events " (format nil " Tab ~d/3 | ~d events "
(1+ (getf *app* :tab)) (length *log*)) (1+ (getf *app* :tab)) (length *log*))
:bright-white :blue :bold t) :bright-white :blue :bold t)
(finish-output *standard-output*) (finish-output *standard-output*)
;; Read event — blocks until a key or mouse event arrives ;; Read event — blocks until a key or mouse event arrives
(let ((event (read-event backend))) (let ((event (cl-tty.input:read-event backend)))
(cond (cond
((eq event :eof) (setf (getf *app* :running) nil)) ((eq event :eof) (setf (getf *app* :running) nil))
(event (handle-event event))))) (event (handle-event event)))))
(shutdown-backend backend)))) (cl-tty.backend:shutdown-backend backend))))
(run-demo) (run-demo)
(uiop:quit 0) (uiop:quit 0)

91
docs/ARCHITECTURE.org
View File

@@ -265,46 +265,89 @@ reads terminal background color at startup.
#+BEGIN_SRC #+BEGIN_SRC
cl-tty/ cl-tty/
├── cl-tty.asd ├── cl-tty.asd # ASDF system (main + test)
├── cl-tty-tests.asd
├── README.org ├── README.org
├── LICENSE ├── LICENSE
├── .gitignore
├── demo.lisp # Interactive demo
├── demo.sh # PTY launcher for demo
├── run-all-tests.lisp # Test runner
├── docs/ ├── docs/
│ ├── ROADMAP.org │ ├── ROADMAP.org
│ └── ARCHITECTURE.org ← this file │ └── ARCHITECTURE.org ← this file
├── org/ # Literate source files
│ ├── backend-protocol.org
│ ├── box-renderable.org
│ ├── detection.org
│ ├── dialog.org
│ ├── framebuffer.org
│ ├── layout-engine.org
│ ├── markdown-renderer.org
│ ├── modern-backend.org
│ ├── mouse.org
│ ├── scrollbox-tabbar.org
│ ├── select.org
│ ├── slot.org
│ └── text-input.org
├── src/ ├── src/
│ ├── package.lisp
│ ├── backend/ │ ├── backend/
│ │ ├── protocol.lisp │ │ ├── package.lisp
│ │ ├── detection.lisp │ │ ├── classes.lisp
│ │ ├── simple.lisp │ │ ├── simple.lisp
│ │ └── modern.lisp │ │ ├── modern.lisp
│ │ └── detection.lisp
│ ├── layout/ │ ├── layout/
│ │ ├── nodes.lisp │ │ └── layout.lisp
│ │ ├── solver.lisp
│ │ └── api.lisp
│ ├── components/ │ ├── components/
│ │ ├── base.lisp │ │ ├── package.lisp
│ │ ├── box.lisp │ │ ├── box.lisp
│ │ └── text.lisp │ │ ├── text.lisp
│ ├── rendering/ │ │ ├── render.lisp
│ │ ├── pipeline.lisp │ │ ├── theme.lisp
│ │ ├── dirty.lisp │ │ ├── dirty.lisp
│ │ └── diff.lisp │ │ ├── input-package.lisp
│ └── theme/ │ │ ├── input.lisp
│ ├── tokens.lisp │ │ ├── text-input.lisp
│ └── presets.lisp │ │ ├── textarea.lisp
└── tests/ │ │ ├── keybindings.lisp
├── package.lisp │ │ ├── container-package.lisp
├── backend.lisp │ │ ├── scrollbox.lisp
├── layout.lisp │ │ ├── tabbar.lisp
└── components.lisp │ │ ├── select-package.lisp
│ │ ├── select.lisp
│ │ ├── markdown-package.lisp
│ │ ├── markdown.lisp
│ │ ├── dialog-package.lisp
│ │ ├── dialog.lisp
│ │ ├── mouse-package.lisp
│ │ ├── mouse.lisp
│ │ ├── slot-package.lisp
│ │ └── slot.lisp
│ └── rendering/
│ └── framebuffer.lisp
├── tests/
│ ├── input-tests.lisp
│ ├── scrollbox-tabbar-tests.lisp
│ ├── select-tests.lisp
│ ├── markdown-tests.lisp
│ ├── dialog-tests.lisp
│ ├── mouse-tests.lisp
│ ├── slot-tests.lisp
│ ├── framebuffer-tests.lisp
│ └── integration-tests.lisp
└── scripts/
├── binary-search.lisp
├── code-audit.lisp
├── audit-compiler.lisp
├── find-t-form.lisp
├── find-t-warning.lisp
└── verify-api.py
#+END_SRC #+END_SRC
** Dependency Graph ** Dependency Graph
backend/ (no deps) src/backend/ (no deps)
layout/ (no deps — pure math) src/layout/ (no deps — pure math)
theme/ (backend for color resolution) theme/ (backend for color resolution)
components/ (layout, theme, rendering) components/ (layout, theme, rendering)
rendering/ (layout, components, backend, theme) rendering/ (layout, components, backend, theme)

2
docs/BUG-REPORT.md
View File

@@ -78,7 +78,7 @@ The warning fires during the `defmethod read-event` compilation unit but the exa
## Bug 6 [LOW]: %simple-border-char ignores edge-style ## Bug 6 [LOW]: %simple-border-char ignores edge-style
**File:** backend/simple.lisp, lines 33-40 **File:** src/backend/simple.lisp, lines 33-40
```lisp ```lisp
(defun %simple-border-char (edge-style pos) (defun %simple-border-char (edge-style pos)

49
docs/ROADMAP.org
View File

@@ -142,7 +142,49 @@ DONE. Enhance mouse support with drag-to-select and link clicking.
- Copy-to-clipboard via xclip/wl-copy/pbcopy - Copy-to-clipboard via xclip/wl-copy/pbcopy
- ~80 lines - ~80 lines
** v1.0.0: Release ** v0.15.0: Bug fixes, demo rewrite, verification, tangle tooling
DONE. Demo rewrite with interactive tabs, critical bug fixes, and
quality-of-life infrastructure.
- Demo (demo.lisp): full rewrite with Console, Components, Layout,
Events tabs — tab navigation, scrollbox with hot-reload, layout
visualization with live row/column swapping, event logging panel
- Demo uses backend-size instead of hardcoded 80x24
- Box title rendering: modern and simple backends now render titles
with title and title-align parameters
- Cursor rendering: text-input cursor renders as solid block at
cursor position
- Arrow key fix: demo arrow keys on Widgets tab no longer steal
focus from tab bar
- read-raw-byte buffer fix: sb-sys:with-pinned-objects + vector-sap
for proper sb-posix:read buffer (SBCL type error with plain arrays)
- EOF detection: read-raw-byte returns (values nil :eof) on stdin
EOF, not nil — prevents 100% CPU busy-spin on pipes
- Escape key: 50ms timeout in read-escape-sequence to disambiguate
lone Escape from escape-prefixed sequences
- confirm-dialog: fix option plist comparison (was comparing
objects, not keys)
- mouse-event: button slot type changed from keyword to (or keyword
null)
- tangle tooling: replace Emacs org-babel-tangle with pure-Python
script (scripts/tangle.py, later moved to Hermes skill)
- Verification: verify-api.py (API smoke tests), verify-demo-pty.py
(PTY-based demo verification — 17 checks)
- tangle.py fix: write-once-then-append logic (was always-appending,
triplicating files)
- Org/Lisp sync: verified — 483+57+17 checks pass on fresh tangle
- Project restructure: move backend/ and layout/ into src/
- .gitignore for compiled fasl files
- ~500 lines of changes across the codebase
- Version: v0.15.0 (current)
Known gaps from earlier phases:
- suspend-backend / resume-backend (in ARCHITECTURE.org protocol
spec but never implemented)
- Slot modes (defslot :mode parameter planned but not implemented)
** v1.0.0: Release (target — not yet released)
All phases integrated and tested. Applications can build rich terminal UIs All phases integrated and tested. Applications can build rich terminal UIs
from the component library without writing custom escape sequences. from the component library without writing custom escape sequences.
@@ -158,6 +200,8 @@ Checklist:
- [X] Rendering pipeline (v0.13.0) - [X] Rendering pipeline (v0.13.0)
- [X] Mouse improvements (v0.14.0) - [X] Mouse improvements (v0.14.0)
- [X] Org/Lisp sync verified (first tangle produces no regressions) - [X] Org/Lisp sync verified (first tangle produces no regressions)
- [ ] Suspend/resume-backend protocol methods (ARCHITECTURE.org spec)
- [ ] Slot modes (defslot :mode parameter)
** Feature Reference ** Feature Reference
@@ -177,5 +221,6 @@ Checklist:
| 10 | Terminal capability detection | ~100 | v0.12.0 | DONE | | 10 | Terminal capability detection | ~100 | v0.12.0 | DONE |
| 11 | Rendering pipeline (framebuffer diff) | ~250 | v0.13.0 | DONE | | 11 | Rendering pipeline (framebuffer diff) | ~250 | v0.13.0 | DONE |
| 12 | Mouse improvements (selection, links) | ~80 | v0.14.0 | DONE | | 12 | Mouse improvements (selection, links) | ~80 | v0.14.0 | DONE |
| 13 | Bug fixes, demo rewrite, verification | ~500 | v0.15.0 | DONE |
|-------+----------------------------------------+--------+---------|--------| |-------+----------------------------------------+--------+---------|--------|
| | Total | ~2800 | | | | | Total | ~5760 | | |

253
docs/plans/2026-05-11-rendering-pipeline.md
View File

@@ -1,253 +0,0 @@
# Rendering Pipeline — Implementation Plan
> **For Hermes:** Implement this plan task-by-task.
**Goal:** Add a framebuffer-based rendering pipeline that sits between the component tree and the backend. Eliminates flicker via incremental diff output. Enables future features (mouse text selection, click-to-open-link).
**Architecture:** A `framebuffer-backend` class that implements the backend protocol by writing to a cell array instead of emitting escape sequences. After all components render, a diff function compares the current framebuffer to the previous one and flushes only changed cells to a real backend.
**Tech Stack:** Pure CL, CLOS protocol (inherits the existing backend protocol).
---
### Task 1: Create framebuffer.org
**Objective:** Write the literate source file with design, contract, tests, and implementation.
**Files:**
- Create: `org/framebuffer.org`
**Structure:**
```
#+TITLE: Rendering Pipeline (v0.13.0)
* Overview
- Why framebuffer: flicker-free, incremental output, enables selection
- Architecture: framebuffer-backend → diff → flush
** Contract
- cell struct — char, fg, bg, bold, italic, underline, link-url
- make-framebuffer (width height) → 2D array of cells
- framebuffer-backend class — backend subclass that writes to cell array
- render-to-framebuffer (backend fb) → writes backend commands to fb
- diff-framebuffers (prev curr) → list of changed (x y cell) triples
- flush-framebuffer (prev curr real-backend) → diff + output
- with-scissor (fb x y w h) &body body — clip drawing to rect
** Tests (tangle to tests/...)
** Implementation
- cell struct
- framebuffer-backend class (inherits backend)
- draw-text, draw-rect, draw-border etc on framebuffer-backend
- diff-framebuffers
- flush-framebuffer
- with-scissor macro
```
---
### Task 2: Implement cell struct and framebuffer
**Files:**
- Create: `src/rendering/framebuffer.lisp`
**Code:**
```lisp
(defpackage :cl-tty.rendering
(:use :cl :cl-tty.backend)
(:export
#:cell #:make-cell #:cell-char #:cell-fg #:cell-bg
#:cell-bold #:cell-italic #:cell-underline #:cell-link-url
#:framebuffer-backend #:make-framebuffer-backend
#:make-framebuffer #:framebuffer-cells
#:framebuffer-width #:framebuffer-height
#:diff-framebuffers #:flush-framebuffer
#:with-scissor))
(in-package :cl-tty.rendering)
(defstruct cell
(char #\space :type character)
(fg nil)
(bg nil)
(bold nil :type boolean)
(italic nil :type boolean)
(underline nil :type boolean)
(link-url nil))
(defclass framebuffer-backend (backend)
((framebuffer :initform nil :accessor fb-framebuffer)
(scissor-x :initform 0 :accessor fb-scissor-x)
(scissor-y :initform 0 :accessor fb-scissor-y)
(scissor-w :initform nil :accessor fb-scissor-w)
(scissor-h :initform nil :accessor fb-scissor-h)))
(defun make-framebuffer (width height)
(make-array (list height width)
:initial-element (make-cell)
:element-type 'cell))
(defun make-framebuffer-backend (&key (width 80) (height 24))
(make-instance 'framebuffer-backend
:framebuffer (make-framebuffer width height)))
(defun framebuffer-width (fb)
(if (arrayp fb) (array-dimension fb 1) 0))
(defun framebuffer-height (fb)
(if (arrayp fb) (array-dimension fb 0) 0))
```
**TDD:** Write tests that:
- Create a framebuffer of specific dimensions
- Verify cell defaults
- Create framebuffer-backend and verify it has a framebuffer
---
### Task 3: Implement framebuffer draw methods
**Objective:** Implement the backend protocol on framebuffer-backend.
**Files:**
- Modify: `src/rendering/framebuffer.lisp`
**Key method — draw-text:**
```lisp
(defmethod draw-text ((fb framebuffer-backend) x y string fg bg &rest attrs)
(let ((cells (fb-framebuffer fb))
(sx (fb-scissor-x fb)) (sy (fb-scissor-y fb))
(sw (fb-scissor-w fb)) (sh (fb-scissor-h fb)))
(loop for i from 0 below (length string)
for cx = (+ x i)
for cy = y
when (and (or (null sw) (and (>= cx sx) (< cx (+ sx sw))))
(or (null sh) (and (>= cy sy) (< cy (+ sy sh))))
(< cy (framebuffer-height cells))
(< cx (framebuffer-width cells)))
do (setf (aref cells cy cx)
(make-cell :char (char string i)
:fg fg :bg bg
:bold (getf attrs :bold)
:italic (getf attrs :italic)
:underline (getf attrs :underline)
:link-url (getf attrs :link-url))))))
```
Similar methods for draw-rect, draw-border, backend-clear.
---
### Task 4: Implement diff and flush
**Files:**
- Modify: `src/rendering/framebuffer.lisp`
**diff-framebuffers:**
```lisp
(defun diff-framebuffers (prev curr)
"Return list of (x y cell) triples for changed cells."
(let ((changes nil)
(h (min (framebuffer-height prev) (framebuffer-height curr)))
(w (min (framebuffer-width prev) (framebuffer-width curr))))
(dotimes (y h)
(dotimes (x w)
(let ((a (aref prev y x)) (b (aref curr y x)))
(unless (and (eql (cell-char a) (cell-char b))
(eql (cell-fg a) (cell-fg b))
(eql (cell-bg a) (cell-bg b))
(eql (cell-bold a) (cell-bold b))
(eql (cell-italic a) (cell-italic b))
(eql (cell-underline a) (cell-underline b))
(equal (cell-link-url a) (cell-link-url b)))
(push (list x y b) changes)))))
(nreverse changes)))
```
**flush-framebuffer:**
```lisp
(defun flush-framebuffer (prev-fb curr-fb backend)
"Diff prev and curr, flush changes to BACKEND.
Returns count of changed cells."
(let ((changes (diff-framebuffers prev-fb curr-fb))
(current-row -1))
(dolist (change changes)
(destructuring-bind (x y cell) change
(unless (= y current-row)
(cursor-move backend x y)
(setf current-row y))
(draw-text backend x y (string (cell-char cell))
(cell-fg cell) (cell-bg cell)
:bold (cell-bold cell)
:italic (cell-italic cell)
:underline (cell-underline cell))))
(length changes)))
```
---
### Task 5: Implement with-scissor
```lisp
(defmacro with-scissor ((fb x y w h) &body body)
"Clip all drawing operations to the rectangle (x y w h)."
(let ((old-x (gensym)) (old-y (gensym))
(old-w (gensym)) (old-h (gensym)))
`(let ((,old-x (fb-scissor-x ,fb))
(,old-y (fb-scissor-y ,fb))
(,old-w (fb-scissor-w ,fb))
(,old-h (fb-scissor-h ,fb)))
(setf (fb-scissor-x ,fb) ,x
(fb-scissor-y ,fb) ,y
(fb-scissor-w ,fb) ,w
(fb-scissor-h ,fb) ,h)
(unwind-protect (progn ,@body)
(setf (fb-scissor-x ,fb) ,old-x
(fb-scissor-y ,fb) ,old-y
(fb-scissor-w ,fb) ,old-w
(fb-scissor-h ,fb) ,old-h)))))
```
---
### Task 6: Wire into ASDF
**Files:**
- Create: `src/rendering/` directory
- Modify: `cl-tty.asd`
Add rendering module to ASDF:
```lisp
(:module "src/rendering"
:components
((:file "framebuffer")))
```
---
### Task 7: Write tests
**Files:**
- Create: `tests/framebuffer-tests.lisp`
Tests to write:
1. `make-framebuffer-creates-correct-size` — verify dimensions
2. `cell-defaults-are-space` — default cell has #\space char
3. `draw-text-on-fb-sets-cells` — verify text lands in right cells
4. `draw-text-clips-at-bounds` — text beyond width is ignored
5. `diff-identical-fbs-returns-empty` — no changes detected
6. `diff-changed-fb-returns-changes` — changed cells detected
7. `with-scissor-clips-drawing` — drawing outside scissor is ignored
8. `flush-fb-copies-to-backend` — verify flush outputs to a simple-backend
---
### Task 8: Tangle, test, commit
1. Tangle all org files
2. Run full test suite (verify ~368 tests pass)
3. Commit with message

207
docs/plans/2026-05-11-terminal-detection.md
View File

@@ -1,207 +0,0 @@
# Terminal Capability Detection — Implementation Plan
> **For Hermes:** Implement this plan task-by-task using subagent-driven-development.
**Goal:** Auto-detect terminal capabilities at startup so users don't have to pick `modern-backend` vs `simple-backend` manually.
**Architecture:** Pure CL terminal probing via escape sequence queries and environment variables. No external dependencies. Detection happens once at startup and returns a backend instance.
**Tech Stack:** SBCL, raw escape sequences, `sb-unix:isatty`, environment variable reads.
---
### Task 1: Create detection.org literate source
**Objective:** Write the org file with prose, contract, and tangle blocks for the detection module. No code generation yet — this is the design document.
**Files:**
- Create: `org/detection.org`
**Content structure:**
```
#+TITLE: Terminal Capability Detection (v0.12.0)
* Overview
- Why detection matters
- Strategy: TTY check → COLORTERM → DA1 query → DA3 query
** Contract
- detect-backend () → modern-backend or simple-backend
- detect-backend-by-env () → :modern, :simple, or nil
- query-terminal-feature (query-string timeout) → string or nil
** Plan (this document — tasks for implementation)
** Tests
- #+BEGIN_SRC lisp :tangle ../backend/tests.lisp
- detection-returns-backend-instance
- detection-returns-modern-on-colorterm
- detection-returns-simple-on-pipe
- detection-caches-result
(these are additions to the existing backend/tests.lisp)
** Implementation
- Package (adds to cl-tty.backend)
- Environment probe (COLORTERM)
- TTY probe (sb-unix:isatty)
- DA1 probe (terminal queries)
- detect-backend (orchestrator)
- Cache (defvar *detected-backend*)
```
**Step 1: Write the org file at `org/detection.org`** with the sections above, full prose, and empty code blocks.
**Step 2: Review** — verify structure matches existing .org files in the project.
**Step 3: Commit**
```bash
git add org/detection.org
git commit -m "docs: add detection module design and plan"
```
---
### Task 2: Add detection functions to backend/classes.lisp
**Objective:** Implement the environment and TTY probe functions.
**Files:**
- Modify: `backend/classes.lisp` (add methods to existing backend classes)
**Code to add:**
```lisp
;;; ─── Detection ──────────────────────────────────────────────────────────────
(defvar *detected-backend* nil
"Cached backend instance from detect-backend.")
(defun detect-backend-by-env ()
"Check COLORTERM environment variable for modern terminal support."
(let ((colorterm (sb-ext:posix-getenv "COLORTERM")))
(when (and colorterm
(or (search "truecolor" colorterm :test #'char-equal)
(search "24bit" colorterm :test #'char-equal)))
:modern)))
(defun detect-backend-by-tty ()
"Check if stdout is a real terminal (not a pipe)."
(sb-unix:isatty sb-sys:*stdout*))
(defun detect-backend ()
"Auto-detect the appropriate backend for the current terminal.
Returns a backend instance."
(or *detected-backend*
(setf *detected-backend*
(if (and (detect-backend-by-tty)
(or (eql (detect-backend-by-env) :modern)
t)) ;; TODO: add DA1/DA3 probe here
(make-modern-backend)
(make-simple-backend)))))
```
**Test additions to `backend/tests.lisp`:**
```lisp
(def-test detection-returns-backend-instance ()
(let ((be (cl-tty.backend:detect-backend)))
(is-true (typep be 'cl-tty.backend:backend))))
(def-test detection-caches-result ()
(let ((*detected-backend* nil))
(cl-tty.backend:detect-backend)
(is-true (not (null cl-tty.backend::*detected-backend*)))))
```
**Follow TDD:**
1. Write failing tests in `src/components/box-tests.lisp` (or wherever backend tests live — actually in `backend/tests.lisp`)
2. Run tests to verify failure
3. Write implementation code in `backend/classes.lisp`
4. Run tests to verify pass
5. Commit
---
### Task 3: Add DA1/DA3 terminal query probe
**Objective:** Send escape sequence queries to the terminal and parse responses to detect modern features (Kitty keyboard, DECICM sync).
**Files:**
- Modify: `backend/classes.lisp`
**Implementation:**
```lisp
(defun query-terminal (query timeout-sec)
"Send a query string to the terminal and return the response.
Returns nil if no response within TIMEOUT-SEC seconds."
(let ((response (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t)))
(format t "~A" query)
(force-output)
(sleep timeout-sec)
(loop while (listen)
do (vector-push-extend (read-char-no-hang) response))
(when (plusp (length response))
response)))
(defun detect-backend-by-da1 ()
"Send DA1 (Device Attributes) query and parse response for modern features."
(let ((response (query-terminal (format nil "~C[c" #\Esc) 0.1)))
(when response
;; Check for specific feature codes in response
(search "?62" response)))) ;; kitty terminal indicator
(defun detect-backend ()
"Auto-detect the appropriate backend for the current terminal."
(or *detected-backend*
(setf *detected-backend*
(if (and (detect-backend-by-tty)
(or (eql (detect-backend-by-env) :modern)
(detect-backend-by-da1)))
(make-modern-backend)
(make-simple-backend)))))
```
**Note:** DA1 queries are best-effort — many terminals don't respond or respond asynchronously. The env-var check is more reliable. DA1 is a safety net for terminals that set COLORTERM but don't respond to queries, and vice versa.
**Test for DA1 is hard to automate** (requires a real terminal). Add a manual test note.
---
### Task 4: Wire into ASDF and run full test suite
**Files:**
- Modify: `cl-tty.asd` (add detection.lisp if created as separate file, or verify existing)
- Run: `run-all-tests.lisp`
**Steps:**
1. Ensure `cl-tty.asd` includes the detection code (if in `backend/classes.lisp` it's already loaded)
2. Run full test suite: `sbcl --script run-all-tests.lisp`
3. Verify all 358+ tests pass (add 2 new detection tests → 360)
4. Commit
---
### Task 5: Update demo.lisp to use detection
**Objective:** Make `demo.lisp` use `detect-backend` instead of hardcoded `make-modern-backend`.
**Files:**
- Modify: `demo.lisp`
**Change:** Replace `(make-modern-backend)` with `(detect-backend)`.
**Verification:** `sbcl --script demo.lisp` should work in a terminal.
---
### Task 6: Tangle org → lisp and verify no regressions
**Files:** All
**Steps:**
1. Tangle all org files: `for f in org/*.org; do emacs --batch ...; done`
2. Run full test suite
3. Verify 0 regressions
4. Commit final

127
docs/plans/2026-05-11-v0.2.0-box-and-text.md
View File

@@ -1,127 +0,0 @@
# v0.2.0: Renderables — Box and Text
> Implementation plan for the first two renderable component types.
**Goal:** Create Box (border+background+title) and Text (styled wrapping text) renderables that render through the backend protocol.
**Architecture:** Each renderable is a CLOS class with a `layout-node` slot for positioning. The `render` method dispatches through the backend protocol (draw-text, draw-border, draw-rect). Tests capture backend output via string streams.
**Files created:**
- `org/box-renderable.org` — Box class, render method (literate source)
- `org/text-renderable.org` — Text class, render method, inline spans (literate source)
- `org/dirty-tracking.org` — Dirty flag system (literate source)
- `src/components/box.lisp` — tangled
- `src/components/text.lisp` — tangled
- `src/components/dirty.lisp` — tangled
**Files modified:**
- `cl-tty.asd` — add component modules
- `docs/ROADMAP.org` — mark v0.2.0 tasks DONE
## Task 1: Box renderable
**Objective:** Box class that draws borders, fills backgrounds, and renders titles.
**Files:**
- Create: `org/box-renderable.org`
- Create: `src/components/box.lisp` (extracted)
- Modify: `cl-tty.asd` — add components module
**Box class:**
```lisp
(defclass box ()
((layout-node :initarg :layout-node :accessor box-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)))
```
**render-box method:**
Renders at computed layout position using backend's draw-border, draw-rect, draw-text.
Delegates to the backend — no escape sequences directly.
**Tests:**
- Create box with border, verify draw-border was called with correct params
- Create box with title, verify title positioning
- Create box with background fill
- Edge cases: box with 0 width/height, no border style, very long title
## Task 2: Text renderable
**Objective:** Text class that renders strings at layout position with word-wrap.
**Files:**
- Create: `org/text-renderable.org`
- Create: `src/components/text.lisp` (extracted)
**Text class:**
```lisp
(defclass text ()
((layout-node :initarg :layout-node :accessor text-layout-node)
(content :initarg :content :accessor text-content)
(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)
(spans :initform nil :initarg :spans :accessor text-spans)))
```
**render-text method:**
1. Get layout position (x, y, width, height)
2. If wrap-mode is :none, truncate to width
3. If wrap-mode is :word, word-wrap (break on whitespace)
4. Draw each line via backend's draw-text
5. Apply span attributes (bold, italic, etc.) per segment
**Inline spans:**
```lisp
(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)))
```
**Tests:**
- Text renders string at correct position
- Word-wrap breaks at word boundaries
- Truncation mode clips at width
- Spans apply style attributes per segment
- Empty string rendering
- Single character
- String shorter than width (no wrapping needed)
## Task 3: Dirty tracking
**Objective:** Lightweight dirty-flag system for incremental rendering.
**Files:**
- Create: `org/dirty-tracking.org`
- Create: `src/components/dirty.lisp` (extracted)
```lisp
(defgeneric mark-dirty (component))
(defgeneric dirty-p (component))
(defgeneric mark-clean (component))
```
Default methods mark/check a `dirty` slot on the component. When implemented:
- `mark-dirty` — sets dirty flag, propagates to parent
- `dirty-p` — returns T if component needs re-render
- `mark-clean` — clears dirty flag after render
**Tests:**
- New component is dirty (default)
- mark-clean clears dirty flag
- dirty-p returns nil after mark-clean
- mark-dirty sets dirty flag again
## Task 4: Wire into ASDF + update roadmap
**Files:**
- Modify: `cl-tty.asd` — add `:module "components"` to both main and test systems
- Modify: `docs/ROADMAP.org` — mark v0.2.0 tasks DONE
**Run full test suite:**
All 72 existing tests + new component tests: 100% GREEN.

365
docs/plans/2026-05-11-v0.5.0-text-input.md
View File

@@ -1,365 +0,0 @@
# v0.5.0: Text Input + Keybinding System
**Architecture:** Three layers. First, terminal input infrastructure (raw mode, escape parsing, key events) — this is the missing piece the roadmap assumed croatoan would provide. Then TextInput and Textarea widgets. Finally, the layered keybinding system.
**The hidden dependency:** `read-event` is currently a no-op in both backends. We need raw terminal I/O (tcsetattr, non-canonical mode, escape sequence parsing) before any input widget works. SBCL provides `sb-posix` for POSIX terminal APIs.
**File structure:**
```
org/input.org — literate source: terminal input + key events
org/text-input.org — literate source: TextInput widget
org/textarea.org — literate source: Textarea widget
org/keybindings.org — literate source: keybinding system
backend/input.lisp — tangled: raw terminal, escape parser, key events
src/components/input.lisp — tangled: TextInput widget
src/components/textarea.lisp — tangled: Textarea widget
src/components/keybindings.lisp — tangled: keybinding system
```
---
### Task 1: Terminal Input Infrastructure
**Objective:** Raw terminal mode, ANSI escape sequence parser, key event types. Implements `read-event` for both backends.
**Files:**
- Create: `org/input.org`
- Create: `src/input.lisp` (tangled)
- Create: `tests/input-tests.lisp`
- Modify: `backend/package.lisp` — add input exports
- Modify: `backend/modern.lisp` — implement read-event
- Modify: `backend/simple.lisp` — implement read-event (stdin)
- Modify: `cl-tty.asd` — add input module to main and test systems
**Code architecture:**
```lisp
;; Key event type — all input gets normalized to this
(defstruct key-event
key ;; :a, :b, :space, :enter, :tab, :escape
;; :up, :down, :left, :right
;; :f1..:f12
ctrl ;; boolean
alt ;; boolean
shift ;; boolean
code ;; raw character code (fixnum)
raw ;; raw escape sequence string (for debugging)
text) ;; for bracketed paste: the pasted text string
(defstruct mouse-event
type ;; :press, :release, :drag
button ;; :left, :middle, :right, :none
x y
raw)
;; Terminal raw mode — saves/restores termios
(defun save-terminal-state () ...) ;; tcgetattr(0)
(defun set-raw-mode () ...) ;; tcsetattr(0, TCSANOW, raw)
(defun restore-terminal-state () ...)
(defmacro with-raw-terminal (&body body) ...)
;; Escape sequence parser
(defun read-byte-from-stdin (&optional timeout) ...)
(defun parse-escape-sequence () ...) ;; reads CSI, SS3 sequences
(defun parse-csi-sequence () ...) ;; parses CSI number;...$char
(defun parse-sgr-mouse () ...) ;; parse CSI < r;c;M/m
(defun read-event-from-stdin (&key timeout) ...) ;; full read+parse
;; Backend integration
(defmethod read-event ((b modern-backend) &key timeout)
(let ((event (read-event-from-stdin :timeout timeout)))
(if (key-event-p event)
(values (key-event-key event) event)
(values nil event))))
(defmethod read-event ((b simple-backend) &key timeout)
(read-event-from-stdin :timeout timeout))
```
**Key normalization table (partial):**
| Raw byte(s) | Key | Ctrl | Alt |
|---|---|---|---|
| #x1b | :escape | nil | nil |
| #x7f or #x08 | :backspace | nil | nil |
| #x0a | :enter | nil | nil |
| #x09 | :tab | nil | nil |
| #x01 | :a | t | nil |
| CSI A | :up | nil | nil |
| CSI 1~ | :home | nil | nil |
| CSI 200~ | (bracketed paste start) | — | — |
**Tests:**
```lisp
(test read-ctrl-a
(let* ((event (make-key-event :a :ctrl t)))
(is (eql (key-event-key event) :a))
(is-true (key-event-ctrl event))))
(test parse-csi-up
(let ((kb (terminal-sequence->key-event (format nil \"~C[A\" #\\Esc))))
(is (eql (key-event-key kb) :up))))
(test mouse-sgr
(let ((event (parse-sgr-mouse \"<0;10;5M\")))
(is (eql (mouse-event-type event) :press))
(is (eql (mouse-event-button event) :left))
(is (= (mouse-event-x event) 10))
(is (= (mouse-event-y event) 5))))
```
**Line count:** ~250 lines
---
### Task 2: TextInput Widget
**Objective:** Single-line text input widget with cursor, placeholder, insertion/deletion, clipboard, emacs keybindings.
**Files:**
- Create: `org/text-input.org`
- Create: `src/components/input.lisp`
- Modify: `src/components/package.lisp` — add exports
- Modify: `cl-tty.asd` — add input.lisp
**TextInput class:**
```lisp
(defclass text-input (dirty-mixin)
((value :initform "" :initarg :value :accessor text-input-value)
(cursor :initform 0 :initarg :cursor :accessor text-input-cursor)
(placeholder :initform "" :initarg :placeholder :accessor text-input-placeholder)
(max-length :initform nil :initarg :max-length :accessor text-input-max-length)
(on-submit :initform nil :initarg :on-submit :accessor text-input-on-submit)
(layout-node :initform (make-layout-node) :accessor text-input-layout-node)
(focusable :initform t :accessor text-input-focusable)))
```
**Methods:**
- `render-text-input` — renders value at cursor position, placeholder when empty, cursor
- `handle-input text-input key-event` — dispatches key events to editing actions:
- Left/Right → cursor-char-left/right
- Home → cursor-line-start
- End → cursor-line-end
- Backspace → delete-char-before
- Delete → delete-char-after
- Printable chars → insert-char
- Enter → on-submit callback
- Ctrl+W → delete-word-before
- Ctrl+U → delete-line-before
- Ctrl+K → delete-line-after
- Ctrl+A → cursor-line-start
- Ctrl+E → cursor-line-end
**Visual:**
```
┌──────────────────────────────┐
│ Hello world| │ ← cursor at position 11
└──────────────────────────────┘
┌──────────────────────────────┐
│ Type something... │ ← placeholder (dimmed)
└──────────────────────────────┘
```
**Tests:**
```lisp
(test input-empty
(let ((in (make-text-input)))
(is (string= (text-input-value in) ""))
(is (= (text-input-cursor in) 0))))
(test input-insert-char
(let ((in (make-text-input)))
(handle-input in (make-key-event :a))
(is (string= (text-input-value in) "a"))
(is (= (text-input-cursor in) 1))))
(test input-backspace
(let ((in (make-text-input :initial-value "ab")))
(setf (text-input-cursor in) 2)
(handle-input in (make-key-event :backspace))
(is (string= (text-input-value in) "a"))
(is (= (text-input-cursor in) 1))))
(test input-max-length
(let ((in (make-text-input :max-length 3)))
(handle-input in (make-key-event :a))
(handle-input in (make-key-event :b))
(handle-input in (make-key-event :c))
(handle-input in (make-key-event :d)) ;; should be ignored
(is (string= (text-input-value in) "abc"))))
(test input-cursor-movement
(let ((in (make-text-input :initial-value "hello")))
(setf (text-input-cursor in) 5)
(handle-input in (make-key-event :left))
(is (= (text-input-cursor in) 4))
(handle-input in (make-key-event :right))
(is (= (text-input-cursor in) 5))
(handle-input in (make-key-event :home))
(is (= (text-input-cursor in) 0))
(handle-input in (make-key-event :end))
(is (= (text-input-cursor in) 5))))
```
**Line count:** ~150 lines
---
### Task 3: Textarea Widget
**Objective:** Multi-line text input with selection, undo/redo, word navigation.
**Files:**
- Create: `org/textarea.org`
- Create: `src/components/textarea.lisp`
- Modify: `src/components/package.lisp` — add exports
- Modify: `cl-tty.asd` — add textarea.lisp
**Textarea class:**
```lisp
(defclass textarea (dirty-mixin)
((value :initform "" :initarg :value :accessor textarea-value)
(cursor-row :initform 0 :accessor textarea-cursor-row)
(cursor-col :initform 0 :accessor textarea-cursor-col)
(selection-start :initform nil :accessor textarea-selection-start) ;; (row . col) or nil
(undo-stack :initform (make-array 100 :fill-pointer 0) :accessor textarea-undo-stack)
(on-submit :initform nil :initarg :on-submit :accessor textarea-on-submit)
(layout-node :initform (make-layout-node) :accessor textarea-layout-node)
(focusable :initform t :accessor textarea-focusable)))
```
**Methods:**
- `render-textarea` — renders visible lines with cursor, optional selection highlight
- `handle-textarea-input textarea key-event` — dispatches
- `textarea-insert-at textarea str` — insert at cursor
- `textarea-delete-before textarea` — backspace
- `textarea-delete-after textarea` — delete
- `textarea-newline textarea` — insert newline
- `textarea-cursor-up/down/left/right` — movement
- `textarea-word-forward/backward` — word skips
- `textarea-select-to textarea` — extend selection to cursor
- `textarea-copy-selection / cut-selection / paste` — clipboard
- `textarea-undo / redo` — undo/redo stack
**Tests:** Similar pattern to TextInput but multi-line, with selection tests.
**Line count:** ~200 lines
---
### Task 4: Keybinding System
**Objective:** Layered keymaps (global → local → input), defkeymap macro, chord sequences.
**Files:**
- Create: `org/keybindings.org`
- Create: `src/components/keybindings.lisp`
- Modify: `src/components/package.lisp` — add exports
- Modify: `cl-tty.asd` — add keybindings.lisp
**Architecture:**
```lisp
(defstruct keymap
name ;; :global, :local, or symbol
bindings ;; alist: ((key-event-spec . handler-function) ...)
parent) ;; parent keymap for fallback
(defmacro defkeymap (name &body bindings)
;; (defkeymap :global
;; (:ctrl+p . command-palette)
;; ((:ctrl+c :ctrl+d) . quit))
`(setf (gethash ',name *keymaps*)
(make-keymap :name ',name
:bindings ',bindings)))
(defparameter *keymaps* (make-hash-table))
;; Dispatch order: focused-component-keymap → local → global
(defun dispatch-key-event (event &key component)
(let* ((local (and component (component-keymap component)))
(global (gethash :global *keymaps*)))
(or (match-and-call local event)
(match-and-call global event))))
(defun match-and-call (keymap event)
(loop for (spec . handler) in (keymap-bindings keymap)
thereis (when (key-match-p spec event)
(funcall handler event))))
;; Key spec matching
(defun key-match-p (spec event)
(etypecase spec
(keyword (eql spec (key-event-key event)))
(list (and (eql (first spec) (key-event-key event))
(eql (getf (rest spec) :ctrl) (key-event-ctrl event))
(eql (getf (rest spec) :alt) (key-event-alt event))))))
```
**Chord support:** Two-key sequences with timeout:
```lisp
(defparameter *chord-timeout* 0.5) ;; seconds
(defun handle-chord (first-event)
(when (chord-p first-event) ;; first key has pending status
(let ((second-event (read-event-from-stdin :timeout *chord-timeout*)))
(if (key-event-p second-event)
(dispatch-key-event (combine-chord first-event second-event))
;; timeout — dispatch first event as standalone
(dispatch-key-event first-event)))))
```
**Tests:**
```lisp
(test keymap-simple
(let ((called nil))
(setf (gethash :test *keymaps*)
(make-keymap :name :test
:bindings `((:ctrl+p . ,(lambda (e) (setf called t))))))
(dispatch-key-event (make-key-event :p :ctrl t))
(is-true called)))
(test keymap-fallback
(let ((global-called nil) (local-called nil))
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+q . ,(lambda (e) (setf global-called t))))))
;; Event not in local should fall through
(dispatch-key-event (make-key-event :q :ctrl t))
(is-true global-called)))
(test chord-sequence
(let ((called nil))
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `(((:ctrl+c :ctrl+d) . ,(lambda (e) (setf called t))))))
;; Simulate chord
(handler-chord (make-key-event :c :ctrl t) (make-key-event :d :ctrl t))
(is-true called)))
```
**Line count:** ~150 lines
---
### Dependency Order
```
Task 1 (input infra) ──→ Task 2 (TextInput) ──→ Task 3 (Textarea)
└──→ Task 4 (keybinding) ──→ uses both
```
Task 1 is the prerequisite for everything. Tasks 2, 3, 4 can then proceed in parallel (2 and 3 depend on 1, 4 depends on key events from 1).
---
### Verification
After each task:
1. `sbcl --eval "(asdf:test-system :cl-tty)" --quit` — all tests GREEN
2. `scripts/validate-parens.py` — all files balanced
3. Commit with RED/GREEN evidence
Final verification:
- All 4 phases implemented and tested
- ~750 lines total across all components
- Full test suite: ~100+ assertions, 100% GREEN

10
org/detection.org
View File

@@ -48,7 +48,7 @@ See =docs/plans/2026-05-11-terminal-detection.md= for implementation tasks.
* Tests * Tests
#+BEGIN_SRC lisp :tangle no #+BEGIN_SRC lisp :tangle no
;; Tests are manually added to backend/tests.lisp ;; Tests are manually added to src/backend/tests.lisp
(def-test detection-returns-backend-instance () (def-test detection-returns-backend-instance ()
(let ((be (cl-tty.backend:detect-backend))) (let ((be (cl-tty.backend:detect-backend)))
(is-true (typep be 'cl-tty.backend:backend)))) (is-true (typep be 'cl-tty.backend:backend))))
@@ -70,7 +70,7 @@ No new package definition needed.
Check ~COLORTERM~ first — it's the simplest and most reliable signal. Check ~COLORTERM~ first — it's the simplest and most reliable signal.
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp #+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
(in-package :cl-tty.backend) (in-package :cl-tty.backend)
;;; ─── Detection cache ──────────────────────────────────────────────────────── ;;; ─── Detection cache ────────────────────────────────────────────────────────
@@ -94,7 +94,7 @@ Returns :modern if COLORTERM contains 'truecolor' or '24bit', nil otherwise."
Check if stdout is connected to a terminal (not a pipe or file). Check if stdout is connected to a terminal (not a pipe or file).
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp #+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
;;; ─── TTY probe ────────────────────────────────────────────────────────────── ;;; ─── TTY probe ──────────────────────────────────────────────────────────────
(defun detect-backend-by-tty () (defun detect-backend-by-tty ()
@@ -119,7 +119,7 @@ Fix: Write queries to ~*standard-output*~ and read responses from
~*standard-input*~. This matches where the terminal actually delivers its ~*standard-input*~. This matches where the terminal actually delivers its
DA1/DA3 response bytes. DA1/DA3 response bytes.
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp #+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
;;; ─── DA1 terminal query ───────────────────────────────────────────────────── ;;; ─── DA1 terminal query ─────────────────────────────────────────────────────
(defun query-terminal (query &optional (timeout 0.1)) (defun query-terminal (query &optional (timeout 0.1))
@@ -149,7 +149,7 @@ Returns T if terminal reports kitty compatibility codes."
Tie all probes together into ~detect-backend~. Tie all probes together into ~detect-backend~.
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp #+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
;;; ─── Orchestrator ─────────────────────────────────────────────────────────── ;;; ─── Orchestrator ───────────────────────────────────────────────────────────
(defun detect-backend () (defun detect-backend ()

4
run-all-tests.lisp
View File

@@ -4,8 +4,8 @@
(ql:quickload :fiveam :silent t) (ql:quickload :fiveam :silent t)
;; Load all test files ;; Load all test files
(dolist (f '("backend/tests.lisp" "backend/modern-tests.lisp" (dolist (f '("src/backend/tests.lisp" "src/backend/modern-tests.lisp"
"layout/tests.lisp" "src/layout/tests.lisp"
"src/components/box-tests.lisp" "src/components/box-tests.lisp"
"src/components/dirty-tests.lisp" "src/components/dirty-tests.lisp"
"src/components/render-tests.lisp" "src/components/render-tests.lisp"

10
scripts/audit-compiler.lisp
View File

@@ -26,9 +26,9 @@
*results*))))) *results*)))))
(let ((files (let ((files
'("backend/classes.lisp" "backend/package.lisp" '("src/backend/classes.lisp" "src/backend/package.lisp"
"backend/detection.lisp" "backend/simple.lisp" "backend/modern.lisp" "src/backend/detection.lisp" "src/backend/simple.lisp" "src/backend/modern.lisp"
"layout/layout.lisp" "src/layout/layout.lisp"
"src/components/container-package.lisp" "src/components/container-package.lisp"
"src/components/dialog-package.lisp" "src/components/dialog.lisp" "src/components/dialog-package.lisp" "src/components/dialog.lisp"
"src/components/dirty.lisp" "src/components/dirty.lisp"
@@ -45,8 +45,8 @@
"src/components/box.lisp" "src/components/box.lisp"
"src/rendering/framebuffer.lisp" "src/rendering/framebuffer.lisp"
"demo.lisp" "demo.lisp"
"backend/modern-tests.lisp" "backend/tests.lisp" "src/backend/modern-tests.lisp" "src/backend/tests.lisp"
"layout/tests.lisp" "src/layout/tests.lisp"
"src/components/box-tests.lisp" "src/components/dirty-tests.lisp" "src/components/box-tests.lisp" "src/components/dirty-tests.lisp"
"src/components/render-tests.lisp" "src/components/theme-tests.lisp" "src/components/render-tests.lisp" "src/components/theme-tests.lisp"
"src/components/input-tests.lisp" "src/components/input-tests.lisp"

43
scripts/ci-watchdog.sh
View File

@@ -1,43 +0,0 @@
#!/bin/bash
# Watchdog script: checks if the latest commit on the active branch is new,
# runs the full test suite if so.
# Designed to run every 15 minutes via Hermes cron.
# Prints output only when tests are run (silent otherwise).
cd /mnt/hermes/projects/cl-tty || exit 1
STATE_FILE="/tmp/.cl-tty-ci-last-commit"
BRANCH="feature/v0.11.0-slots"
# Fetch latest
git fetch origin "$BRANCH" 2>/dev/null || exit 0
LATEST=$(git rev-parse "origin/$BRANCH" 2>/dev/null) || exit 0
# Check against last seen
if [ -f "$STATE_FILE" ]; then
LAST_SEEN=$(cat "$STATE_FILE")
[ "$LATEST" = "$LAST_SEEN" ] && exit 0 # No new commits, silent exit
fi
# New commit found! Save it and run tests
echo "$LATEST" > "$STATE_FILE"
COMMIT_MSG=$(git log --oneline "origin/$BRANCH" -1 2>/dev/null)
echo "New commit on $BRANCH: $COMMIT_MSG"
echo ""
echo "=== Running Tier 1: Unit Tests ==="
sbcl --noinform --eval '(load "~/quicklisp/setup.lisp")' \
--eval '(push (truename ".") asdf:*central-registry*)' \
--eval '(asdf:test-system :cl-tty)' --eval '(uiop:quit 0)' \
2>&1 | grep -E "Fail:|Pass:|Did|Running test"
echo ""
echo "=== Running Tier 2: API Verification ==="
python3 scripts/verify-api.py 2>&1 | tail -3
echo ""
echo "=== Running Tier 3: PTY Demo Test ==="
python3 scripts/verify-demo-pty.py 2>&1 | tail -3
echo ""
echo "Done."

10
scripts/code-audit.lisp
View File

@@ -25,9 +25,9 @@
;; Load all source files directly to catch per-file warnings ;; Load all source files directly to catch per-file warnings
(let ((files (let ((files
'("backend/classes.lisp" "backend/package.lisp" '("src/backend/classes.lisp" "src/backend/package.lisp"
"backend/detection.lisp" "backend/simple.lisp" "backend/modern.lisp" "src/backend/detection.lisp" "src/backend/simple.lisp" "src/backend/modern.lisp"
"layout/layout.lisp" "src/layout/layout.lisp"
"src/components/container-package.lisp" "src/components/container-package.lisp"
"src/components/dialog-package.lisp" "src/components/dialog.lisp" "src/components/dialog-package.lisp" "src/components/dialog.lisp"
"src/components/dirty.lisp" "src/components/dirty.lisp"
@@ -49,8 +49,8 @@
(load f)))) (load f))))
;; Also run the test files for good measure ;; Also run the test files for good measure
(dolist (f '("backend/tests.lisp" "backend/modern-tests.lisp" (dolist (f '("src/backend/tests.lisp" "src/backend/modern-tests.lisp"
"layout/tests.lisp" "src/layout/tests.lisp"
"src/components/box-tests.lisp" "src/components/box-tests.lisp"
"src/components/dirty-tests.lisp" "src/components/dirty-tests.lisp"
"src/components/render-tests.lisp" "src/components/render-tests.lisp"

67
scripts/tangle.py
View File

@@ -1,67 +0,0 @@
#!/usr/bin/env python3
"""Simple org-babel tangle replacement.
Extracts #+BEGIN_SRC blocks with :tangle headers and writes target files.
"""
import re, os, sys
ORG_DIR = os.path.dirname(os.path.dirname(os.path.abspath(__file__)))
def tangle_file(org_path):
org_path = os.path.join(ORG_DIR, org_path)
with open(org_path) as f:
text = f.read()
# Find all #+BEGIN_SRC blocks with :tangle
pattern = re.compile(
r'#\+BEGIN_SRC\s+(\w+)\s+(.*?)\n(.*?)\n#\+END_SRC',
re.DOTALL
)
count = 0
block_count = {}
for match in pattern.finditer(text):
lang = match.group(1)
header = match.group(2)
content = match.group(3)
# Extract :tangle path
tangle_match = re.search(r':tangle\s+(\S+)', header)
if not tangle_match:
continue
tangle_path = tangle_match.group(1)
# Resolve relative path
if tangle_path.startswith('../'):
target = os.path.normpath(os.path.join(os.path.dirname(org_path), tangle_path))
else:
target = os.path.join(ORG_DIR, tangle_path)
# Ensure directory exists
os.makedirs(os.path.dirname(target), exist_ok=True)
# Don't write :tangle no blocks
if tangle_path == 'no':
continue
# Write the content (write mode — each run produces clean files)
content = content.rstrip('\n') + '\n'
if os.path.exists(target) and block_count.get(target, 0) == 0:
with open(target, 'w') as f:
f.write(content)
elif os.path.exists(target):
with open(target, 'a') as f:
f.write('\n' + content)
else:
with open(target, 'w') as f:
f.write(content)
block_count[target] = block_count.get(target, 0) + 1
print(f" {target} ({len(content)} bytes)")
count += 1
return count
if __name__ == '__main__':
for f in sys.argv[1:] or ['org/text-input.org']:
print(f"Tangling {f}...")
c = tangle_file(f)
print(f" {c} code blocks")

2
scripts/verify-demo-pty.py
View File

@@ -96,7 +96,7 @@ size = len(output)
check("Output is non-empty", size > 100, f"got {size} bytes") check("Output is non-empty", size > 100, f"got {size} bytes")
check("Shows title 'cl-tty'", has_text(output, "cl-tty")) check("Shows title 'cl-tty'", has_text(output, "cl-tty"))
check("Shows component list", has_text(output, "TextInput")) check("Shows component list", has_text(output, "TextInput"))
check("Shows test count", has_text(output, "392")) check("Shows test count", has_text(output, "483"))
check("Shows controls help", has_text(output, "Ctrl+C")) check("Shows controls help", has_text(output, "Ctrl+C"))
check("Shows tab bar items", has_text(output, "Home")) check("Shows tab bar items", has_text(output, "Home"))
check("Shows Console tab", has_text(output, "Console")) check("Shows Console tab", has_text(output, "Console"))

0
backend/classes.lisp → src/backend/classes.lisp
View File

0
backend/detection.lisp → src/backend/detection.lisp
View File

0
backend/modern-tests.lisp → src/backend/modern-tests.lisp
View File

2
backend/modern.lisp → src/backend/modern.lisp
View File

@@ -170,7 +170,7 @@ as a fallback when a keyword is not in *named-colors*.")
(progn (progn
(sb-unix:unix-ioctl (sb-sys:fd-stream-fd (backend-output-stream b)) (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (backend-output-stream b))
+tiocgwinsz+ +tiocgwinsz+
winsize) (sb-alien:alien-sap winsize))
(values (sb-alien:deref winsize 1) ;; cols (values (sb-alien:deref winsize 1) ;; cols
(sb-alien:deref winsize 0))) ;; rows (sb-alien:deref winsize 0))) ;; rows
(sb-alien:free-alien winsize)))) (sb-alien:free-alien winsize))))

0
backend/package.lisp → src/backend/package.lisp
View File

0
backend/simple.lisp → src/backend/simple.lisp
View File

0
backend/tests.lisp → src/backend/tests.lisp
View File

2
src/components/dialog.lisp
View File

@@ -73,7 +73,7 @@
(list :title "No" :value :no)) (list :title "No" :value :no))
:on-select (lambda (opt) :on-select (lambda (opt)
(pop-dialog) (pop-dialog)
(if (eql (getf opt :value) :yes) (if (eql opt :yes)
(when on-yes (funcall on-yes)) (when on-yes (funcall on-yes))
(when on-no (funcall on-no))))))) (when on-no (funcall on-no)))))))

BIN
src/components/input.fasl
View File

Binary file not shown.

0
layout/layout.lisp → src/layout/layout.lisp
View File

0
layout/tests.lisp → src/layout/tests.lisp
View File

1
system-index.txt
View File

@@ -1 +0,0 @@
cl-tty.asd