backend/modern.lisp

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

backend/package.lisp

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

backend/simple.lisp

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

cl-tty.asd

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

org/scrollbox-tabbar.org

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

run-all-tests.lisp

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

src/components/input.lisp

@@ -204,10 +204,14 @@
              (make-key-event :key :escape :raw (string #\Esc)))))
       ;; CSI: ESC [ ...
       (#x5b
-       (multiple-value-bind (params final-byte) (parse-csi-params)
+       (multiple-value-bind (params final-byte raw) (parse-csi-params)
          (if (null final-byte)
              (make-key-event :key :escape :raw (string #\Esc))
-             (if (and (char= (code-char final-byte) #\M)
+             ;; SGR mouse: ESC [ < ... m/M
+             (if (and raw (plusp (length raw)) (char= (char raw 0) #\<))
+                 (or (parse-sgr-mouse raw)
+                     (make-key-event :key :unknown :raw raw))
+                 (if (and (char= (code-char final-byte) #\M)
                       (>= (length params) 3))
                  (let* ((p0 (first params)))
                    (if (zerop (logand p0 #x40))
@@ -252,7 +256,7 @@
                              ctrl  (logtest modifier 4)))
                      (make-key-event :key (or key :unknown)
                                      :ctrl ctrl :alt alt :shift shift
-                                     :raw (format nil "~C[~d~C" #\Esc param (code-char final-byte))))))))))
+                                     :raw (format nil "~C[~d~C" #\Esc param (code-char final-byte)))))))))))
       ;; ESC ESC
       (#x1b
        (make-key-event :key :escape :alt t :raw "\\e\\e"))
@@ -273,24 +277,24 @@
   (let ((b (read-raw-byte :timeout timeout)))
     (unless b
       (return-from %read-event nil))
-    (case b
-      (#x1b
+    (cond
+      ((= b #x1b)
        (%read-escape-sequence))
-      (#x09
+      ((= b #x09)
        (make-key-event :key :tab :code #x09))
-      (#x0a
+      ((= b #x0a)
        (make-key-event :key :enter :code #x0a))
-      (#x0d
+      ((= b #x0d)
        (make-key-event :key :enter :code #x0d))
-      ((#x7f #x08)
+      ((or (= b #x7f) (= b #x08))
        (make-key-event :key :backspace :code b))
       ((and (>= b #x01) (<= b #x1a))
        (let ((key (intern (string-upcase (string (code-char (+ b #x60)))) :keyword)))
          (make-key-event :key key :ctrl t :code b)))
-      (#x1c (make-key-event :key :backslash :ctrl t :code b))
-      (#x1d (make-key-event :key :rbracket :ctrl t :code b))
-      (#x1e (make-key-event :key :caret :ctrl t :code b))
-      (#x1f (make-key-event :key :underscore :ctrl t :code b))
+      ((= b #x1c) (make-key-event :key :backslash :ctrl t :code b))
+      ((= b #x1d) (make-key-event :key :rbracket :ctrl t :code b))
+      ((= b #x1e) (make-key-event :key :caret :ctrl t :code b))
+      ((= b #x1f) (make-key-event :key :underscore :ctrl t :code b))
       ((and (>= b #x20) (<= b #x7e))
        (let ((ch (code-char b)))
          (make-key-event :key (intern (string (string-upcase ch)) :keyword)

src/components/mouse.lisp

@@ -16,18 +16,18 @@
     (when handler (funcall handler event))))
 
 (defun hit-test (root x y)
+  "Find the deepest component at (X, Y) by testing layout-node bounds.
+Components without a layout-node or position return nil."
   (labels ((recurse (node)
-             (when (and (slot-exists-p node 'x) (slot-boundp node 'x)
-                        (slot-exists-p node 'y) (slot-boundp node 'y)
-                        (slot-exists-p node 'width) (slot-boundp node 'width)
-                        (slot-exists-p node 'height) (slot-boundp node 'height))
-               (let ((nx (slot-value node 'x))
-                     (ny (slot-value node 'y))
-                     (nw (slot-value node 'width))
-                     (nh (slot-value node 'height)))
-                 (when (and (>= x nx) (< x (+ nx nw))
-                            (>= y ny) (< y (+ ny nh)))
-                   node)))))
+             (let ((ln (ignore-errors (component-layout-node node))))
+               (when ln
+                 (let ((nx (layout-node-x ln))
+                       (ny (layout-node-y ln))
+                       (nw (layout-node-width ln))
+                       (nh (layout-node-height ln)))
+                   (when (and (>= x nx) (< x (+ nx nw))
+                              (>= y ny) (< y (+ ny nh)))
+                     node))))))
     (recurse root)))
 
 ;; Selection

src/components/scrollbox.lisp

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

src/components/tabbar.lisp

@@ -44,7 +44,7 @@
              (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)
+        (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)))))

src/components/text-input.lisp

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

src/components/textarea.lisp

@@ -237,11 +237,20 @@
             (textarea-insert-char ta ch))))))))
 
 ;;; ---------------------------------------------------------------------------
-;;; Rendering (stub — proper rendering uses theme + backend)
+;;; Rendering
 ;;; ---------------------------------------------------------------------------
 (defmethod render ((ta textarea) (backend t))
-  "Render a textarea widget. Full rendering requires *current-backend*,
-  *current-theme*, and the rendering pipeline. This is a no-op stub for
-  unit testing the widget logic."
-  (declare (ignore ta backend))
-  (values))
+  "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)))
+    (declare (ignore w))
+    (loop for i from 0 below max-lines
+          for line in lines
+          do (draw-text backend x (+ y i)
+                        (subseq line 0 (min (length line) w))
+                        nil nil))))

src/components/theme.lisp

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

tests/input-tests.lisp

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