cl-tty/org/text-input.org

cl-tui v0.5.0 — Text Input + Keybinding System

• Text Input System
  • Design decisions
  • Contract
  • Tests
• TextInput Widget
  • Design
  • Contract
  • Tests
• Textarea Widget
  • Design
  • Contract
  • Tests
• Keybinding System
  • Design
  • Contract
  • Tests
• Implementation
  • Input Infrastructure
  • TextInput Widget
  • Textarea Widget
  • Keybinding System
  • Package

Text Input System

The input pipeline has four layers:

1. Terminal raw mode — put stdin into non-canonical mode so every keystroke is delivered immediately (no line buffering, no echo).
2. Escape sequence parser — read bytes from stdin, classify them as plain characters, modified keys (Ctrl/Alt), cursor keys, function keys, mouse events, or bracketed paste.
3. Input widget (TextInput / Textarea) — editable text with cursor, selection, undo/redo, and emacs-style keybindings.
4. Keybinding system — layered keymaps that route keystrokes through focused-component → local → global dispatch.

SBCL's sb-posix provides the POSIX terminal APIs (tcgetattr, tcsetattr, read) needed for raw mode. No external libraries required.

Design decisions

• key-event is a struct, not a class — structs are value types with inline accessors, no allocation overhead in tight loops.
• Mouse events are a separate struct — they carry coordinates and button info that key events don't need.
• Terminal state save/restore is explicit (save/set-raw/restore), not wired into backend lifecycle. Different apps may want different modes.
• The parser is a state machine that reads one byte at a time, not a buffer-at-once approach. This keeps the implementation simple and allows for timeout-based input (polling).

Contract

(make-key-event key &key ctrl alt shift code raw text) Returns a new key-event struct. KEY is a keyword (:a, :enter, :space, :up, :f1, etc.). CTRL/ALT/SHIFT are booleans. CODE is the raw character code. RAW is the raw escape sequence string. TEXT is for bracketed paste content.

(key-event-p thing) — returns T if THING is a key-event struct.

(key-event-key event) / (key-event-ctrl event) / etc. — accessors.

~

(make-mouse-event type button x y &key raw) Returns a mouse-event struct. TYPE is :press, :release, or :drag. BUTTON is :left, :middle, :right, or :wheel-up~/:down~.

~

(save-terminal-state) → termios struct Calls tcgetattr(0) and returns the current terminal settings.

(set-raw-mode) → termios struct Configures stdin for raw input: no ICANON, no ECHO, no ISIG, no IEXTEN, VMIN=1, VTIME=0. Returns the new termios.

(restore-terminal-state termios) Calls tcsetattr(0, TCSANOW, termios) to restore saved settings.

(with-raw-terminal &body body) — macro: save, set raw, execute body, restore (even on non-local exit via unwind-protect).

~

(read-byte &key timeout) → byte or NIL Read a single byte from stdin (fd 0). If TIMEOUT is a number, waits at most that many seconds. Returns NIL on timeout.

(read-event &key timeout) → key-event, mouse-event, or NIL Read and parse one input event from stdin. Handles:

• Plain ASCII bytes (0x20-0x7e)
• Ctrl characters (0x01-0x1a) → :a through :z with ctrl=T
• Escape (0x1b) → either standalone :escape or start of escape sequence
• CSI sequences (ESC[...) → cursor keys, function keys, home/end, ins/del
• SS3 sequences (ESCO) → F1-F4
• SGR mouse (ESC[<...M/m) → mouse-event
• Bracketed paste (ESC[200…ESC[201~~) → key-event with text field
• Tab (0x09), Enter (0x0a), Backspace (0x7f/0x08)

~

backend methods: (setf (backend-input-stream backend) stream) — set the input stream (defaults to *standard-input* for simple-backend, *standard-input* for modern-backend). (read-event backend &key timeout) — calls read-event on the backend's input stream.

Tests

(in-package #:cl-tui-input-test)

(def-suite :cl-tui-input :description "Input infrastructure tests")
(in-suite :cl-tui-input)

(test key-event-construction
  "A key-event can be created and queried."
  (let ((e (make-key-event :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 :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 :press :left 10 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 Widget

Design

text-input is a focused renderable with edit buffer. It handles:

• Character insertion at cursor
• Backspace and Delete
• Left/Right cursor movement, Home/End
• Ctrl+W (delete word before), Ctrl+U (delete to start), Ctrl+K (delete to end)
• Ctrl+A/E (home/end)
• Enter → on-submit callback
• Placeholder text when empty
• Max-length enforcement
• Dirty tracking on every edit

The widget does NOT directly read terminal input — it receives key-event structs from the application's input loop. This separates concerns: the widget handles text editing logic, the framework handles input reading.

Contract

(make-text-input &key value cursor placeholder max-length on-submit) Create a new text-input instance.

text-input-* — accessors for all slots (value, cursor, placeholder, etc.)

(render-text-input input window) — renders the input field:

• When empty: placeholder text in dim style
• When non-empty: value text with cursor at current position
• Cursor rendered as reverse-video block

(handle-text-input input key-event) — process one key event:

• Printable chars → insert at cursor
• :left/:right → move cursor
• :home/:end → jump to start/end
• :backspace → delete char before cursor
• :delete → delete char at cursor
• :enter → call on-submit callback
• :ctrl+w → delete word before cursor
• :ctrl+u → delete from cursor to line start
• :ctrl+k → delete from cursor to line end
• :ctrl+a → home (goto start)
• :ctrl+e → end (goto end)

Tests

(in-package #:cl-tui-input-test)

(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 :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 :h))
    (handle-text-input in (make-key-event :e))
    (handle-text-input in (make-key-event :l))
    (handle-text-input in (make-key-event :l))
    (handle-text-input in (make-key-event :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 :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 :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 :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 :left))
    (is (= (text-input-cursor in) 1))
    (handle-text-input in (make-key-event :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 :left))
    (is (= (text-input-cursor in) 0))
    (setf (text-input-cursor in) 2)
    (handle-text-input in (make-key-event :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 :home))
    (is (= (text-input-cursor in) 0))
    (handle-text-input in (make-key-event :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 :a))
    (handle-text-input in (make-key-event :b))
    (handle-text-input in (make-key-event :c))
    (handle-text-input in (make-key-event :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 nil)
        (in (make-text-input :value "hello"
                             :on-submit (lambda (v) (setf result v)))))
    (handle-text-input in (make-key-event :enter))
    (is (string= result "hello"))))

(test text-input-ctrl-a-e
  "Ctrl+A → home, Ctrl+E → end."
  (let ((in (make-text-input :value "abc" :cursor 2)))
    (handle-text-input in (make-key-event :a :ctrl t))
    (is (= (text-input-cursor in) 0))
    (handle-text-input in (make-key-event :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 :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 :a))
    (is-true (dirty-p in))))

Textarea Widget

Design

textarea is a multi-line text input with:

• Line-based value storage (list of strings or single string with #\Newline)
• Row/column cursor navigation (up/down/home/end within and across lines)
• Selection (Shift + navigation extends selection, or mouse drag)
• Undo/redo stack (depth-limited, default 100)
• Visual: cursor rendered as reverse-video block, selection as highlighted background

Textarea shares the editing API pattern with TextInput (handle-textarea-input) but adds multi-line operations.

Contract

(make-textarea &key value on-submit) Create a new textarea instance.

textarea-* — accessors for all slots.

(render-textarea area window) — renders visible lines with cursor and selection highlight.

(handle-textarea-input area key-event) — process a key event:

• All TextInput operations (insert, backspace, delete)
• :enter → insert newline
• :up/:down → move cursor to previous/next line
• With :shift → extend selection
• :ctrl+z → undo
• :ctrl+y → redo

Tests

(in-package #:cl-tui-input-test)

(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 :a))
    (handle-textarea-input a (make-key-event :enter))
    (handle-textarea-input a (make-key-event :b))
    (is (string= (textarea-value a) "a\nb"))))

(test textarea-cursor-up-down
  "Cursor moves between lines maintaining column position."
  (let ((a (make-textarea :value "abc\nde\nf")))
    (setf (textarea-cursor-row a) 1)
    (setf (textarea-cursor-col a) 1)
    (handle-textarea-input a (make-key-event :up))
    (is (= (textarea-cursor-row a) 0))
    (is (= (textarea-cursor-col a) 1))
    (handle-textarea-input a (make-key-event :down))
    (is (= (textarea-cursor-row a) 1))
    (is (= (textarea-cursor-col a) 1))))

(test textarea-undo
  "Ctrl+Z undoes the last edit."
  (let ((a (make-textarea)))
    (handle-textarea-input a (make-key-event :a))
    (handle-textarea-input a (make-key-event :ctrl+z))
    (is (string= (textarea-value a) ""))))

(test textarea-redo
  "Ctrl+Y redoes an undone edit."
  (let ((a (make-textarea)))
    (handle-textarea-input a (make-key-event :a))
    (handle-textarea-input a (make-key-event :ctrl+z))
    (handle-textarea-input a (make-key-event :ctrl+y))
    (is (string= (textarea-value a) "a"))))

Keybinding System

Design

Three layered keymaps, checked in order:

1. Focused component's keymap — if the active widget defines bindings
2. Local keymap — keymap for the current screen/modal context
3. Global keymap — always active, catches Ctrl+C, Ctrl+Q, etc.

Keymap dispatch stops at the first match. Each keymap has a parent slot for inheritance chains.

Chords (two-key sequences like Ctrl+X Ctrl+S) are supported via a timer-based second-key listener. If the second key arrives within *chord-timeout* (default 0.5s), the combined chord is dispatched. On timeout, the first key fires as a standalone event.

Contract

(defkeymap name &body bindings) — macro to register a keymap. Each binding is (key-spec . handler-fn). Key-spec examples: :ctrl+p, :alt+f, :f1, (:ctrl+x :ctrl+s) (chord), (:enter :ctrl t) (full spec).

(dispatch-key-event event &key component) — route an event through focused → local → global.

(make-keymap name &key bindings parent) — create a keymap struct.

*chord-timeout* — dynamic variable, seconds to wait for chord completion (default 0.5).

(key-match-p spec event) — T if a key-spec matches an event. Spec can be: :ctrl+p (keyword shorthand for key+ctrl), (:ctrl+p) (list: first element is key, rest plist of modifiers), ((:ctrl+x :ctrl+s)) (chord: list of two key-specs).

Tests

(in-package #:cl-tui-input-test)

(test keymap-simple
  "A keymap dispatches to its handler on matching event."
  (let ((called nil))
    (setf (gethash :test *keymaps*)
          (make-keymap :name :test
                       :bindings `((:ctrl+p . ,(lambda (e)
                                                 (declare (ignore e))
                                                 (setf called t))))))
    (is-true (dispatch-key-event (make-key-event :p :ctrl t)))
    (is-true called)))

(test keymap-no-match
  "Non-matching event returns nil."
  (let ((called nil))
    (setf (gethash :test *keymaps*)
          (make-keymap :name :test
                       :bindings `((:ctrl+p . ,(lambda (e)
                                                 (declare (ignore e))
                                                 (setf called t))))))
    (is-false (dispatch-key-event (make-key-event :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 :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 :p :ctrl t)))
  (is-false (key-match-p :ctrl+p (make-key-event :a :ctrl t)))
  (is-false (key-match-p :ctrl+p (make-key-event :p))))

(test key-spec-full
  "List key-spec matches full modifier spec."
  (is-true (key-match-p '(:p :ctrl t) (make-key-event :p :ctrl t)))
  (is-true (key-match-p '(:f1) (make-key-event :f1)))
  (is-true (key-match-p '(:a :ctrl t :alt t)
                         (make-key-event :a :ctrl t :alt t))))

(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 :q :ctrl t))
    (is-true called)))

Implementation

Input Infrastructure

(in-package #:cl-tui.input)

;;; ---------------------------------------------------------------------------
;;; Key event struct
;;; ---------------------------------------------------------------------------
(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)))

;;; ---------------------------------------------------------------------------
;;; Mouse event struct
;;; ---------------------------------------------------------------------------
(defstruct mouse-event
  (type nil :type (or keyword null))     ;; :press :release :drag
  (button nil :type (or keyword null))   ;; :left :middle :right :wheel-up :wheel-down
  (x 0 :type fixnum)
  (y 0 :type fixnum)
  (raw nil :type (or string null)))

;;; ---------------------------------------------------------------------------
;;; Terminal raw mode
;;; ---------------------------------------------------------------------------
(defun save-terminal-state ()
  "Capture current terminal settings for fd 0."
  (sb-posix:tcgetattr 0))

(defun make-raw-termios (termios)
  "Convert a termios to raw mode by clearing local/input/output flags."
  (flet ((clear-flag (flags mask)
           (logand flags (lognot mask))))
    (setf (sb-posix:termios-iflag termios)
          (clear-flag (sb-posix:termios-iflag termios)
                      (logior sb-posix:brkint sb-posix:ignpar
                              sb-posix:istrip sb-posix:inlcr
                              sb-posix:igncr sb-posix:icrnl
                              sb-posix:ixon)))
    (setf (sb-posix:termios-oflag termios)
          (clear-flag (sb-posix:termios-oflag termios)
                      sb-posix:opost))
    (setf (sb-posix:termios-lflag termios)
          (clear-flag (sb-posix:termios-lflag termios)
                      (logior sb-posix:icanon sb-posix:echo
                              sb-posix:isig sb-posix:iexten)))
    (setf (sb-posix:termios-cc termios sb-posix:vmin) 1)
    (setf (sb-posix:termios-cc termios sb-posix:vtime) 0)
    termios))

(defun set-raw-mode ()
  "Put fd 0 into raw input mode. Returns the new termios."
  (let ((raw (make-raw-termios (save-terminal-state))))
    (sb-posix:tcsetattr 0 sb-posix:tcsanow raw)
    raw))

(defun restore-terminal-state (termios)
  "Restore terminal settings from a saved termios."
  (sb-posix:tcsetattr 0 sb-posix:tcsanow termios))

(defmacro with-raw-terminal (&body body)
  "Execute BODY with the terminal in raw mode, restoring on exit."
  (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-byte (&key timeout)
  "Read a single byte from stdin (fd 0).
  If TIMEOUT is a number, returns NIL after that many seconds.
  If TIMEOUT is NIL, blocks indefinitely."
  (if timeout
      ;; Poll with sb-posix:select or similar — use a simple loop for now
      (let ((deadline (+ (get-universal-time) timeout)))
        (loop while (< (get-universal-time) deadline)
              do (handler-case
                     (let ((buf (make-array 1 :element-type '(unsigned-byte 8))))
                       (let ((n (sb-posix:read 0 buf 1)))
                         (when (plusp n)
                           (return-from read-byte (aref buf 0)))))
                   (sb-posix:syscall-error ()
                     (return-from read-byte nil)))
              (sleep 0.01))
        nil)
      ;; Blocking read
      (let ((buf (make-array 1 :element-type '(unsigned-byte 8))))
        (multiple-value-bind (n err)
            (ignore-errors (sb-posix:read 0 buf 1))
          (if (and (integerp n) (plusp n))
              (aref buf 0)
              (progn
                (when err (format *error-output* "read error: ~A~%" err))
                nil))))))

;;; ---------------------------------------------------------------------------
;;; CSI parameter parser
;;; ---------------------------------------------------------------------------
(defun parse-csi-params ()
  "Read CSI parameter bytes until a final byte 0x40-0x7E.
  Returns (values params-list final-byte raw-string)."
  (let ((params '())
        (raw (make-array 0 :element-type '(unsigned-byte 8)
                           :fill-pointer 0 :adjustable t))
        (current 0))
    (loop
      (let ((b (read-byte)))
        (unless b (return (values nil nil nil)))
        (vector-push-extend b raw)
        (cond
          ((and (>= b #x30) (<= b #x3f))
           ;; Parameter byte (digits, semicolon)
           (if (char= (code-char b) #\;)
               (progn (push current params) (setf current 0))
               (setf current (+ (* current 10) (- b #x30)))))
          ((and (>= b #x20) (<= b #x2f))
           ;; Intermediate byte (rare — space, quote, etc.) — ignore for now
           nil)
          ((and (>= b #x40) (<= b #x7e))
           ;; Final byte
           (push current params)
           (return (values (nreverse params) b
                           (map 'string #'code-char raw))))
          (t
           ;; Unexpected byte — abort
           (return (values nil nil nil))))))))

;;; ---------------------------------------------------------------------------
;;; SGR mouse parser
;;; ---------------------------------------------------------------------------
(defun parse-sgr-mouse (raw)
  "Parse an SGR mouse sequence like 'ESC[<0;10;5M' into a mouse-event.
  RAw is the string from the ESC to the final byte."
  (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-sequence:split-sequence
                            #\; (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)))))

;;; ---------------------------------------------------------------------------
;;; Key names for CSI final bytes
;;; ---------------------------------------------------------------------------
(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)))  ;; back-tab (shift+tab)

;;; --- CSI ~ codes (home, end, ins, del, pgup, pgdn, f1-f12) ---
(defparameter *csi-tilde-table*
  '((1 . :home) (2 . :insert) (3 . :delete)
    (4 . :end) (5 . :page-up) (6 . :page-down)
    (7 . :home) (8 . :end)
    (11 . :f1) (12 . :f2) (13 . :f3) (14 . :f4)
    (15 . :f5) (17 . :f6) (18 . :f7) (19 . :f8)
    (20 . :f9) (21 . :f10) (23 . :f11) (24 . :f12)))

;;; ---------------------------------------------------------------------------
;;; Escape sequence mode
;;; ---------------------------------------------------------------------------
(defun %read-escape-sequence ()
  "We've read ESC (0x1b). Read the next byte and determine what to do."
  (let ((b (read-byte)))
    (unless b (return-from %read-escape-sequence
                (make-key-event :escape :raw (string #\Esc))))
    (case b
      ;; ESC O ... — SS3 sequences (F1-F4 on some terminals)
      (#x4f  ;; #\O
       (let ((b2 (read-byte)))
         (if b2
             (let ((key (cdr (assoc (code-char b2)
                                    '(#\P . :f1) (#\Q . :f2)
                                    (#\R . :f3) (#\S . :f4)))))
               (make-key-event (or key :unknown)
                               :raw (format nil "~C~C~C" #\Esc #\O (code-char b2))))
             (make-key-event :escape :raw (string #\Esc)))))
      ;; ESC [ ... — CSI sequences
      (#x5b  ;; #\[
       (multiple-value-bind (params final-byte raw)
           (parse-csi-params)
         (declare (ignore raw))
         (cond
           ((null final-byte)
            (make-key-event :escape :raw (string #\Esc)))
           ;; SGR mouse: ESC [ < params M or m
           ((and (char= (code-char final-byte) #\M)
                 (first params)
                 (zerop (logand (first params) #x40)))
            ;; This is a button press/release — not a mouse event? Actually
            ;; SGR mouse format is ESC [ < Cx ; Cy M/m. The leading < is
            ;; encoded in parameter byte 0x3c which parse-csi-params
            ;; absorbs as part of the parameter stream. We need to detect
            ;; the < before the params.
            ;; Real detection: if first byte after [ was < (0x3c), it's mouse.
            ;; Let's re-parse from raw.
            (let ((raw-str (map 'string #'code-char
                                (coerce (list b #x5b) 'vector))))
              (or (parse-sgr-mouse raw-str)
                  (make-key-event :unknown :raw (format nil "~C[~A" #\Esc raw-str)))))
           ;; Standard CSI: ESC [ params 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))))
              ;; Determine modifiers from param if CSI has modifier prefix
              (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 (or key :unknown)
                                :ctrl ctrl :alt alt :shift shift
                                :raw (format nil "~C[~A" #\Esc raw-str)))))))))
      ;; ESC ESC — double escape (Alt modifier on some terminals)
      (#x1b
       (make-key-event :escape :alt t :raw "\\e\\e"))
      ;; ESC followed by a printable — treated as Alt+key
      (t
       (let ((ch (code-char b)))
         (if (and (>= b #x20) (<= b #x7e))
             (make-key-event (intern (string-upcase ch) :keyword)
                             :alt t
                             :raw (format nil "~C~C" #\Esc ch))
             (make-key-event :unknown :raw (format nil "~C~C" #\Esc ch))))))))

;;; ---------------------------------------------------------------------------
;;; Top-level event reader
;;; ---------------------------------------------------------------------------
(defun read-event (&key timeout)
  "Read one input event from stdin.
  Returns a key-event, mouse-event, or NIL on timeout."
  (let ((b (read-byte :timeout timeout)))
    (unless b
      (return-from read-event nil))
    (case b
      ;; Escape — could be standalone or start of escape sequence
      (#x1b
       (%read-escape-sequence))
      ;; Tab
      (#x09
       (make-key-event :tab :code #x09))
      ;; Newline / Enter
      (#x0a
       (make-key-event :enter :code #x0a))
      ;; Carriage return (treat as Enter too)
      (#x0d
       (make-key-event :enter :code #x0d))
      ;; Backspace (DEL = 0x7f, BS = 0x08)
      ((#x7f #x08)
       (make-key-event :backspace :code b))
      ;; Ctrl characters (0x01-0x1a) → ctrl+A through ctrl+Z
      ((and (>= b #x01) (<= b #x1a))
       (let ((key (intern (string (code-char (+ b #x60))) :keyword)))
         (make-key-event key :ctrl t :code b)))
      ;; Ctrl+\ (0x1c), Ctrl+] (0x1d), Ctrl+^ (0x1e), Ctrl+_ (0x1f)
      (#x1c (make-key-event :backslash :ctrl t :code b))
      (#x1d (make-key-event :rbracket :ctrl t :code b))
      (#x1e (make-key-event :caret :ctrl t :code b))
      (#x1f (make-key-event :underscore :ctrl t :code b))
      ;; Printable ASCII
      ((and (>= b #x20) (<= b #x7e))
       (let ((ch (code-char b)))
         (make-key-event (intern (string-upcase ch) :keyword)
                         :code b)))
      ;; High bytes (UTF-8 multi-byte or unknown)
      (t
       (make-key-event :unknown :code b :raw (string (code-char b)))))))

;;; ---------------------------------------------------------------------------
;;; Backend integration
;;; ---------------------------------------------------------------------------
(defmethod read-event ((b cl-tui.backend:backend) &key timeout)
  "Default read-event — tries stdin via our parser.
  Falls back to inherited no-op if input stream is unavailable."
  (when (probe-file "/dev/stdin")
    (read-event :timeout timeout)))

TextInput Widget

(in-package #:cl-tui.input)

;;; ---------------------------------------------------------------------------
;;; TextInput class
;;; ---------------------------------------------------------------------------
(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))

;;; ---------------------------------------------------------------------------
;;; 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)))
    (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)))
    (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)
  "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))))
    (mark-dirty input)))

;;; ---------------------------------------------------------------------------
;;; Cursor movement
;;; ---------------------------------------------------------------------------
(defun text-input-move-left (input)
  (when (plusp (text-input-cursor input))
    (decf (text-input-cursor input))))

(defun text-input-move-right (input)
  (when (< (text-input-cursor input) (length (text-input-value input)))
    (incf (text-input-cursor input))))

(defun text-input-move-home (input)
  (setf (text-input-cursor input) 0))

(defun text-input-move-end (input)
  (setf (text-input-cursor input) (length (text-input-value 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)))
       (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)
       ;; Insert printable characters
       (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) window)
  (let* ((x (available-x window))
         (y (available-y window))
         (w (available-width window))
         (fg (theme-color (or *current-theme* (make-theme)) :text))
         (bg (theme-color (or *current-theme* (make-theme)) :background-element))
         (val (text-input-value in))
         (cur (text-input-cursor in))
         (ph (text-input-placeholder in)))
    (if (string= val "")
        ;; Placeholder
        (draw-text *current-backend* x y ph :text-muted bg)
        ;; Value
        (let ((display (subseq val 0 (min (length val) w))))
          (draw-text *current-backend* x y display fg bg)
          ;; Draw cursor as reverse block
          (when (and (>= cur 0) (< cur (length display)))
            (let ((ch (char display cur)))
              (draw-text *current-backend* (+ x cur) y (string ch) bg fg
                         :reverse t)))))))

Textarea Widget

(in-package #:cl-tui.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-sequence #\Newline (textarea-value ta)))

(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))))))

;;; ---------------------------------------------------------------------------
;;; Text manipulation
;;; ---------------------------------------------------------------------------
(defun textarea-insert-char (ta char)
  "Insert CHAR at the cursor position."
  (let* ((lines (textarea-lines ta))
         (row (textarea-cursor-row ta))
         (col (textarea-cursor-col ta)))
    (if (< row (length lines))
        (let* ((line (nth row lines))
               (new-line (concatenate 'string
                           (subseq line 0 col)
                           (string char)
                           (subseq line col))))
          (setf (nth row lines) new-line)
          (setf (textarea-value ta)
                (format nil "~{~A~^~C~}" lines #\Newline))
          (incf (textarea-cursor-col ta))
          (mark-dirty ta))
        (progn
          (setf (textarea-value ta) (string char))
          (incf (textarea-cursor-col ta))
          (mark-dirty ta)))))

(defun textarea-newline (ta)
  "Insert a newline at the cursor."
  (let* ((lines (textarea-lines ta))
         (row (textarea-cursor-row ta))
         (col (textarea-cursor-col ta)))
    (if (< row (length lines))
        (let* ((line (nth row lines))
               (before (subseq line 0 col))
               (after (subseq line col)))
          (setf (nth row lines) before)
          (setf lines (concatenate 'vector
                       (subseq lines 0 (1+ row))
                       (vector after)
                       (subseq lines (1+ row))))
          (setf (textarea-value ta)
                (format nil "~{~A~^~C~}" (coerce lines 'list) #\Newline))
          (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."
  (let* ((lines (textarea-lines ta))
         (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 (nth (1- row) lines))
              (curr (nth row lines))
              (new-pos (length prev)))
         (setf (nth (1- row) lines)
               (concatenate 'string prev curr))
         (setf lines (concatenate 'vector
                       (subseq lines 0 row)
                       (subseq lines (1+ row))))
         (setf (textarea-value ta)
               (format nil "~{~A~^~C~}" (coerce lines 'list) #\Newline))
         (decf (textarea-cursor-row ta))
         (setf (textarea-cursor-col ta) new-pos)
         (mark-dirty ta)))
      (t
       (let* ((line (nth row lines))
              (new-line (concatenate 'string
                          (subseq line 0 (1- col))
                          (subseq line col))))
         (setf (nth row lines) new-line)
         (setf (textarea-value ta)
               (format nil "~{~A~^~C~}" (coerce lines 'list) #\Newline))
         (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))
      (setf (textarea-undo-stack ta)
            (make-array 100 :fill-pointer 0)))
    (vector-push (textarea-value ta) stack)
    ;; Clear redo stack on new action
    (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)
  (cond
    ((key-event-ctrl event)
     (case (key-event-key event)
       (:z (textarea-undo ta))
       (:y (textarea-redo ta))
       (t (handle-text-input ta event))))
    (t
     (case (key-event-key event)
       (:up (textarea-move-up ta))
       (:down (textarea-move-down ta))
       (:enter (let ((cb (textarea-on-submit ta)))
                 (if cb
                     (funcall cb (textarea-value ta))
                     (textarea-newline ta))))
       (:backspace (textarea-backspace ta))
       (t (handle-text-input ta event))))))

;;; ---------------------------------------------------------------------------
;;; Rendering
;;; ---------------------------------------------------------------------------
(defmethod render ((ta textarea) window)
  (let* ((x (available-x window))
         (y (available-y window))
         (w (available-width window))
         (h (available-height window))
         (fg (theme-color (or *current-theme* (make-theme)) :text))
         (bg (theme-color (or *current-theme* (make-theme)) :background-element))
         (lines (textarea-lines ta))
         (start-row (max 0 (- (textarea-cursor-row ta) (1- h))))
         (visible (subseq lines start-row
                          (min (+ start-row h) (length lines)))))
    (loop for i from 0 below (length visible)
          for line = (nth i visible)
          do (draw-text *current-backend* x (+ y i)
                        (subseq line 0 (min (length line) w))
                        fg bg))
    ;; Draw cursor
    (when (and (>= (textarea-cursor-row ta) start-row)
               (< (- (textarea-cursor-row ta) start-row) h))
      (let ((cursor-screen-row (+ y (- (textarea-cursor-row ta) start-row)))
            (cursor-screen-col (+ x (textarea-cursor-col ta)))
            (current-line (nth (textarea-cursor-row ta) lines)))
        (when (< (textarea-cursor-col ta) (length current-line))
          (let ((ch (char current-line (textarea-cursor-col ta))))
            (draw-text *current-backend* cursor-screen-col cursor-screen-row
                       (string ch) bg fg :reverse t)))))))

Keybinding System

(in-package #:cl-tui.input)

;;; ---------------------------------------------------------------------------
;;; Key map struct
;;; ---------------------------------------------------------------------------
(defstruct keymap
  (name nil :type (or keyword null))
  (bindings nil :type list)   ;; alist: (spec . handler-fn)
  (parent nil :type (or keymap null)))

;;; ---------------------------------------------------------------------------
;;; Global keymap registry
;;; ---------------------------------------------------------------------------
(defparameter *keymaps* (make-hash-table :test #'equal))
(defparameter *chord-timeout* 0.5
  "Seconds to wait for chord completion.")

;;; ---------------------------------------------------------------------------
;;; Key spec matching
;;; ---------------------------------------------------------------------------
(defun key-match-p (spec event)
  "T if SPEC (a key spec form) matches EVENT (a key-event struct)."
  (etypecase spec
    ;; Simple keyword: :ctrl+p  → key=:p and ctrl=t
    (keyword
     (let* ((name (string spec))
            (colon (position #\: name)))
       (if colon
           (let ((mod-str (subseq name 0 colon))
                 (key-str (subseq name (1+ colon))))
             (and (eql (intern key-str :keyword) (key-event-key event))
                  (case mod-str
                    ("ctrl" (key-event-ctrl event))
                    ("alt"  (key-event-alt event))
                    ("shift" (key-event-shift event))
                    (t t))))
           (eql spec (key-event-key event)))))
    ;; List: (:ctrl+p) or (:ctrl+x :ctrl+s) (chord)
    (list
     (if (= (length spec) 1)
         ;; Single spec: (:ctrl+p)
         (key-match-p (first spec) event)
         ;; Chord: (:ctrl+x :ctrl+s) — match first key only for dispatch
         (key-match-p (first spec) event)))))

;;; ---------------------------------------------------------------------------
;;; Dispatch
;;; ---------------------------------------------------------------------------
(defun dispatch-key-event (event &key component)
  "Route EVENT through focused → local → global keymaps.
  Returns T if handled, NIL if unhandled."
  (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)
  "Register a keymap with NAME and BINDINGS.
  Each binding: (key-spec . handler-form)"
  `(setf (gethash ',name *keymaps*)
         (make-keymap :name ',name
                      :bindings (list ,@(loop for (spec . handler) in bindings
                                              collect `(cons ',spec ,handler))))))

;;; --- Component protocol integration ---
(defgeneric component-keymap (component)
  (:method ((c t)) nil))

Package

(defpackage :cl-tui.input
  (:use :cl :cl-tui.backend :cl-tui.box :cl-tui.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
   ;; 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-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))