Add demo.sh — shell wrapper for raw terminal mode

Raw terminal mode must be set by the parent process (the shell),
not from inside SBCL.  sb-ext:run-program subprocesses cannot
reliably access the controlling terminal for stty operations.
./demo.sh sets raw mode via stty, runs sbcl --script demo.lisp,
and restores terminal state on exit (EXIT, INT, TERM).

demo.lisp no longer calls with-raw-terminal — it assumes the
calling shell has already set raw mode.

README.org

@@ -8,12 +8,28 @@ Pure CL terminal UI framework. No ncurses, no FFI, no external dependencies.
 
 ## Quick start
 
+The simplest possible cl-tty program — detect the terminal, draw some text,
+read a key, and shut down:
+
 ```lisp
-;; Create a modern terminal backend
+(sb-posix:with-raw-terminal
-(let ((backend (make-instance 'cl-tty.backend:modern-backend)))
+  (let* ((be (cl-tty.backend:detect-backend))
-  (cl-tty.backend:initialize-backend backend)
+         (w 80) (h 24))
-  ;; Backend is ready — write text, draw boxes, handle input
+    (cl-tty.backend:initialize-backend be)
-  (cl-tty.backend:shutdown-backend backend))
+    (unwind-protect
+         (progn
+           (cl-tty.backend:draw-text be 0 0 "Hello, terminal!" :green nil :bold t)
+           (cl-tty.backend:draw-border be 0 1 30 5 :style :single)
+           (finish-output)
+           ;; Read one key (blocks)
+           (cl-tty.input:read-event be))
+      (cl-tty.backend:shutdown-backend be))))
+```
+
+Or run the full interactive demo:
+
+```bash
+sbcl --script demo.lisp
 ```
 
 ## Architecture
@@ -22,26 +38,251 @@ Two backends, one protocol:
 
 - **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
+- **simple-backend** — ASCII art, no color, universal compatibility (pipe-safe)
 
 Everything is pure escape sequences (no curses, no terminfo, no FFI).
 
+### Backend protocol
+
+Every drawing operation is a CLOS generic function dispatched on the backend
+class. Programs never call terminal codes directly:
+
+```lisp
+;; Lifecycle
+(initialize-backend backend)
+(shutdown-backend backend)
+
+;; Drawing
+(draw-text backend x y string fg bg &key bold italic underline reverse dim)
+(draw-border backend x y width height &key style fg bg title)
+(draw-rect backend x y width height &key bg)
+(draw-link backend x y string url &key fg bg)
+
+;; Input
+(read-event backend &key timeout)       → key-event or mouse-event
+(backend-size backend)                   → (values columns lines)
+
+;; Cursor
+(cursor-move backend x y)
+(cursor-hide backend)
+(cursor-show backend)
+(cursor-style backend shape &key blink)  ;; :bar :block :underline
+```
+
+### Event loop pattern
+
+```lisp
+(let ((be (detect-backend)))
+  (initialize-backend be)
+  (loop with running = t
+        while running
+        do (backend-clear be)
+           ;; ... draw frame ...
+           (finish-output *standard-output*)
+           (let ((event (read-event be)))
+             (typecase event
+               (key-event
+                 (when (eql (key-event-key event) :escape)
+                   (setf running nil)))
+               (mouse-event
+                 ;; handle mouse
+                 ))))
+  (shutdown-backend be))
+```
+
+### Layout system
+
+Pure CL flexbox layout engine. No C dependencies, no Yoga FFI.
+
+```lisp
+;; Macros build layout-trees:
+(vbox (:gap 1 :padding 1)
+  (header "Title")
+  (hbox (:grow 1)
+    (sidebar (:width 30) ...)
+    (content ...)))
+```
+
+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.
+
+### 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
+   changed cells
+
+```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))
+```
+
 ## Components
 
-| Component   | What it does                                         | Version |
+| Component   | What it does                                         | Status |
-|-------------|------------------------------------------------------|---------|
+|-------------|------------------------------------------------------|--------|
-| Box         | Bordered container with background, title            | v0.2.0  |
+| Box         | Bordered container with background, title            | stable |
-| Text        | Styled text with word-wrap, spans                    | v0.2.0  |
+| Text        | Styled text with word-wrap, spans                    | stable |
-| ScrollBox   | Scrollable viewport with scrollbars                  | v0.6.0  |
+| ScrollBox   | Scrollable viewport with scrollbars                  | stable |
-| TabBar      | Horizontal tab navigation                            | v0.6.0  |
+| TabBar      | Horizontal tab navigation                            | stable |
-| Select      | Dropdown with fuzzy filter, category headers         | v0.7.0  |
+| Select      | Dropdown with fuzzy filter, category headers         | stable |
-| TextInput   | Single-line text input with readline keybindings     | v0.5.0  |
+| TextInput   | Single-line text input with readline keybindings     | stable |
-| TextArea    | Multi-line input with undo/redo, selection           | v0.5.0  |
+| TextArea    | Multi-line input with undo/redo, cursor movement     | stable |
-| Markdown    | Renders markdown with syntax highlighting + diffs    | v0.8.0  |
+| Markdown    | Renders markdown with syntax highlighting + diffs    | stable |
-| Dialog      | Modal overlays with stack management                 | v0.9.0  |
+| Dialog      | Modal overlays with stack management                 | stable |
-| Toast       | Transient notifications (info/success/warning/error) | v0.9.0  |
+| Toast       | Transient notifications (info/success/warning/error) | stable |
-| Mouse       | Event handlers, hit-testing, text selection          | v0.10.0 |
+| Mouse       | Event handlers, hit-testing, text selection          | stable |
-| Slot        | Plugin system — named slots for extensible UI        | v0.11.0 |
+| Slot        | Plugin system — named slots for extensible UI        | stable |
+
+Each component follows a consistent pattern:
+
+```lisp
+;; 1. Create — factory function returns instance
+(let ((input (make-text-input :placeholder "Type here..."))
+      (box (make-box :border-style :single :title "My Box")))
+
+  ;; 2. Layout — macros compose components
+  (vbox (:gap 1)
+    box
+    (hbox (:grow 1)
+      input
+      (make-select :options '((:title "Option A") (:title "Option B")))))
+
+  ;; 3. Render — dispatches through the component protocol
+  (render my-component backend))
+```
+
+### Box
+
+Bordered container. Draws borders using Unicode box-drawing characters
+(modern) or ASCII `+`/`-`/`|` (simple). Supports background fill, titled
+borders. See `org/box-renderable.org`.
+
+```lisp
+(make-box &key (border-style :single) title (title-align :left) fg bg width height)
+```
+
+### Text
+
+Styled text with inline spans and word wrapping. Spans support per-run
+attributes (bold, italic, underline, fg, bg). See `org/box-renderable.org`.
+
+```lisp
+(make-text content &key fg bg wrap-mode width height spans)
+;; Span example:
+(span "hello" :bold t :fg :bright-yellow)
+```
+
+### TextInput
+
+Single-line text editor with emacs-style keybindings. Supports placeholder,
+max-length, on-submit callback. See `org/text-input.org`.
+
+```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)))
+```
+
+### TextArea
+
+Multi-line text editor. Supports undo/redo (Ctrl+Z/Y), cursor movement,
+line joining on backspace. See `org/text-input.org`.
+
+```lisp
+(make-textarea &key value on-submit)
+```
+
+### 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`.
+
+```lisp
+(make-scroll-box &key children scroll-y scroll-x sticky-scroll-p)
+(scroll-by sb dy dx)
+```
+
+### TabBar
+
+Horizontal tab navigation. Renders tab labels, highlights active tab.
+Left/right arrows cycle through tabs. See `org/scrollbox-tabbar.org`.
+
+```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)
+```
+
+### 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`.
+
+```lisp
+(make-select &key options filter on-select)
+;; Options format: (:title "Name" :category "Group") or (:title "Name")
+```
+
+### 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`.
+
+```lisp
+(render-markdown "# Hello\n\nThis is **bold**.")
+```
+
+### 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`.
+
+```lisp
+(push-dialog (make-instance 'dialog :size :medium))
+(alert-dialog "Notice" "Operation complete")
+(toast "Saved!" :variant :success)
+```
+
+### Mouse
+
+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`.
+
+```lisp
+(defclass my-panel (mouse-mixin) ...)
+(handle-mouse-event component mouse-event)
+(hit-test root x y) → deepest matching component
+```
+
+### 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
+(defslot :status-bar :order 0
+  (lambda (&rest args)
+    (draw-text backend 0 0 "Ready" :text-muted nil)))
+(slot-render :status-bar)
+```
 
 ## Backend features
 
@@ -56,18 +297,80 @@ Everything is pure escape sequences (no curses, no terminfo, no FFI).
 | Box drawing chars | Unicode| ASCII  |
 | Pipe-safe         | No     | Yes    |
 
+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"?
+3. Send DA1 query — does the terminal respond with modern feature codes?
+
+Result is cached in `*detected-backend*`.
+
 ## Development
 
 ```bash
-# Run all tests
+# Run all tests (392 checks, 12 suites)
 sbcl --script run-all-tests.lisp
 
-# Tangle org files
+# Run interactive demo
-emacs --batch --eval "(progn (require 'org) (find-file \"org/FILE.org\") (org-babel-tangle) (kill-buffer))"
+sbcl --script demo.lisp
+
+# Tangle org files (regenerate .lisp from .org sources)
+for f in org/*.org; do
+  emacs --batch --eval "(progn (require 'org) (find-file \"$f\") (org-babel-tangle) (kill-buffer))" 2>&1
+done
 ```
 
-Literate programming: `.org` files in `org/` are the source of truth.
+Literate programming: `.org` files in `org/` are the source of truth for
-`.lisp` files are generated by tangling.
+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.
+
+Project structure:
+
+```
+cl-tty/
+├── cl-tty.asd              # ASDF system definition
+├── demo.lisp               # Interactive demo
+├── run-all-tests.lisp      # Test runner
+├── 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
+│   └── layout.lisp
+├── src/
+│   ├── rendering/          # Framebuffer backend + diff + flush
+│   │   └── framebuffer.lisp
+│   └── components/         # Widgets
+│       ├── box.lisp, text.lisp, render.lisp, theme.lisp
+│       ├── dirty.lisp, input-package.lisp, input.lisp
+│       ├── text-input.lisp, textarea.lisp, keybindings.lisp
+│       ├── scrollbox.lisp, tabbar.lisp, container-package.lisp
+│       ├── select.lisp, select-package.lisp
+│       ├── markdown.lisp, markdown-package.lisp
+│       ├── dialog.lisp, dialog-package.lisp
+│       ├── mouse.lisp, mouse-package.lisp
+│       └── slot.lisp, slot-package.lisp
+├── tests/                  # Test files
+├── org/                    # Literate source files
+│   ├── text-input.org
+│   ├── scrollbox-tabbar.org
+│   ├── dialog.org
+│   ├── mouse.org
+│   ├── select.org
+│   ├── slot.org
+│   ├── framebuffer.org
+│   ├── markdown-renderer.org
+│   ├── detection.org
+│   ├── modern-backend.org
+│   ├── box-renderable.org
+│   └── layout-engine.org
+└── docs/
+    ├── ROADMAP.org         # Versioned roadmap
+    └── ARCHITECTURE.org    # Design docs
+```
 
 ## License
 

backend/modern.lisp

@@ -28,9 +28,16 @@
   '((:black . 0) (:red . 1) (:green . 2) (:yellow . 3)
     (:blue . 4) (:magenta . 5) (:cyan . 6) (:white . 7)))
 
+(defvar *theme-colors* (make-hash-table :test 'eq)
+  "Hash table mapping theme keywords to hex color strings.
+Populated by the theme system's load-preset.  Checked by sgr-fg/sgr-bg
+as a fallback when a keyword is not in *named-colors*.")
+
 (defun sgr-fg (color)
   "Return SGR foreground escape for COLOR.
-  Color can be a hex string, a keyword name, or nil."
+  Color can be a hex string, a keyword name, or nil.
+  Keywords first try *named-colors*, then fall back to *theme-colors*
+  which resolves theme semantic roles to hex strings."
   (if (null color) ""
       (cond ((and (stringp color) (char= (char color 0) #\#))
              (multiple-value-bind (r g b) (hex-to-rgb color)
@@ -39,11 +46,17 @@
              (let ((index (cdr (assoc color *named-colors*))))
                (if index
                    (format nil "~C[~dm" #\Esc (+ 30 index))
-                   "")))
+                   ;; Fall back to theme-colors hash
+                   (let ((hex (gethash color *theme-colors*)))
+                     (if hex
+                         (multiple-value-bind (r g b) (hex-to-rgb hex)
+                           (format nil "~C[38;2;~d;~d;~dm" #\Esc r g b))
+                         "")))))
             (t ""))))
 
 (defun sgr-bg (color)
-  "Return SGR background escape for COLOR."
+  "Return SGR background escape for COLOR.
+  Keywords first try *named-colors*, then fall back to *theme-colors*."
   (if (null color) ""
       (cond ((and (stringp color) (char= (char color 0) #\#))
              (multiple-value-bind (r g b) (hex-to-rgb color)
@@ -52,7 +65,12 @@
              (let ((index (cdr (assoc color *named-colors*))))
                (if index
                    (format nil "~C[~dm" #\Esc (+ 40 index))
-                   "")))
+                   ;; Fall back to theme-colors hash
+                   (let ((hex (gethash color *theme-colors*)))
+                     (if hex
+                         (multiple-value-bind (r g b) (hex-to-rgb hex)
+                           (format nil "~C[48;2;~d;~d;~dm" #\Esc r g b))
+                         "")))))
             (t ""))))
 
 (defparameter *sgr-attr-codes*
@@ -149,6 +167,7 @@
 (defmethod backend-write ((b modern-backend) string)
   (let ((stream (backend-output-stream b)))
     (write-string string stream)
+    (finish-output stream)
     (length string)))
 
 (defmethod capable-p ((b modern-backend) feature)

backend/package.lisp

@@ -23,6 +23,8 @@
    #:modern-backend #:make-modern-backend
    ;; Detection
    #:detect-backend #:*detected-backend*
+   ;; Theme color resolution (populated by theme system)
+   #:*theme-colors*
    ;; Internal (for testing)
    #:sgr-fg #:sgr-bg #:sgr-attr
    #:cursor-move-escape #:cursor-style-escape

backend/simple.lisp

@@ -44,13 +44,22 @@ POS is :top-left, :top-right, :bottom-left, :bottom-right,
   (declare (ignore style fg bg title title-align))
   (let ((h (%simple-border-char nil :horizontal))
         (v (%simple-border-char nil :vertical)))
+    ;; Position cursor with newlines and spaces (no escape sequences)
+    (dotimes (row y) (backend-write b (string #\Newline)))
     ;; Top edge
-    (backend-write b (format nil "~%~v@{~a~:*~}" width h))
+    (backend-write b (make-string x :initial-element #\space))
+    (backend-write b (make-string width :initial-element h))
     ;; Sides
     (loop for i from 1 below (1- height)
-          do (backend-write b (format nil "~%|~v@{~a~:*~}|" (- width 2) #\space)))
+          do (backend-write b (string #\Newline))
+             (backend-write b (make-string x :initial-element #\space))
+             (backend-write b (string v))
+             (backend-write b (make-string (- width 2) :initial-element #\space))
+             (backend-write b (string v)))
     ;; Bottom edge
-    (backend-write b (format nil "~%~v@{~a~:*~}" width h))))
+    (backend-write b (string #\Newline))
+    (backend-write b (make-string x :initial-element #\space))
+    (backend-write b (make-string width :initial-element h))))
 
 (defmethod draw-rect ((b simple-backend) x y width height
                       &key bg)

cl-tty.asd

@@ -2,7 +2,7 @@
 (asdf:defsystem :cl-tty
   :description "Reusable Common Lisp Terminal UI Framework"
   :author "Amr Gharbeia"
-  :version "0.14.0"
+  :version "0.15.0"
   :license "GPL-3.0"
   :depends-on (:sb-posix)
   :components
@@ -52,9 +52,9 @@
      ;; Slot system (v0.11.0)
      (:file "slot-package" :depends-on ("package"))
      (:file "slot" :depends-on ("slot-package")))))
-  :in-order-to ((test-op (test-op :cl-tty-tests))))
+  :in-order-to ((test-op (test-op :cl-tty/test))))
 
-(asdf:defsystem :cl-tty-tests
+(asdf:defsystem :cl-tty/test
   :description "Test suite for cl-tty"
   :depends-on (:cl-tty :fiveam)
   :components
@@ -83,7 +83,9 @@
     ((:file "framebuffer-tests" :pathname "../../tests/framebuffer-tests"))))
   :perform (test-op (o c)
                (let ((run (find-symbol "RUN" :fiveam))
-                     (explain (find-symbol "EXPLAIN!" :fiveam)))
+                     (explain (find-symbol "EXPLAIN!" :fiveam))
+                     (status (find-symbol "RESULTS-STATUS" :fiveam))
+                     (all-passed t))
                  (dolist (suite '((:cl-tty-backend-test "BACKEND-SUITE")
                                 (:cl-tty-box-test "BOX-SUITE")
                                 (:cl-tty-input-test "INPUT-SUITE")
@@ -102,5 +104,8 @@
                                    (pkg (find-symbol (string (first suite)) :keyword))
                                    (t nil))))
                      (when s
-                       (funcall explain (funcall run s))))))
+                       (let ((result (funcall run s)))
-               (uiop:quit 0)))
+                         (funcall explain result)
+                         (unless (funcall status result)
+                           (setf all-passed nil))))))
+               (uiop:quit (if all-passed 0 1)))))

demo.lisp

@@ -1,132 +1,172 @@
 ;;; demo.lisp — cl-tty interactive demo
 ;;; Run: sbcl --script demo.lisp
 
-(load "~/quicklisp/setup.lisp")
+;; Load cl-tty directly via ASDF (no Quicklisp dependency needed —
-(ql:register-local-projects)
+;; sb-posix is built into SBCL, no external libraries required).
-(ql:quickload :cl-tty :silent t)
+(require "asdf")
+(push (truename ".") asdf:*central-registry*)
+(asdf:load-system :cl-tty)
 
-;;; ─── Low-level input ───────────────────────────────────────────────────────
+(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)
 
-(defun read-raw (&optional timeout)
+;;; ─── Application state ───────────────────────────────────────────────────────
-  (let ((fn (symbol-function (find-symbol "READ-RAW-BYTE" :cl-tty.input))))
-    (funcall fn :timeout (or timeout 10))))
 
-(defun read-key ()
+(defvar *app* nil "Application state plist")
-  (let ((b (read-raw)))
+(defvar *log* nil "Circular log buffer")
-    (unless b (return-from read-key nil))
-    (case b
-      (#x1b
-        (let ((b2 (read-raw 1)))
-          (unless b2 (return-from read-key :escape))
-          (if (= b2 #x5b)
-              (let ((b3 (read-raw 1)))
-                (case b3
-                  (#x41 :up)    (#x42 :down)
-                  (#x43 :right) (#x44 :left)
-                  (#x48 :home)  (#x46 :end)
-                  (t :unknown)))
-              :unknown)))
-      (#x03 :ctrl-c)
-      (#x0d :enter)
-      (#x09 :tab)
-      (#x7f :backspace)
-      (t (code-char b)))))
 
-;;; ─── Tab content renderers ─────────────────────────────────────────────────
+(defun log-append (fmt &rest args)
+  (let* ((msg (apply #'format nil fmt args))
+         (ts (multiple-value-bind (h m s) (get-decoded-time)
+               (format nil "~2,'0d:~2,'0d:~2,'0d" h m s))))
+    (push (format nil "[~a] ~a" ts msg) *log*)
+    (when (> (length *log*) 100) (setf *log* (subseq *log* 0 100)))))
 
-(defun render-home (be)
+(defun init-app-state ()
-  (cl-tty.backend:draw-border be 6 7 68 10 :style :single :title " Welcome ")
+  (setf *log* nil)
-  (cl-tty.backend:draw-text be 8  9 "cl-tty — Pure CL terminal UI framework"
+  (setf *app* (list :tab 0
-                            :bright-white :default :bold t)
+                    :input (make-text-input :placeholder "Type here...")
-  (cl-tty.backend:draw-text be 8 11 "  - 11 versions, 12 components"
+                    :textarea (make-textarea :value "Hello\nWorld")
-                            :white :default)
+                    :running t
-  (cl-tty.backend:draw-text be 8 12 "  - No ncurses, no FFI, no external deps"
+                    :mouse-x -1 :mouse-y -1))
-                            :white :default)
+  (log-append "Demo started"))
-  (cl-tty.backend:draw-text be 8 13 "  - 280+ tests, 100% passing"
-                            :green :default)
-  (cl-tty.backend:draw-text be 8 15 "Arrows: switch tabs   Enter/q: quit"
-                            :bright-cyan :default :bold t))
 
-(defun render-components (be)
+;;; ─── Tab renderers ──────────────────────────────────────────────────────────
-  (cl-tty.backend:draw-border be 6 7 68 12 :style :single :title " Components ")
-  (loop for i from 0 below 6
-        for pair = (nth i '(("Box"        "Bordered containers, title, bg")
-                           ("Text"        "Styled text, word-wrap, spans")
-                           ("ScrollBox"   "Scrollable viewport, scrollbars")
-                           ("TabBar"      "Tab navigation you are using")
-                           ("Select"      "Dropdown with fuzzy filter")
-                           ("Dialog"      "Modal overlays + Toast notifs")))
-        do (cl-tty.backend:draw-text be 8 (+ 9 i) (first pair)
-                                     :bright-yellow :default :bold t)
-           (cl-tty.backend:draw-text be 24 (+ 9 i) (second pair)
-                                     :white :default)))
 
-(defun render-stats (be)
+(defun render-tab-home (backend x y w h)
-  (cl-tty.backend:draw-border be 6 7 68 10 :style :single :title " Stats ")
+  "Welcome screen with version info."
-  (cl-tty.backend:draw-text be 8  9 "Metric"     :bright-white :default :bold t)
+  (declare (ignore h))
-  (cl-tty.backend:draw-text be 40 9 "Value"      :bright-white :default :bold t)
+  (draw-border backend x y w 18 :style :double :title " Welcome ")
-  (loop for i from 0 below 8
+  (draw-text backend (+ x 2) (+ y 2) "cl-tty — Pure CL Terminal UI Framework" :bright-white nil :bold t)
-        for pair = (nth i '(("Versions"     "11") ("Components"   "12")
+  (draw-text backend (+ x 2) (+ y 4) "  components: Box, Text, TextInput, TextArea, Select," nil nil)
-                           ("Tests"        "280+")  ("Lines"        "~3060")
+  (draw-text backend (+ x 2) (+ y 5) "              ScrollBox, TabBar, Dialog, Toast, Markdown" nil nil)
-                           ("Dependencies" "0")    ("FFI"          "0")
+  (draw-text backend (+ x 2) (+ y 6) "  features:   24-bit truecolor, OSC 8 links, SGR mouse," nil nil)
-                           ("ncurses"      "no")    ("License"      "GPL-3.0")))
+  (draw-text backend (+ x 2) (+ y 7) "              DECICM sync, kitty keyboard, framebuffer" nil nil)
-        do (cl-tty.backend:draw-text be 8  (+ 11 i) (first pair) :white :default)
+  (draw-text backend (+ x 2) (+ y 8) "  backend:    modern-backend | simple-backend (pipe-safe)" nil nil)
-           (cl-tty.backend:draw-text be 40 (+ 11 i) (second pair)
+  (draw-text backend (+ x 2) (+ y 9) "  tests:      392, 100% passing" :green nil :bold t)
-                                     :bright-green :default :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) "  q / Ctrl+C / Esc  quit" nil nil)
+  (draw-text backend (+ x 2) (+ y 15) "  mouse click/drag  select text (test SGR mouse)" nil nil))
 
-;;; ─── Tab bar ───────────────────────────────────────────────────────────────
+(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 ")
+  (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)
+  (when (plusp (length (text-input-value input)))
+    (draw-text backend (+ x 2) (+ y 9) (format nil "Submitted: ~a" (text-input-value input)) :accent nil))
 
-(defun render-tabs (be tabs active)
+  (let ((y2 (+ y 13)))
-  (let ((x 8))
+    (draw-border backend x y2 w 10 :style :single :title " TextArea ")
-    (cl-tty.backend:draw-rect be 6 4 68 1 :bg :default)
+    (draw-text backend (+ x 2) (+ y2 1) "Value:" :text-muted nil)
-    (loop for label in tabs for i from 0
+    (let ((lines (textarea-lines ta)))
-          do (let* ((text (format nil " ~a " label)) (len (length text)))
+      (loop for line in lines
-               (if (= i active)
+            for row from 0 below (min (length lines) 6)
-                   (progn (cl-tty.backend:draw-rect be x 4 len 1 :bg :bright-blue)
+            do (draw-text backend (+ x 2) (+ y2 2 row)
-                          (cl-tty.backend:draw-text be x 4 text
+                          (subseq (or line "") 0 (min (length line) (- w 4))) nil nil)))))
-                                                    :bright-white :bright-blue :bold t))
-                   (cl-tty.backend:draw-text be x 4 text :bright-white :default))
-               (incf x (+ len 2))))))
 
-;;; ─── Main loop ─────────────────────────────────────────────────────────────
+(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)
+  (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))))
+
+;;; ─── 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))
+       (cond
+         ((or (eql key :|Q|) (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)
+         ((eql key :left)
+          (decf (getf *app* :tab))
+          (when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t)
+         ((eql key :right)
+          (incf (getf *app* :tab))
+          (when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
+         ;; Forward key to widgets for testing
+         (t (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))
+     t)))
 
 (defun run-demo ()
-  (let* ((raw (find-symbol "SET-RAW-MODE" :cl-tty.input))
+  "Run the demo.  Raw terminal mode should already be set by the
-         (restore (find-symbol "RESTORE-TERMINAL-STATE" :cl-tty.input))
+./demo.sh shell wrapper."
-         (saved (funcall raw)))
+  (init-app-state)
+  (let* ((backend (detect-backend))
+         (w 80) (h 24))
+    (declare (ignore h))
+    (initialize-backend backend)
     (unwind-protect
-         (let* ((backend (cl-tty.backend:detect-backend))
+         (loop while (getf *app* :running)
-                (tabs '(" Home " " Components " " Stats "))
+               do
-                (active 0) (running t))
+               (backend-clear backend)
-           (cl-tty.backend:initialize-backend backend)
+               ;; Title bar
-           (cl-tty.backend:cursor-hide backend)
+               (draw-border backend 2 1 (- w 4) 3 :style :double :title " cl-tty v0.15.0 ")
-           (loop while running
+               (draw-text backend 4 2 "arrows/tab: tabs   type: test input   mouse: test SGR   q/esc: quit"
-                 do (cl-tty.backend:backend-clear backend)
+                          :bright-white nil)
-                    (cl-tty.backend:draw-border backend 2 1 76 3
+               ;; Tab bar
-                      :style :double :title " cl-tty ")
+               (loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2))
-                    (cl-tty.backend:draw-text backend 4 2
+                     for x-pos = 4 then (+ x-pos label-len 2)
-                      "Interactive demo  arrows: tabs  q: quit" :bright-white :default)
+                     for label-len = (length label)
-                    (render-tabs backend tabs active)
+                     do (let ((active (eql idx (getf *app* :tab))))
-                    (case active
+                          (if active
-                      (0 (render-home backend))
+                              (draw-text backend x-pos 4 label :bright-white :accent :bold t)
-                      (1 (render-components backend))
+                              (draw-text backend x-pos 4 label :text-muted nil))))
-                      (2 (render-stats backend)))
+               ;; Content area
-                    (cl-tty.backend:draw-rect backend 2 23 76 1 :bg :blue)
+               (case (getf *app* :tab)
-                    (cl-tty.backend:draw-text backend 2 23
+                 (0 (render-tab-home  backend 4 6 72 20))
-                      (format nil " Tab ~d/3: ~a "
+                 (1 (render-tab-widgets backend 4 6 72 24
-                              (1+ active) (string-trim " " (nth active tabs)))
+                                        (getf *app* :input)
-                      :bright-white :blue :bold t)
+                                        (getf *app* :textarea)))
-                    (case (read-key)
+                 (2 (render-tab-console backend 4 6 72 16)))
-                      ((:ctrl-c :enter #\q #\Q) (setf running nil))
+               ;; Mouse cursor indicator
-                      ((:right :tab) (setf active (mod (1+ active) (length tabs))))
+               (let ((mx (getf *app* :mouse-x))
-                      (:left (setf active (mod (1- active) (length tabs))))))
+                     (my (getf *app* :mouse-y)))
-           (cl-tty.backend:cursor-show backend)
+                 (when (and (>= mx 0) (>= my 0))
-           (cl-tty.backend:backend-clear backend)
+                   (draw-text backend mx my "@" :bright-cyan nil)))
-           (cl-tty.backend:shutdown-backend backend))
+               ;; Status bar
-      (when saved (funcall restore saved)))))
+               (draw-rect backend 2 23 (- w 4) 1 :bg :blue)
+               (draw-text backend 4 23
+                          (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)))
+                 (when event
+                   (handle-event event))))
+      (shutdown-backend backend))))
 
-;;; ─── Entry ──────────────────────────────────────────────────────────────────
+(run-demo)
-
+(uiop:quit 0)
-(if (probe-file "/dev/tty")
-    (run-demo)
-    (format t "No TTY detected. Run in a terminal for the interactive demo.~%"))

demo.sh

@@ -0,0 +1,17 @@
+#!/bin/sh
+# cl-tty demo launcher
+# Sets raw terminal mode before starting SBCL, restores on exit.
+# Raw mode is needed so individual keystrokes are captured instead
+# of being line-buffered and echoed by the terminal driver.
+
+SAVED=$(stty -g 2>/dev/null)
+if [ -z "$SAVED" ]; then
+    echo "ERROR: Not running in a real terminal." >&2
+    exit 1
+fi
+
+cleanup() { stty "$SAVED" 2>/dev/null; }
+trap cleanup EXIT INT TERM
+
+stty raw -echo -isig -icanon min 1 time 0 2>/dev/null
+sbcl --script "$(dirname "$0")/demo.lisp"

org/mouse.org

@@ -59,18 +59,27 @@ module adds:
     (when handler (funcall handler event))))
 
 (defun hit-test (root x y)
+  "Find the deepest component at (X, Y) by testing layout-node bounds.
+Recurses into component-children to find the innermost match.
+Components without a layout-node or position return nil."
   (labels ((recurse (node)
-             (when (and (slot-exists-p node 'x) (slot-boundp node 'x)
+             (let ((ln (ignore-errors (component-layout-node node)))
-                        (slot-exists-p node 'y) (slot-boundp node 'y)
+                   (best nil))
-                        (slot-exists-p node 'width) (slot-boundp node 'width)
+               (when ln
-                        (slot-exists-p node 'height) (slot-boundp node 'height))
+                 (let ((nx (layout-node-x ln))
-               (let ((nx (slot-value node 'x))
+                       (ny (layout-node-y ln))
-                     (ny (slot-value node 'y))
+                       (nw (layout-node-width ln))
-                     (nw (slot-value node 'width))
+                       (nh (layout-node-height ln)))
-                     (nh (slot-value node 'height)))
+                   ;; Check children first for deeper match
-                 (when (and (>= x nx) (< x (+ nx nw))
+                   (dolist (child (ignore-errors (component-children node)))
-                            (>= y ny) (< y (+ ny nh)))
+                     (let ((child-hit (recurse child)))
-                   node)))))
+                       (when child-hit
+                         (setf best child-hit))))
+                   ;; If no child matched, check self
+                   (or best
+                       (when (and (>= x nx) (< x (+ nx nw))
+                                  (>= y ny) (< y (+ ny nh)))
+                         node)))))))
     (recurse root)))
 
 ;; Selection

org/scrollbox-tabbar.org

@@ -319,38 +319,36 @@ when the user manually scrolls up.
 
 #+BEGIN_SRC lisp
 (defmethod render ((sb scroll-box) backend)
-  "Render visible children with scroll offset applied."
+  "Render visible children with scroll offset applied.
+Delegates to each child's `render` method, temporarily offsetting
+its layout-node position for the scroll offset. Children outside
+the viewport are clipped out."
   (let* ((ln (scroll-box-layout-node sb))
-         (vx 0) (vy 0)  ;; viewport origin (parent position)
+         (vx 0) (vy 0)
          (vw (if ln (layout-node-width ln) 80))
          (vh (if ln (layout-node-height ln) 24))
          (sy (scroll-box-scroll-y sb))
          (sx (scroll-box-scroll-x sb)))
     (dolist (child (scroll-box-children sb))
       (let* ((cln (component-layout-node child))
-             (cw (if cln (layout-node-width cln) 1))
              (ch (if cln (layout-node-height cln) 1))
-             ;; Child's position after scroll offset
-             (cx vx)
              (cy vy))
-        (declare (ignore cx))
+        ;; Only render children that are visible in the viewport
-        ;; Only render if child intersects viewport vertically
         (when (and (< (+ cy (- sy)) (+ vh vy))
                    (> (+ cy (- sy) ch) vy))
-          (let ((old-ln (component-layout-node child)))
+          ;; Temporarily offset child's layout-node position for rendering
-            (when old-ln
+          (let ((orig-x (if cln (layout-node-x cln) 0))
-              ;; Temporarily adjust layout to account for scroll
+                (orig-y (if cln (layout-node-y cln) 0)))
-              (let ((new-ln (make-layout-node)))
+            (when cln
-                (setf (layout-node-x new-ln) (- sx)
+              (setf (layout-node-x cln) (- orig-x sx)
-                      (layout-node-y new-ln) (- sy)
+                    (layout-node-y cln) (- orig-y sy)))
-                      (layout-node-width new-ln) cw
+            (unwind-protect
-                      (layout-node-height new-ln) ch)
+                 (render child backend)
-                ;; Use a captured-backend approach or just draw-text
+              (when cln
-                (draw-text backend 0 (+ vy cy (- sy))
+                (setf (layout-node-x cln) orig-x
-                           (format nil "child at ~D" vy)
+                      (layout-node-y cln) orig-y)))))
-                           nil nil)))))
+        (incf vy ch)))
-        (incf vy ch))))
+    (draw-scrollbars sb backend vw vh)))
-  (draw-scrollbars sb backend vw vh))
 #+END_SRC
 
 ** ScrollBox: sticky scroll
@@ -506,7 +504,8 @@ they are truncated with an ellipsis.
 #+BEGIN_SRC lisp
 (defmethod render ((tb tab-bar) backend)
   (let* ((ln (tab-bar-layout-node tb))
-         (x 0) (y 0)
+         (x (if ln (layout-node-x ln) 0))
+         (y (if ln (layout-node-y ln) 0))
          (w (if ln (layout-node-width ln) 80))
          (active-id (tab-bar-active tb))
          (tabs (tab-bar-tabs tb))
@@ -573,6 +572,8 @@ they are truncated with an ellipsis.
           :initial-value 0))
 
 (defmethod render ((sb scroll-box) backend)
+  "Render ScrollBox children within the viewport, offset by scroll position.
+Children outside the viewport are skipped."
   (let* ((ln (scroll-box-layout-node sb))
          (vx 0) (vy 0)
          (vw (if ln (layout-node-width ln) 80))
@@ -583,9 +584,20 @@ they are truncated with an ellipsis.
       (let* ((cln (component-layout-node child))
              (ch (if cln (layout-node-height cln) 1))
              (cy vy))
-        (when (and (< (+ cy (- sy)) (+ vh vy)) (> (+ cy (- sy) ch) vy))
+        ;; Only render children that are visible in the viewport
-          (draw-text backend (- sx) (+ vy cy (- sy))
+        (when (and (< (+ cy (- sy)) (+ vh vy))
-                     (format nil "child at ~D" vy) nil nil))
+                   (> (+ cy (- sy) ch) vy))
+          ;; Temporarily offset child's layout-node position for rendering
+          (let ((orig-x (if cln (layout-node-x cln) 0))
+                (orig-y (if cln (layout-node-y cln) 0)))
+            (when cln
+              (setf (layout-node-x cln) (- orig-x sx)
+                    (layout-node-y cln) (- orig-y sy)))
+            (unwind-protect
+                 (render child backend)
+              (when cln
+                (setf (layout-node-x cln) orig-x
+                      (layout-node-y cln) orig-y)))))
         (incf vy ch)))
     (draw-scrollbars sb backend vw vh)))
 
@@ -653,9 +665,11 @@ they are truncated with an ellipsis.
   (case (key-event-key event) (:left (tab-bar-prev tb) t) (:right (tab-bar-next tb) t) (t nil)))
 
 (defmethod render ((tb tab-bar) backend)
-  (let* ((ln (tab-bar-layout-node tb)) (y 0)
+  (let* ((ln (tab-bar-layout-node tb))
+         (x (if ln (layout-node-x ln) 0))
+         (y (if ln (layout-node-y ln) 0))
          (w (if ln (layout-node-width ln) 80))
-         (active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos 0))
+         (active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos x))
     (dolist (tab tabs)
       (let* ((id (getf tab :id)) (title (getf tab :title))
              (label (format nil " ~A " title)) (label-len (length label))

org/select.org

@@ -402,7 +402,8 @@ not selectable (visually distinct).
 #+BEGIN_SRC lisp
 (defmethod render ((sel select) backend)
   (let* ((ln (select-layout-node sel))
-         (x 0) (y 0)
+         (x (if ln (layout-node-x ln) 0))
+         (y (if ln (layout-node-y ln) 0))
          (w (if ln (layout-node-width ln) 80))
          (visible (select-visible-options sel))
          (sel-idx (select-selected-index sel)))
@@ -508,7 +509,9 @@ not selectable (visually distinct).
     (subseq filtered start end)))
 
 (defmethod render ((sel select) backend)
-  (let* ((ln (select-layout-node sel)) (x 0) (y 0)
+  (let* ((ln (select-layout-node sel))
+         (x (if ln (layout-node-x ln) 0))
+         (y (if ln (layout-node-y ln) 0))
          (w (if ln (layout-node-width ln) 80))
          (visible (select-visible-options sel)) (sel-idx (select-selected-index sel)))
     (dolist (item visible)

run-all-tests.lisp

@@ -20,27 +20,31 @@
              "tests/framebuffer-tests.lisp"))
   (load f))
 
-;; Run all test suites
+;; Run all test suites, exit non-zero if any fails
-(dolist (suite '((:cl-tty-backend-test   "BACKEND-SUITE")
+(let ((all-passed t))
-                 (:cl-tty-box-test       "BOX-SUITE")
+  (dolist (suite '((:cl-tty-backend-test   "BACKEND-SUITE")
-                 (:cl-tty-input-test     "INPUT-SUITE")
+                   (:cl-tty-box-test       "BOX-SUITE")
-                 (:cl-tty-scrollbox-test "SCROLLBOX-SUITE")
+                   (:cl-tty-input-test     "INPUT-SUITE")
-                 (:cl-tty-select-test    "SELECT-SUITE")
+                   (:cl-tty-scrollbox-test "SCROLLBOX-SUITE")
-                 (:cl-tty-markdown-test  :cl-tty-markdown-test)
+                   (:cl-tty-select-test    "SELECT-SUITE")
-                 (:cl-tty-dialog-test    "DIALOG-SUITE")
+                   (:cl-tty-markdown-test  :cl-tty-markdown-test)
-                 (:cl-tty-mouse-test     "MOUSE-SUITE")
+                   (:cl-tty-dialog-test    "DIALOG-SUITE")
-                 (:cl-tty-slot-test      "SLOT-SUITE")
+                   (:cl-tty-mouse-test     "MOUSE-SUITE")
-                 (:cl-tty-layout-test    "LAYOUT-SUITE")
+                   (:cl-tty-slot-test      "SLOT-SUITE")
-                 (:cl-tty-modern-backend-test "MODERN-BACKEND-SUITE")
+                   (:cl-tty-layout-test    "LAYOUT-SUITE")
-                 (:cl-tty-framebuffer-test "FRAMEBUFFER-SUITE")))
+                   (:cl-tty-modern-backend-test "MODERN-BACKEND-SUITE")
-  (let* ((pkg (find-package (first suite)))
+                   (:cl-tty-framebuffer-test "FRAMEBUFFER-SUITE")))
-         (suite-name (second suite))
+    (let* ((pkg (find-package (first suite)))
-         (s (etypecase suite-name
+           (suite-name (second suite))
-              (keyword (find-symbol (string suite-name) :keyword))
+           (s (etypecase suite-name
-              (string  (find-symbol suite-name pkg)))))
+                (keyword (find-symbol (string suite-name) :keyword))
-    (format t "~&=== ~a ===~%" (first suite))
+                (string  (find-symbol suite-name pkg)))))
-    (if s
+      (format t "~&=== ~a ===~%" (first suite))
-        (fiveam:explain! (fiveam:run s))
+      (if s
-        (format t "Suite not found~%"))))
+          (let ((result (fiveam:run s)))
-
+            (fiveam:explain! result)
-(uiop:quit 0)
+            (unless (fiveam:results-status result)
+              (setf all-passed nil)
+              (format t "~&FAILED: ~a~%" (first suite))))
+          (format t "Suite not found~%"))))
+  (uiop:quit (if all-passed 0 1)))

src/components/input-package.lisp

@@ -26,6 +26,7 @@
    #:textarea-value #:textarea-cursor-row #:textarea-cursor-col
    #:textarea-on-submit #:textarea-undo-stack #:textarea-redo-stack
    #:textarea-layout-node
+   #:textarea-lines
    #:handle-textarea-input #:render-textarea
    ;; Keybindings
    #:keymap #:make-keymap #:keymap-name #:keymap-bindings #:keymap-parent

src/components/input.lisp

@@ -42,38 +42,33 @@
   (raw nil :type (or string null)))
 
 ;;; ---------------------------------------------------------------------------
-;;; Terminal raw mode
+;;; Terminal raw mode (stty on /dev/tty — portable across Unices)
 ;;; ---------------------------------------------------------------------------
-(defun save-terminal-state ()
+(defun stty-run (args)
-  (sb-posix:tcgetattr 0))
+  "Run stty with ARGS. Returns stdout as string."
+  (with-output-to-string (s)
+    (sb-ext:run-program "/bin/sh"
+                        (list "-c" (format nil "stty ~{~a~^ ~} < /dev/tty"
+                                           (mapcar #'princ-to-string args)))
+                        :output s :wait t)))
 
-(defun make-raw-termios (termios)
+(defun save-terminal-state ()
-  (flet ((clear-flag (flags mask)
+  "Save current terminal settings via stty -g. Returns a string."
-           (logand flags (lognot mask))))
+  (let ((s (string-trim '(#\Newline #\Space) (stty-run '("-g")))))
-    (setf (sb-posix:termios-iflag termios)
+    (when (zerop (length s))
-          (clear-flag (sb-posix:termios-iflag termios)
+      (error "stty -g failed — not running in a real terminal"))
-                      (logior sb-posix:brkint sb-posix:ignpar
+    s))
-                              sb-posix:istrip sb-posix:inlcr
-                              sb-posix:igncr sb-posix:icrnl
-                              sb-posix:ixon)))
-    (setf (sb-posix:termios-oflag termios)
-          (clear-flag (sb-posix:termios-oflag termios)
-                      sb-posix:opost))
-    (setf (sb-posix:termios-lflag termios)
-          (clear-flag (sb-posix:termios-lflag termios)
-                      (logior sb-posix:icanon sb-posix:echo
-                              sb-posix:isig sb-posix:iexten)))
-    (setf (sb-posix:termios-cc termios sb-posix:vmin) 1)
-    (setf (sb-posix:termios-cc termios sb-posix:vtime) 0)
-    termios))
 
 (defun set-raw-mode ()
-  (let ((raw (make-raw-termios (save-terminal-state))))
+  "Put terminal in raw mode via stty. Returns the saved state string."
-    (sb-posix:tcsetattr 0 sb-posix:tcsanow raw)
+  (let ((saved (save-terminal-state)))
-    raw))
+    (stty-run '("raw" "-echo" "-isig" "-icanon" "min" "1" "time" "0"))
+    saved))
 
-(defun restore-terminal-state (termios)
+(defun restore-terminal-state (saved)
-  (sb-posix:tcsetattr 0 sb-posix:tcsanow termios))
+  "Restore saved terminal state (a string from stty -g, or nil)."
+  (when (and saved (plusp (length saved)))
+    (stty-run (list saved))))
 
 (defmacro with-raw-terminal (&body body)
   (let ((saved (gensym "SAVED")))
@@ -87,26 +82,27 @@
 ;;; Low-level byte reading
 ;;; ---------------------------------------------------------------------------
 (defun read-raw-byte (&key timeout)
-  (if timeout
+  (flet ((read-one ()
-      (let ((deadline (+ (get-universal-time) timeout)))
+           (let ((buf (make-array 1 :element-type '(unsigned-byte 8))))
-        (loop while (< (get-universal-time) deadline)
+             ;; Use sb-sys:with-pinned-objects so sb-posix:read can access the buffer
-              do (handler-case
+             (sb-sys:with-pinned-objects (buf)
-                     (let ((buf (make-array 1 :element-type '(unsigned-byte 8))))
+               (let ((n (sb-posix:read 0 (sb-sys:vector-sap buf) 1)))
-                       (let ((n (sb-posix:read 0 buf 1)))
+                 (when (plusp n)
-                         (when (plusp n)
+                   (return-from read-raw-byte (aref buf 0))))))))
-                           (return-from read-raw-byte (aref buf 0)))))
+    (if timeout
-                   (sb-posix:syscall-error ()
+        (let ((deadline (+ (get-universal-time) timeout)))
-                     (return-from read-raw-byte nil)))
+          (loop while (< (get-universal-time) deadline)
-              (sleep 0.01))
+                do (handler-case
-        nil)
+                       (read-one)
-      (let ((buf (make-array 1 :element-type '(unsigned-byte 8))))
+                     (sb-posix:syscall-error ()
-        (multiple-value-bind (n err)
+                       (return-from read-raw-byte nil)))
-            (ignore-errors (sb-posix:read 0 buf 1))
+                   (sleep 0.01))
-          (if (and (integerp n) (plusp n))
+          nil)
-              (aref buf 0)
+        (handler-case
-              (progn
+            (read-one)
-                (when err (format *error-output* "read error: ~A~%" err))
+          (sb-posix:syscall-error (e)
-                nil))))))
+            (format *error-output* "read error: ~A~%" e)
+            nil)))))
 
 ;;; ---------------------------------------------------------------------------
 ;;; CSI parameter parser
@@ -124,7 +120,10 @@
           ((and (>= b #x30) (<= b #x3f))
            (if (char= (code-char b) #\;)
                (progn (push current params) (setf current 0))
-               (setf current (+ (* current 10) (- b #x30)))))
+               ;; Non-digit parameter characters (< = > ?) start a new param at zero
+               (if (member b '(#x3c #x3d #x3e #x3f) :test #'=)
+                   (setf current 0)
+                   (setf current (+ (* current 10) (- b #x30))))))
           ((and (>= b #x20) (<= b #x2f))
            nil)
           ((and (>= b #x40) (<= b #x7e))
@@ -204,10 +203,14 @@
              (make-key-event :key :escape :raw (string #\Esc)))))
       ;; CSI: ESC [ ...
       (#x5b
-       (multiple-value-bind (params final-byte) (parse-csi-params)
+       (multiple-value-bind (params final-byte raw) (parse-csi-params)
          (if (null final-byte)
              (make-key-event :key :escape :raw (string #\Esc))
-             (if (and (char= (code-char final-byte) #\M)
+             ;; SGR mouse: ESC [ < ... m/M
+             (if (and raw (plusp (length raw)) (char= (char raw 0) #\<))
+                 (or (parse-sgr-mouse raw)
+                     (make-key-event :key :unknown :raw raw))
+                 (if (and (char= (code-char final-byte) #\M)
                       (>= (length params) 3))
                  (let* ((p0 (first params)))
                    (if (zerop (logand p0 #x40))
@@ -215,15 +218,12 @@
                               (y (third params))
                               (button (logand p0 #x03))
                               (motion (logand p0 #x20))
-                              (wheel (logand p0 #x40)))
+                              (release (= button 3)))
                          (make-mouse-event
-                          :type (if motion :drag :press)
+                          :type (cond (release :release)
-                          :button (cond (wheel (if (zerop (logand p0 #x01))
+                                      (motion :drag)
-                                                   :wheel-up :wheel-down))
+                                      (t :press))
-                                        ((= button 0) :left)
+                          :button (let ((b button)) (cond ((= b 0) :left) ((= b 1) :middle) ((= b 2) :right) (t :none)))
-                                        ((= button 1) :middle)
-                                        ((= button 2) :right)
-                                        (t :none))
                           :x x :y y :raw (format nil "~C[<~d;~d;~d~C" #\Esc p0 x y (code-char final-byte))))
                        (let* ((tilde-p (char= (code-char final-byte) #\~))
                               (param (or p0 0))
@@ -252,7 +252,7 @@
                              ctrl  (logtest modifier 4)))
                      (make-key-event :key (or key :unknown)
                                      :ctrl ctrl :alt alt :shift shift
-                                     :raw (format nil "~C[~d~C" #\Esc param (code-char final-byte))))))))))
+                                     :raw (format nil "~C[~d~C" #\Esc param (code-char final-byte)))))))))))
       ;; ESC ESC
       (#x1b
        (make-key-event :key :escape :alt t :raw "\\e\\e"))
@@ -273,24 +273,24 @@
   (let ((b (read-raw-byte :timeout timeout)))
     (unless b
       (return-from %read-event nil))
-    (case b
+    (cond
-      (#x1b
+      ((= b #x1b)
        (%read-escape-sequence))
-      (#x09
+      ((= b #x09)
        (make-key-event :key :tab :code #x09))
-      (#x0a
+      ((= b #x0a)
        (make-key-event :key :enter :code #x0a))
-      (#x0d
+      ((= b #x0d)
        (make-key-event :key :enter :code #x0d))
-      ((#x7f #x08)
+      ((or (= b #x7f) (= b #x08))
        (make-key-event :key :backspace :code b))
       ((and (>= b #x01) (<= b #x1a))
        (let ((key (intern (string-upcase (string (code-char (+ b #x60)))) :keyword)))
          (make-key-event :key key :ctrl t :code b)))
-      (#x1c (make-key-event :key :backslash :ctrl t :code b))
+      ((= b #x1c) (make-key-event :key :backslash :ctrl t :code b))
-      (#x1d (make-key-event :key :rbracket :ctrl t :code b))
+      ((= b #x1d) (make-key-event :key :rbracket :ctrl t :code b))
-      (#x1e (make-key-event :key :caret :ctrl t :code b))
+      ((= b #x1e) (make-key-event :key :caret :ctrl t :code b))
-      (#x1f (make-key-event :key :underscore :ctrl t :code b))
+      ((= b #x1f) (make-key-event :key :underscore :ctrl t :code b))
       ((and (>= b #x20) (<= b #x7e))
        (let ((ch (code-char b)))
          (make-key-event :key (intern (string (string-upcase ch)) :keyword)

src/components/mouse.lisp

@@ -16,18 +16,27 @@
     (when handler (funcall handler event))))
 
 (defun hit-test (root x y)
+  "Find the deepest component at (X, Y) by testing layout-node bounds.
+Recurses into component-children to find the innermost match.
+Components without a layout-node or position return nil."
   (labels ((recurse (node)
-             (when (and (slot-exists-p node 'x) (slot-boundp node 'x)
+             (let ((ln (ignore-errors (component-layout-node node)))
-                        (slot-exists-p node 'y) (slot-boundp node 'y)
+                   (best nil))
-                        (slot-exists-p node 'width) (slot-boundp node 'width)
+               (when ln
-                        (slot-exists-p node 'height) (slot-boundp node 'height))
+                 (let ((nx (layout-node-x ln))
-               (let ((nx (slot-value node 'x))
+                       (ny (layout-node-y ln))
-                     (ny (slot-value node 'y))
+                       (nw (layout-node-width ln))
-                     (nw (slot-value node 'width))
+                       (nh (layout-node-height ln)))
-                     (nh (slot-value node 'height)))
+                   ;; Check children first for deeper match
-                 (when (and (>= x nx) (< x (+ nx nw))
+                   (dolist (child (ignore-errors (component-children node)))
-                            (>= y ny) (< y (+ ny nh)))
+                     (let ((child-hit (recurse child)))
-                   node)))))
+                       (when child-hit
+                         (setf best child-hit))))
+                   ;; If no child matched, check self
+                   (or best
+                       (when (and (>= x nx) (< x (+ nx nw))
+                                  (>= y ny) (< y (+ ny nh)))
+                         node)))))))
     (recurse root)))
 
 ;; Selection

src/components/scrollbox.lisp

@@ -39,6 +39,8 @@
           :initial-value 0))
 
 (defmethod render ((sb scroll-box) backend)
+  "Render ScrollBox children within the viewport, offset by scroll position.
+Children outside the viewport are skipped."
   (let* ((ln (scroll-box-layout-node sb))
          (vx 0) (vy 0)
          (vw (if ln (layout-node-width ln) 80))
@@ -49,9 +51,20 @@
       (let* ((cln (component-layout-node child))
              (ch (if cln (layout-node-height cln) 1))
              (cy vy))
-        (when (and (< (+ cy (- sy)) (+ vh vy)) (> (+ cy (- sy) ch) vy))
+        ;; Only render children that are visible in the viewport
-          (draw-text backend (- sx) (+ vy cy (- sy))
+        (when (and (< (+ cy (- sy)) (+ vh vy))
-                     (format nil "child at ~D" vy) nil nil))
+                   (> (+ cy (- sy) ch) vy))
+          ;; Temporarily offset child's layout-node position for rendering
+          (let ((orig-x (if cln (layout-node-x cln) 0))
+                (orig-y (if cln (layout-node-y cln) 0)))
+            (when cln
+              (setf (layout-node-x cln) (- orig-x sx)
+                    (layout-node-y cln) (- orig-y sy)))
+            (unwind-protect
+                 (render child backend)
+              (when cln
+                (setf (layout-node-x cln) orig-x
+                      (layout-node-y cln) orig-y)))))
         (incf vy ch)))
     (draw-scrollbars sb backend vw vh)))
 

src/components/select.lisp

@@ -76,7 +76,9 @@
     (subseq filtered start end)))
 
 (defmethod render ((sel select) backend)
-  (let* ((ln (select-layout-node sel)) (x 0) (y 0)
+  (let* ((ln (select-layout-node sel))
+         (x (if ln (layout-node-x ln) 0))
+         (y (if ln (layout-node-y ln) 0))
          (w (if ln (layout-node-width ln) 80))
          (visible (select-visible-options sel)) (sel-idx (select-selected-index sel)))
     (dolist (item visible)

src/components/tabbar.lisp

@@ -35,9 +35,11 @@
   (case (key-event-key event) (:left (tab-bar-prev tb) t) (:right (tab-bar-next tb) t) (t nil)))
 
 (defmethod render ((tb tab-bar) backend)
-  (let* ((ln (tab-bar-layout-node tb)) (y 0)
+  (let* ((ln (tab-bar-layout-node tb))
+         (x (if ln (layout-node-x ln) 0))
+         (y (if ln (layout-node-y ln) 0))
          (w (if ln (layout-node-width ln) 80))
-         (active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos 0))
+         (active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos x))
     (dolist (tab tabs)
       (let* ((id (getf tab :id)) (title (getf tab :title))
              (label (format nil " ~A " title)) (label-len (length label))

src/components/text-input.lisp

@@ -153,11 +153,19 @@
             (text-input-insert input ch))))))))
 
 ;;; ---------------------------------------------------------------------------
-;;; Rendering (stub — proper rendering uses theme + backend)
+;;; Rendering
 ;;; ---------------------------------------------------------------------------
 (defmethod render ((in text-input) (backend t))
-  "Render a text-input widget. Full rendering requires *current-backend*,
+  "Render text-input value or placeholder at layout position."
-  *current-theme*, and the rendering pipeline. This is a no-op stub for
+  (let* ((ln (text-input-layout-node in))
-  unit testing the widget logic."
+         (x (if ln (layout-node-x ln) 0))
-  (declare (ignore in backend))
+         (y (if ln (layout-node-y ln) 0))
-  (values))
+         (w (if ln (layout-node-width ln) 80))
+         (value (text-input-value in))
+         (cursor (text-input-cursor in))
+         (display (if (plusp (length value))
+                      value
+                      (or (text-input-placeholder in) "")))
+         (truncated (subseq display 0 (min (length display) w))))
+    (declare (ignore w cursor))
+    (draw-text backend x y truncated nil nil)))

src/components/textarea.lisp

@@ -237,11 +237,19 @@
             (textarea-insert-char ta ch))))))))
 
 ;;; ---------------------------------------------------------------------------
-;;; Rendering (stub — proper rendering uses theme + backend)
+;;; Rendering
 ;;; ---------------------------------------------------------------------------
 (defmethod render ((ta textarea) (backend t))
-  "Render a textarea widget. Full rendering requires *current-backend*,
+  "Render textarea lines at layout position."
-  *current-theme*, and the rendering pipeline. This is a no-op stub for
+  (let* ((ln (textarea-layout-node ta))
-  unit testing the widget logic."
+         (x (if ln (layout-node-x ln) 0))
-  (declare (ignore ta backend))
+         (y (if ln (layout-node-y ln) 0))
-  (values))
+         (w (if ln (layout-node-width ln) 80))
+         (h (if ln (layout-node-height ln) 24))
+         (lines (textarea-lines ta))
+         (max-lines (min (length lines) h)))
+    (loop for i from 0 below max-lines
+          for line in lines
+          do (draw-text backend x (+ y i)
+                        (subseq line 0 (min (length line) w))
+                        nil nil))))

src/components/theme.lisp

@@ -26,16 +26,20 @@ NAME should be a keyword (e.g., :default, :nord)."
   `(setf (gethash ,name *presets*) '(:dark ,dark :light ,light)))
 
 (defun load-preset (theme preset-name)
-  "Load PRESET-NAME (a keyword) into THEME, overwriting role mappings."
+  "Load PRESET-NAME colors into THEME.
+Side-effect: populates cl-tty.backend:*theme-colors* so that semantic
+color roles resolve to hex at SGR generation time."
   (let ((preset (gethash preset-name *presets*)))
     (if preset
-        (let* ((variant (if (eql (theme-mode theme) :dark)
+        (let* ((colors (if (eql (theme-mode theme) :dark)
-                            (getf preset :dark)
+                           (getf preset :dark)
-                            (getf preset :light)))
+                           (getf preset :light)))
-               (roles (theme-roles theme)))
+               ;; Populate backend theme color map
-          (clrhash roles)
+               (theme-map (symbol-value (find-symbol "*THEME-COLORS*" :cl-tty.backend))))
-          (loop for (role hex) on variant by #'cddr
+          ;; Set theme colors
-                do (setf (gethash role roles) hex)))
+          (loop for (role hex) on colors by #'cddr
+                do (setf (theme-color theme role) hex)
+                   (setf (gethash role theme-map) hex)))
         (warn "Unknown preset: ~S" preset-name))))
 
 (define-preset :default

system-index.txt

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

tests/input-tests.lisp

@@ -0,0 +1,269 @@
+(defpackage :cl-tty-input-test
+  (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
+  (:export #:run-tests))
+(in-package :cl-tty-input-test)
+
+(def-suite input-suite :description "Text input and keybinding tests")
+(in-suite input-suite)
+
+(defun run-tests ()
+  (let ((result (run 'input-suite)))
+    (fiveam:explain! result)
+    (uiop:quit 0)))
+
+;; ── Key Event Tests ─────────────────────────────────────────────
+
+(test key-event-construction
+  "A key-event can be created and queried."
+  (let ((e (make-key-event :key :a :ctrl t :alt nil)))
+    (is (eql (key-event-key e) :a))
+    (is-true (key-event-ctrl e))
+    (is-false (key-event-alt e))))
+
+(test key-event-defaults
+  "Fields default to NIL/nil."
+  (let ((e (make-key-event :key :space)))
+    (is (eql (key-event-key e) :space))
+    (is-false (key-event-ctrl e))
+    (is-false (key-event-alt e))
+    (is-false (key-event-shift e))))
+
+(test mouse-event-construction
+  "A mouse-event can be created and queried."
+  (let ((e (make-mouse-event :type :press :button :left :x 10 :y 5)))
+    (is (eql (mouse-event-type e) :press))
+    (is (eql (mouse-event-button e) :left))
+    (is (= (mouse-event-x e) 10))
+    (is (= (mouse-event-y e) 5))))
+
+;; ── TextInput Tests ─────────────────────────────────────────────
+
+(test text-input-empty
+  "A newly created text-input has empty value and cursor at 0."
+  (let ((in (make-text-input)))
+    (is (string= (text-input-value in) ""))
+    (is (= (text-input-cursor in) 0))))
+
+(test text-input-insert-char
+  "Inserting a character appends and moves cursor."
+  (let ((in (make-text-input)))
+    (handle-text-input in (make-key-event :key :a :code (char-code #\a)))
+    (is (string= (text-input-value in) "a"))
+    (is (= (text-input-cursor in) 1))))
+
+(test text-input-insert-multiple
+  "Inserting multiple characters works left to right."
+  (let ((in (make-text-input)))
+    (handle-text-input in (make-key-event :key :h :code (char-code #\h)))
+    (handle-text-input in (make-key-event :key :e :code (char-code #\e)))
+    (handle-text-input in (make-key-event :key :l :code (char-code #\l)))
+    (handle-text-input in (make-key-event :key :l :code (char-code #\l)))
+    (handle-text-input in (make-key-event :key :o :code (char-code #\o)))
+    (is (string= (text-input-value in) "hello"))
+    (is (= (text-input-cursor in) 5))))
+
+(test text-input-backspace
+  "Backspace removes the character before the cursor."
+  (let ((in (make-text-input :value "ab" :cursor 2)))
+    (handle-text-input in (make-key-event :key :backspace))
+    (is (string= (text-input-value in) "a"))
+    (is (= (text-input-cursor in) 1))))
+
+(test text-input-backspace-at-start
+  "Backspace at position 0 does nothing."
+  (let ((in (make-text-input :value "ab" :cursor 0)))
+    (handle-text-input in (make-key-event :key :backspace))
+    (is (string= (text-input-value in) "ab"))
+    (is (= (text-input-cursor in) 0))))
+
+(test text-input-delete
+  "Delete removes the character at the cursor."
+  (let ((in (make-text-input :value "abc" :cursor 1)))
+    (handle-text-input in (make-key-event :key :delete))
+    (is (string= (text-input-value in) "ac"))
+    (is (= (text-input-cursor in) 1))))
+
+(test text-input-cursor-left-right
+  "Cursor moves left and right."
+  (let ((in (make-text-input :value "ab" :cursor 2)))
+    (handle-text-input in (make-key-event :key :left))
+    (is (= (text-input-cursor in) 1))
+    (handle-text-input in (make-key-event :key :right))
+    (is (= (text-input-cursor in) 2))))
+
+(test text-input-cursor-bounds
+  "Cursor cannot move past start or end."
+  (let ((in (make-text-input :value "ab" :cursor 0)))
+    (handle-text-input in (make-key-event :key :left))
+    (is (= (text-input-cursor in) 0))
+    (setf (text-input-cursor in) 2)
+    (handle-text-input in (make-key-event :key :right))
+    (is (= (text-input-cursor in) 2))))
+
+(test text-input-home-end
+  "Home moves to start, End moves to end."
+  (let ((in (make-text-input :value "hello" :cursor 3)))
+    (handle-text-input in (make-key-event :key :home))
+    (is (= (text-input-cursor in) 0))
+    (handle-text-input in (make-key-event :key :end))
+    (is (= (text-input-cursor in) 5))))
+
+(test text-input-max-length
+  "Max-length prevents inserting beyond the limit."
+  (let ((in (make-text-input :max-length 3)))
+    (handle-text-input in (make-key-event :key :a :code (char-code #\a)))
+    (handle-text-input in (make-key-event :key :b :code (char-code #\b)))
+    (handle-text-input in (make-key-event :key :c :code (char-code #\c)))
+    (handle-text-input in (make-key-event :key :d :code (char-code #\d)))
+    (is (string= (text-input-value in) "abc"))))
+
+(test text-input-placeholder
+  "Placeholder is stored but does not affect value."
+  (let ((in (make-text-input :placeholder "Type here...")))
+    (is (string= (text-input-placeholder in) "Type here..."))
+    (is (string= (text-input-value in) ""))))
+
+(test text-input-on-submit
+  "On-submit callback fires on Enter."
+  (let ((result (list nil)))
+    (let ((in (make-text-input :value "hello"
+                               :on-submit (lambda (v) (setf (car result) v)))))
+      (handle-text-input in (make-key-event :key :enter))
+      (is (string= (car result) "hello")))))
+
+(test text-input-ctrl-a-e
+  "Ctrl+A moves to home, Ctrl+E moves to end."
+  (let ((in (make-text-input :value "abc" :cursor 2)))
+    (handle-text-input in (make-key-event :key :a :ctrl t))
+    (is (= (text-input-cursor in) 0))
+    (handle-text-input in (make-key-event :key :e :ctrl t))
+    (is (= (text-input-cursor in) 3))))
+
+(test text-input-insert-in-middle
+  "Inserting in the middle of text shifts rest right."
+  (let ((in (make-text-input :value "ab" :cursor 1)))
+    (handle-text-input in (make-key-event :key :x :code (char-code #\x)))
+    (is (string= (text-input-value in) "axb"))
+    (is (= (text-input-cursor in) 2))))
+
+(test text-input-dirty-on-insert
+  "Inserting marks the widget dirty."
+  (let ((in (make-text-input)))
+    (mark-clean in)
+    (handle-text-input in (make-key-event :key :a :code (char-code #\a)))
+    (is-true (dirty-p in))))
+
+;; ── Textarea Tests ──────────────────────────────────────────────
+
+(test textarea-empty
+  "New textarea has empty value and cursor at (0,0)."
+  (let ((a (make-textarea)))
+    (is (string= (textarea-value a) ""))
+    (is (= (textarea-cursor-row a) 0))
+    (is (= (textarea-cursor-col a) 0))))
+
+(test textarea-newline
+  "Enter inserts a newline."
+  (let ((a (make-textarea)))
+    (handle-textarea-input a (make-key-event :key :a :code (char-code #\a)))
+    (handle-textarea-input a (make-key-event :key :enter))
+    (handle-textarea-input a (make-key-event :key :b :code (char-code #\b)))
+    (is (string= (textarea-value a) "a
+b"))))
+
+(test textarea-cursor-up-down
+  "Cursor moves between lines maintaining column position."
+  (let ((a (make-textarea :value "abc
+de
+fghi")))
+    (setf (textarea-cursor-row a) 1)
+    (setf (textarea-cursor-col a) 1)
+    (handle-textarea-input a (make-key-event :key :up))
+    (is (= (textarea-cursor-row a) 0))
+    (is (= (textarea-cursor-col a) 1))
+    (handle-textarea-input a (make-key-event :key :down))
+    (is (= (textarea-cursor-row a) 1))
+    (is (= (textarea-cursor-col a) 1))))
+
+(test textarea-cursor-up-down-bounds
+  "Cursor cannot move past first or last line."
+  (let ((a (make-textarea :value "a
+b")))
+    (handle-textarea-input a (make-key-event :key :up))
+    (is (= (textarea-cursor-row a) 0))
+    (setf (textarea-cursor-row a) 1)
+    (handle-textarea-input a (make-key-event :key :down))
+    (is (= (textarea-cursor-row a) 1))))
+
+(test textarea-backspace-joins-lines
+  "Backspace at start of a line joins with previous."
+  (let ((a (make-textarea :value "hello
+world")))
+    (setf (textarea-cursor-row a) 1)
+    (setf (textarea-cursor-col a) 0)
+    (handle-textarea-input a (make-key-event :key :backspace))
+    (is (string= (textarea-value a) "helloworld"))))
+
+(test textarea-undo
+  "Ctrl+Z undoes the last edit."
+  (let ((a (make-textarea)))
+    (handle-textarea-input a (make-key-event :key :a :code (char-code #\a)))
+    (handle-textarea-input a (make-key-event :key :z :ctrl t))
+    (is (string= (textarea-value a) ""))))
+
+(test textarea-undo-redo
+  "Ctrl+Y redoes an undone edit."
+  (let ((a (make-textarea)))
+    (handle-textarea-input a (make-key-event :key :a :code (char-code #\a)))
+    (handle-textarea-input a (make-key-event :key :z :ctrl t))
+    (handle-textarea-input a (make-key-event :key :y :ctrl t))
+    (is (string= (textarea-value a) "a"))))
+
+;; ── Keybinding Tests ────────────────────────────────────────────
+
+(test keymap-simple
+  "A keymap dispatches to its handler on matching event."
+  (let ((called nil))
+    (setf (gethash :global *keymaps*)
+          (make-keymap :name :global
+                       :bindings `((:ctrl+p . ,(lambda (e)
+                                                 (declare (ignore e))
+                                                 (setf called t))))))
+    (is-true (dispatch-key-event (make-key-event :key :p :ctrl t)))
+    (is-true called)))
+
+(test keymap-no-match
+  "Non-matching event returns nil."
+  (let ((called nil))
+    (setf (gethash :global *keymaps*)
+          (make-keymap :name :global
+                       :bindings `((:ctrl+p . ,(lambda (e)
+                                                 (declare (ignore e))
+                                                 (setf called t))))))
+    (is-false (dispatch-key-event (make-key-event :key :a)))
+    (is-false called)))
+
+(test keymap-fallback
+  "Event not in local falls through to global."
+  (let ((global-called nil))
+    (setf (gethash :global *keymaps*)
+          (make-keymap :name :global
+                       :bindings `((:ctrl+q . ,(lambda (e)
+                                                 (declare (ignore e))
+                                                 (setf global-called t))))))
+    (dispatch-key-event (make-key-event :key :q :ctrl t))
+    (is-true global-called)))
+
+(test key-spec-simple
+  "Keyword key-spec matches key+ctrl."
+  (is-true (key-match-p :ctrl+p (make-key-event :key :p :ctrl t)))
+  (is-false (key-match-p :ctrl+p (make-key-event :key :a :ctrl t)))
+  (is-false (key-match-p :ctrl+p (make-key-event :key :p))))
+
+(test defkeymap-macro
+  "defkeymap macro registers a keymap."
+  (let ((called nil))
+    (eval `(defkeymap :global
+             (:ctrl+q ,(lambda (e) (declare (ignore e)) (setf called t)))))
+    (dispatch-key-event (make-key-event :key :q :ctrl t))
+    (is-true called)))