org/framebuffer.org

@@ -356,3 +356,118 @@ Returns the number of changed cells."
                (fb-scissor-w ,fb) ,old-w
                (fb-scissor-h ,fb) ,old-h)))))
 #+END_SRC
+
+** Tests
+
+#+BEGIN_SRC lisp :tangle ../tests/framebuffer-tests.lisp
+(defpackage :cl-tty-framebuffer-test
+  (:use :cl :fiveam :cl-tty.rendering :cl-tty.backend))
+(in-package :cl-tty-framebuffer-test)
+
+(def-suite framebuffer-suite :description "Framebuffer rendering pipeline tests")
+(in-suite framebuffer-suite)
+
+(test make-framebuffer-creates-correct-size
+  (let ((fb (make-framebuffer 80 24)))
+    (is (= 24 (framebuffer-height fb)))
+    (is (= 80 (framebuffer-width fb)))))
+
+(test cell-defaults-are-space
+  (let ((cell (aref (make-framebuffer 10 10) 0 0)))
+    (is (eql #\space (cell-char cell)))
+    (is (null (cell-fg cell)))
+    (is (null (cell-bg cell)))))
+
+(test draw-text-on-fb-sets-cells
+  (let ((fb (make-framebuffer-backend)))
+    (draw-text fb 2 3 "abc" :red nil)
+    (let ((cells (fb-framebuffer fb)))
+      (is (eql #\a (cell-char (aref cells 3 2))))
+      (is (eql #\b (cell-char (aref cells 3 3))))
+      (is (eql #\c (cell-char (aref cells 3 4))))
+      (is (eql :red (cell-fg (aref cells 3 2)))))))
+
+(test draw-text-clips-at-bounds
+  (let ((fb (make-framebuffer-backend :width 10 :height 5)))
+    (draw-text fb 8 2 "hello" nil nil)
+    (let ((cells (fb-framebuffer fb)))
+      (is (eql #\h (cell-char (aref cells 2 8))))
+      (is (eql #\e (cell-char (aref cells 2 9))))
+      (is (eql #\space (cell-char (aref cells 2 0))) "out of bounds text is ignored"))))
+
+(test diff-identical-fbs-returns-empty
+  (let ((fb1 (make-framebuffer 80 24))
+        (fb2 (make-framebuffer 80 24)))
+    (is (null (diff-framebuffers fb1 fb2)))))
+
+(test diff-changed-fb-returns-changes
+  (let* ((fb1 (make-framebuffer 10 10))
+         (fb2 (make-framebuffer 10 10)))
+    (setf (aref fb2 5 5) (make-cell :char #\X :fg :red))
+    (let ((changes (diff-framebuffers fb1 fb2)))
+      (is (= 1 (length changes)))
+      (destructuring-bind (x y cell) (first changes)
+        (is (= 5 x))
+        (is (= 5 y))
+        (is (eql #\X (cell-char cell)))))))
+
+(test with-scissor-clips-drawing
+  (let ((fb (make-framebuffer-backend :width 20 :height 10)))
+    (with-scissor (fb 5 5 3 3)
+      (draw-text fb 6 6 "ABC" nil nil)
+      (draw-text fb 1 1 "OUTSIDE" nil nil))
+    (let ((cells (fb-framebuffer fb)))
+      (is (eql #\A (cell-char (aref cells 6 6))) "inside scissor draws")
+      (is (eql #\space (cell-char (aref cells 1 1))) "outside scissor is clipped"))))
+
+(test flush-different-sized-fbs-handles-edge-cells
+  (let* ((small-fb (make-framebuffer 5 5))
+         (large-fb (make-framebuffer 10 10))
+         (be (make-simple-backend :output-stream (make-string-output-stream))))
+    (setf (aref small-fb 0 0) (make-cell :char #\X :fg :red))
+    (let ((changes (diff-framebuffers small-fb large-fb)))
+      (is (= 1 (length changes)) "one cell changed in overlap region"))
+    (let ((changed (flush-framebuffer small-fb large-fb be)))
+      (is (= 1 changed) "flush reports 1 changed cell"))
+    (setf (aref large-fb 9 9) (make-cell :char #\Y :fg :blue))
+    (let ((changes2 (diff-framebuffers large-fb small-fb)))
+      (is (= 1 (length changes2)) "only overlapping region diffed"))
+    (let ((changed2 (flush-framebuffer large-fb small-fb be)))
+      (is (= 1 changed2) "flush with shrunk fb reports 1 changed cell"))))
+
+(test flush-fb-copies-to-backend
+  (let* ((real-be (make-simple-backend :output-stream (make-string-output-stream)))
+         (fb (make-framebuffer-backend)))
+    (draw-text fb 0 0 "X" :red nil)
+    (let ((changed (flush-framebuffer (make-framebuffer 80 24) (fb-framebuffer fb) real-be)))
+      (is (>= changed 1)))))
+
+(test fb-cell-link-url-returns-nil-for-blank-cell
+  (let ((fb (make-framebuffer 10 10)))
+    (is (null (fb-cell-link-url fb 5 5)))))
+
+(test fb-cell-link-url-finds-link-url
+  (let ((fb (make-framebuffer-backend)))
+    (draw-text fb 0 0 "click" nil nil :link-url "https://example.com")
+    (is (equal "https://example.com" (fb-cell-link-url (fb-framebuffer fb) 0 0)))
+    (is (null (fb-cell-link-url (fb-framebuffer fb) 5 5)))))
+
+(test fb-cell-link-url-out-of-bounds-returns-nil
+  (let ((fb (make-framebuffer 5 5)))
+    (is (null (fb-cell-link-url fb 10 10)))))
+
+(test extract-text-single-row
+  (let ((fb (make-framebuffer-backend)))
+    (draw-text fb 0 0 "hello" nil nil)
+    (let ((cells (fb-framebuffer fb)))
+      (is (equal "hello" (extract-text cells 0 0 4 0))))))
+
+(test extract-text-multi-row
+  (let ((fb (make-framebuffer-backend)))
+    (draw-text fb 0 0 "abc" nil nil)
+    (draw-text fb 0 1 "def" nil nil)
+    (let* ((cells (fb-framebuffer fb))
+           (text (extract-text cells 0 0 2 1)))
+      (is (equal "abc
+def" text)))))
+#+END_SRC

org/text-input.org

@@ -1406,4 +1406,316 @@ world")))
   (is-false (gethash :global *keymaps*))
   (is-false (gethash :local *keymaps*)))
 
+;; 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
+
+** input.lisp — Raw input reader and escape parser
+** input.lisp — Raw input reader and escape parser
+
+#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
+(in-package #:cl-tty.input)
+
+(defun %split-string (string separator)
+  (loop with start = 0
+        for pos = (position separator string :start start)
+        collect (subseq string start pos)
+        while pos
+        do (setf start (1+ pos))))
+
+(defstruct key-event
+  (key nil :type (or keyword null))
+  (ctrl nil :type boolean)
+  (alt nil :type boolean)
+  (shift nil :type boolean)
+  (code nil :type (or fixnum null))
+  (raw nil :type (or string null))
+  (text nil :type (or string null)))
+
+(defstruct mouse-event
+  (type nil :type (or keyword null))
+  (button nil :type (or keyword null))
+  (x 0 :type fixnum)
+  (y 0 :type fixnum))
+
+(defparameter *csi-tilde-table*
+  '((1 . :home) (2 . :insert) (3 . :delete) (4 . :end)
+    (5 . :page-up) (6 . :page-down)
+    (11 . :f1) (12 . :f2) (13 . :f3) (14 . :f4)
+    (15 . :f5) (17 . :f6) (18 . :f7) (19 . :f8)
+    (20 . :f9) (21 . :f10) (23 . :f11) (24 . :f12)))
+
+(defparameter *csi-key-table*
+  '((#\A . :up) (#\B . :down) (#\C . :right) (#\D . :left)
+    (#\F . :end) (#\H . :home)
+    (#\P . :f1) (#\Q . :f2) (#\R . :f3) (#\S . :f4)
+    (#\Z . :back-tab)))
+
+(defun parse-csi-params (params terminator extended)
+  (let* ((key (if (find terminator '(#\~ #\u))
+                  (cdr (assoc (first params) *csi-tilde-table*))
+                  (cdr (assoc terminator *csi-key-table*))))
+         (modifier (when (and (> (length params) 1) (not (find terminator '(#\~ #\u))))
+                     (second params)))
+         (actual-modifier (when (> (length extended) 1) (second extended)))
+         (ctrl nil) (alt nil) (shift nil))
+    (when modifier
+      (setf shift (logtest modifier 1)
+            alt   (logtest modifier 2)
+            ctrl  (logtest modifier 4)))
+    (when actual-modifier
+      (setf shift (or shift (logtest actual-modifier 1))
+            alt   (or alt (logtest actual-modifier 2))
+            ctrl  (or ctrl (logtest actual-modifier 4))))
+    (if (eql terminator #\u)
+        (let ((code (first params)))
+          (make-key-event :key :codepoint :code code
+                          :ctrl ctrl :alt alt :shift shift
+                          :raw (string (code-char code))))
+        (make-key-event :key (or key :unknown)
+                        :ctrl ctrl :alt alt :shift shift
+                        :raw (format nil "~C[~{~d~};~d~C" #\Esc params terminator)))))
+
+(defun read-raw-byte (&key timeout)
+  (let* ((buf (sb-alien:make-alien sb-alien:unsigned-char 1))
+         (fd 0))
+    (unwind-protect
+         (if timeout
+             (progn (sb-unix:unix-simple-poll fd :input timeout)
+                    (let ((n (sb-unix:unix-read fd buf 1)))
+                      (if (= n 1) (sb-alien:deref buf 0) (values nil :eof))))
+             (let ((n (sb-unix:unix-read fd buf 1)))
+               (if (= n 1) (sb-alien:deref buf 0) (values nil :eof))))
+      (sb-alien:free-alien buf))))
+
+(defun %read-escape-sequence ()
+  (flet ((read-next (&optional (timeout nil))
+           (let ((b (read-raw-byte :timeout timeout)))
+             (unless b (return-from %read-escape-sequence
+                         (make-key-event :key :escape :code 27)))
+             b)))
+    (let ((b1 (read-next 0.05)))
+      (cond
+        ((null b1) (make-key-event :key :escape :code 27))
+        ((= b1 79) (let ((b2 (read-next)))
+                     (case b2
+                       (80 (make-key-event :key :f1))
+                       (81 (make-key-event :key :f2))
+                       (82 (make-key-event :key :f3))
+                       (83 (make-key-event :key :f4))
+                       (72 (make-key-event :key :home))
+                       (70 (make-key-event :key :end))
+                       (65 (make-key-event :key :up :shift t))
+                       (66 (make-key-event :key :down :shift t))
+                       (67 (make-key-event :key :right :shift t))
+                       (68 (make-key-event :key :left :shift t))
+                       (otherwise (make-key-event :key :unknown :raw (string (code-char b2)))))))
+        ((= b1 91) (parse-csi-sequence))
+        ((= b1 127) (make-key-event :key :alt-backspace))
+        ((< b1 32)
+         (let ((c (code-char (+ b1 96))))
+           (make-key-event :key (intern (string-upcase (string c)) :keyword)
+                           :alt t :code b1)))
+        (t (make-key-event :key (intern (string-upcase (string (code-char b1))) :keyword)
+                           :alt t :code b1))))))
+
+(defun parse-csi-sequence ()
+  (flet ((read-param (next-fn) (let ((acc nil))
+               (loop for b = (funcall next-fn)
+                     do (if (and (>= b 48) (<= b 57))
+                            (push (- b 48) acc)
+                            (return (values (reverse acc) b)))))))
+    (let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))
+           (b2 (read-raw-byte))
+           (params (if (and (>= b2 48) (<= b2 57))
+                       (multiple-value-bind (p term) (read-param (lambda () (read-raw-byte)))
+                         (setf (fill-pointer extended) (length p))
+                         (replace extended p)
+                         (values p term))
+                       (progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte)))))))
+      (destructuring-bind (params terminator) params
+        (parse-csi-params params terminator extended)))))
+
+(defun utf8-decode (bytes)
+  (case (length bytes)
+    (2 (let ((b0 (first bytes)) (b1 (second bytes)))
+         (when (and (<= #xc2 b0 #xdf) (<= #x80 b1 #xbf))
+           (+ (ash (logand b0 #x1f) 6) (logand b1 #x3f)))))
+    (3 (let ((b0 (first bytes)) (b1 (second bytes)) (b2 (third bytes)))
+         (when (and (<= #xe0 b0 #xef) (<= #x80 b1 #xbf) (<= #x80 b2 #xbf))
+           (+ (ash (logand b0 #x0f) 12) (ash (logand b1 #x3f) 6) (logand b2 #x3f)))))
+    (4 (let ((b0 (first bytes)) (b1 (second bytes)) (b2 (third bytes)) (b3 (fourth bytes)))
+         (when (and (<= #xf0 b0 #xf4) (<= #x80 b1 #xbf) (<= #x80 b2 #xbf) (<= #x80 b3 #xbf))
+           (+ (ash (logand b0 #x07) 18) (ash (logand b1 #x3f) 12)
+              (ash (logand b2 #x3f) 6) (logand b3 #x3f)))))
+    (t nil)))
+
+(defun %read-event (&key timeout)
+  (multiple-value-bind (b reason) (read-raw-byte :timeout timeout)
+    (unless b (return-from %read-event (if (eq reason :eof) :eof nil)))
+    (cond
+      ((= b #x1b) (%read-escape-sequence))
+      ((= b #x09) (make-key-event :key :tab :code #x09))
+      ((= b #x0a) (make-key-event :key :enter :code #x0a))
+      ((= b #x0d) (make-key-event :key :enter :code #x0d))
+      ((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)))
+      ((= 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) :code b)))
+      ((>= b #xc2)
+       (let* ((n (cond ((<= b #xdf) 2) ((<= b #xef) 3) (t 4)))
+              (bytes (list b)))
+         (loop for i from 1 below n
+               for b2 = (multiple-value-bind (byte reason) (read-raw-byte :timeout 0.5)
+                          (declare (ignore reason)) byte)
+               while (and b2 (<= #x80 b2 #xbf))
+               do (push b2 bytes))
+         (setf bytes (nreverse bytes))
+         (if (= (length bytes) n)
+             (let ((cp (utf8-decode bytes)))
+               (if cp (make-key-event :key :codepoint :code cp :raw (map 'string #'code-char bytes))
+                   (make-key-event :key :unknown :raw (map 'string #'code-char bytes))))
+             (make-key-event :key :unknown :raw (map 'string #'code-char bytes)))))
+      (t (make-key-event :key :unknown :code b :raw (string (code-char b)))))))
+
+(defvar *terminal-resized-p* nil)
+
+#+sbcl
+(eval-when (:load-toplevel :execute)
+  (sb-sys:enable-interrupt sb-posix:sigwinch
+    (lambda (signal info context)
+      (declare (ignore signal info context))
+      (setf *terminal-resized-p* t))))
+
+(defmethod read-event ((b cl-tty.backend:backend) &key timeout)
+  (declare (ignore b))
+  (when (probe-file "/dev/stdin")
+    (%read-event :timeout timeout)))
+#+END_SRC
+
+** text-input.lisp — TextInput widget logic
+
+#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
+(in-package #:cl-tty.input)
+
+(defclass text-input (dirty-mixin)
+  ((value :initform "" :initarg :value :accessor text-input-value
+          :type string)
+   (cursor :initform 0 :initarg :cursor :accessor text-input-cursor
+           :type fixnum)
+   (placeholder :initform "" :initarg :placeholder
+                :accessor text-input-placeholder :type string)
+   (max-length :initform nil :initarg :max-length
+               :accessor text-input-max-length)
+   (on-submit :initform nil :initarg :on-submit
+              :accessor text-input-on-submit)
+   (layout-node :initform (make-layout-node) :accessor text-input-layout-node)
+   (focusable :initform t :accessor text-input-focusable)))
+
+(defun make-text-input (&key value cursor placeholder max-length on-submit)
+  (make-instance 'text-input
+    :value (or value "")
+    :cursor (or cursor 0)
+    :placeholder (or placeholder "")
+    :max-length max-length
+    :on-submit on-submit))
+
+(defun text-input-insert (input char)
+  (let* ((val (text-input-value input))
+         (pos (text-input-cursor input))
+         (max (text-input-max-length input)))
+    (when (and max (>= (length val) max)) (return-from text-input-insert))
+    (setf (text-input-value input) (concatenate 'string (subseq val 0 pos) (string char) (subseq val pos)))
+    (incf (text-input-cursor input))
+    (mark-dirty input)))
+
+(defun text-input-backspace (input)
+  (let* ((val (text-input-value input)) (pos (text-input-cursor input)))
+    (when (zerop pos) (return-from text-input-backspace))
+    (setf (text-input-value input) (concatenate 'string (subseq val 0 (1- pos)) (subseq val pos)))
+    (decf (text-input-cursor input))
+    (mark-dirty input)))
+
+(defun text-input-delete (input)
+  (let* ((val (text-input-value input)) (pos (text-input-cursor input)))
+    (when (>= pos (length val)) (return-from text-input-delete))
+    (setf (text-input-value input) (concatenate 'string (subseq val 0 pos) (subseq val (1+ pos))))
+    (mark-dirty input)))
+
+(defun text-input-move-left (input)
+  (when (plusp (text-input-cursor input)) (decf (text-input-cursor input)))
+  (mark-dirty input))
+
+(defun text-input-move-right (input)
+  (when (< (text-input-cursor input) (length (text-input-value input))) (incf (text-input-cursor input)))
+  (mark-dirty input))
+
+(defun text-input-move-home (input)
+  (setf (text-input-cursor input) 0)
+  (mark-dirty input))
+
+(defun text-input-move-end (input)
+  (setf (text-input-cursor input) (length (text-input-value input)))
+  (mark-dirty input))
+
+(defun text-input-delete-word-before (input)
+  (let* ((val (text-input-value input)) (pos (text-input-cursor input)))
+    (when (zerop pos) (return-from text-input-delete-word-before))
+    (let* ((start (or (position-if (lambda (c) (not (char= c #\Space))) val :end pos :from-end t) 0))
+           (word-start (or (and (plusp start) (position #\Space val :end start :from-end t)) 0))
+           (delete-start (if (and (zerop word-start) (or (char/= (char val 0) #\Space) (zerop start)))
+                             0
+                             (if (zerop start) (1+ word-start) (1+ (or (position #\Space val :end start :from-end t) 0))))))
+      (setf (text-input-value input) (concatenate 'string (subseq val 0 delete-start) (subseq val pos)))
+      (setf (text-input-cursor input) delete-start)
+      (mark-dirty input))))
+
+(defun handle-text-input (input event)
+  (cond
+    ((key-event-ctrl event)
+     (case (key-event-key event)
+       (:a (text-input-move-home input))
+       (:e (text-input-move-end input))
+       (:w (text-input-delete-word-before input))
+       (:u (progn (setf (text-input-value input) (subseq (text-input-value input) (text-input-cursor input)))
+                  (setf (text-input-cursor input) 0) (mark-dirty input)))
+       (:k (progn (setf (text-input-value input) (subseq (text-input-value input) 0 (text-input-cursor input)))
+                  (mark-dirty input)))
+       (t nil)))
+    (t
+     (case (key-event-key event)
+       (:left (text-input-move-left input))
+       (:right (text-input-move-right input))
+       (:home (text-input-move-home input))
+       (:end (text-input-move-end input))
+       (:backspace (text-input-backspace input))
+       (:delete (text-input-delete input))
+       (:enter (let ((cb (text-input-on-submit input))) (when cb (funcall cb (text-input-value input)))))
+       (:tab nil) (:escape nil)
+       (otherwise (let ((ch (code-char (key-event-code event))))
+                    (when (and ch (graphic-char-p ch)) (text-input-insert input ch))))))))
+
+(defmethod render ((in text-input) (backend t))
+  (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) "")))
+         (truncated (subseq display 0 (min (length display) w))))
+    (draw-text backend x y truncated nil nil)
+    (when (plusp (length value))
+      (let ((cursor-col (min cursor (length truncated))))
+        (draw-text backend (+ x cursor-col) y "█" :bright-white nil)))))
 #+END_SRC

src/components/input.lisp

@@ -1,19 +1,12 @@
 (in-package #:cl-tty.input)
 
-;;; ---------------------------------------------------------------------------
-;;; Utility: split-string (avoids external dependency)
-;;; ---------------------------------------------------------------------------
 (defun %split-string (string separator)
-  "Split STRING at each occurrence of SEPARATOR. Returns list of strings."
   (loop with start = 0
         for pos = (position separator string :start start)
         collect (subseq string start pos)
         while pos
         do (setf start (1+ pos))))
 
-;;; ---------------------------------------------------------------------------
-;;; Key event struct
-;;; ---------------------------------------------------------------------------
 (defstruct key-event
   (key nil :type (or keyword null))
   (ctrl nil :type boolean)
@@ -23,266 +16,111 @@
   (raw nil :type (or string null))
   (text nil :type (or string null)))
 
-;;; ---------------------------------------------------------------------------
-;;; Mouse event struct
-;;; ---------------------------------------------------------------------------
 (defstruct mouse-event
   (type nil :type (or keyword null))
-   (button nil :type (or keyword null))
+  (button nil :type (or keyword null))
   (x 0 :type fixnum)
-  (y 0 :type fixnum)
-  (raw nil :type (or string null)))
-
-;;; ---------------------------------------------------------------------------
-;;; Terminal raw mode (stty on /dev/tty — portable across Unices)
-;;; ---------------------------------------------------------------------------
-(defun stty-run (args)
-  "Run stty with ARGS. Returns stdout as string."
-  (with-output-to-string (s)
-    (sb-ext:run-program "/bin/sh"
-                        (list "-c" (format nil "stty ~{~a~^ ~} < /dev/tty"
-                                           (mapcar #'princ-to-string args)))
-                        :output s :wait t)))
-
-(defun save-terminal-state ()
-  "Save current terminal settings via stty -g. Returns a string."
-  (let ((s (string-trim '(#\Newline #\Space) (stty-run '("-g")))))
-    (when (zerop (length s))
-      (error "stty -g failed — not running in a real terminal"))
-    s))
-
-(defun set-raw-mode ()
-  "Put terminal in raw mode via stty. Returns the saved state string."
-  (let ((saved (save-terminal-state)))
-    (stty-run '("raw" "-echo" "-isig" "-icanon" "min" "1" "time" "0"))
-    saved))
-
-(defun restore-terminal-state (saved)
-  "Restore saved terminal state (a string from stty -g, or nil)."
-  (when (and saved (plusp (length saved)))
-    (stty-run (list saved))))
-
-(defmacro with-raw-terminal (&body body)
-  (let ((saved (gensym "SAVED")))
-    `(let ((,saved (save-terminal-state)))
-       (set-raw-mode)
-       (unwind-protect
-            (progn ,@body)
-         (restore-terminal-state ,saved)))))
-
-;;; ---------------------------------------------------------------------------
-;;; Low-level byte reading
-;;; ---------------------------------------------------------------------------
-(defun read-raw-byte (&key timeout)
-  "Read one raw byte from stdin.
-Returns:
-  (values byte nil)    on success (byte is 0-255)
-  (values nil :timeout) on timeout
-  (values nil :eof)    on EOF (stdin closed or /dev/null)"
-  (flet ((read-one ()
-           (let ((buf (make-array 1 :element-type '(unsigned-byte 8))))
-             ;; Use sb-sys:with-pinned-objects so sb-posix:read can access the buffer
-             (sb-sys:with-pinned-objects (buf)
-               (let ((n (sb-posix:read 0 (sb-sys:vector-sap buf) 1)))
-                 (cond
-                   ((plusp n) (return-from read-raw-byte (aref buf 0)))
-                   ((zerop n) (return-from read-raw-byte (values nil :eof)))))))))
-    (if timeout
-        (let* ((start (get-internal-real-time))
-               (ticks (round (* timeout internal-time-units-per-second)))
-               (deadline (+ start ticks)))
-          (loop while (< (get-internal-real-time) deadline)
-                do (handler-case
-                       (read-one)
-                     (sb-posix:syscall-error ()
-                       (return-from read-raw-byte (values nil :timeout))))
-                   (sleep 0.01))
-          (values nil :timeout))
-        (handler-case
-            (read-one)
-          (sb-posix:syscall-error (e)
-            (format *error-output* "read error: ~A~%" e)
-            (values nil :eof))))))
-
-;;; ---------------------------------------------------------------------------
-;;; CSI parameter parser
-;;; ---------------------------------------------------------------------------
-(defun parse-csi-params (&key timeout)
-  (let ((params '())
-        (raw (make-array 0 :element-type '(unsigned-byte 8)
-                           :fill-pointer 0 :adjustable t))
-        (current 0))
-    (loop
-      (multiple-value-bind (b reason) (read-raw-byte :timeout timeout)
-        (unless b
-          (return-from parse-csi-params
-            (if (eq reason :eof)
-                (values nil nil :eof)
-                (values nil nil :timeout))))
-        (vector-push-extend b raw)
-        (cond
-          ((and (>= b #x30) (<= b #x3f))
-           (if (char= (code-char b) #\;)
-               (progn (push current params) (setf current 0))
-               ;; Non-digit parameter characters (< = > ?) start a new param at zero
-               (if (member b '(#x3c #x3d #x3e #x3f) :test #'=)
-                   (setf current 0)
-                   (setf current (+ (* current 10) (- b #x30))))))
-          ((and (>= b #x20) (<= b #x2f))
-           nil)
-          ((and (>= b #x40) (<= b #x7e))
-           (push current params)
-           (return (values (nreverse params) b
-                           (map 'string #'code-char raw))))
-          (t
-           (return (values nil nil nil))))))))
-
-;;; ---------------------------------------------------------------------------
-;;; Key event tables
-;;; ---------------------------------------------------------------------------
-(defparameter *csi-key-table*
-  '((#\A . :up) (#\B . :down) (#\C . :right) (#\D . :left)
-    (#\F . :end) (#\H . :home)
-    (#\P . :f1) (#\Q . :f2) (#\R . :f3) (#\S . :f4)
-    (#\Z . :tab)))
+  (y 0 :type fixnum))
 
 (defparameter *csi-tilde-table*
-  '((1 . :home) (2 . :insert) (3 . :delete)
-    (4 . :end) (5 . :page-up) (6 . :page-down)
-    (7 . :home) (8 . :end)
+  '((1 . :home) (2 . :insert) (3 . :delete) (4 . :end)
+    (5 . :page-up) (6 . :page-down)
     (11 . :f1) (12 . :f2) (13 . :f3) (14 . :f4)
     (15 . :f5) (17 . :f6) (18 . :f7) (19 . :f8)
     (20 . :f9) (21 . :f10) (23 . :f11) (24 . :f12)))
 
-;;; ---------------------------------------------------------------------------
-;;; SGR mouse parser
-;;; ---------------------------------------------------------------------------
-(defun parse-sgr-mouse (raw)
-  (let* ((start (position #\< raw))
-         (end (position #\m raw :from-end t))
-         (end2 (position #\M raw :from-end t))
-         (final (if end end end2))
-         (releasep (char= (char raw (1- (length raw))) #\m)))
-    (when (and start final (> final start))
-      (let* ((nums (mapcar #'parse-integer
-                           (%split-string (subseq raw (1+ start) final) #\;)))
-             (code (first nums))
-             (x    (or (second nums) 0))
-             (y    (or (third nums) 0))
-             (button (logand code #x03))
-             (mod    (logand code #x1c))
-             (motion (logand code #x20))
-             (wheel  (logand code #x40)))
-        (declare (ignore mod))
-        (make-mouse-event
-         :type (cond (releasep :release)
-                     (motion :drag)
-                     (t :press))
-         :button (cond (wheel (if (zerop (logand code #x01))
-                                  :wheel-up :wheel-down))
-                       ((= button 0) :left)
-                       ((= button 1) :middle)
-                       ((= button 2) :right)
-                       (t :none))
-         :x x :y y :raw raw)))))
+(defparameter *csi-key-table*
+  '((#\A . :up) (#\B . :down) (#\C . :right) (#\D . :left)
+    (#\F . :end) (#\H . :home)
+    (#\P . :f1) (#\Q . :f2) (#\R . :f3) (#\S . :f4)
+    (#\Z . :back-tab)))
+
+(defun parse-csi-params (params terminator extended)
+  (let* ((key (if (find terminator '(#\~ #\u))
+                  (cdr (assoc (first params) *csi-tilde-table*))
+                  (cdr (assoc terminator *csi-key-table*))))
+         (modifier (when (and (> (length params) 1) (not (find terminator '(#\~ #\u))))
+                     (second params)))
+         (actual-modifier (when (> (length extended) 1) (second extended)))
+         (ctrl nil) (alt nil) (shift nil))
+    (when modifier
+      (setf shift (logtest modifier 1)
+            alt   (logtest modifier 2)
+            ctrl  (logtest modifier 4)))
+    (when actual-modifier
+      (setf shift (or shift (logtest actual-modifier 1))
+            alt   (or alt (logtest actual-modifier 2))
+            ctrl  (or ctrl (logtest actual-modifier 4))))
+    (if (eql terminator #\u)
+        (let ((code (first params)))
+          (make-key-event :key :codepoint :code code
+                          :ctrl ctrl :alt alt :shift shift
+                          :raw (string (code-char code))))
+        (make-key-event :key (or key :unknown)
+                        :ctrl ctrl :alt alt :shift shift
+                        :raw (format nil "~C[~{~d~};~d~C" #\Esc params terminator)))))
+
+(defun read-raw-byte (&key timeout)
+  (let* ((buf (sb-alien:make-alien sb-alien:unsigned-char 1))
+         (fd 0))
+    (unwind-protect
+         (if timeout
+             (progn (sb-unix:unix-simple-poll fd :input timeout)
+                    (let ((n (sb-unix:unix-read fd buf 1)))
+                      (if (= n 1) (sb-alien:deref buf 0) (values nil :eof))))
+             (let ((n (sb-unix:unix-read fd buf 1)))
+               (if (= n 1) (sb-alien:deref buf 0) (values nil :eof))))
+      (sb-alien:free-alien buf))))
 
-;;; ---------------------------------------------------------------------------
-;;; Escape sequence reader
-;;; ---------------------------------------------------------------------------
 (defun %read-escape-sequence ()
-  "Read the remainder of an escape sequence after the initial ESC (0x1b).
-Uses a 50ms timeout on the first follow-up byte to resolve the classic
-Escape ambiguity: a lone Escape press returns immediately as an :escape
-key event rather than blocking indefinitely."
-  (multiple-value-bind (b reason) (read-raw-byte :timeout 0.05)
-    (unless b
-      (return-from %read-escape-sequence
-        (if (eq reason :eof) :eof
-            (make-key-event :key :escape :raw (string #\Esc)))))
-    (if (eql b #x4f)
-      ;; SS3: ESC O X
-      (multiple-value-bind (b2 reason) (read-raw-byte :timeout 0.1)
-        (if b2
-            (let ((key (cdr (assoc (code-char b2)
-                                   '((#\P . :f1) (#\Q . :f2)
-                                     (#\R . :f3) (#\S . :f4))))))
-              (make-key-event :key (or key :unknown)
-                              :raw (format nil "~C~C~C" #\Esc #\O (code-char b2))))
-            (make-key-event :key :escape :raw (string #\Esc))))
-      (if (eql b #x5b)
-        ;; CSI: ESC [ ...
-        (multiple-value-bind (params final-byte raw) (parse-csi-params :timeout 0.5)
-          (cond
-            ((null final-byte)
-             ;; EOF during CSI parsing — propagate it
-             (if (eq raw :eof)
-                 :eof
-                 (make-key-event :key :escape :raw (string #\Esc))))
-            ;; SGR mouse: ESC [ < ... m/M
-            ((and raw (plusp (length raw)) (char= (char raw 0) #\<))
-             (or (parse-sgr-mouse raw)
-                 (make-key-event :key :unknown :raw raw)))
-            ((and (char= (code-char final-byte) #\M)
-              (>= (length params) 3))
-             (let* ((p0 (first params)))
-               (if (zerop (logand p0 #x40))
-                   (let* ((x (second params))
-                          (y (third params))
-                          (button (logand p0 #x03))
-                          (motion (logand p0 #x20))
-                          (release (= button 3)))
-                     (make-mouse-event
-                      :type (cond (release :release)
-                                  (motion :drag)
-                                  (t :press))
-                      :button (let ((b button)) (cond ((= b 0) :left) ((= b 1) :middle) ((= b 2) :right) (t :none)))
-                      :x x :y y :raw (format nil "~C[<~d;~d;~d~C" #\Esc p0 x y (code-char final-byte))))
-                   (let* ((tilde-p (char= (code-char final-byte) #\~))
-                          (param (or p0 0))
-                          (key (if tilde-p
-                                   (cdr (assoc param *csi-tilde-table*))
-                                   (cdr (assoc (code-char final-byte) *csi-key-table*))))
-                          (modifier (when (> (length params) 1) (second params))))
-                     (let ((ctrl nil) (alt nil) (shift nil))
-                       (when modifier
-                         (setf shift (logtest modifier 1)
-                               alt   (logtest modifier 2)
-                               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)))))))
-            (t
-             (let* ((tilde-p (char= (code-char final-byte) #\~))
-                    (param (or (first params) 0))
-                    (key (if tilde-p
-                             (cdr (assoc param *csi-tilde-table*))
-                             (cdr (assoc (code-char final-byte) *csi-key-table*))))
-                    (modifier (when (> (length params) 1) (second params))))
-               (let ((ctrl nil) (alt nil) (shift nil))
-                 (when modifier
-                   (setf shift (logtest modifier 1)
-                         alt   (logtest modifier 2)
-                         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)))))))))
-        (if (eql b #x1b)
-          ;; ESC ESC
-          (make-key-event :key :escape :alt t :raw "\\e\\e")
-          ;; ESC + printable = Alt+key
-          (let ((ch (code-char b)))
-            (if (and (>= b #x20) (<= b #x7e))
-                (make-key-event :key (intern (string (string-upcase ch)) :keyword)
-                                :alt t
-                                :raw (format nil "~C~C" #\Esc ch))
-                (make-key-event :key :unknown
-                                :raw (format nil "~C~C" #\Esc ch)))))))))
+  (flet ((read-next (&optional (timeout nil))
+           (let ((b (read-raw-byte :timeout timeout)))
+             (unless b (return-from %read-escape-sequence
+                         (make-key-event :key :escape :code 27)))
+             b)))
+    (let ((b1 (read-next 0.05)))
+      (cond
+        ((null b1) (make-key-event :key :escape :code 27))
+        ((= b1 79) (let ((b2 (read-next)))
+                     (case b2
+                       (80 (make-key-event :key :f1))
+                       (81 (make-key-event :key :f2))
+                       (82 (make-key-event :key :f3))
+                       (83 (make-key-event :key :f4))
+                       (72 (make-key-event :key :home))
+                       (70 (make-key-event :key :end))
+                       (65 (make-key-event :key :up :shift t))
+                       (66 (make-key-event :key :down :shift t))
+                       (67 (make-key-event :key :right :shift t))
+                       (68 (make-key-event :key :left :shift t))
+                       (otherwise (make-key-event :key :unknown :raw (string (code-char b2)))))))
+        ((= b1 91) (parse-csi-sequence))
+        ((= b1 127) (make-key-event :key :alt-backspace))
+        ((< b1 32)
+         (let ((c (code-char (+ b1 96))))
+           (make-key-event :key (intern (string-upcase (string c)) :keyword)
+                           :alt t :code b1)))
+        (t (make-key-event :key (intern (string-upcase (string (code-char b1))) :keyword)
+                           :alt t :code b1))))))
+
+(defun parse-csi-sequence ()
+  (flet ((read-param (next-fn) (let ((acc nil))
+               (loop for b = (funcall next-fn)
+                     do (if (and (>= b 48) (<= b 57))
+                            (push (- b 48) acc)
+                            (return (values (reverse acc) b)))))))
+    (let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))
+           (b2 (read-raw-byte))
+           (params (if (and (>= b2 48) (<= b2 57))
+                       (multiple-value-bind (p term) (read-param (lambda () (read-raw-byte)))
+                         (setf (fill-pointer extended) (length p))
+                         (replace extended p)
+                         (values p term))
+                       (progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte)))))))
+      (destructuring-bind (params terminator) params
+        (parse-csi-params params terminator extended)))))
 
-;;; ---------------------------------------------------------------------------
-;;; UTF-8 decoder
-;;; ---------------------------------------------------------------------------
 (defun utf8-decode (bytes)
-  "Decode a UTF-8 byte sequence to a code point, or nil if invalid."
   (case (length bytes)
     (2 (let ((b0 (first bytes)) (b1 (second bytes)))
          (when (and (<= #xc2 b0 #xdf) (<= #x80 b1 #xbf))
@@ -296,24 +134,15 @@ key event rather than blocking indefinitely."
               (ash (logand b2 #x3f) 6) (logand b3 #x3f)))))
     (t nil)))
 
-;;; ---------------------------------------------------------------------------
-;;; Top-level event reader
-;;; ---------------------------------------------------------------------------
 (defun %read-event (&key timeout)
   (multiple-value-bind (b reason) (read-raw-byte :timeout timeout)
-    (unless b
-      (return-from %read-event (if (eq reason :eof) :eof nil)))
+    (unless b (return-from %read-event (if (eq reason :eof) :eof nil)))
     (cond
-      ((= b #x1b)
-       (%read-escape-sequence))
-      ((= b #x09)
-       (make-key-event :key :tab :code #x09))
-      ((= b #x0a)
-       (make-key-event :key :enter :code #x0a))
-      ((= b #x0d)
-       (make-key-event :key :enter :code #x0d))
-      ((or (= b #x7f) (= b #x08))
-       (make-key-event :key :backspace :code b))
+      ((= b #x1b) (%read-escape-sequence))
+      ((= b #x09) (make-key-event :key :tab :code #x09))
+      ((= b #x0a) (make-key-event :key :enter :code #x0a))
+      ((= b #x0d) (make-key-event :key :enter :code #x0d))
+      ((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)))
@@ -323,40 +152,24 @@ key event rather than blocking indefinitely."
       ((= 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)
-                         :code b)))
-      ;; UTF-8 multi-byte sequence
+         (make-key-event :key (intern (string (string-upcase ch)) :keyword) :code b)))
       ((>= b #xc2)
-       (let* ((n (cond ((<= b #xdf) 2)
-                       ((<= b #xef) 3)
-                       (t 4)))
+       (let* ((n (cond ((<= b #xdf) 2) ((<= b #xef) 3) (t 4)))
               (bytes (list b)))
          (loop for i from 1 below n
-               for b2 = (multiple-value-bind (byte reason)
-                            (read-raw-byte :timeout 0.5)
-                          (declare (ignore reason))
-                          byte)
+               for b2 = (multiple-value-bind (byte reason) (read-raw-byte :timeout 0.5)
+                          (declare (ignore reason)) byte)
                while (and b2 (<= #x80 b2 #xbf))
                do (push b2 bytes))
          (setf bytes (nreverse bytes))
          (if (= (length bytes) n)
              (let ((cp (utf8-decode bytes)))
-               (if cp
-                   (make-key-event :key :codepoint :code cp
-                                   :raw (map 'string #'code-char bytes))
-                   (make-key-event :key :unknown
-                                   :raw (map 'string #'code-char bytes))))
-             (make-key-event :key :unknown
-                             :raw (map 'string #'code-char bytes)))))
-      (t
-       (make-key-event :key :unknown :code b :raw (string (code-char b)))))))
+               (if cp (make-key-event :key :codepoint :code cp :raw (map 'string #'code-char bytes))
+                   (make-key-event :key :unknown :raw (map 'string #'code-char bytes))))
+             (make-key-event :key :unknown :raw (map 'string #'code-char bytes)))))
+      (t (make-key-event :key :unknown :code b :raw (string (code-char b)))))))
 
-;;; ---------------------------------------------------------------------------
-;;; SIGWINCH handler for terminal resize
-;;; ---------------------------------------------------------------------------
-(defvar *terminal-resized-p* nil
-  "Set to T by SIGWINCH handler when terminal is resized.
-Applications should check and clear this flag each frame.")
+(defvar *terminal-resized-p* nil)
 
 #+sbcl
 (eval-when (:load-toplevel :execute)
@@ -365,9 +178,6 @@ Applications should check and clear this flag each frame.")
       (declare (ignore signal info context))
       (setf *terminal-resized-p* t))))
 
-;;; ---------------------------------------------------------------------------
-;;; Backend integration
-;;; ---------------------------------------------------------------------------
 (defmethod read-event ((b cl-tty.backend:backend) &key timeout)
   (declare (ignore b))
   (when (probe-file "/dev/stdin")

src/components/text-input.lisp

@@ -1,8 +1,5 @@
 (in-package #:cl-tty.input)
 
-;;; ---------------------------------------------------------------------------
-;;; TextInput class
-;;; ---------------------------------------------------------------------------
 (defclass text-input (dirty-mixin)
   ((value :initform "" :initarg :value :accessor text-input-value
           :type string)
@@ -25,59 +22,34 @@
     :max-length max-length
     :on-submit on-submit))
 
-;;; ---------------------------------------------------------------------------
-;;; Editing operations
-;;; ---------------------------------------------------------------------------
 (defun text-input-insert (input char)
-  "Insert CHAR at the cursor position in INPUT."
   (let* ((val (text-input-value input))
          (pos (text-input-cursor input))
          (max (text-input-max-length input)))
-    (when (and max (>= (length val) max))
-      (return-from text-input-insert))
-    (setf (text-input-value input)
-          (concatenate 'string
-            (subseq val 0 pos)
-            (string char)
-            (subseq val pos)))
+    (when (and max (>= (length val) max)) (return-from text-input-insert))
+    (setf (text-input-value input) (concatenate 'string (subseq val 0 pos) (string char) (subseq val pos)))
     (incf (text-input-cursor input))
     (mark-dirty input)))
 
 (defun text-input-backspace (input)
-  "Delete character before cursor."
-  (let* ((val (text-input-value input))
-         (pos (text-input-cursor input)))
+  (let* ((val (text-input-value input)) (pos (text-input-cursor input)))
     (when (zerop pos) (return-from text-input-backspace))
-    (setf (text-input-value input)
-          (concatenate 'string
-            (subseq val 0 (1- pos))
-            (subseq val pos)))
+    (setf (text-input-value input) (concatenate 'string (subseq val 0 (1- pos)) (subseq val pos)))
     (decf (text-input-cursor input))
     (mark-dirty input)))
 
 (defun text-input-delete (input)
-  "Delete character at cursor."
-  (let* ((val (text-input-value input))
-         (pos (text-input-cursor input)))
-    (when (>= pos (length val))
-      (return-from text-input-delete))
-    (setf (text-input-value input)
-          (concatenate 'string
-            (subseq val 0 pos)
-            (subseq val (1+ pos))))
+  (let* ((val (text-input-value input)) (pos (text-input-cursor input)))
+    (when (>= pos (length val)) (return-from text-input-delete))
+    (setf (text-input-value input) (concatenate 'string (subseq val 0 pos) (subseq val (1+ pos))))
     (mark-dirty input)))
 
-;;; ---------------------------------------------------------------------------
-;;; Cursor movement
-;;; ---------------------------------------------------------------------------
 (defun text-input-move-left (input)
-  (when (plusp (text-input-cursor input))
-    (decf (text-input-cursor input)))
+  (when (plusp (text-input-cursor input)) (decf (text-input-cursor input)))
   (mark-dirty input))
 
 (defun text-input-move-right (input)
-  (when (< (text-input-cursor input) (length (text-input-value input)))
-    (incf (text-input-cursor input)))
+  (when (< (text-input-cursor input) (length (text-input-value input))) (incf (text-input-cursor input)))
   (mark-dirty input))
 
 (defun text-input-move-home (input)
@@ -89,54 +61,28 @@
   (mark-dirty input))
 
 (defun text-input-delete-word-before (input)
-  "Delete from cursor back to previous word boundary."
-  (let* ((val (text-input-value input))
-         (pos (text-input-cursor input)))
-    (when (zerop pos)
-      (return-from text-input-delete-word-before))
-    (let* ((start (or (position-if (lambda (c) (not (char= c #\Space)))
-                                   val :end pos :from-end t)
-                      0))
-           (word-start (or (and (plusp start)
-                               (position #\Space val :end start :from-end t))
-                           0))
-           (delete-start (if (and (zerop word-start)
-                                  (or (char/= (char val 0) #\Space)
-                                      (zerop start)))
+  (let* ((val (text-input-value input)) (pos (text-input-cursor input)))
+    (when (zerop pos) (return-from text-input-delete-word-before))
+    (let* ((start (or (position-if (lambda (c) (not (char= c #\Space))) val :end pos :from-end t) 0))
+           (word-start (or (and (plusp start) (position #\Space val :end start :from-end t)) 0))
+           (delete-start (if (and (zerop word-start) (or (char/= (char val 0) #\Space) (zerop start)))
                              0
-                             (if (zerop start)
-                                 (1+ word-start)
-                                 (1+ (or (position #\Space val :end start :from-end t)
-                                         0))))))
-      (setf (text-input-value input)
-            (concatenate 'string
-              (subseq val 0 delete-start)
-              (subseq val pos)))
+                             (if (zerop start) (1+ word-start) (1+ (or (position #\Space val :end start :from-end t) 0))))))
+      (setf (text-input-value input) (concatenate 'string (subseq val 0 delete-start) (subseq val pos)))
       (setf (text-input-cursor input) delete-start)
       (mark-dirty input))))
 
-;;; ---------------------------------------------------------------------------
-;;; Key event handler
-;;; ---------------------------------------------------------------------------
 (defun handle-text-input (input event)
-  "Process a key-event on a text-input widget."
   (cond
     ((key-event-ctrl event)
      (case (key-event-key event)
        (:a (text-input-move-home input))
        (:e (text-input-move-end input))
        (:w (text-input-delete-word-before input))
-       (:u (progn
-             (setf (text-input-value input)
-                   (subseq (text-input-value input)
-                           (text-input-cursor input)))
-             (setf (text-input-cursor input) 0)
-             (mark-dirty input)))
-       (:k (progn
-             (setf (text-input-value input)
-                   (subseq (text-input-value input) 0
-                           (text-input-cursor input)))
-             (mark-dirty input)))
+       (:u (progn (setf (text-input-value input) (subseq (text-input-value input) (text-input-cursor input)))
+                  (setf (text-input-cursor input) 0) (mark-dirty input)))
+       (:k (progn (setf (text-input-value input) (subseq (text-input-value input) 0 (text-input-cursor input)))
+                  (mark-dirty input)))
        (t nil)))
     (t
      (case (key-event-key event)
@@ -146,33 +92,19 @@
        (:end (text-input-move-end input))
        (:backspace (text-input-backspace input))
        (:delete (text-input-delete input))
-       (:enter (let ((cb (text-input-on-submit input)))
-                 (when cb (funcall cb (text-input-value input)))))
-       (:tab nil)
-       (:escape nil)
-       ;; Insert printable characters
-       (otherwise
-        (let ((ch (code-char (key-event-code event))))
-          (when (and ch (graphic-char-p ch))
-            (text-input-insert input ch))))))))
+       (:enter (let ((cb (text-input-on-submit input))) (when cb (funcall cb (text-input-value input)))))
+       (:tab nil) (:escape nil)
+       (otherwise (let ((ch (code-char (key-event-code event))))
+                    (when (and ch (graphic-char-p ch)) (text-input-insert input ch))))))))
 
-;;; ---------------------------------------------------------------------------
-;;; Rendering
-;;; ---------------------------------------------------------------------------
 (defmethod render ((in text-input) (backend t))
-  "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))
+         (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) "")))
+         (value (text-input-value in)) (cursor (text-input-cursor in))
+         (display (if (plusp (length value)) value (or (text-input-placeholder in) "")))
          (truncated (subseq display 0 (min (length display) w))))
     (draw-text backend x y truncated nil nil)
-    ;; Draw a solid-block cursor at the visible cursor position
     (when (plusp (length value))
       (let ((cursor-col (min cursor (length truncated))))
         (draw-text backend (+ x cursor-col) y "█" :bright-white nil)))))

tests/framebuffer-tests.lisp

@@ -59,25 +59,17 @@
       (is (eql #\space (cell-char (aref cells 1 1))) "outside scissor is clipped"))))
 
 (test flush-different-sized-fbs-handles-edge-cells
-  "flush-framebuffer handles prev and curr framebuffers of different sizes
-   without errors. Cells in the overlapping region are diffed; cells outside
-   the overlap are silently ignored (no crash on array bounds)."
   (let* ((small-fb (make-framebuffer 5 5))
          (large-fb (make-framebuffer 10 10))
          (be (make-simple-backend :output-stream (make-string-output-stream))))
-    ;; Set a cell in the small one for a change in the overlapping region
     (setf (aref small-fb 0 0) (make-cell :char #\X :fg :red))
-    ;; diff-framebuffers should use min dimensions (5,5) — no crash
     (let ((changes (diff-framebuffers small-fb large-fb)))
       (is (= 1 (length changes)) "one cell changed in overlap region"))
-    ;; flush-framebuffer should also handle different sizes gracefully
     (let ((changed (flush-framebuffer small-fb large-fb be)))
       (is (= 1 changed) "flush reports 1 changed cell"))
-    ;; Reverse: large as prev, small as curr — extra cells in prev ignored
     (setf (aref large-fb 9 9) (make-cell :char #\Y :fg :blue))
     (let ((changes2 (diff-framebuffers large-fb small-fb)))
-      (is (= 1 (length changes2)) "only overlapping region diffed (smaller bounds)"))
-    ;; flush should also work with shrunk framebuffer
+      (is (= 1 (length changes2)) "only overlapping region diffed"))
     (let ((changed2 (flush-framebuffer large-fb small-fb be)))
       (is (= 1 changed2) "flush with shrunk fb reports 1 changed cell"))))
 
@@ -88,8 +80,6 @@
     (let ((changed (flush-framebuffer (make-framebuffer 80 24) (fb-framebuffer fb) real-be)))
       (is (>= changed 1)))))
 
-;; ── Frame inspection ──────────────────────────────────────────
-
 (test fb-cell-link-url-returns-nil-for-blank-cell
   (let ((fb (make-framebuffer 10 10)))
     (is (null (fb-cell-link-url fb 5 5)))))

tests/input-tests.lisp

@@ -386,3 +386,11 @@ world")))
   (remhash :local *keymaps*)
   (is-false (gethash :global *keymaps*))
   (is-false (gethash :local *keymaps*)))
+
+;; 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*)))