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
@@ -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
|
||||
Reference in New Issue
Block a user