fix: org tangle — fix END_SRC boundaries in mouse.org/slot.org (prose inside code blocks), replace emacs tangle with Python script that handles all blocks

backend/detection.lisp

@@ -60,3 +60,66 @@ Result is cached in *detected-backend* for subsequent calls."
                          (detect-backend-by-da1)))
                 (make-modern-backend)
                 (make-simple-backend)))))
+
+(in-package :cl-tty.backend)
+
+;;; ─── Detection cache ────────────────────────────────────────────────────────
+
+(defvar *detected-backend* nil
+  "Cached backend instance from detect-backend. Nil = not yet detected.")
+
+;;; ─── Environment probe ──────────────────────────────────────────────────────
+
+(defun detect-backend-by-env ()
+  "Check COLORTERM environment variable for modern terminal support.
+Returns :modern if COLORTERM contains 'truecolor' or '24bit', nil otherwise."
+  (let ((colorterm (sb-ext:posix-getenv "COLORTERM")))
+    (when (and colorterm
+               (or (search "truecolor" colorterm :test #'char-equal)
+                   (search "24bit" colorterm :test #'char-equal)))
+      :modern)))
+
+;;; ─── TTY probe ──────────────────────────────────────────────────────────────
+
+(defun detect-backend-by-tty ()
+  "Check if stdout is a real terminal (not a pipe/redirect).
+Returns T if stdout is interactive, nil otherwise."
+  (interactive-stream-p *standard-output*))
+
+;;; ─── DA1 terminal query ─────────────────────────────────────────────────────
+
+(defun query-terminal (query &optional (timeout 0.1))
+  "Send QUERY string to terminal and return any response received within
+TIMEOUT seconds. Returns the response string, or nil if no response."
+  (write-string query *standard-output*)
+  (force-output *standard-output*)
+  (sleep timeout)
+  (let ((response (make-array 0 :element-type 'character
+                              :fill-pointer 0 :adjustable t)))
+    (loop while (listen *standard-input*)
+          do (vector-push-extend (read-char-no-hang *standard-input*) response))
+    (when (plusp (length response))
+      response)))
+
+(defun detect-backend-by-da1 ()
+  "Send DA1 (ESC[c) query and check for kitty terminal response code.
+Returns T if terminal reports kitty compatibility codes."
+  (let ((response (query-terminal (format nil "~C[c" #\Esc))))
+    (when response
+      ;; DA1 response format: ESC [ ? digits ; digits c
+      ;; Kitty reports code 62 in the response
+      (search "?62" response))))
+
+;;; ─── Orchestrator ───────────────────────────────────────────────────────────
+
+(defun detect-backend ()
+  "Auto-detect the appropriate backend for the current terminal.
+Returns a backend instance (modern-backend or simple-backend).
+Result is cached in *detected-backend* for subsequent calls."
+  (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)))))

org/detection.org

@@ -108,19 +108,30 @@ Returns T if stdout is interactive, nil otherwise."
 Send a DA1 (Device Attributes) query and briefly listen for a response.
 This is best-effort — many terminals respond asynchronously or not at all.
 
+*** Bug Fixes (v1.0.0): query-terminal stream fix
+
+~query-terminal~ originally used ~*query-io*~ for both writing the query and
+reading the response.  In raw terminal mode, the terminal's response arrives on
+stdin, not on the query I/O stream.  This caused ~query-terminal~ to never
+receive a response on certain terminal emulators.
+
+Fix: Write queries to ~*standard-output*~ and read responses from
+~*standard-input*~.  This matches where the terminal actually delivers its
+DA1/DA3 response bytes.
+
 #+BEGIN_SRC lisp :tangle ../backend/detection.lisp
 ;;; ─── DA1 terminal query ─────────────────────────────────────────────────────
 
 (defun query-terminal (query &optional (timeout 0.1))
   "Send QUERY string to terminal and return any response received within
 TIMEOUT seconds. Returns the response string, or nil if no response."
-  (write-string query *query-io*)
+  (write-string query *standard-output*)
-  (force-output *query-io*)
+  (force-output *standard-output*)
   (sleep timeout)
   (let ((response (make-array 0 :element-type 'character
                               :fill-pointer 0 :adjustable t)))
-    (loop while (listen *query-io*)
+    (loop while (listen *standard-input*)
-          do (vector-push-extend (read-char-no-hang *query-io*) response))
+          do (vector-push-extend (read-char-no-hang *standard-input*) response))
     (when (plusp (length response))
       response)))
 

org/dialog.org

@@ -64,24 +64,49 @@ inside the dialog panel), its size preset, title, and callbacks.
 
 --- per-function: dialog-size-pixels
 
-Helper to convert size keyword to pixel dimensions.
+Helper to convert size keyword to pixel dimensions, clamped to available
+terminal dimensions.
+
+*** Bug Fixes (v1.0.0): dialog size clamp and draw-border keyword
+
+Three bugs were fixed:
+
+1. *Unclamped dialog size*: ~dialog-size-pixels~ returned fixed sizes
+   (~:large~ = 88x24) that could exceed the terminal dimensions, causing
+   the dialog panel to overflow off-screen.
+
+   Fix: ~dialog-size-pixels~ now accepts optional ~max-w~ and ~max-h~
+   parameters and clamps the result to those bounds using ~(min ...)~.
+
+2. *render-dialog not passing dimensions*: ~render-dialog~ called
+   ~dialog-size-pixels~ with only the size keyword, so terminal dimensions
+   were never forwarded for clamping.
+
+   Fix: ~render-dialog~ now passes ~w h~ to ~dialog-size-pixels~.
+
+3. *draw-border keyword style*: The ~draw-border~ call used a bare ~:single~
+   keyword for the border style.  The function signature expects ~:style :single~.
+
+   Fix: Changed ~:single~ to ~:style :single~.
 
 #+BEGIN_SRC lisp :tangle no
-(defun dialog-size-pixels (size)
+(defun dialog-size-pixels (size &optional (max-w 80) (max-h 24))
+  (multiple-value-bind (dw dh)
       (case size
         (:small (values 40 8))
         (:medium (values 60 16))
         (:large (values 88 24))
-    (t (values 60 16))))
+        (t (values 60 16)))
+    (values (min dw max-w) (min dh max-h))))
 #+END_SRC
 
---- per-function: render-dialog
+|--- per-function: render-dialog
 
 Render a dialog: backdrop (dimmed full-screen), then centered panel.
 
 #+BEGIN_SRC lisp :tangle no
 (defun render-dialog (dialog screen w h)
-  (multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog))
+  (multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog) w h)
     (let ((x (floor (- w dw) 2))
           (y (floor (- h dh) 2)))
       ;; Backdrop — draw dim characters over full screen
@@ -89,7 +114,7 @@ Render a dialog: backdrop (dimmed full-screen), then centered panel.
         (dotimes (col w)
           (backend-write screen col row " " :bg :dim)))
       ;; Panel border
-      (draw-border screen x y dw dh :single :title (dialog-title dialog))
+      (draw-border screen x y dw dh :style :single :title (dialog-title dialog))
       ;; Content area (inset by 1 on each side)
       (when (dialog-content dialog)
         (render-component (dialog-content dialog) screen (1+ x) (1+ y) (- dw 2) (- dh 2))))))
@@ -288,7 +313,7 @@ Remove a toast from the list.
 ;;; dialog-package.lisp — Package definition for cl-tty.dialog
 
 (defpackage :cl-tty.dialog
-  (:use :cl :cl-tty.input :cl-tty.select)
+  (:use :cl :cl-tty.backend :cl-tty.input :cl-tty.select)
   (:export
    #:dialog
    #:dialog-title
@@ -333,22 +358,24 @@ Remove a toast from the list.
    (content :initarg :content :initform nil :accessor dialog-content)
    (on-dismiss :initarg :on-dismiss :initform nil :accessor dialog-on-dismiss)))
 
-(defun dialog-size-pixels (size)
+(defun dialog-size-pixels (size &optional (max-w 80) (max-h 24))
+  (multiple-value-bind (dw dh)
       (case size
         (:small (values 40 8))
         (:medium (values 60 16))
         (:large (values 88 24))
-    (t (values 60 16))))
+        (t (values 60 16)))
+    (values (min dw max-w) (min dh max-h))))
 
 (defun render-dialog (dialog screen w h)
-  (multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog))
+  (multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog) w h)
     (let ((x (floor (- w dw) 2))
           (y (floor (- h dh) 2)))
       ;; Backdrop — dim the full screen
       (dotimes (row h)
         (draw-rect screen 0 row w 1 :bg :bright-black))
       ;; Dialog panel
-      (draw-border screen x y dw dh :single :title (dialog-title dialog))
+      (draw-border screen x y dw dh :style :single :title (dialog-title dialog))
       (when (dialog-content dialog)
         ;; Content rendering delegated to component system
         (draw-text screen (1+ x) (1+ y)

org/mouse.org

@@ -90,10 +90,26 @@ Components without a layout-node or position return nil."
 
 (defun get-selection ()
   (when *selection* (sel-text *selection*)))
+#+END_SRC
 
+*** Bug Fixes (v1.0.0): Wayland clipboard support
+
+~copy-to-clipboard~ only called ~xclip~, which fails silently on Wayland
+sessions (where ~xclip~ is often unavailable or requires XWayland).
+
+Fix: Check the ~WAYLAND_DISPLAY~ environment variable.  If set, use
+~wl-copy~ instead of ~xclip~.  Fall back to ~xclip~ for traditional X11
+sessions.
+
+#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
 (defun copy-to-clipboard (text)
-  #+linux (sb-ext:run-program "xclip" (list "-selection" "clipboard")
+  #+linux
-                               :input text :wait nil)
+  (cond
+    ((sb-ext:posix-getenv "WAYLAND_DISPLAY")
+     (sb-ext:run-program "wl-copy" nil :input text :wait nil))
+    (t
+     (sb-ext:run-program "xclip" (list "-selection" "clipboard")
+                         :input text :wait nil)))
   #+darwin (sb-ext:run-program "pbcopy" nil :input text :wait nil))
 
 ;;; --- Selection tracking (mouse drag) ---------------------------------------

org/scrollbox-tabbar.org

@@ -528,6 +528,26 @@ they are truncated with an ellipsis.
     (values)))
 #+END_SRC
 
+** Bug Fixes (v1.0.0): scroll offset and scrollbar position
+
+Two bugs were fixed in the ScrollBox render pipeline:
+
+1. *Render scroll origin*: The render method used ~orig-y~ (the child's original
+   layout-node Y position, always 0 for top-level children) as the basis for
+   scroll offset.  This caused the content-relative position ~vy~ to be ignored,
+   making scroll offsets incorrect when children were offset by layout.
+
+   Fix: Use ~vy~ (the content-relative Y accumulator) instead of ~orig-y~ when
+   setting the temporary layout offset: ~(layout-node-y cln) (- vy sy)~.
+
+2. *Scrollbar positions*: ~draw-scrollbars~ drew scrollbars at viewport-local
+   coordinates (0, 0), not accounting for the scrollbox's own position within
+   the layout tree.  Scrollbars would appear at the wrong screen location when
+   the scrollbox was nested inside other containers.
+
+   Fix: Read the scrollbox's layout-node origin ~(ox, oy)~ and offset all
+   scrollbar drawing coordinates by those values.
+
 ** Combined tangle blocks
 
 #+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
@@ -585,14 +605,14 @@ Children outside the viewport are skipped."
              (ch (if cln (layout-node-height cln) 1))
              (cy vy))
         ;; Only render children that are visible in the viewport
-        (when (and (< (+ cy (- sy)) (+ vh vy))
+        (when (and (< (- cy sy) vh)
-                   (> (+ cy (- sy) ch) vy))
+                   (> (+ (- cy sy) ch) 0))
           ;; 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)
+              (setf (layout-node-x cln) (- vx sx)
-                    (layout-node-y cln) (- orig-y sy)))
+                    (layout-node-y cln) (- vy sy)))
             (unwind-protect
                  (render child backend)
               (when cln
@@ -606,17 +626,20 @@ Children outside the viewport are skipped."
 
 (defun draw-scrollbars (sb backend viewport-w viewport-h)
   (let* ((content-h (scroll-box-content-height sb)) (content-w (scroll-box-content-width sb))
-         (sy (scroll-box-scroll-y sb)) (sx (scroll-box-scroll-x sb)))
+         (sy (scroll-box-scroll-y sb)) (sx (scroll-box-scroll-x sb))
+         (ln (scroll-box-layout-node sb))
+         (ox (if ln (layout-node-x ln) 0))
+         (oy (if ln (layout-node-y ln) 0)))
     (when (> content-h viewport-h)
       (let* ((thumb (scrollbar-thumb sy viewport-h content-h))
              (thumb-pos (round (* thumb viewport-h))))
-        (draw-rect backend (1- viewport-w) 0 1 viewport-h :bg :bright-black)
+        (draw-rect backend (+ ox (1- viewport-w)) oy 1 viewport-h :bg :bright-black)
-        (draw-text backend (1- viewport-w) thumb-pos "█" nil nil)))
+        (draw-text backend (+ ox (1- viewport-w)) (+ oy thumb-pos) "█" nil nil)))
     (when (> content-w viewport-w)
       (let* ((thumb (scrollbar-thumb sx viewport-w content-w))
              (thumb-pos (round (* thumb viewport-w))))
-        (draw-rect backend 0 (1- viewport-h) viewport-w 1 :bg :bright-black)
+        (draw-rect backend ox (+ oy (1- viewport-h)) viewport-w 1 :bg :bright-black)
-        (draw-text backend thumb-pos (1- viewport-h) "█" nil nil)))))
+        (draw-text backend (+ ox thumb-pos) (+ oy (1- viewport-h)) "█" nil nil)))))
 
 (defun update-sticky-scroll (sb)
   (when (sticky-scroll-p sb)

org/slot.org

@@ -51,11 +51,26 @@ Slot modes:
         (setf (gethash key *slots*)
               (sort (cons (cons order render-fn) entries) #'< :key #'car))))
   render-fn)
+#+END_SRC
 
+*** Bug Fixes (v1.0.0): nil handler guard in slot-render
+
+~slot-render~ called ~(apply (cdr entry) args)~ unconditionally, but
+~defslot~ stores ~(order . render-fn)~ pairs where ~render-fn~ can be
+~nil~ (if called without ~:render-fn~).  This caused a type error when
+~apply~ received ~nil~ as the function argument.
+
+Fix: Check ~(when fn)~ before calling ~apply~.  Entries with a nil
+handler are silently skipped.
+
+#+BEGIN_SRC lisp :tangle ../src/components/slot.lisp :noweb no
 (defun slot-render (slot-name &rest args)
   (let ((entries (gethash (string slot-name) *slots*)))
     (when entries
-      (mapcar (lambda (entry) (apply (cdr entry) args)) entries))))
+      (mapcar (lambda (entry)
+                (let ((fn (cdr entry)))
+                  (when fn (apply fn args))))
+              entries))))
 
 (defun slot-p (slot-name)
   (nth-value 1 (gethash (string slot-name) *slots*)))

org/text-input.org

@@ -445,11 +445,11 @@ terminal raw mode, TextInput, Textarea, and the keybinding system.
    ;; Textarea
    #:textarea #:make-textarea
    #:textarea-value #:textarea-cursor-row #:textarea-cursor-col
+   #:textarea-lines
    #:textarea-on-submit #:textarea-undo-stack #:textarea-redo-stack
    #:textarea-layout-node
    #:handle-textarea-input #:render-textarea
    ;; Keybindings
-   #:keymap #:make-keymap #:keymap-name #:keymap-bindings #:keymap-parent
    #:*keymaps* #:*chord-timeout*
    #:defkeymap #:dispatch-key-event #:key-match-p
    #:component-keymap))
@@ -656,7 +656,8 @@ debugging argument mismatches — avoid that trap.
           (max 0 (min (textarea-cursor-row ta) (1- (length lines)))))
     (let ((line-len (length (nth (textarea-cursor-row ta) lines))))
       (setf (textarea-cursor-col ta)
-            (max 0 (min (textarea-cursor-col ta) line-len))))))
+            (max 0 (min (textarea-cursor-col ta) line-len)))))
+  (mark-dirty ta))
 
 ;;; ---------------------------------------------------------------------------
 ;;; Utility: join strings with newline
@@ -824,11 +825,13 @@ debugging argument mismatches — avoid that trap.
                (textarea-ensure-cursor ta))
        (:up (textarea-move-up ta))
        (:down (textarea-move-down ta))
-       (:home (setf (textarea-cursor-col ta) 0))
+        (:home (setf (textarea-cursor-col ta) 0)
+               (textarea-ensure-cursor ta))
         (:end (let ((lines (textarea-lines ta)))
                 (when (< (textarea-cursor-row ta) (length lines))
                   (setf (textarea-cursor-col ta)
-                       (length (nth (textarea-cursor-row ta) lines))))))
+                        (length (nth (textarea-cursor-row ta) lines))))
+                (textarea-ensure-cursor ta)))
        (:enter (let ((cb (textarea-on-submit ta)))
                  (if cb
                      (funcall cb (textarea-value ta))
@@ -923,6 +926,21 @@ debugging argument mismatches — avoid that trap.
 ;;; ---------------------------------------------------------------------------
 ;;; Dispatch
 ;;; ---------------------------------------------------------------------------
+;;; dispatch-key-event — main entry point for keymap-based dispatch.
+;;;
+;;; IMPORTANT: This function is NOT called by the demo's event loop
+;;; or by any built-in widget event handlers.  Users who want to use
+;;; the keymap system MUST call dispatch-key-event explicitly in their
+;;; own event loops, e.g.:
+;;;
+;;;   (defun handle-event (event)
+;;;     (or (dispatch-key-event event)
+;;;         (handle-text-input my-input event)
+;;;         ...))
+;;;
+;;; Chords ((:ctrl+x :ctrl+s)) are not yet supported; only single
+;;; key specs work.  The *chord-timeout* and list-of-lists syntax
+;;; are reserved for future implementation.
 (defun dispatch-key-event (event &key component)
   (labels ((try-keymap (km)
              (when km
@@ -974,6 +992,8 @@ debugging argument mismatches — avoid that trap.
    #:with-raw-terminal
    ;; Event reading
    #:read-event
+   ;; UTF-8 input support
+   #:utf8-decode
    ;; TextInput
    #:text-input #:make-text-input
    #:text-input-value #:text-input-cursor
@@ -983,6 +1003,7 @@ debugging argument mismatches — avoid that trap.
    ;; Textarea
    #:textarea #:make-textarea
    #:textarea-value #:textarea-cursor-row #:textarea-cursor-col
+   #:textarea-lines
    #:textarea-on-submit #:textarea-undo-stack #:textarea-redo-stack
    #:textarea-layout-node
    #:handle-textarea-input #:render-textarea
@@ -1034,6 +1055,28 @@ debugging argument mismatches — avoid that trap.
     (is (= (mouse-event-x e) 10))
     (is (= (mouse-event-y e) 5))))
 
+;; ── UTF-8 Decode Tests ──────────────────────────────────────────
+
+(test utf8-decode-latin1-supplement
+  "0xC3 0xA9 (é) decodes to code point 233."
+  (is (= (cl-tty.input:utf8-decode '(#xc3 #xa9)) 233)))
+
+(test utf8-decode-euro-sign
+  "0xE2 0x82 0xAC (€) decodes to code point 8364."
+  (is (= (cl-tty.input:utf8-decode '(#xe2 #x82 #xac)) 8364)))
+
+(test utf8-decode-emoji
+  "0xF0 0x9F 0x92 0xA9 (💩) decodes to code point 128169."
+  (is (= (cl-tty.input:utf8-decode '(#xf0 #x9f #x92 #xa9)) 128169)))
+
+(test utf8-decode-invalid-short
+  "Invalid byte 0x80 alone returns nil."
+  (is-false (cl-tty.input:utf8-decode '(#x80))))
+
+(test utf8-decode-invalid-overlong
+  "Overlong 2-byte sequence 0xC0 0x80 returns nil."
+  (is-false (cl-tty.input:utf8-decode '(#xc0 #x80))))
+
 ;; ── TextInput Tests ─────────────────────────────────────────────
 
 (test text-input-empty
@@ -1218,6 +1261,15 @@ world")))
     (is (string= (textarea-value a) "a"))))
 
 ;; ── Keybinding Tests ────────────────────────────────────────────
+;; These tests verify the keymap dispatch system works correctly
+;; when wired up.  Note: dispatch-key-event is NOT called by the
+;; demo's event loop — users MUST call it explicitly in their own
+;; event loops if they want to use the defkeymap/dispatch-key-event
+;; system.  See src/components/keybindings.lisp for details.
+;;
+;; Chords ((:ctrl+x :ctrl+s)) are not yet supported; only single
+;; key specs work.  The *chord-timeout* variable and list-of-lists
+;; syntax are reserved for future implementation.
 
 (test keymap-simple
   "A keymap dispatches to its handler on matching event."
@@ -1258,6 +1310,78 @@ world")))
   (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 key-spec-alt-modifier
+  "Alt modifier is matched correctly."
+  (is-true (key-match-p :alt+x (make-key-event :key :x :alt t)))
+  (is-false (key-match-p :alt+x (make-key-event :key :x)))
+  (is-false (key-match-p :alt+x (make-key-event :key :x :ctrl t))))
+
+(test key-spec-shift-modifier
+  "Shift modifier is matched correctly."
+  (is-true (key-match-p :shift+tab (make-key-event :key :tab :shift t)))
+  (is-false (key-match-p :shift+tab (make-key-event :key :tab))))
+
+(test key-spec-plain
+  "Plain key spec matches unmodified keys."
+  (is-true (key-match-p :enter (make-key-event :key :enter)))
+  (is-true (key-match-p :escape (make-key-event :key :escape)))
+  (is-false (key-match-p :enter (make-key-event :key :escape))))
+
+(test key-spec-list-form
+  "List-form spec (:ctrl+p) matches same as keyword :ctrl+p."
+  (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))))
+
+(test dispatch-return-value-match
+  "dispatch-key-event returns T on matching binding."
+  (setf (gethash :global *keymaps*)
+        (make-keymap :name :global
+                     :bindings `((:ctrl+p . ,(lambda (e) (declare (ignore e)))))))
+  (is-true (dispatch-key-event (make-key-event :key :p :ctrl t))))
+
+(test dispatch-return-value-no-match
+  "dispatch-key-event returns NIL when no binding matches."
+  (setf (gethash :global *keymaps*)
+        (make-keymap :name :global
+                     :bindings `((:ctrl+p . ,(lambda (e) (declare (ignore e)))))))
+  (is-false (dispatch-key-event (make-key-event :key :a))))
+
+(test dispatch-empty-keymap
+  "dispatch-key-event returns NIL on empty keymap."
+  (setf (gethash :global *keymaps*) (make-keymap :name :global))
+  (is-false (dispatch-key-event (make-key-event :key :a))))
+
+(test dispatch-local-overrides-global
+  "Local keymap takes priority over global."
+  (let ((local-called nil) (global-called nil))
+    (setf (gethash :local *keymaps*)
+          (make-keymap :name :local
+                       :bindings `((:ctrl+p . ,(lambda (e)
+                                                  (declare (ignore e))
+                                                  (setf local-called t))))))
+    (setf (gethash :global *keymaps*)
+          (make-keymap :name :global
+                       :bindings `((:ctrl+p . ,(lambda (e)
+                                                  (declare (ignore e))
+                                                  (setf global-called t))))))
+    (is-true (dispatch-key-event (make-key-event :key :p :ctrl t)))
+    (is-true local-called)
+    (is-false global-called)))
+
+(test dispatch-multiple-bindings
+  "dispatch-key-event finds the right binding among many."
+  (let ((called nil))
+    (setf (gethash :global *keymaps*)
+          (make-keymap :name :global
+                       :bindings `((:ctrl+a . (lambda (e) (declare (ignore e))))
+                                   (:ctrl+b . (lambda (e) (declare (ignore e))))
+                                   (:ctrl+c . ,(lambda (e)
+                                                  (declare (ignore e))
+                                                  (setf called t)))
+                                   (:ctrl+d . (lambda (e) (declare (ignore e)))))))
+    (is-true (dispatch-key-event (make-key-event :key :c :ctrl t)))
+    (is-true called)))
+
 (test defkeymap-macro
   "defkeymap macro registers a keymap."
   (let ((called nil))
@@ -1265,4 +1389,21 @@ world")))
              (:ctrl+q ,(lambda (e) (declare (ignore e)) (setf called t)))))
     (dispatch-key-event (make-key-event :key :q :ctrl t))
     (is-true called)))
+
+(test defkeymap-macro-with-list-spec
+  "defkeymap macro works with list-form specs."
+  (let ((called nil))
+    (eval `(defkeymap :global
+             ((:ctrl+w) ,(lambda (e) (declare (ignore e)) (setf called t)))))
+    (dispatch-key-event (make-key-event :key :w :ctrl t))
+    (is-true called)))
+
+;; cleanup after keybinding tests
+(test keybinding-cleanup-global
+  "Clean up global keymap after testing."
+  (remhash :global *keymaps*)
+  (remhash :local *keymaps*)
+  (is-false (gethash :global *keymaps*))
+  (is-false (gethash :local *keymaps*)))
+
 #+END_SRC

scripts/tangle.py

@@ -1,74 +1,62 @@
 #!/usr/bin/env python3
-"""tangle.py — Extract code blocks from .org files into .lisp files.
+"""Simple org-babel tangle replacement.
-
+Extracts #+BEGIN_SRC blocks with :tangle headers and writes target files.
-Reads all .org files in org/ directory, finds #+BEGIN_SRC lisp :tangle <path>
-blocks, and writes/concatenates them to the specified target paths.
-
-Blocks with the same :tangle target are concatenated in file order.
-
-Usage:
-  python3 scripts/tangle.py              # tangle all org/ files
-  python3 scripts/tangle.py org/specific.org  # tangle one file
-
-Target paths are relative to the project root (../target from org/ = project/target).
 """
-import re
+import re, os, sys
-import os
-import sys
-from collections import OrderedDict
 
-PROJECT_ROOT = os.path.dirname(os.path.dirname(os.path.abspath(__file__)))
+ORG_DIR = os.path.dirname(os.path.dirname(os.path.abspath(__file__)))
-ORG_DIR = os.path.join(PROJECT_ROOT, 'org')
 
 def tangle_file(org_path):
-    """Extract tangle blocks from one .org file."""
+    org_path = os.path.join(ORG_DIR, org_path)
     with open(org_path) as f:
-        content = f.read()
+        text = f.read()
     
-    # Find all tangle blocks with their targets
+    # Find all #+BEGIN_SRC blocks with :tangle
-    pattern = r'#\+BEGIN_SRC lisp :tangle ([^\n]+)\n(.*?)\n#\+END_SRC'
+    pattern = re.compile(
-    blocks = re.findall(pattern, content, re.DOTALL)
+        r'#\+BEGIN_SRC\s+(\w+)\s+(.*?)\n(.*?)\n#\+END_SRC',
+        re.DOTALL
+    )
     
-    if not blocks:
+    count = 0
-        return 0
+    for match in pattern.finditer(text):
+        lang = match.group(1)
+        header = match.group(2)
+        content = match.group(3)
         
-    # Group by target path
+        # Extract :tangle path
-    targets = OrderedDict()
+        tangle_match = re.search(r':tangle\s+(\S+)', header)
-    for tangle_path, code in blocks:
+        if not tangle_match:
-        # Resolve tangle path: ../src/x.lisp -> src/x.lisp
+            continue
-        resolved = tangle_path.replace('../', '')
+        tangle_path = tangle_match.group(1)
-        full_path = os.path.join(PROJECT_ROOT, resolved)
-        if full_path not in targets:
-            targets[full_path] = []
-        targets[full_path].append(code.strip())
         
-    for full_path, codes in targets.items():
+        # Resolve relative path
-        os.makedirs(os.path.dirname(full_path), exist_ok=True)
+        if tangle_path.startswith('../'):
-        combined = '\n\n'.join(codes) + '\n'
+            target = os.path.normpath(os.path.join(os.path.dirname(org_path), tangle_path))
-        with open(full_path, 'w') as f:
-            f.write(combined)
-        print(f"  {os.path.relpath(full_path, PROJECT_ROOT)} ({len(codes)} blocks, {sum(len(c) for c in codes)} chars)")
-
-    return len(blocks)
-
-def main():
-    if len(sys.argv) > 1:
-        org_files = [f for f in sys.argv[1:] if f.endswith('.org')]
         else:
-        org_files = [os.path.join(ORG_DIR, f) for f in os.listdir(ORG_DIR) if f.endswith('.org')]
+            target = os.path.join(ORG_DIR, tangle_path)
         
-    total_blocks = 0
+        # Ensure directory exists
-    for org_file in sorted(org_files):
+        os.makedirs(os.path.dirname(target), exist_ok=True)
-        name = os.path.basename(org_file)
-        blocks = tangle_file(org_file)
-        if blocks:
-            print(f"{name}: {blocks} blocks")
-            total_blocks += blocks
         
-    if total_blocks > 0:
+        # Don't write :tangle no blocks
-        print(f"\nTotal: {total_blocks} code blocks tangled")
+        if tangle_path == 'no':
+            continue
+        
+        # Write the content (append if same file already written)
+        content = content.rstrip('\n') + '\n'
+        if os.path.exists(target):
+            with open(target, 'a') as f:
+                f.write('\n' + content)
         else:
-        print("No tangle blocks found.")
+            with open(target, 'w') as f:
+                f.write(content)
+        print(f"  {target} ({len(content)} bytes)")
+        count += 1
+    
+    return count
 
 if __name__ == '__main__':
-    main()
+    for f in sys.argv[1:] or ['org/text-input.org']:
+        print(f"Tangling {f}...")
+        c = tangle_file(f)
+        print(f"  {c} code blocks")

src/components/container-package.lisp

@@ -10,3 +10,16 @@
    #:tab-bar-active #:tab-bar-tabs
    #:tab-bar-add #:tab-bar-next #:tab-bar-prev
    #:tab-bar-select #:tab-bar-handle-key))
+
+(defpackage :cl-tty.container
+  (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
+  (:export
+   #:scroll-box #:make-scroll-box
+   #:scroll-box-scroll-y #:scroll-box-scroll-x
+   #:scroll-box-children #:scroll-by
+   #:sticky-scroll-p
+   #:clamp-scroll
+   #:tab-bar #:make-tab-bar
+   #:tab-bar-active #:tab-bar-tabs
+   #:tab-bar-add #:tab-bar-next #:tab-bar-prev
+   #:tab-bar-select #:tab-bar-handle-key))

src/components/dialog-package.lisp

@@ -23,3 +23,29 @@
    #:render-toast
    #:dismiss-toast
    #:*toasts*))
+
+;;; dialog-package.lisp — Package definition for cl-tty.dialog
+
+(defpackage :cl-tty.dialog
+  (:use :cl :cl-tty.backend :cl-tty.input :cl-tty.select)
+  (:export
+   #:dialog
+   #:dialog-title
+   #:dialog-content
+   #:dialog-on-dismiss
+   #:dialog-size
+   #:dialog-size-pixels
+   #:render-dialog
+   #:push-dialog
+   #:pop-dialog
+   #:*dialog-stack*
+   #:alert-dialog
+   #:confirm-dialog
+   #:select-dialog
+   #:prompt-dialog
+   #:toast
+   #:toast-message
+   #:toast-variant
+   #:render-toast
+   #:dismiss-toast
+   #:*toasts*))

src/components/dialog.lisp

@@ -124,3 +124,130 @@
 
 (defun dismiss-toast (toast)
   (setf *toasts* (remove toast *toasts*)))
+
+;;; dialog.lisp — Dialog System + Toast for cl-tty
+
+(in-package :cl-tty.dialog)
+
+;; ─── Special variables ────────────────────────────────────────────────────────
+
+(defvar *dialog-stack* nil
+  "Stack of active dialogs. (list) of dialog instances.")
+
+(defvar *toasts* nil
+  "List of active toast notifications.")
+
+;; ─── Dialog class ─────────────────────────────────────────────────────────────
+
+(defclass dialog ()
+  ((title :initarg :title :accessor dialog-title)
+   (size :initarg :size :initform :medium :accessor dialog-size)
+   (content :initarg :content :initform nil :accessor dialog-content)
+   (on-dismiss :initarg :on-dismiss :initform nil :accessor dialog-on-dismiss)))
+
+(defun dialog-size-pixels (size &optional (max-w 80) (max-h 24))
+  (multiple-value-bind (dw dh)
+      (case size
+        (:small (values 40 8))
+        (:medium (values 60 16))
+        (:large (values 88 24))
+        (t (values 60 16)))
+    (values (min dw max-w) (min dh max-h))))
+
+(defun render-dialog (dialog screen w h)
+  (multiple-value-bind (dw dh) (dialog-size-pixels (dialog-size dialog) w h)
+    (let ((x (floor (- w dw) 2))
+          (y (floor (- h dh) 2)))
+      ;; Backdrop — dim the full screen
+      (dotimes (row h)
+        (draw-rect screen 0 row w 1 :bg :bright-black))
+      ;; Dialog panel
+      (draw-border screen x y dw dh :style :single :title (dialog-title dialog))
+      (when (dialog-content dialog)
+        ;; Content rendering delegated to component system
+        (draw-text screen (1+ x) (1+ y)
+                   (format nil "~a" (dialog-content dialog))
+                   :white :default)))))
+
+(defun push-dialog (dialog)
+  (push dialog *dialog-stack*)
+  dialog)
+
+(defun pop-dialog ()
+  (when *dialog-stack*
+    (let ((dialog (pop *dialog-stack*)))
+      (when (dialog-on-dismiss dialog)
+        (funcall (dialog-on-dismiss dialog)))
+      dialog)))
+
+;; ─── Dialog sub-classes ──────────────────────────────────────────────────────
+
+(defun alert-dialog (title message)
+  (make-instance 'dialog
+    :title title
+    :size :small
+    :content (make-instance 'select
+               :options (list (list :title "OK" :value :ok))
+               :on-select (lambda (opt) (declare (ignore opt)) (pop-dialog)))
+    :on-dismiss (lambda () (pop-dialog))))
+
+(defun confirm-dialog (title message &key on-yes on-no)
+  (make-instance 'dialog
+    :title title
+    :size :small
+    :content (make-instance 'select
+               :options (list (list :title "Yes" :value :yes)
+                              (list :title "No" :value :no))
+               :on-select (lambda (opt)
+                            (pop-dialog)
+                            (if (eql opt :yes)
+                                (when on-yes (funcall on-yes))
+                                (when on-no (funcall on-no)))))))
+
+(defun select-dialog (title options &key on-select)
+  (make-instance 'dialog
+    :title title
+    :size :medium
+    :content (make-instance 'select
+               :options options
+               :on-select (lambda (opt)
+                            (pop-dialog)
+                            (when on-select (funcall on-select opt))))))
+
+(defun prompt-dialog (title &key on-submit)
+  (make-instance 'dialog
+    :title title
+    :size :small
+    :content (make-instance 'text-input
+               :on-submit (lambda (value)
+                            (pop-dialog)
+                            (when on-submit (funcall on-submit value))))))
+
+;; ─── Toast system ─────────────────────────────────────────────────────────────
+
+(defclass toast ()
+  ((message :initarg :message :accessor toast-message)
+   (variant :initarg :variant :initform :info :accessor toast-variant)))
+
+(defun render-toast (toast screen w)
+  (let* ((msg (toast-message toast))
+         (variant (toast-variant toast))
+         (color (case variant
+                  (:info :blue) (:success :green)
+                  (:warning :yellow) (:error :red)))
+         (max-w (min 60 (1- w)))
+         (x (- w max-w 1))
+         (text (if (> (length msg) (- max-w 2))
+                   (concatenate 'string (subseq msg 0 (- max-w 5)) "...")
+                   msg)))
+    (draw-rect screen x 0 max-w 1 :bg color)
+    (draw-text screen (1+ x) 0 text :white color :bold t)))
+
+(defun toast (message &key (variant :info) (duration 0))
+  (let ((toast (make-instance 'toast :message message :variant variant)))
+    (push toast *toasts*)
+    (when (plusp duration) (dismiss-toast toast))
+    toast))
+
+(defun dismiss-toast (toast)
+  (setf *toasts* (remove toast *toasts*)))

src/components/input-package.lisp

@@ -36,3 +36,41 @@
    #:*keymaps* #:*chord-timeout*
    #:defkeymap #:dispatch-key-event #:key-match-p
    #:component-keymap))
+
+(defpackage :cl-tty.input
+  (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout)
+  (:export
+   ;; Key events
+   #:key-event #:make-key-event
+   #:key-event-p #:key-event-key #:key-event-ctrl
+   #:key-event-alt #:key-event-shift #:key-event-code
+   #:key-event-raw #:key-event-text
+   ;; Mouse events
+   #:mouse-event #:make-mouse-event
+   #:mouse-event-p #:mouse-event-type #:mouse-event-button
+   #:mouse-event-x #:mouse-event-y
+   ;; Terminal raw mode
+   #:save-terminal-state #:set-raw-mode #:restore-terminal-state
+   #:with-raw-terminal
+   ;; Event reading
+   #:read-event
+   ;; UTF-8 input support
+   #:utf8-decode
+   ;; TextInput
+   #:text-input #:make-text-input
+   #:text-input-value #:text-input-cursor
+   #:text-input-placeholder #:text-input-max-length
+   #:text-input-on-submit #:text-input-layout-node
+   #:handle-text-input #:render-text-input
+   ;; Textarea
+   #:textarea #:make-textarea
+   #:textarea-value #:textarea-cursor-row #:textarea-cursor-col
+   #:textarea-lines
+   #:textarea-on-submit #:textarea-undo-stack #:textarea-redo-stack
+   #:textarea-layout-node
+   #:handle-textarea-input #:render-textarea
+   ;; Keybindings
+   #:keymap #:make-keymap #:keymap-name #:keymap-bindings #:keymap-parent
+   #:*keymaps* #:*chord-timeout*
+   #:defkeymap #:dispatch-key-event #:key-match-p
+   #:component-keymap))

src/components/keybindings.lisp

@@ -90,3 +90,96 @@
 ;;; --- Component protocol integration ---
 (defgeneric component-keymap (component)
   (:method ((c t)) nil))
+
+(in-package #:cl-tty.input)
+
+;;; ---------------------------------------------------------------------------
+;;; Key map struct
+;;; ---------------------------------------------------------------------------
+(defstruct keymap
+  (name nil :type (or keyword null))
+  (bindings nil :type list)
+  (parent nil :type (or keymap null)))
+
+;;; ---------------------------------------------------------------------------
+;;; Global keymap registry
+;;; ---------------------------------------------------------------------------
+(defparameter *keymaps* (make-hash-table :test #'equal))
+(defparameter *chord-timeout* 0.5)
+
+;;; ---------------------------------------------------------------------------
+;;; Key spec matching
+;;; ---------------------------------------------------------------------------
+(defun key-match-p (spec event)
+  "T if SPEC matches EVENT. Spec is :ctrl+p (modifier+key keyword)
+  or (:ctrl+p) for single-spec in a list, or (:ctrl+x :ctrl+s) for chords."
+  (etypecase spec
+    ;; Keyword like :ctrl+p, :alt+f, :enter, :space, :f1
+    (keyword
+     (let* ((name (string spec))
+            (plus (position #\+ name)))
+       (if plus
+           ;; Modified key: :ctrl+p → mod-str="CTRL", key-str="P"
+           (let ((mod-str (subseq name 0 plus))
+                 (key-str (subseq name (1+ plus))))
+            (and (eql (intern key-str :keyword)
+                      (key-event-key event))
+                 (cond
+                   ((string= mod-str "CTRL") (key-event-ctrl event))
+                   ((string= mod-str "ALT")  (key-event-alt event))
+                   ((string= mod-str "SHIFT") (key-event-shift event))
+                   (t t))))
+           ;; Plain keyword: :enter, :escape, :f1, etc.
+           (eql spec (key-event-key event)))))
+    ;; List: (:ctrl+p) or (:ctrl+x :ctrl+s)
+    (list
+     (when spec
+       (key-match-p (first spec) event)))))
+
+;;; ---------------------------------------------------------------------------
+;;; Dispatch
+;;; ---------------------------------------------------------------------------
+;;; dispatch-key-event — main entry point for keymap-based dispatch.
+;;;
+;;; IMPORTANT: This function is NOT called by the demo's event loop
+;;; or by any built-in widget event handlers.  Users who want to use
+;;; the keymap system MUST call dispatch-key-event explicitly in their
+;;; own event loops, e.g.:
+;;;
+;;;   (defun handle-event (event)
+;;;     (or (dispatch-key-event event)
+;;;         (handle-text-input my-input event)
+;;;         ...))
+;;;
+;;; Chords ((:ctrl+x :ctrl+s)) are not yet supported; only single
+;;; key specs work.  The *chord-timeout* and list-of-lists syntax
+;;; are reserved for future implementation.
+(defun dispatch-key-event (event &key component)
+  (labels ((try-keymap (km)
+             (when km
+               (loop for (spec . handler) in (keymap-bindings km)
+                     thereis (when (key-match-p spec event)
+                               (funcall handler event)
+                               t))))
+           (find-keymap (name)
+             (gethash name *keymaps*)))
+    (or (and component
+             (let ((km (component-keymap component)))
+               (when km (try-keymap km))))
+        (try-keymap (find-keymap :local))
+        (try-keymap (find-keymap :global)))))
+
+;;; ---------------------------------------------------------------------------
+;;; defkeymap macro
+;;; ---------------------------------------------------------------------------
+(defmacro defkeymap (name &body bindings)
+  `(setf (gethash ',name *keymaps*)
+         (make-keymap :name ',name
+                      :bindings (list ,@(loop for b in bindings
+                                              collect (if (consp (cdr b))
+                                                          `(cons ',(car b) ,(cadr b))
+                                                          `(cons ',(car b) ,(cdr b))))))))
+
+;;; --- Component protocol integration ---
+(defgeneric component-keymap (component)
+  (:method ((c t)) nil))

src/components/mouse-package.lisp

@@ -10,3 +10,16 @@
    #:start-selection #:update-selection #:finalize-selection
    #:selection-active-p
    #:cell-link-at #:open-link-at))
+
+(defpackage :cl-tty.mouse
+  (:use :cl :cl-tty.layout :cl-tty.input :cl-tty.box :cl-tty.rendering)
+  (:export
+   #:mouse-mixin
+   #:on-mouse-down #:on-mouse-up #:on-mouse-move #:on-mouse-scroll
+   #:handle-mouse-event
+   #:hit-test
+   #:selection #:get-selection #:copy-to-clipboard
+   #:make-selection #:selection-p
+   #:start-selection #:update-selection #:finalize-selection
+   #:selection-active-p
+   #:cell-link-at #:open-link-at))

src/components/mouse.lisp

@@ -111,3 +111,117 @@ Components without a layout-node or position return nil."
       #+linux (sb-ext:run-program "xdg-open" (list url) :wait nil)
       #+darwin (sb-ext:run-program "open" (list url) :wait nil))
     url))
+
+(in-package :cl-tty.mouse)
+
+(defclass mouse-mixin ()
+  ((on-mouse-down  :initarg :on-mouse-down  :initform nil :accessor on-mouse-down)
+   (on-mouse-up    :initarg :on-mouse-up    :initform nil :accessor on-mouse-up)
+   (on-mouse-move  :initarg :on-mouse-move  :initform nil :accessor on-mouse-move)
+   (on-mouse-scroll :initarg :on-mouse-scroll :initform nil :accessor on-mouse-scroll)))
+
+(defun handle-mouse-event (component event)
+  (let* ((type (mouse-event-type event))
+         (handler (case type
+                    (:press (on-mouse-down component))
+                    (:release (on-mouse-up component))
+                    (:drag (on-mouse-move component))
+                    (t nil))))
+    (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)
+             (let ((ln (ignore-errors (component-layout-node node)))
+                   (best nil))
+               (when ln
+                 (let ((nx (layout-node-x ln))
+                       (ny (layout-node-y ln))
+                       (nw (layout-node-width ln))
+                       (nh (layout-node-height ln)))
+                   ;; Check children first for deeper match
+                   (dolist (child (ignore-errors (component-children node)))
+                     (let ((child-hit (recurse child)))
+                       (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
+(defvar *selection* nil)
+
+(defstruct (selection (:conc-name sel-))
+  (start-x 0) (start-y 0) (end-x 0) (end-y 0) (text ""))
+
+(defun get-selection ()
+  (when *selection* (sel-text *selection*)))
+
+(defun copy-to-clipboard (text)
+  #+linux
+  (cond
+    ((sb-ext:posix-getenv "WAYLAND_DISPLAY")
+     (sb-ext:run-program "wl-copy" nil :input text :wait nil))
+    (t
+     (sb-ext:run-program "xclip" (list "-selection" "clipboard")
+                         :input text :wait nil)))
+  #+darwin (sb-ext:run-program "pbcopy" nil :input text :wait nil))
+
+;;; --- Selection tracking (mouse drag) ---------------------------------------
+
+(defvar *selection-active* nil
+  "T when a drag selection is in progress.")
+
+(defvar *selection-start* nil
+  "Cons (X . Y) of mouse-down position during drag.")
+
+(defvar *selection-end* nil
+  "Cons (X . Y) of current mouse position during drag.")
+
+(defun start-selection (x y)
+  "Begin a drag selection at (X Y)."
+  (setf *selection-start* (cons x y)
+        *selection-end* (cons x y)
+        *selection-active* t))
+
+(defun update-selection (x y)
+  "Update the drag selection end position to (X Y)."
+  (setf *selection-end* (cons x y)))
+
+(defun selection-active-p ()
+  "Return T if a drag selection is in progress."
+  *selection-active*)
+
+(defun finalize-selection (fb)
+  "End the drag selection and extract text from the framebuffer."
+  (setf *selection-active* nil)
+  (when (and *selection-start* *selection-end* fb)
+    (let* ((x1 (car *selection-start*))
+           (y1 (cdr *selection-start*))
+           (x2 (car *selection-end*))
+           (y2 (cdr *selection-end*))
+           (text (cl-tty.rendering:extract-text fb x1 y1 x2 y2)))
+      (setf *selection* (make-selection :start-x x1 :start-y y1
+                                        :end-x x2 :end-y y2
+                                        :text text))
+      (setf *selection-start* nil *selection-end* nil)
+      text)))
+
+;;; --- Link clicking ---------------------------------------------------------
+
+(defun cell-link-at (fb x y)
+  "Return the link URL at (X Y) in framebuffer FB, or nil."
+  (cl-tty.rendering:fb-cell-link-url fb x y))
+
+(defun open-link-at (fb x y)
+  "If there is a link URL at (X Y) in FB, open it via xdg-open."
+  (let ((url (cell-link-at fb x y)))
+    (when url
+      #+linux (sb-ext:run-program "xdg-open" (list url) :wait nil)
+      #+darwin (sb-ext:run-program "open" (list url) :wait nil))
+    url))

src/components/scrollbox.lisp

@@ -95,3 +95,101 @@ Children outside the viewport are skipped."
            (viewport-h (if ln (layout-node-height ln) 24)))
       (when (>= (scroll-box-scroll-y sb) (- content-h viewport-h 1))
         (setf (scroll-box-scroll-y sb) (max 0 (- content-h viewport-h)))))))
+
+(in-package #:cl-tty.container)
+
+(defclass scroll-box (dirty-mixin)
+  ((children :initform nil :initarg :children :accessor scroll-box-children :type list)
+   (scroll-y :initform 0 :initarg :scroll-y :accessor scroll-box-scroll-y :type fixnum)
+   (scroll-x :initform 0 :initarg :scroll-x :accessor scroll-box-scroll-x :type fixnum)
+   (sticky-scroll-p :initform t :initarg :sticky-scroll-p :accessor sticky-scroll-p :type boolean)
+   (layout-node :initform (make-layout-node) :accessor scroll-box-layout-node)))
+
+(defun make-scroll-box (&key (children nil) (scroll-y 0) (scroll-x 0) sticky-scroll-p)
+  (make-instance 'scroll-box
+    :children children :scroll-y scroll-y :scroll-x scroll-x
+    :sticky-scroll-p (if (null sticky-scroll-p) t sticky-scroll-p)))
+
+(defmethod component-children ((sb scroll-box)) (scroll-box-children sb))
+(defmethod component-layout-node ((sb scroll-box)) (scroll-box-layout-node sb))
+
+(defun clamp-scroll (sb)
+  (let* ((ln (scroll-box-layout-node sb))
+         (viewport-h (if ln (layout-node-height ln) 0))
+         (viewport-w  (if ln (layout-node-width ln) 0))
+         (content-h (scroll-box-content-height sb))
+         (content-w  (scroll-box-content-width sb)))
+    (setf (scroll-box-scroll-y sb) (max 0 (min (scroll-box-scroll-y sb) (- content-h viewport-h))))
+    (setf (scroll-box-scroll-x sb) (max 0 (min (scroll-box-scroll-x sb) (- content-w viewport-w))))))
+
+(defun scroll-by (sb dy dx)
+  (incf (scroll-box-scroll-y sb) dy) (incf (scroll-box-scroll-x sb) dx)
+  (clamp-scroll sb) (mark-dirty sb))
+
+(defun scroll-box-content-height (sb)
+  (reduce #'+ (scroll-box-children sb)
+          :key (lambda (c) (let ((ln (component-layout-node c))) (if ln (max 1 (layout-node-height ln)) 1)))
+          :initial-value 0))
+
+(defun scroll-box-content-width (sb)
+  (reduce #'max (scroll-box-children sb)
+          :key (lambda (c) (let ((ln (component-layout-node c))) (if ln (max 1 (layout-node-width ln)) 1)))
+          :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))
+         (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))
+             (ch (if cln (layout-node-height cln) 1))
+             (cy vy))
+        ;; Only render children that are visible in the viewport
+        (when (and (< (- cy sy) vh)
+                   (> (+ (- cy sy) ch) 0))
+          ;; 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) (- vx sx)
+                    (layout-node-y cln) (- vy 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)))
+
+(defun scrollbar-thumb (scroll-pos viewport-size content-size)
+  (if (> content-size viewport-size) (/ (float scroll-pos) (- content-size viewport-size)) 0.0))
+
+(defun draw-scrollbars (sb backend viewport-w viewport-h)
+  (let* ((content-h (scroll-box-content-height sb)) (content-w (scroll-box-content-width sb))
+         (sy (scroll-box-scroll-y sb)) (sx (scroll-box-scroll-x sb))
+         (ln (scroll-box-layout-node sb))
+         (ox (if ln (layout-node-x ln) 0))
+         (oy (if ln (layout-node-y ln) 0)))
+    (when (> content-h viewport-h)
+      (let* ((thumb (scrollbar-thumb sy viewport-h content-h))
+             (thumb-pos (round (* thumb viewport-h))))
+        (draw-rect backend (+ ox (1- viewport-w)) oy 1 viewport-h :bg :bright-black)
+        (draw-text backend (+ ox (1- viewport-w)) (+ oy thumb-pos) "█" nil nil)))
+    (when (> content-w viewport-w)
+      (let* ((thumb (scrollbar-thumb sx viewport-w content-w))
+             (thumb-pos (round (* thumb viewport-w))))
+        (draw-rect backend ox (+ oy (1- viewport-h)) viewport-w 1 :bg :bright-black)
+        (draw-text backend (+ ox thumb-pos) (+ oy (1- viewport-h)) "█" nil nil)))))
+
+(defun update-sticky-scroll (sb)
+  (when (sticky-scroll-p sb)
+    (let* ((content-h (scroll-box-content-height sb))
+           (ln (scroll-box-layout-node sb))
+           (viewport-h (if ln (layout-node-height ln) 24)))
+      (when (>= (scroll-box-scroll-y sb) (- content-h viewport-h 1))
+        (setf (scroll-box-scroll-y sb) (max 0 (- content-h viewport-h)))))))

src/components/select-package.lisp

@@ -11,3 +11,17 @@
    #:select-handle-key
    #:render
    #:fuzzy-match-p))
+
+(defpackage :cl-tty.select
+  (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
+  (:export
+   #:select #:make-select
+   #:select-options #:select-filter
+   #:select-selected-index #:select-on-select
+   #:select-layout-node
+   #:select-filtered-options
+   #:select-next #:select-prev
+   #:select-visible-options
+   #:select-handle-key
+   #:render
+   #:fuzzy-match-p))

src/components/select.lisp

@@ -94,3 +94,100 @@
               (t (draw-text backend x y display nil nil)))
         (incf y 1)))
     (values)))
+
+(in-package #:cl-tty.select)
+
+(defclass select (dirty-mixin)
+  ((options :initform nil :initarg :options :accessor select-options :type list)
+   (filter :initform nil :initarg :filter :accessor select-filter :type (or string null))
+   (selected-index :initform 0 :initarg :selected-index :accessor select-selected-index :type fixnum)
+   (on-select :initform nil :initarg :on-select :accessor select-on-select)
+   (layout-node :initform (make-layout-node) :initarg :layout-node :accessor select-layout-node)))
+
+(defun make-select (&key options filter on-select)
+  (make-instance 'select :options (or options nil) :filter filter :on-select on-select))
+
+(defmethod component-layout-node ((sel select)) (select-layout-node sel))
+
+(defun select-filtered-options (sel)
+  (let* ((filter (select-filter sel)) (all-options (select-options sel))
+         (filtered (if (null filter) all-options
+                       (let ((lower (string-downcase filter)))
+                         (remove-if-not
+                          (lambda (opt)
+                            (or (getf opt :category)
+                                (let ((title (string-downcase (getf opt :title))))
+                                  (or (search lower title) (fuzzy-match-p lower title)))))
+                          all-options)))))
+    (loop for opt in filtered for i from 0
+          collect (list i (position opt all-options) opt))))
+
+(defun fuzzy-match-p (query target)
+  (let* ((q (remove-duplicates (coerce (string-downcase query) 'list)))
+         (tg (remove-duplicates (coerce (string-downcase target) 'list)))
+         (intersection (length (intersection q tg)))
+         (union (length (union q tg))))
+    (if (zerop union) nil (> (/ (float intersection) union) 0.3))))
+
+(defun select-clamp-index (sel)
+  (let* ((filtered (select-filtered-options sel)) (count (length filtered)))
+    (if (zerop count) (setf (select-selected-index sel) 0)
+        (setf (select-selected-index sel) (max 0 (min (select-selected-index sel) (1- count)))))))
+
+(defun select-next (sel)
+  (let* ((filtered (select-filtered-options sel)) (count (length filtered))
+         (current (select-selected-index sel)))
+    (when (plusp count)
+      (loop for i from 1 below count
+            for idx = (mod (+ current i) count)
+            for opt = (third (nth idx filtered))
+            when (not (getf opt :category))
+            do (setf (select-selected-index sel) idx) (mark-dirty sel) (return)))))
+
+(defun select-prev (sel)
+  (let* ((filtered (select-filtered-options sel)) (count (length filtered))
+         (current (select-selected-index sel)))
+    (when (plusp count)
+      (loop for i from 1 below count
+            for idx = (mod (- current i) count)
+            for opt = (third (nth idx filtered))
+            when (not (getf opt :category))
+            do (setf (select-selected-index sel) idx) (mark-dirty sel) (return)))))
+
+(defun select-handle-key (sel event)
+  (let ((key (key-event-key event)) (ctrl (key-event-ctrl event)))
+    (cond
+      ((or (eql key :down) (and ctrl (eql key :n))) (select-next sel) t)
+      ((or (eql key :up) (and ctrl (eql key :p))) (select-prev sel) t)
+      ((eql key :enter)
+       (let* ((filtered (select-filtered-options sel)) (idx (select-selected-index sel))
+              (item (when (< idx (length filtered)) (third (nth idx filtered)))))
+         (when item (let ((cb (select-on-select sel))) (when cb (funcall cb item)))) t))
+      ((eql key :escape) nil) (t nil))))
+
+(defun select-visible-options (sel)
+  (let* ((ln (select-layout-node sel)) (height (if ln (layout-node-height ln) 80))
+         (filtered (select-filtered-options sel)) (sel-idx (select-selected-index sel))
+         (half (floor (1- height) 2)) (start (max 0 (- sel-idx half)))
+         (end (min (length filtered) (+ start height))))
+    (subseq filtered start end)))
+
+(defmethod render ((sel select) backend)
+  (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)
+      (let* ((display-idx (first item)) (option (third item))
+             (title (getf option :title)) (cat (getf option :category))
+             (selected (eql display-idx sel-idx))
+             (display (if (> (length title) (1- w))
+                          (concatenate 'string (subseq title 0 (1- w)) "…") title)))
+        (cond (cat (draw-text backend x y display :text-muted nil))
+              (selected
+               (draw-rect backend x y w 1 :bg :accent)
+               (draw-text backend x y display :background :accent))
+              (t (draw-text backend x y display nil nil)))
+        (incf y 1)))
+    (values)))

src/components/slot-package.lisp

@@ -7,3 +7,13 @@
    #:clear-slot
    #:list-slots
    #:*slots*))
+
+(defpackage :cl-tty.slot
+  (:use :cl)
+  (:export
+   #:defslot
+   #:slot-render
+   #:slot-p
+   #:clear-slot
+   #:list-slots
+   #:*slots*))

src/components/slot.lisp

@@ -28,3 +28,34 @@
 
 (defun list-slots ()
   (loop for key being the hash-keys of *slots* collect key))
+
+(in-package :cl-tty.slot)
+
+(defvar *slots* (make-hash-table :test #'equal)
+  "Hash table mapping slot name (string) -> list of (order . render-fn) pairs.")
+
+(defun defslot (name &key (order 0) render-fn)
+  (let* ((key (string name))
+         (entries (gethash key *slots*)))
+    (if (null entries)
+        (setf (gethash key *slots*) (list (cons order render-fn)))
+        (setf (gethash key *slots*)
+              (sort (cons (cons order render-fn) entries) #'< :key #'car))))
+  render-fn)
+
+(defun slot-render (slot-name &rest args)
+  (let ((entries (gethash (string slot-name) *slots*)))
+    (when entries
+      (mapcar (lambda (entry)
+                (let ((fn (cdr entry)))
+                  (when fn (apply fn args))))
+              entries))))
+
+(defun slot-p (slot-name)
+  (nth-value 1 (gethash (string slot-name) *slots*)))
+
+(defun clear-slot (slot-name)
+  (remhash (string slot-name) *slots*))
+
+(defun list-slots ()
+  (loop for key being the hash-keys of *slots* collect key))

src/components/tabbar.lisp

@@ -51,3 +51,57 @@
         (draw-text backend x-pos y label fg bg)
         (incf x-pos (+ label-len 2)))))
   (values))
+
+(in-package #:cl-tty.container)
+
+(defclass tab-bar (dirty-mixin)
+  ((tabs :initform nil :initarg :tabs :accessor tab-bar-tabs :type list)
+   (active :initform nil :initarg :active :accessor tab-bar-active)
+   (layout-node :initform (make-layout-node) :accessor tab-bar-layout-node)
+   (focusable :initform t :accessor tab-bar-focusable)))
+
+(defun make-tab-bar (&key tabs active)
+  (make-instance 'tab-bar :tabs (or tabs nil) :active active))
+
+(defun tab-bar-add (tb id title)
+  (setf (tab-bar-tabs tb) (nconc (tab-bar-tabs tb) (list (list :id id :title title))))
+  (unless (tab-bar-active tb) (setf (tab-bar-active tb) id)) id)
+
+(defmethod component-layout-node ((tb tab-bar)) (tab-bar-layout-node tb))
+
+(defun tab-bar-next (tb)
+  (let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb))
+         (ids (mapcar (lambda (tab) (getf tab :id)) tabs))
+         (pos (position current ids)))
+    (when pos (let ((next (nth (mod (1+ pos) (length ids)) ids)))
+                (setf (tab-bar-active tb) next) (mark-dirty tb)))))
+
+(defun tab-bar-prev (tb)
+  (let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb))
+         (ids (mapcar (lambda (tab) (getf tab :id)) tabs))
+         (pos (position current ids)))
+    (when pos (let ((prev (nth (mod (1- pos) (length ids)) ids)))
+                (setf (tab-bar-active tb) prev) (mark-dirty tb)))))
+
+(defun tab-bar-select (tb id) (setf (tab-bar-active tb) id) (mark-dirty tb))
+
+(defun tab-bar-handle-key (tb event)
+  (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))
+         (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 x))
+    (dolist (tab tabs)
+      (let* ((id (getf tab :id)) (title (getf tab :title))
+             (label (format nil " ~A " title)) (label-len (length label))
+             (is-active (eql id active-id))
+             (fg (if is-active :accent :text-muted))
+             (bg (if is-active :background-element nil)))
+        (when (>= (+ x-pos label-len 2) w)
+          (draw-text backend x-pos y "..." :text-muted nil) (return))
+        (draw-text backend x-pos y label fg bg)
+        (incf x-pos (+ label-len 2)))))
+  (values))

src/components/textarea.lisp

@@ -256,3 +256,262 @@
           do (draw-text backend x (+ y i)
                         (subseq line 0 (min (length line) w))
                         nil nil))))
+
+(in-package #:cl-tty.input)
+
+;;; ---------------------------------------------------------------------------
+;;; Textarea class
+;;; ---------------------------------------------------------------------------
+(defclass textarea (dirty-mixin)
+  ((value :initform "" :initarg :value :accessor textarea-value :type string)
+   (cursor-row :initform 0 :accessor textarea-cursor-row :type fixnum)
+   (cursor-col :initform 0 :accessor textarea-cursor-col :type fixnum)
+   (selection-start :initform nil :accessor textarea-selection-start)
+   (undo-stack :initform (make-array 100 :fill-pointer 0)
+               :accessor textarea-undo-stack)
+   (redo-stack :initform (make-array 100 :fill-pointer 0)
+               :accessor textarea-redo-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)))
+
+(defun make-textarea (&key value on-submit)
+  (make-instance 'textarea
+    :value (or value "")
+    :on-submit on-submit))
+
+;;; ---------------------------------------------------------------------------
+;;; Line helpers
+;;; ---------------------------------------------------------------------------
+(defun textarea-lines (ta)
+  "Split value into lines."
+  (%split-string (textarea-value ta) #\Newline))
+
+(defun textarea-line-count (ta)
+  "Number of lines in value."
+  (length (textarea-lines ta)))
+
+(defun textarea-ensure-cursor (ta)
+  "Clamp cursor to valid range."
+  (let ((lines (textarea-lines ta)))
+    (setf (textarea-cursor-row ta)
+          (max 0 (min (textarea-cursor-row ta) (1- (length lines)))))
+    (let ((line-len (length (nth (textarea-cursor-row ta) lines))))
+      (setf (textarea-cursor-col ta)
+            (max 0 (min (textarea-cursor-col ta) line-len)))))
+  (mark-dirty ta))
+
+;;; ---------------------------------------------------------------------------
+;;; Utility: join strings with newline
+;;; ---------------------------------------------------------------------------
+(defun %join-lines (lines)
+  "Join a sequence of strings with newlines."
+  (with-output-to-string (s)
+    (loop for line across (if (listp lines) (coerce lines 'vector) lines)
+          for first = t then nil
+          do (unless first (write-char #\Newline s))
+             (write-string line s))))
+
+;;; ---------------------------------------------------------------------------
+;;; Text manipulation
+;;; ---------------------------------------------------------------------------
+(defun textarea-insert-char (ta char)
+  "Insert CHAR at the cursor position."
+  (textarea-push-undo ta)
+  (let* ((lines (coerce (textarea-lines ta) 'vector))
+         (row (textarea-cursor-row ta))
+         (col (textarea-cursor-col ta)))
+    (if (< row (length lines))
+        (let* ((line (aref lines row))
+               (new-line (concatenate 'string
+                           (subseq line 0 col)
+                           (string char)
+                           (subseq line col))))
+          (setf (aref lines row) new-line)
+          (setf (textarea-value ta)
+                (%join-lines lines))
+          (incf (textarea-cursor-col ta))
+          (mark-dirty ta))
+        (progn
+          (setf (textarea-value ta)
+                (concatenate 'string (textarea-value ta) (string char)))
+          (incf (textarea-cursor-col ta))
+          (mark-dirty ta)))))
+
+(defun textarea-newline (ta)
+  "Insert a newline at the cursor."
+  (textarea-push-undo ta)
+  (let* ((lines (coerce (textarea-lines ta) 'vector))
+         (row (textarea-cursor-row ta))
+         (col (textarea-cursor-col ta)))
+    (if (< row (length lines))
+        (let* ((line (aref lines row))
+               (before (subseq line 0 col))
+               (after (subseq line col)))
+          (setf (aref lines row) before)
+          (let ((new-lines (concatenate 'vector
+                            (subseq lines 0 (1+ row))
+                            (vector after)
+                            (subseq lines (1+ row)))))
+            (setf (textarea-value ta)
+                  (%join-lines new-lines)))
+          (incf (textarea-cursor-row ta))
+          (setf (textarea-cursor-col ta) 0)
+          (mark-dirty ta))
+        (progn
+          (setf (textarea-value ta)
+                (concatenate 'string (textarea-value ta) (string #\Newline)))
+          (incf (textarea-cursor-row ta))
+          (setf (textarea-cursor-col ta) 0)
+          (mark-dirty ta)))))
+
+(defun textarea-backspace (ta)
+  "Delete character before cursor."
+  (textarea-push-undo ta)
+  (let* ((lines (coerce (textarea-lines ta) 'vector))
+         (row (textarea-cursor-row ta))
+         (col (textarea-cursor-col ta)))
+    (cond
+      ((and (zerop row) (zerop col))
+       nil)  ;; nothing to delete
+      ((zerop col)
+       ;; Join with previous line
+       (let* ((prev (aref lines (1- row)))
+              (curr (aref lines row))
+              (new-pos (length prev)))
+         (setf (aref lines (1- row))
+               (concatenate 'string prev curr))
+         (let ((new-lines (concatenate 'vector
+                           (subseq lines 0 row)
+                           (subseq lines (1+ row)))))
+           (setf (textarea-value ta)
+                 (%join-lines new-lines)))
+         (decf (textarea-cursor-row ta))
+         (setf (textarea-cursor-col ta) new-pos)
+         (mark-dirty ta)))
+      (t
+       (let* ((line (aref lines row))
+              (new-line (concatenate 'string
+                          (subseq line 0 (1- col))
+                          (subseq line col))))
+         (setf (aref lines row) new-line)
+         (setf (textarea-value ta)
+               (%join-lines lines))
+         (decf (textarea-cursor-col ta))
+         (mark-dirty ta))))))
+
+;;; ---------------------------------------------------------------------------
+;;; Cursor movement
+;;; ---------------------------------------------------------------------------
+(defun textarea-move-up (ta)
+  (decf (textarea-cursor-row ta))
+  (textarea-ensure-cursor ta))
+
+(defun textarea-move-down (ta)
+  (incf (textarea-cursor-row ta))
+  (textarea-ensure-cursor ta))
+
+;;; ---------------------------------------------------------------------------
+;;; Undo/redo
+;;; ---------------------------------------------------------------------------
+(defun textarea-push-undo (ta)
+  "Save current value on undo stack."
+  (let ((stack (textarea-undo-stack ta)))
+    (when (>= (length stack) (array-total-size stack))
+      (loop for i from 1 below (length stack)
+            do (setf (aref stack (1- i)) (aref stack i)))
+      (decf (fill-pointer stack)))
+    (vector-push (textarea-value ta) stack)
+    (setf (fill-pointer (textarea-redo-stack ta)) 0)))
+
+(defun textarea-undo (ta)
+  (let ((stack (textarea-undo-stack ta)))
+    (when (plusp (length stack))
+      (let ((prev (vector-pop stack)))
+        (vector-push (textarea-value ta) (textarea-redo-stack ta))
+        (setf (textarea-value ta) prev)
+        (textarea-ensure-cursor ta)
+        (mark-dirty ta)))))
+
+(defun textarea-redo (ta)
+  (let ((stack (textarea-redo-stack ta)))
+    (when (plusp (length stack))
+      (let ((next (vector-pop stack)))
+        (vector-push (textarea-value ta) (textarea-undo-stack ta))
+        (setf (textarea-value ta) next)
+        (textarea-ensure-cursor ta)
+        (mark-dirty ta)))))
+
+;;; ---------------------------------------------------------------------------
+;;; Key event handler
+;;; ---------------------------------------------------------------------------
+(defun handle-textarea-input (ta event)
+  "Process a key-event on a textarea widget."
+  (cond
+    ((key-event-ctrl event)
+     (case (key-event-key event)
+       (:z (textarea-undo ta))
+       (:y (textarea-redo ta))
+       ;; Ctrl+A/E: home/end
+       (:a (setf (textarea-cursor-col ta) 0))
+       (:e (let ((lines (textarea-lines ta)))
+             (when (< (textarea-cursor-row ta) (length lines))
+               (setf (textarea-cursor-col ta)
+                     (length (nth (textarea-cursor-row ta) lines))))))
+        (t nil)))
+    (t
+     (case (key-event-key event)
+       (:left (decf (textarea-cursor-col ta))
+              (textarea-ensure-cursor ta))
+       (:right (incf (textarea-cursor-col ta))
+               (textarea-ensure-cursor ta))
+       (:up (textarea-move-up ta))
+       (:down (textarea-move-down ta))
+        (:home (setf (textarea-cursor-col ta) 0)
+               (textarea-ensure-cursor ta))
+        (:end (let ((lines (textarea-lines ta)))
+                (when (< (textarea-cursor-row ta) (length lines))
+                  (setf (textarea-cursor-col ta)
+                        (length (nth (textarea-cursor-row ta) lines))))
+                (textarea-ensure-cursor ta)))
+       (:enter (let ((cb (textarea-on-submit ta)))
+                 (if cb
+                     (funcall cb (textarea-value ta))
+                     (textarea-newline ta))))
+       (:backspace (textarea-backspace ta))
+       (:delete (let* ((lines (textarea-lines ta))
+                       (row (textarea-cursor-row ta))
+                       (col (textarea-cursor-col ta))
+                       (line (nth row lines)))
+                  (when (and line (< col (length line)))
+                    (textarea-push-undo ta)
+                    (setf (nth row lines)
+                          (concatenate 'string
+                            (subseq line 0 col)
+                            (subseq line (1+ col))))
+                    (setf (textarea-value ta)
+                          (%join-lines lines))
+                    (mark-dirty ta))))
+       ;; Character insertion
+       (otherwise
+        (let ((ch (code-char (key-event-code event))))
+          (when (and ch (graphic-char-p ch))
+            (textarea-insert-char ta ch))))))))
+
+;;; ---------------------------------------------------------------------------
+;;; Rendering
+;;; ---------------------------------------------------------------------------
+(defmethod render ((ta textarea) (backend t))
+  "Render textarea lines at layout position."
+  (let* ((ln (textarea-layout-node ta))
+         (x (if ln (layout-node-x ln) 0))
+         (y (if ln (layout-node-y ln) 0))
+         (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/rendering/framebuffer.lisp

@@ -218,3 +218,223 @@ Returns the number of changed cells."
                (fb-scissor-y ,fb) ,old-y
                (fb-scissor-w ,fb) ,old-w
                (fb-scissor-h ,fb) ,old-h)))))
+
+(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 #:fb-framebuffer
+   #:framebuffer-width #:framebuffer-height
+   #:diff-framebuffers #:flush-framebuffer
+   #:with-scissor
+   #:extract-text #:fb-cell-link-url))
+
+(in-package :cl-tty.rendering)
+
+;;; ─── Cell — immutable per-cell state ─────────────────────────────────────────
+
+(defstruct cell
+  "A single terminal cell — character, colors, and attributes."
+  (char #\space :type character)
+  (fg nil)
+  (bg nil)
+  (bold nil :type boolean)
+  (italic nil :type boolean)
+  (underline nil :type boolean)
+  (link-url nil))
+
+;;; ─── Framebuffer — 2D array of cells ────────────────────────────────────────
+
+(defun make-framebuffer (width height)
+  "Create a 2D array of CELL with dimensions HEIGHT x WIDTH."
+  (make-array (list height width)
+              :initial-element (make-cell)
+              :element-type 'cell))
+
+(defun framebuffer-width (fb)
+  "Return the width (columns) of framebuffer FB."
+  (if (arrayp fb) (array-dimension fb 1) 0))
+
+(defun framebuffer-height (fb)
+  "Return the height (rows) of framebuffer FB."
+  (if (arrayp fb) (array-dimension fb 0) 0))
+
+;;; ─── Framebuffer Backend — implements backend protocol ─────────────────────
+
+(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-backend (&key (width 80) (height 24))
+  "Create a framebuffer-backend with a fresh framebuffer."
+  (let ((fb (make-instance 'framebuffer-backend)))
+    (setf (fb-framebuffer fb) (make-framebuffer width height))
+    fb))
+
+;;; ─── Drawing methods ─────────────────────────────────────────────────────────
+
+(defun %in-scissor-p (fb cx cy)
+  "Check if (CX, CY) falls within the current scissor rectangle."
+  (let ((sx (fb-scissor-x fb)) (sy (fb-scissor-y fb))
+        (sw (fb-scissor-w fb)) (sh (fb-scissor-h fb)))
+    (and (or (null sw) (and (>= cx sx) (< cx (+ sx sw))))
+         (or (null sh) (and (>= cy sy) (< cy (+ sy sh)))))))
+
+(defun %set-cell (fb x y char &key fg bg bold italic underline link-url)
+  "Set cell (X, Y) if within bounds and scissor."
+  (let ((cells (fb-framebuffer fb)))
+    (when (and (>= y 0) (< y (framebuffer-height cells))
+               (>= x 0) (< x (framebuffer-width cells))
+               (%in-scissor-p fb x y))
+      (setf (aref cells y x)
+            (make-cell :char char :fg fg :bg bg
+                       :bold bold :italic italic :underline underline
+                       :link-url link-url)))))
+
+(defmethod draw-text ((fb framebuffer-backend) x y string fg bg
+                        &key bold italic underline reverse dim blink
+                             (link-url nil link-url-p)
+                        &allow-other-keys)
+  (declare (ignore reverse dim blink link-url-p))
+  (loop for i from 0 below (length string)
+        do (%set-cell fb (+ x i) y (char string i)
+                      :fg fg :bg bg
+                      :bold bold :italic italic :underline underline
+                      :link-url link-url)))
+
+(defmethod draw-rect ((fb framebuffer-backend) x y w h &key bg)
+  (dotimes (row h)
+    (dotimes (col w)
+      (%set-cell fb (+ x col) (+ y row) #\space :fg nil :bg bg))))
+
+(defmethod draw-border ((fb framebuffer-backend) x y w h &key (style :single) title title-align fg bg)
+  (let* ((chars (case style
+                  (:single '(#\+ #\- #\|))
+                  (:double '(#\+ #\= #\|))
+                  (:rounded '(#\. #\- #\|))
+                  (t '(#\+ #\- #\|))))
+         (tc (first chars)) (hc (second chars)) (vc (third chars)))
+    ;; Top edge
+    (%set-cell fb x y tc :fg fg :bg bg)
+    (loop for i from 1 below (1- w) do (%set-cell fb (+ x i) y hc :fg fg :bg bg))
+    (%set-cell fb (1- (+ x w)) y tc :fg fg :bg bg)
+    ;; Sides
+    (dotimes (row (- h 2))
+      (%set-cell fb x (+ y row 1) vc :fg fg :bg bg)
+      (%set-cell fb (1- (+ x w)) (+ y row 1) vc :fg fg :bg bg))
+    ;; Bottom edge
+    (%set-cell fb x (+ y h -1) tc :fg fg :bg bg)
+    (loop for i from 1 below (1- w) do (%set-cell fb (+ x i) (+ y h -1) hc :fg fg :bg bg))
+    (%set-cell fb (1- (+ x w)) (+ y h -1) tc :fg fg :bg bg)
+    ;; Title
+    (when title
+      (loop for i from 0 below (length title)
+            do (%set-cell fb (+ x 2 i) y (char title i) :fg fg :bg bg)))))
+
+(defmethod backend-clear ((fb framebuffer-backend))
+  (let ((cells (fb-framebuffer fb)))
+    (dotimes (y (framebuffer-height cells))
+      (dotimes (x (framebuffer-width cells))
+        (setf (aref cells y x) (make-cell))))))
+
+(defmethod draw-link ((fb framebuffer-backend) x y string url &key fg bg)
+  ;; OSC 8 links are not rendered in framebuffer — store as text
+  (draw-text fb x y string fg bg :link-url url))
+
+(defmethod draw-ellipsis ((fb framebuffer-backend) x y width &key fg bg)
+  (dotimes (i (min 3 width))
+    (%set-cell fb (+ x i) y #\. :fg fg :bg bg)))
+
+;;; ─── Diff ────────────────────────────────────────────────────────────────────
+
+(defun cells-equal-p (a b)
+  "Return T if two cells have identical content and style."
+  (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))))
+
+(defun diff-framebuffers (prev curr)
+  "Compare PREV and CURR framebuffers. Return list of (X Y CELL) for changes."
+  (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 (cells-equal-p a b)
+            (push (list x y b) changes)))))
+    (nreverse changes)))
+
+;;; ─── Flush ───────────────────────────────────────────────────────────────────
+
+(defun flush-framebuffer (prev-fb curr-fb backend)
+  "Diff PREV-FB and CURR-FB and flush changes to BACKEND.
+Returns the number of changed cells."
+  (let* ((changes (diff-framebuffers prev-fb curr-fb))
+         (count (length changes))
+         (current-row -1))
+    (when (plusp count)
+      (begin-sync backend)
+      (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))))
+      (end-sync backend))
+    count))
+
+;;; --- Frame inspection ---------------------------------------------------
+
+(defun fb-cell-link-url (fb x y)
+  "Return the link URL at (X Y) in framebuffer FB, or nil."
+  (when (and (arrayp fb) (>= y 0) (< y (array-dimension fb 0))
+             (>= x 0) (< x (array-dimension fb 1)))
+    (let ((c (aref fb y x)))
+      (cell-link-url c))))
+
+(defun extract-text (fb x1 y1 x2 y2)
+  "Extract visible text from the rectangle between (X1,Y1) and (X2,Y2)."
+  (let ((x-min (max 0 (min x1 x2))) (x-max (max 0 (max x1 x2)))
+        (y-min (max 0 (min y1 y2))) (y-max (max 0 (max y1 y2)))
+        (h (if (arrayp fb) (array-dimension fb 0) 0))
+        (w (if (arrayp fb) (array-dimension fb 1) 0)))
+    (with-output-to-string (s)
+      (loop for y from y-min to (min y-max (1- h))
+            do (loop for x from x-min to (min x-max (1- w))
+                     do (let ((c (aref fb y x)))
+                          (princ (cell-char c) s)))
+               (when (< y y-max) (princ #\Newline s))))))
+
+;;; ─── Scissor clipping ────────────────────────────────────────────────────────
+
+(defmacro with-scissor ((fb x y w h) &body body)
+  "Clip all drawing on FB to 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)))))

tests/dialog-tests.lisp

@@ -41,3 +41,47 @@
   (let ((*toasts* (list (make-instance 'toast :message "T" :variant :info))))
     (dismiss-toast (first *toasts*))
     (is (= 0 (length *toasts*)))))
+
+;;; dialog-tests.lisp — Tests for cl-tty.dialog
+
+(defpackage :cl-tty-dialog-test
+  (:use :cl :cl-tty.dialog :fiveam))
+
+(in-package :cl-tty-dialog-test)
+
+(def-suite dialog-suite :description "Dialog + Toast tests for cl-tty.dialog")
+(in-suite dialog-suite)
+
+(def-test dialog-create ()
+  (let ((d (make-instance 'dialog :title "Test")))
+    (is-true (typep d 'dialog))
+    (is (equal "Test" (dialog-title d)))))
+
+(def-test dialog-size-small ()
+  (multiple-value-bind (w h) (dialog-size-pixels :small)
+    (is (= 40 w))
+    (is (= 8 h))))
+
+(def-test dialog-size-medium ()
+  (multiple-value-bind (w h) (dialog-size-pixels :medium)
+    (is (= 60 w))
+    (is (= 16 h))))
+
+(def-test dialog-push-pop ()
+  (let ((*dialog-stack* nil))
+    (push-dialog (make-instance 'dialog :title "D1"))
+    (is (= 1 (length *dialog-stack*)))
+    (push-dialog (make-instance 'dialog :title "D2"))
+    (is (= 2 (length *dialog-stack*)))
+    (pop-dialog)
+    (is (= 1 (length *dialog-stack*)))))
+
+(def-test toast-create ()
+  (let ((*toasts* nil))
+    (toast "Hello" :variant :info :duration 0)
+    (is (= 1 (length *toasts*)))))
+
+(def-test toast-dismiss ()
+  (let ((*toasts* (list (make-instance 'toast :message "T" :variant :info))))
+    (dismiss-toast (first *toasts*))
+    (is (= 0 (length *toasts*)))))

tests/input-tests.lisp

@@ -386,3 +386,392 @@ world")))
   (remhash :local *keymaps*)
   (is-false (gethash :global *keymaps*))
   (is-false (gethash :local *keymaps*)))
+
+(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))))
+
+;; ── UTF-8 Decode Tests ──────────────────────────────────────────
+
+(test utf8-decode-latin1-supplement
+  "0xC3 0xA9 (é) decodes to code point 233."
+  (is (= (cl-tty.input:utf8-decode '(#xc3 #xa9)) 233)))
+
+(test utf8-decode-euro-sign
+  "0xE2 0x82 0xAC (€) decodes to code point 8364."
+  (is (= (cl-tty.input:utf8-decode '(#xe2 #x82 #xac)) 8364)))
+
+(test utf8-decode-emoji
+  "0xF0 0x9F 0x92 0xA9 (💩) decodes to code point 128169."
+  (is (= (cl-tty.input:utf8-decode '(#xf0 #x9f #x92 #xa9)) 128169)))
+
+(test utf8-decode-invalid-short
+  "Invalid byte 0x80 alone returns nil."
+  (is-false (cl-tty.input:utf8-decode '(#x80))))
+
+(test utf8-decode-invalid-overlong
+  "Overlong 2-byte sequence 0xC0 0x80 returns nil."
+  (is-false (cl-tty.input:utf8-decode '(#xc0 #x80))))
+
+;; ── 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 ────────────────────────────────────────────
+;; These tests verify the keymap dispatch system works correctly
+;; when wired up.  Note: dispatch-key-event is NOT called by the
+;; demo's event loop — users MUST call it explicitly in their own
+;; event loops if they want to use the defkeymap/dispatch-key-event
+;; system.  See src/components/keybindings.lisp for details.
+;;
+;; Chords ((:ctrl+x :ctrl+s)) are not yet supported; only single
+;; key specs work.  The *chord-timeout* variable and list-of-lists
+;; syntax are reserved for future implementation.
+
+(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 key-spec-alt-modifier
+  "Alt modifier is matched correctly."
+  (is-true (key-match-p :alt+x (make-key-event :key :x :alt t)))
+  (is-false (key-match-p :alt+x (make-key-event :key :x)))
+  (is-false (key-match-p :alt+x (make-key-event :key :x :ctrl t))))
+
+(test key-spec-shift-modifier
+  "Shift modifier is matched correctly."
+  (is-true (key-match-p :shift+tab (make-key-event :key :tab :shift t)))
+  (is-false (key-match-p :shift+tab (make-key-event :key :tab))))
+
+(test key-spec-plain
+  "Plain key spec matches unmodified keys."
+  (is-true (key-match-p :enter (make-key-event :key :enter)))
+  (is-true (key-match-p :escape (make-key-event :key :escape)))
+  (is-false (key-match-p :enter (make-key-event :key :escape))))
+
+(test key-spec-list-form
+  "List-form spec (:ctrl+p) matches same as keyword :ctrl+p."
+  (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))))
+
+(test dispatch-return-value-match
+  "dispatch-key-event returns T on matching binding."
+  (setf (gethash :global *keymaps*)
+        (make-keymap :name :global
+                     :bindings `((:ctrl+p . ,(lambda (e) (declare (ignore e)))))))
+  (is-true (dispatch-key-event (make-key-event :key :p :ctrl t))))
+
+(test dispatch-return-value-no-match
+  "dispatch-key-event returns NIL when no binding matches."
+  (setf (gethash :global *keymaps*)
+        (make-keymap :name :global
+                     :bindings `((:ctrl+p . ,(lambda (e) (declare (ignore e)))))))
+  (is-false (dispatch-key-event (make-key-event :key :a))))
+
+(test dispatch-empty-keymap
+  "dispatch-key-event returns NIL on empty keymap."
+  (setf (gethash :global *keymaps*) (make-keymap :name :global))
+  (is-false (dispatch-key-event (make-key-event :key :a))))
+
+(test dispatch-local-overrides-global
+  "Local keymap takes priority over global."
+  (let ((local-called nil) (global-called nil))
+    (setf (gethash :local *keymaps*)
+          (make-keymap :name :local
+                       :bindings `((:ctrl+p . ,(lambda (e)
+                                                  (declare (ignore e))
+                                                  (setf local-called t))))))
+    (setf (gethash :global *keymaps*)
+          (make-keymap :name :global
+                       :bindings `((:ctrl+p . ,(lambda (e)
+                                                  (declare (ignore e))
+                                                  (setf global-called t))))))
+    (is-true (dispatch-key-event (make-key-event :key :p :ctrl t)))
+    (is-true local-called)
+    (is-false global-called)))
+
+(test dispatch-multiple-bindings
+  "dispatch-key-event finds the right binding among many."
+  (let ((called nil))
+    (setf (gethash :global *keymaps*)
+          (make-keymap :name :global
+                       :bindings `((:ctrl+a . (lambda (e) (declare (ignore e))))
+                                   (:ctrl+b . (lambda (e) (declare (ignore e))))
+                                   (:ctrl+c . ,(lambda (e)
+                                                  (declare (ignore e))
+                                                  (setf called t)))
+                                   (:ctrl+d . (lambda (e) (declare (ignore e)))))))
+    (is-true (dispatch-key-event (make-key-event :key :c :ctrl t)))
+    (is-true called)))
+
+(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)))
+
+(test defkeymap-macro-with-list-spec
+  "defkeymap macro works with list-form specs."
+  (let ((called nil))
+    (eval `(defkeymap :global
+             ((:ctrl+w) ,(lambda (e) (declare (ignore e)) (setf called t)))))
+    (dispatch-key-event (make-key-event :key :w :ctrl t))
+    (is-true called)))
+
+;; cleanup after keybinding tests
+(test keybinding-cleanup-global
+  "Clean up global keymap after testing."
+  (remhash :global *keymaps*)
+  (remhash :local *keymaps*)
+  (is-false (gethash :global *keymaps*))
+  (is-false (gethash :local *keymaps*)))

tests/mouse-tests.lisp

@@ -47,3 +47,53 @@
     (let ((text (finalize-selection fb)))
       (is (equal "hello
 world" text)))))
+
+(defpackage :cl-tty-mouse-test (:use :cl :cl-tty.mouse :fiveam))
+(in-package :cl-tty-mouse-test)
+
+(def-suite mouse-suite :description "Mouse tests")
+(in-suite mouse-suite)
+
+(def-test mouse-mixin-create ()
+  (let ((m (make-instance 'mouse-mixin)))
+    (is-true (typep m 'mouse-mixin))))
+
+(def-test mouse-hit-test-point ()
+  "hit-test returns nil when no component has position slots bound"
+  (let ((obj (make-instance 'mouse-mixin)))
+    (is-false (hit-test obj 0 0))
+    (is-false (hit-test obj 100 100))))
+
+(def-test selection-set-and-get ()
+  (setf cl-tty.mouse::*selection* (make-selection :text "hello"))
+  (is (equal "hello" (get-selection))))
+
+;; ── Selection tracking ──────────────────────────────────────
+
+(def-test start-selection-initializes-state ()
+  (start-selection 5 10)
+  (is-true (selection-active-p))
+  (is (equal '(5 . 10) cl-tty.mouse::*selection-start*))
+  (is (equal '(5 . 10) cl-tty.mouse::*selection-end*))
+  (setf cl-tty.mouse::*selection-active* nil
+        cl-tty.mouse::*selection-start* nil
+        cl-tty.mouse::*selection-end* nil))
+
+(def-test update-selection-moves-end ()
+  (start-selection 0 0)
+  (update-selection 3 7)
+  (is (equal '(3 . 7) cl-tty.mouse::*selection-end*))
+  (setf cl-tty.mouse::*selection-active* nil
+        cl-tty.mouse::*selection-start* nil
+        cl-tty.mouse::*selection-end* nil))
+
+(def-test finalize-selection-extracts-text ()
+  (let* ((fb-be (cl-tty.rendering:make-framebuffer-backend))
+         (fb (cl-tty.rendering:fb-framebuffer fb-be)))
+    (cl-tty.backend:draw-text fb-be 0 0 "hello" nil nil)
+    (cl-tty.backend:draw-text fb-be 0 1 "world" nil nil)
+    (start-selection 0 0)
+    (update-selection 4 1)
+    (let ((text (finalize-selection fb)))
+      (is (equal "hello
+world" text)))))

tests/scrollbox-tabbar-tests.lisp

@@ -126,3 +126,132 @@
     (setf (scroll-box-scroll-y sb) 1000000)
     (clamp-scroll sb)
     (is (= (scroll-box-scroll-y sb) 0) "clamps above max (no children = 0 content)")))
+
+(defpackage :cl-tty-scrollbox-test
+  (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.container)
+  (:export #:run-tests))
+(in-package #:cl-tty-scrollbox-test)
+
+(def-suite scrollbox-suite :description "ScrollBox + TabBar tests")
+(in-suite scrollbox-suite)
+
+(defun run-tests ()
+  (let ((result (run 'scrollbox-suite)))
+    (fiveam:explain! result)
+    (uiop:quit 0)))
+
+;; ── ScrollBox Tests ─────────────────────────────────────────────
+
+(test scrollbox-creates
+  "A ScrollBox can be created with defaults."
+  (let ((sb (make-scroll-box)))
+    (is (typep sb 'scroll-box))
+    (is (= (scroll-box-scroll-y sb) 0))
+    (is (= (scroll-box-scroll-x sb) 0))
+    (is-false (scroll-box-children sb))))
+
+(test scrollbox-with-children
+  "A ScrollBox can have children."
+  (let ((sb (make-scroll-box :children (list (make-text "hello")))))
+    (is (= (length (scroll-box-children sb)) 1))))
+
+(test scrollbox-scroll-by
+  "ScrollBy adjusts offset clamped to valid range."
+  (let ((sb (make-scroll-box :scroll-y 0)))
+    (scroll-by sb 5 0)
+    (is (>= (scroll-box-scroll-y sb) 0))))
+
+(test scrollbox-component-children
+  "Component protocol: children are accessible."
+  (let* ((child (make-text "hello"))
+         (sb (make-scroll-box :children (list child))))
+    (is (eql (first (component-children sb)) child))))
+
+(test scrollbox-render-noop
+  "Rendering a ScrollBox with no children does not error."
+  (let* ((stream (make-string-output-stream))
+         (backend (make-simple-backend :output-stream stream))
+         (sb (make-scroll-box)))
+    (render sb backend)
+    (is-true t)))
+
+;; ── TabBar Tests ────────────────────────────────────────────────
+
+(test tabbar-creates
+  "A TabBar can be created with defaults."
+  (let ((tb (make-tab-bar)))
+    (is (typep tb 'tab-bar))
+    (is-false (tab-bar-active tb))
+    (is-false (tab-bar-tabs tb))))
+
+(test tabbar-add-tab
+  "Adding a tab returns the id and updates tabs."
+  (let ((tb (make-tab-bar)))
+    (let ((id (tab-bar-add tb :tab1 "Tab One")))
+      (is (eql id :tab1))
+      (is (= (length (tab-bar-tabs tb)) 1))
+      (is (string= (getf (first (tab-bar-tabs tb)) :title) "Tab One")))))
+
+(test tabbar-active-tab
+  "Setting active tab works."
+  (let ((tb (make-tab-bar)))
+    (tab-bar-add tb :tab1 "One")
+    (tab-bar-add tb :tab2 "Two")
+    (setf (tab-bar-active tb) :tab2)
+    (is (eql (tab-bar-active tb) :tab2))))
+
+(test tabbar-render-noop
+  "Rendering a TabBar does not error."
+  (let* ((stream (make-string-output-stream))
+         (backend (make-simple-backend :output-stream stream))
+         (tb (make-tab-bar)))
+    (tab-bar-add tb :tab1 "One")
+    (tab-bar-add tb :tab2 "Two")
+    (setf (tab-bar-active tb) :tab1)
+    (render tb backend)
+    (is-true t)))
+
+(test tabbar-next-prev
+  "TabBar next/prev wraps around through tabs."
+  (let ((tb (make-tab-bar)))
+    (tab-bar-add tb :tab1 "One")
+    (tab-bar-add tb :tab2 "Two")
+    (tab-bar-add tb :tab3 "Three")
+    (is (eql (tab-bar-active tb) :tab1))
+    (tab-bar-next tb)
+    (is (eql (tab-bar-active tb) :tab2))
+    (tab-bar-next tb)
+    (is (eql (tab-bar-active tb) :tab3))
+    (tab-bar-next tb)
+    (is (eql (tab-bar-active tb) :tab1) "wrap around past last")
+    (tab-bar-prev tb)
+    (is (eql (tab-bar-active tb) :tab3) "wrap around past first")))
+
+(test tabbar-select
+  "TabBar select activates the specified tab."
+  (let ((tb (make-tab-bar)))
+    (tab-bar-add tb :tab1 "One")
+    (tab-bar-add tb :tab2 "Two")
+    (tab-bar-select tb :tab2)
+    (is (eql (tab-bar-active tb) :tab2))))
+
+(test tabbar-handle-key
+  "TabBar handle-key dispatches left/right."
+  (let ((tb (make-tab-bar)))
+    (tab-bar-add tb :tab1 "One")
+    (tab-bar-add tb :tab2 "Two")
+    (setf (tab-bar-active tb) :tab1)
+    (tab-bar-handle-key tb (make-key-event :key :right))
+    (is (eql (tab-bar-active tb) :tab2))
+    (tab-bar-handle-key tb (make-key-event :key :left))
+    (is (eql (tab-bar-active tb) :tab1))))
+
+(test scrollbox-scroll-clamp
+  "ScrollBox clamp prevents scrolling past bounds."
+  (let ((sb (make-scroll-box :scroll-y 5 :scroll-x 3)))
+    (setf (scroll-box-scroll-y sb) -1)
+    (clamp-scroll sb)
+    (is (= (scroll-box-scroll-y sb) 0) "clamps below 0")
+    (setf (scroll-box-scroll-y sb) 1000000)
+    (clamp-scroll sb)
+    (is (= (scroll-box-scroll-y sb) 0) "clamps above max (no children = 0 content)")))

tests/select-tests.lisp

@@ -118,3 +118,124 @@
     (let ((filtered (select-filtered-options sel)))
       (is (= (length filtered) 1))
       (is (eql (getf (third (first filtered)) :value) :nord)))))
+
+(defpackage :cl-tty-select-test
+  (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.select)
+  (:export #:run-tests))
+(in-package #:cl-tty-select-test)
+
+(def-suite select-suite :description "Select widget tests")
+(in-suite select-suite)
+
+(defun run-tests ()
+  (let ((result (run 'select-suite)))
+    (fiveam:explain! result)
+    (uiop:quit 0)))
+
+(test select-creates
+  "A Select can be created with defaults."
+  (let ((sel (make-select)))
+    (is (typep sel 'select))
+    (is-false (select-options sel))
+    (is-false (select-filter sel))
+    (is (= (select-selected-index sel) 0))))
+
+(test select-with-options
+  "A Select stores options."
+  (let ((sel (make-select :options '((:title "Red" :value :red)
+                                     (:title "Blue" :value :blue)))))
+    (is (= (length (select-options sel)) 2))))
+
+(test select-filtered-exact
+  "Filter returns case-insensitive substring matches."
+  (let ((sel (make-select
+              :options '((:title "Red" :value :red)
+                         (:title "Green" :value :green)
+                         (:title "Blue" :value :blue)))))
+    (setf (select-filter sel) "bl")
+    (let ((filtered (select-filtered-options sel)))
+      (is (= (length filtered) 1))
+      (is (eql (getf (third (first filtered)) :value) :blue)))))
+
+(test select-filtered-all
+  "Nil filter returns all options."
+  (let ((sel (make-select
+              :options '((:title "Red" :value :red)
+                         (:title "Blue" :value :blue)))))
+    (let ((filtered (select-filtered-options sel)))
+      (is (= (length filtered) 2)))))
+
+(test select-navigation
+  "Select-next and select-prev navigate through options."
+  (let ((sel (make-select
+              :options '((:title "A" :value :a)
+                         (:title "B" :value :b)
+                         (:title "C" :value :c)))))
+    (is (= (select-selected-index sel) 0))
+    (select-next sel)
+    (is (= (select-selected-index sel) 1))
+    (select-next sel)
+    (is (= (select-selected-index sel) 2))
+    (select-next sel)
+    (is (= (select-selected-index sel) 0) "wraps forward")
+    (select-prev sel)
+    (is (= (select-selected-index sel) 2) "wraps backward")))
+
+(test select-navigation-skips-categories
+  "Navigation skips category header options."
+  (let ((sel (make-select
+              :options '((:title "Colors" :category t)
+                         (:title "Red" :value :red)
+                         (:title "Green" :value :green)
+                         (:title "Shapes" :category t)
+                         (:title "Circle" :value :circle)))))
+    (is (= (select-selected-index sel) 0))
+    (select-next sel)
+    (is (= (select-selected-index sel) 1) "skipped category header at 0")
+    (select-next sel)
+    (is (= (select-selected-index sel) 2))
+    (select-next sel)
+    (is (= (select-selected-index sel) 4) "skipped category header at 3")))
+
+(test select-handle-key
+  "Select handle-key dispatches navigation and selection."
+  (let* ((result (list nil))
+         (sel (make-select
+              :options '((:title "A" :value :a) (:title "B" :value :b))
+              :on-select (lambda (opt) (setf (car result) (getf opt :value))))))
+    (select-handle-key sel (make-key-event :key :down))
+    (is (= (select-selected-index sel) 1))
+    (select-handle-key sel (make-key-event :key :up))
+    (is (= (select-selected-index sel) 0))
+    (select-handle-key sel (make-key-event :key :enter))
+    (is (eql (car result) :a))))
+
+(test select-handle-key-ctrl
+  "Ctrl+N and Ctrl+P navigate like down/up."
+  (let ((sel (make-select
+              :options '((:title "A" :value :a) (:title "B" :value :b) (:title "C" :value :c)))))
+    (select-handle-key sel (make-key-event :key :n :ctrl t))
+    (is (= (select-selected-index sel) 1))
+    (select-handle-key sel (make-key-event :key :p :ctrl t))
+    (is (= (select-selected-index sel) 0))))
+
+(test select-visible-count
+  "Visible options respects viewport height."
+  (let* ((ln (make-layout-node))
+         (sel (make-select
+               :options (loop for i below 20 collect (list :title (format nil "Item ~D" i) :value i)))))
+    (setf (select-layout-node sel) ln)
+    (setf (layout-node-height ln) 5)
+    (let ((visible (select-visible-options sel)))
+      (is (<= (length visible) 5)))))
+
+(test select-fuzzy-fallback
+  "Fuzzy filter catches near-misses."
+  (let ((sel (make-select
+              :options '((:title "Nord" :value :nord)
+                         (:title "Tokyo Night" :value :tokyo)
+                         (:title "Catppuccin" :value :cat)))))
+    (setf (select-filter sel) "nrd")
+    (let ((filtered (select-filtered-options sel)))
+      (is (= (length filtered) 1))
+      (is (eql (getf (third (first filtered)) :value) :nord)))))

tests/slot-tests.lisp

@@ -52,3 +52,30 @@
   (let ((result (slot-render :args-slot 3 4)))
     (is (equal '("3+4") result)))
   (clear-slot :args-slot))
+
+(defpackage :cl-tty-slot-test (:use :cl :cl-tty.slot :fiveam))
+(in-package :cl-tty-slot-test)
+
+(def-suite slot-suite :description "Slot system tests")
+(in-suite slot-suite)
+
+(def-test defslot-register ()
+  (clear-slot :test-slot)
+  (defslot :test-slot :order 1 :render-fn (lambda () "hello"))
+  (is-true (slot-p :test-slot)))
+
+(def-test slot-render-calls ()
+  (clear-slot :test-slot)
+  (defslot :test-slot :order 1 :render-fn (lambda () "a"))
+  (defslot :test-slot :order 2 :render-fn (lambda () "b"))
+  (is (equal '("a" "b") (slot-render :test-slot))))
+
+(def-test slot-render-empty ()
+  (clear-slot :ghost)
+  (is-false (slot-render :ghost)))
+
+(def-test clear-slot-removes ()
+  (clear-slot :test-slot)
+  (defslot :test-slot :order 1 :render-fn (lambda () "x"))
+  (clear-slot :test-slot)
+  (is-false (slot-p :test-slot)))