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
- 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
14
.gitignore
vendored
Normal file
14
.gitignore
vendored
Normal 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
207
README.org
@@ -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.
|
||||
|
||||
```lisp
|
||||
#+BEGIN_SRC lisp
|
||||
(ql:quickload :cl-tty)
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
## Quick start
|
||||
* Quick start
|
||||
|
||||
The simplest possible cl-tty program — detect the terminal, draw some text,
|
||||
read a key, and shut down:
|
||||
|
||||
```lisp
|
||||
#+BEGIN_SRC lisp
|
||||
(sb-posix:with-raw-terminal
|
||||
(let* ((be (cl-tty.backend:detect-backend))
|
||||
(w 80) (h 24))
|
||||
@@ -24,30 +24,30 @@ read a key, and shut down:
|
||||
;; Read one key (blocks)
|
||||
(cl-tty.input:read-event be))
|
||||
(cl-tty.backend:shutdown-backend be))))
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
Or run the full interactive demo:
|
||||
|
||||
```bash
|
||||
#+BEGIN_SRC bash
|
||||
sbcl --script demo.lisp
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
## Architecture
|
||||
* Architecture
|
||||
|
||||
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
|
||||
- **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).
|
||||
|
||||
### Backend protocol
|
||||
** Backend protocol
|
||||
|
||||
Every drawing operation is a CLOS generic function dispatched on the backend
|
||||
class. Programs never call terminal codes directly:
|
||||
|
||||
```lisp
|
||||
#+BEGIN_SRC lisp
|
||||
;; Lifecycle
|
||||
(initialize-backend backend)
|
||||
(shutdown-backend backend)
|
||||
@@ -67,11 +67,11 @@ class. Programs never call terminal codes directly:
|
||||
(cursor-hide backend)
|
||||
(cursor-show backend)
|
||||
(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)))
|
||||
(initialize-backend be)
|
||||
(loop with running = t
|
||||
@@ -89,48 +89,48 @@ class. Programs never call terminal codes directly:
|
||||
))
|
||||
(when (eq event :eof) (setf running nil))))
|
||||
(shutdown-backend be))
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
### Layout system
|
||||
** Layout system
|
||||
|
||||
Pure CL flexbox layout engine. No C dependencies, no Yoga FFI.
|
||||
|
||||
```lisp
|
||||
#+BEGIN_SRC lisp
|
||||
;; Macros build layout-trees:
|
||||
(vbox (:gap 1 :padding 1)
|
||||
(header "Title")
|
||||
(hbox (:grow 1)
|
||||
(sidebar (:width 30) ...)
|
||||
(content ...)))
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
Layout properties: `:direction` (`:row` / `:column`), `:grow`, `:shrink`,
|
||||
`:basis`, `:gap`, `:padding`, `:margin`, `:width`, `:height`, `:wrap`.
|
||||
Layout properties: ~:direction~ (~:row~ / ~:column~), ~:grow~, ~:shrink~,
|
||||
~: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:
|
||||
|
||||
1. **Layout pass** — `compute-layout` traverses dirty branches, solves flex constraints
|
||||
2. **Render dispatch** — `render` generic dispatches per component type
|
||||
3. **Framebuffer** — (optional) `make-framebuffer-backend` captures to a cell array,
|
||||
`diff-framebuffers` computes minimal changes, `flush-framebuffer` writes only
|
||||
1. *Layout pass* — ~compute-layout~ traverses dirty branches, solves flex constraints
|
||||
2. *Render dispatch* — ~render~ generic dispatches per component type
|
||||
3. *Framebuffer* — (optional) ~make-framebuffer-backend~ captures to a cell array,
|
||||
~diff-framebuffers~ computes minimal changes, ~flush-framebuffer~ writes only
|
||||
changed cells
|
||||
|
||||
```lisp
|
||||
#+BEGIN_SRC lisp
|
||||
;; Full pipeline with framebuffer
|
||||
(let* ((fb-be (make-framebuffer-backend :width 80 :height 24))
|
||||
(fb (fb-framebuffer fb-be)))
|
||||
(render my-component fb-be)
|
||||
(flush-framebuffer prev-fb fb real-backend))
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
## Components
|
||||
* Components
|
||||
|
||||
| Component | What it does | Status |
|
||||
|-------------|------------------------------------------------------|--------|
|
||||
|-------------+------------------------------------------------------+--------|
|
||||
| Box | Bordered container with background, title | stable |
|
||||
| Text | Styled text with word-wrap, spans | stable |
|
||||
| ScrollBox | Scrollable viewport with scrollbars | stable |
|
||||
@@ -146,7 +146,7 @@ Component trees render through a coordinated pipeline:
|
||||
|
||||
Each component follows a consistent pattern:
|
||||
|
||||
```lisp
|
||||
#+BEGIN_SRC lisp
|
||||
;; 1. Create — factory function returns instance
|
||||
(let ((input (make-text-input :placeholder "Type here..."))
|
||||
(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
|
||||
(render my-component backend))
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
### Box
|
||||
*** Box
|
||||
|
||||
Bordered container. Draws borders using Unicode box-drawing characters
|
||||
(modern) or ASCII `+`/`-`/`|` (simple). Supports background fill, titled
|
||||
borders. See `org/box-renderable.org`.
|
||||
(modern) or ASCII ~+~/~-~/~|~ (simple). Supports background fill, titled
|
||||
borders. See ~org/box-renderable.org~.
|
||||
|
||||
```lisp
|
||||
#+BEGIN_SRC lisp
|
||||
(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
|
||||
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)
|
||||
;; Span example:
|
||||
(span "hello" :bold t :fg :bright-yellow)
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
### TextInput
|
||||
*** TextInput
|
||||
|
||||
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)
|
||||
;; Widget logic (input-level, no backend needed):
|
||||
(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,
|
||||
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)
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
### ScrollBox
|
||||
*** ScrollBox
|
||||
|
||||
Scrollable viewport with a list of children. Only renders children
|
||||
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)
|
||||
(scroll-by sb dy dx)
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
### TabBar
|
||||
*** TabBar
|
||||
|
||||
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)
|
||||
(tab-bar-add tb id title)
|
||||
(tab-bar-next tb) / (tab-bar-prev tb)
|
||||
(tab-bar-handle-key tb event)
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
### Select
|
||||
*** Select
|
||||
|
||||
Dropdown/filter widget. Options can have categories (rendered as
|
||||
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)
|
||||
;; Options format: (:title "Name" :category "Group") or (:title "Name")
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
### Markdown
|
||||
*** Markdown
|
||||
|
||||
Parsed markdown AST with rendering. Supports headings, paragraphs,
|
||||
bold, italic, inline code, links, code blocks with syntax highlighting,
|
||||
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**.")
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
### Dialog + Toast
|
||||
*** Dialog + Toast
|
||||
|
||||
Modal dialog stack. `alert-dialog`, `confirm-dialog`, `select-dialog`,
|
||||
`prompt-dialog` are convenience constructors. Toasts are transient
|
||||
notifications that auto-dismiss. See `org/dialog.org`.
|
||||
Modal dialog stack. ~alert-dialog~, ~confirm-dialog~, ~select-dialog~,
|
||||
~prompt-dialog~ are convenience constructors. Toasts are transient
|
||||
notifications that auto-dismiss. See ~org/dialog.org~.
|
||||
|
||||
```lisp
|
||||
#+BEGIN_SRC lisp
|
||||
(push-dialog (make-instance 'dialog :size :medium))
|
||||
(alert-dialog "Notice" "Operation complete")
|
||||
(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.
|
||||
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) ...)
|
||||
(handle-mouse-event component mouse-event)
|
||||
(hit-test root x y) → deepest matching component
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
### Slot system
|
||||
*** Slot system
|
||||
|
||||
Plugin system for extensible rendering slots. Register named rendering
|
||||
functions, then render them by slot name. Useful for toolbars, status
|
||||
bars, and plugin architectures.
|
||||
|
||||
```lisp
|
||||
#+BEGIN_SRC lisp
|
||||
(defslot :status-bar :order 0
|
||||
(lambda (&rest args)
|
||||
(draw-text backend 0 0 "Ready" :text-muted nil)))
|
||||
(slot-render :status-bar)
|
||||
```
|
||||
#+END_SRC
|
||||
|
||||
## Backend features
|
||||
* Backend features
|
||||
|
||||
| Feature | modern | simple |
|
||||
|-------------------|--------|--------|
|
||||
|-------------------+--------+--------|
|
||||
| Truecolor (24-bit)| Yes | No |
|
||||
| Bold/italic | Yes | No |
|
||||
| OSC 8 hyperlinks | Yes | No |
|
||||
@@ -298,16 +298,17 @@ bars, and plugin architectures.
|
||||
| Box drawing chars | Unicode| ASCII |
|
||||
| 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)
|
||||
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?
|
||||
|
||||
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)
|
||||
sbcl --script run-all-tests.lisp
|
||||
|
||||
@@ -315,29 +316,29 @@ sbcl --script run-all-tests.lisp
|
||||
sbcl --script demo.lisp
|
||||
|
||||
# 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,
|
||||
framebuffer, and markdown modules. The backend (`modern.lisp`,
|
||||
`simple.lisp`) and basic components (`box.lisp`, `text.lisp`, `render.lisp`,
|
||||
`theme.lisp`, `dirty.lisp`) are written directly.
|
||||
framebuffer, and markdown modules. The backend (~modern.lisp~,
|
||||
~simple.lisp~) and basic components (~box.lisp~, ~text.lisp~, ~render.lisp~,
|
||||
~theme.lisp~, ~dirty.lisp~) are written directly.
|
||||
|
||||
Project structure:
|
||||
|
||||
```
|
||||
#+BEGIN_EXAMPLE
|
||||
cl-tty/
|
||||
├── cl-tty.asd # ASDF system definition
|
||||
├── demo.lisp # Interactive demo
|
||||
├── run-all-tests.lisp # Test runner
|
||||
├── backend/ # Backend protocol + implementations
|
||||
├── src/backend/ # Backend protocol + implementations
|
||||
│ ├── package.lisp
|
||||
│ ├── classes.lisp # Generic definitions
|
||||
│ ├── simple.lisp # ASCII fallback backend
|
||||
│ ├── modern.lisp # Truecolor escape backend
|
||||
│ └── detection.lisp # Auto-detect backend from env
|
||||
├── layout/ # Flexbox layout engine
|
||||
│ ├── classes.lisp # Generic definitions
|
||||
│ ├── simple.lisp # ASCII fallback backend
|
||||
│ ├── modern.lisp # Truecolor escape backend
|
||||
│ └── detection.lisp # Auto-detect backend from env
|
||||
├── src/layout/ # Flexbox layout engine
|
||||
│ └── layout.lisp
|
||||
├── src/
|
||||
│ ├── rendering/ # Framebuffer backend + diff + flush
|
||||
@@ -369,8 +370,8 @@ cl-tty/
|
||||
└── docs/
|
||||
├── ROADMAP.org # Versioned roadmap
|
||||
└── ARCHITECTURE.org # Design docs
|
||||
```
|
||||
#+END_EXAMPLE
|
||||
|
||||
## License
|
||||
* License
|
||||
|
||||
GNU General Public License v3.0
|
||||
|
||||
@@ -6,14 +6,14 @@
|
||||
:license "GPL-3.0"
|
||||
:depends-on (:sb-posix)
|
||||
:components
|
||||
((:module "backend"
|
||||
((:module "src/backend"
|
||||
:components
|
||||
((:file "package")
|
||||
(:file "classes" :depends-on ("package"))
|
||||
(:file "simple" :depends-on ("package" "classes"))
|
||||
(:file "modern" :depends-on ("package" "classes"))
|
||||
(:file "detection" :depends-on ("package" "classes"))))
|
||||
(:module "layout"
|
||||
(:module "src/layout"
|
||||
:components
|
||||
((:file "layout")))
|
||||
(:module "src/rendering"
|
||||
@@ -58,11 +58,11 @@
|
||||
:description "Test suite for cl-tty"
|
||||
:depends-on (:cl-tty :fiveam)
|
||||
:components
|
||||
((:module "backend"
|
||||
((:module "src/backend"
|
||||
:components
|
||||
((:file "tests")
|
||||
(:file "modern-tests" :depends-on ("tests"))))
|
||||
(:module "layout"
|
||||
(:module "src/layout"
|
||||
:components
|
||||
((:file "tests")))
|
||||
(:module "src/components"
|
||||
|
||||
@@ -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
191
demo.lisp
@@ -7,11 +7,16 @@
|
||||
(push (truename ".") asdf:*central-registry*)
|
||||
(asdf:load-system :cl-tty)
|
||||
|
||||
(use-package :cl-tty.backend)
|
||||
(use-package :cl-tty.input)
|
||||
(use-package :cl-tty.box)
|
||||
(use-package :cl-tty.layout)
|
||||
(use-package :cl-tty.rendering)
|
||||
;; Symbols use explicit package prefixes to avoid read-event
|
||||
;; conflict between cl-tty.backend and cl-tty.input.
|
||||
|
||||
;; Short aliases for readability
|
||||
(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 ───────────────────────────────────────────────────────
|
||||
|
||||
@@ -39,120 +44,148 @@
|
||||
(defun render-tab-home (backend x y w h)
|
||||
"Welcome screen with version info."
|
||||
(declare (ignore h))
|
||||
(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)
|
||||
(draw-text backend (+ x 2) (+ y 4) " components: Box, Text, TextInput, TextArea, Select," nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 5) " ScrollBox, TabBar, Dialog, Toast, Markdown" nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 6) " features: 24-bit truecolor, OSC 8 links, SGR mouse," nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 7) " DECICM sync, kitty keyboard, framebuffer" nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 8) " backend: modern-backend | simple-backend (pipe-safe)" nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 9) " tests: 392, 100% passing" :green nil :bold t)
|
||||
(draw-text backend (+ x 2) (+ y 10) " deps: zero FFI, zero ncurses, pure CL" :bright-cyan nil)
|
||||
(draw-text backend (+ x 2) (+ y 12) "Controls" :bright-white nil :bold t)
|
||||
(draw-text backend (+ x 2) (+ y 13) " Tab / arrows switch tabs" nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 14) " Ctrl+C / Esc quit" nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 15) " mouse click/drag select text (test SGR mouse)" nil nil))
|
||||
(cl-tty.backend:draw-border backend x y w 18 :style :double :title " Welcome ")
|
||||
(cl-tty.backend: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 4)
|
||||
" components: Box, Text, TextInput, TextArea, Select," nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 5)
|
||||
" ScrollBox, TabBar, Dialog, Toast, Markdown" nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 6)
|
||||
" features: 24-bit truecolor, OSC 8 links, SGR mouse," nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 7)
|
||||
" DECICM sync, kitty keyboard, framebuffer" nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 8)
|
||||
" 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)
|
||||
"Interactive widget demo."
|
||||
(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)))
|
||||
(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))
|
||||
(draw-text backend (+ x 2) (+ y 3) "Placeholder: \"Type here...\"" :text-muted nil)
|
||||
(draw-text backend (+ x 2) (+ y 5) "Keys: type to insert, arrows to move," nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 6) "Enter to submit, Backspace to delete," nil 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 1) "Value: " :text-muted nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 10) (+ y 1)
|
||||
(if (plusp (length val)) val "(empty)") :text nil))
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 3)
|
||||
"Placeholder: \"Type here...\"" :text-muted 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)))
|
||||
(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)))
|
||||
(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-border backend x y2 w 10 :style :single :title " TextArea ")
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y2 1) "Value:" :text-muted nil)
|
||||
(let ((lines (textarea-lines ta)))
|
||||
(loop for line in lines
|
||||
for row from 0 below (min (length lines) 6)
|
||||
do (draw-text backend (+ x 2) (+ y2 2 row)
|
||||
(subseq (or line "") 0 (min (length line) (- w 4))) nil nil)))))
|
||||
do (cl-tty.backend:draw-text backend (+ x 2) (+ y2 2 row)
|
||||
(subseq (or line "") 0 (min (length line) (- w 4))) nil nil)))))
|
||||
|
||||
(defun render-tab-console (backend x y w h)
|
||||
"Event log / debug console."
|
||||
(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-border backend x y w h :style :single :title " Event Log ")
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 1)
|
||||
"Last 50 keyboard and mouse events:" :text-muted nil)
|
||||
(let ((lines *log*)
|
||||
(max-rows (- h 3)))
|
||||
(loop for line in (subseq lines 0 (min (length lines) max-rows))
|
||||
for row from 0 below max-rows
|
||||
do (draw-text backend (+ x 2) (+ y 3 row)
|
||||
(subseq (or line "") 0 (min (length line) (- w 4))) nil nil))))
|
||||
do (cl-tty.backend:draw-text backend (+ x 2) (+ y 3 row)
|
||||
(subseq (or line "") 0 (min (length line) (- w 4))) nil nil))))
|
||||
|
||||
;;; ─── Main loop ──────────────────────────────────────────────────────────────
|
||||
|
||||
(defun handle-event (event)
|
||||
"Process a key-event or mouse-event, returning t if consumed."
|
||||
(typecase event
|
||||
(key-event
|
||||
(let ((key (key-event-key event))
|
||||
(ctrl (key-event-ctrl event)))
|
||||
(log-append "Key: ~a (ctrl=~a alt=~a shift=~a)" key ctrl (key-event-alt event) (key-event-shift event))
|
||||
(cl-tty.input:key-event
|
||||
(let ((key (cl-tty.input:key-event-key event))
|
||||
(ctrl (cl-tty.input:key-event-ctrl 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
|
||||
((or (and ctrl (eql key :|C|)) (eql key :escape))
|
||||
(setf (getf *app* :running) nil) t)
|
||||
((eql key :tab)
|
||||
(incf (getf *app* :tab))
|
||||
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
|
||||
;; Only arrow keys switch tabs when NOT on the Widgets tab.
|
||||
;; On the Widgets tab (tab=1), Left/Right are forwarded to widgets
|
||||
;; for cursor navigation in text inputs.
|
||||
((and (not (= (getf *app* :tab) 1))
|
||||
(eql key :left))
|
||||
(decf (getf *app* :tab))
|
||||
(when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t)
|
||||
((and (not (= (getf *app* :tab) 1))
|
||||
(eql key :right))
|
||||
(incf (getf *app* :tab))
|
||||
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
|
||||
;; Forward key to widgets only when on the Widgets tab
|
||||
(t (when (= (getf *app* :tab) 1)
|
||||
(handle-text-input (getf *app* :input) event)
|
||||
(handle-textarea-input (getf *app* :textarea) event))
|
||||
t))))
|
||||
(mouse-event
|
||||
(log-append "Mouse: ~a btn=~a pos=(~d,~d)" (mouse-event-type event)
|
||||
(mouse-event-button event) (mouse-event-x event) (mouse-event-y event))
|
||||
(setf (getf *app* :mouse-x) (mouse-event-x event)
|
||||
(getf *app* :mouse-y) (mouse-event-y event))
|
||||
(incf (getf *app* :tab))
|
||||
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
|
||||
;; Only arrow keys switch tabs when NOT on the Widgets tab.
|
||||
;; On the Widgets tab (tab=1), Left/Right are forwarded to widgets
|
||||
;; for cursor navigation in text inputs.
|
||||
((and (not (= (getf *app* :tab) 1))
|
||||
(eql key :left))
|
||||
(decf (getf *app* :tab))
|
||||
(when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t)
|
||||
((and (not (= (getf *app* :tab) 1))
|
||||
(eql key :right))
|
||||
(incf (getf *app* :tab))
|
||||
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
|
||||
;; Forward key to widgets only when on the Widgets tab
|
||||
(t (when (= (getf *app* :tab) 1)
|
||||
(handle-text-input (getf *app* :input) event)
|
||||
(handle-textarea-input (getf *app* :textarea) event))
|
||||
t))))
|
||||
(cl-tty.input:mouse-event
|
||||
(log-append "Mouse: ~a btn=~a pos=(~d,~d)"
|
||||
(cl-tty.input:mouse-event-type event)
|
||||
(cl-tty.input:mouse-event-button 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)))
|
||||
|
||||
(defun run-demo ()
|
||||
"Run the demo. Raw terminal mode should already be set by the
|
||||
./demo.sh shell wrapper."
|
||||
(init-app-state)
|
||||
(let* ((backend (detect-backend))
|
||||
(w (multiple-value-bind (cols rows) (backend-size backend)
|
||||
(let* ((backend (cl-tty.backend:detect-backend))
|
||||
(w (multiple-value-bind (cols rows) (cl-tty.backend:backend-size backend)
|
||||
(declare (ignore rows))
|
||||
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))
|
||||
rows)))
|
||||
(initialize-backend backend)
|
||||
(cl-tty.backend:initialize-backend backend)
|
||||
(unwind-protect
|
||||
(loop while (getf *app* :running)
|
||||
do
|
||||
(backend-clear backend)
|
||||
(cl-tty.backend:backend-clear backend)
|
||||
;; Title bar
|
||||
(draw-border backend 2 1 (- w 4) 3 :style :double :title " cl-tty v0.15.0 ")
|
||||
(draw-text backend 4 2 "arrows/tab: tabs type: test input mouse: test SGR Esc/Ctrl+C: quit"
|
||||
:bright-white nil)
|
||||
(cl-tty.backend:draw-border backend 2 1 (- w 4) 3
|
||||
:style :double :title " cl-tty v0.15.0 ")
|
||||
(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
|
||||
(loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2))
|
||||
for x-pos = 4 then (+ x-pos label-len 2)
|
||||
for label-len = (length label)
|
||||
do (let ((active (eql idx (getf *app* :tab))))
|
||||
(if active
|
||||
(draw-text backend x-pos 4 label :bright-white :accent :bold t)
|
||||
(draw-text backend x-pos 4 label :text-muted nil))))
|
||||
(cl-tty.backend:draw-text backend x-pos 4 label
|
||||
:bright-white :accent :bold t)
|
||||
(cl-tty.backend:draw-text backend x-pos 4 label
|
||||
:text-muted nil))))
|
||||
;; Content area
|
||||
(case (getf *app* :tab)
|
||||
(0 (render-tab-home backend 4 6 (- w 4) (- h 8)))
|
||||
@@ -164,20 +197,20 @@
|
||||
(let ((mx (getf *app* :mouse-x))
|
||||
(my (getf *app* :mouse-y)))
|
||||
(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
|
||||
(draw-rect backend 2 (- h 2) (- w 4) 1 :bg :blue)
|
||||
(draw-text backend 4 (- h 2)
|
||||
(format nil " Tab ~d/3 | ~d events "
|
||||
(1+ (getf *app* :tab)) (length *log*))
|
||||
:bright-white :blue :bold t)
|
||||
(cl-tty.backend:draw-rect backend 2 (- h 2) (- w 4) 1 :bg :blue)
|
||||
(cl-tty.backend:draw-text backend 4 (- h 2)
|
||||
(format nil " Tab ~d/3 | ~d events "
|
||||
(1+ (getf *app* :tab)) (length *log*))
|
||||
:bright-white :blue :bold t)
|
||||
(finish-output *standard-output*)
|
||||
;; Read event — blocks until a key or mouse event arrives
|
||||
(let ((event (read-event backend)))
|
||||
(let ((event (cl-tty.input:read-event backend)))
|
||||
(cond
|
||||
((eq event :eof) (setf (getf *app* :running) nil))
|
||||
(event (handle-event event)))))
|
||||
(shutdown-backend backend))))
|
||||
(cl-tty.backend:shutdown-backend backend))))
|
||||
|
||||
(run-demo)
|
||||
(uiop:quit 0)
|
||||
|
||||
@@ -265,46 +265,89 @@ reads terminal background color at startup.
|
||||
|
||||
#+BEGIN_SRC
|
||||
cl-tty/
|
||||
├── cl-tty.asd
|
||||
├── cl-tty-tests.asd
|
||||
├── cl-tty.asd # ASDF system (main + test)
|
||||
├── README.org
|
||||
├── LICENSE
|
||||
├── .gitignore
|
||||
├── demo.lisp # Interactive demo
|
||||
├── demo.sh # PTY launcher for demo
|
||||
├── run-all-tests.lisp # Test runner
|
||||
├── docs/
|
||||
│ ├── ROADMAP.org
|
||||
│ └── 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/
|
||||
│ ├── package.lisp
|
||||
│ ├── backend/
|
||||
│ │ ├── protocol.lisp
|
||||
│ │ ├── detection.lisp
|
||||
│ │ ├── package.lisp
|
||||
│ │ ├── classes.lisp
|
||||
│ │ ├── simple.lisp
|
||||
│ │ └── modern.lisp
|
||||
│ │ ├── modern.lisp
|
||||
│ │ └── detection.lisp
|
||||
│ ├── layout/
|
||||
│ │ ├── nodes.lisp
|
||||
│ │ ├── solver.lisp
|
||||
│ │ └── api.lisp
|
||||
│ │ └── layout.lisp
|
||||
│ ├── components/
|
||||
│ │ ├── base.lisp
|
||||
│ │ ├── package.lisp
|
||||
│ │ ├── box.lisp
|
||||
│ │ └── text.lisp
|
||||
│ ├── rendering/
|
||||
│ │ ├── pipeline.lisp
|
||||
│ │ ├── text.lisp
|
||||
│ │ ├── render.lisp
|
||||
│ │ ├── theme.lisp
|
||||
│ │ ├── dirty.lisp
|
||||
│ │ └── diff.lisp
|
||||
│ └── theme/
|
||||
│ ├── tokens.lisp
|
||||
│ └── presets.lisp
|
||||
└── tests/
|
||||
├── package.lisp
|
||||
├── backend.lisp
|
||||
├── layout.lisp
|
||||
└── components.lisp
|
||||
│ │ ├── input-package.lisp
|
||||
│ │ ├── input.lisp
|
||||
│ │ ├── text-input.lisp
|
||||
│ │ ├── textarea.lisp
|
||||
│ │ ├── keybindings.lisp
|
||||
│ │ ├── container-package.lisp
|
||||
│ │ ├── scrollbox.lisp
|
||||
│ │ ├── tabbar.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
|
||||
|
||||
** Dependency Graph
|
||||
|
||||
backend/ (no deps)
|
||||
layout/ (no deps — pure math)
|
||||
src/backend/ (no deps)
|
||||
src/layout/ (no deps — pure math)
|
||||
theme/ (backend for color resolution)
|
||||
components/ (layout, theme, rendering)
|
||||
rendering/ (layout, components, backend, theme)
|
||||
|
||||
@@ -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
|
||||
|
||||
**File:** backend/simple.lisp, lines 33-40
|
||||
**File:** src/backend/simple.lisp, lines 33-40
|
||||
|
||||
```lisp
|
||||
(defun %simple-border-char (edge-style pos)
|
||||
|
||||
@@ -142,7 +142,49 @@ DONE. Enhance mouse support with drag-to-select and link clicking.
|
||||
- Copy-to-clipboard via xclip/wl-copy/pbcopy
|
||||
- ~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
|
||||
from the component library without writing custom escape sequences.
|
||||
@@ -158,6 +200,8 @@ Checklist:
|
||||
- [X] Rendering pipeline (v0.13.0)
|
||||
- [X] Mouse improvements (v0.14.0)
|
||||
- [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
|
||||
|
||||
@@ -177,5 +221,6 @@ Checklist:
|
||||
| 10 | Terminal capability detection | ~100 | v0.12.0 | DONE |
|
||||
| 11 | Rendering pipeline (framebuffer diff) | ~250 | v0.13.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 | | |
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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.
|
||||
@@ -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
|
||||
@@ -48,7 +48,7 @@ See =docs/plans/2026-05-11-terminal-detection.md= for implementation tasks.
|
||||
* Tests
|
||||
|
||||
#+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 ()
|
||||
(let ((be (cl-tty.backend:detect-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.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
|
||||
(in-package :cl-tty.backend)
|
||||
|
||||
;;; ─── 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).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
|
||||
;;; ─── TTY probe ──────────────────────────────────────────────────────────────
|
||||
|
||||
(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
|
||||
DA1/DA3 response bytes.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
|
||||
;;; ─── DA1 terminal query ─────────────────────────────────────────────────────
|
||||
|
||||
(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~.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../backend/detection.lisp
|
||||
#+BEGIN_SRC lisp :tangle ../src/backend/detection.lisp
|
||||
;;; ─── Orchestrator ───────────────────────────────────────────────────────────
|
||||
|
||||
(defun detect-backend ()
|
||||
|
||||
@@ -4,8 +4,8 @@
|
||||
(ql:quickload :fiveam :silent t)
|
||||
|
||||
;; Load all test files
|
||||
(dolist (f '("backend/tests.lisp" "backend/modern-tests.lisp"
|
||||
"layout/tests.lisp"
|
||||
(dolist (f '("src/backend/tests.lisp" "src/backend/modern-tests.lisp"
|
||||
"src/layout/tests.lisp"
|
||||
"src/components/box-tests.lisp"
|
||||
"src/components/dirty-tests.lisp"
|
||||
"src/components/render-tests.lisp"
|
||||
|
||||
@@ -26,9 +26,9 @@
|
||||
*results*)))))
|
||||
|
||||
(let ((files
|
||||
'("backend/classes.lisp" "backend/package.lisp"
|
||||
"backend/detection.lisp" "backend/simple.lisp" "backend/modern.lisp"
|
||||
"layout/layout.lisp"
|
||||
'("src/backend/classes.lisp" "src/backend/package.lisp"
|
||||
"src/backend/detection.lisp" "src/backend/simple.lisp" "src/backend/modern.lisp"
|
||||
"src/layout/layout.lisp"
|
||||
"src/components/container-package.lisp"
|
||||
"src/components/dialog-package.lisp" "src/components/dialog.lisp"
|
||||
"src/components/dirty.lisp"
|
||||
@@ -45,8 +45,8 @@
|
||||
"src/components/box.lisp"
|
||||
"src/rendering/framebuffer.lisp"
|
||||
"demo.lisp"
|
||||
"backend/modern-tests.lisp" "backend/tests.lisp"
|
||||
"layout/tests.lisp"
|
||||
"src/backend/modern-tests.lisp" "src/backend/tests.lisp"
|
||||
"src/layout/tests.lisp"
|
||||
"src/components/box-tests.lisp" "src/components/dirty-tests.lisp"
|
||||
"src/components/render-tests.lisp" "src/components/theme-tests.lisp"
|
||||
"src/components/input-tests.lisp"
|
||||
|
||||
@@ -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."
|
||||
@@ -25,9 +25,9 @@
|
||||
|
||||
;; Load all source files directly to catch per-file warnings
|
||||
(let ((files
|
||||
'("backend/classes.lisp" "backend/package.lisp"
|
||||
"backend/detection.lisp" "backend/simple.lisp" "backend/modern.lisp"
|
||||
"layout/layout.lisp"
|
||||
'("src/backend/classes.lisp" "src/backend/package.lisp"
|
||||
"src/backend/detection.lisp" "src/backend/simple.lisp" "src/backend/modern.lisp"
|
||||
"src/layout/layout.lisp"
|
||||
"src/components/container-package.lisp"
|
||||
"src/components/dialog-package.lisp" "src/components/dialog.lisp"
|
||||
"src/components/dirty.lisp"
|
||||
@@ -49,8 +49,8 @@
|
||||
(load f))))
|
||||
|
||||
;; Also run the test files for good measure
|
||||
(dolist (f '("backend/tests.lisp" "backend/modern-tests.lisp"
|
||||
"layout/tests.lisp"
|
||||
(dolist (f '("src/backend/tests.lisp" "src/backend/modern-tests.lisp"
|
||||
"src/layout/tests.lisp"
|
||||
"src/components/box-tests.lisp"
|
||||
"src/components/dirty-tests.lisp"
|
||||
"src/components/render-tests.lisp"
|
||||
|
||||
@@ -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")
|
||||
@@ -96,7 +96,7 @@ size = len(output)
|
||||
check("Output is non-empty", size > 100, f"got {size} bytes")
|
||||
check("Shows title 'cl-tty'", has_text(output, "cl-tty"))
|
||||
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 tab bar items", has_text(output, "Home"))
|
||||
check("Shows Console tab", has_text(output, "Console"))
|
||||
|
||||
@@ -170,7 +170,7 @@ as a fallback when a keyword is not in *named-colors*.")
|
||||
(progn
|
||||
(sb-unix:unix-ioctl (sb-sys:fd-stream-fd (backend-output-stream b))
|
||||
+tiocgwinsz+
|
||||
winsize)
|
||||
(sb-alien:alien-sap winsize))
|
||||
(values (sb-alien:deref winsize 1) ;; cols
|
||||
(sb-alien:deref winsize 0))) ;; rows
|
||||
(sb-alien:free-alien winsize))))
|
||||
@@ -73,7 +73,7 @@
|
||||
(list :title "No" :value :no))
|
||||
:on-select (lambda (opt)
|
||||
(pop-dialog)
|
||||
(if (eql (getf opt :value) :yes)
|
||||
(if (eql opt :yes)
|
||||
(when on-yes (funcall on-yes))
|
||||
(when on-no (funcall on-no)))))))
|
||||
|
||||
|
||||
Binary file not shown.
@@ -1 +0,0 @@
|
||||
cl-tty.asd
|
||||
Reference in New Issue
Block a user