c55f1773fb
The .lisp files were edited directly during REPL-driven development. Pushed all fixes back into the org source of truth: - Fixed defstruct positional constructor wrappers - Fixed case+string eql trap (cond+string=) - Fixed CL string escape sequences (multiline literals) - Fixed FiveAM closure capture (list boxing) - Fixed textarea format calls (%join-lines helper) - Fixed tangle paths for all 5 code blocks - Consolidated all tests into single test block - Updated key-match-p, dispatch-key-event, defkeymap macro All 60 tests pass (100% GREEN).
62 KiB
62 KiB
cl-tui v0.5.0 — Text Input + Keybinding System
Text Input System
The input pipeline has four layers:
- Terminal raw mode — put stdin into non-canonical mode so every keystroke is delivered immediately (no line buffering, no echo).
- 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.
- Input widget (TextInput / Textarea) — editable text with cursor, selection, undo/redo, and emacs-style keybindings.
- 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-eventis 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) →
:athrough:zwith ctrl=T - Escape (0x1b) → either standalone
:escapeor 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-submitcallback - 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-submitcallback - :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:
- Focused component's keymap — if the active widget defines bindings
- Local keymap — keymap for the current screen/modal context
- 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
(defpackage :cl-tui-input-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.input)
(:export #:run-tests))
(in-package :cl-tui-input-test)
(def-suite input-suite :description "Text input and keybinding tests")
(in-suite input-suite)
(defun run-tests ()
(let ((result (run 'input-suite)))
(fiveam:explain! result)
(uiop:quit 0)))
;; ── Key Event Tests ─────────────────────────────────────────────
(test key-event-construction
"A key-event can be created and queried."
(let ((e (make-key-event :key :a :ctrl t :alt nil)))
(is (eql (key-event-key e) :a))
(is-true (key-event-ctrl e))
(is-false (key-event-alt e))))
(test key-event-defaults
"Fields default to NIL/nil."
(let ((e (make-key-event :key :space)))
(is (eql (key-event-key e) :space))
(is-false (key-event-ctrl e))
(is-false (key-event-alt e))
(is-false (key-event-shift e))))
(test mouse-event-construction
"A mouse-event can be created and queried."
(let ((e (make-mouse-event :type :press :button :left :x 10 :y 5)))
(is (eql (mouse-event-type e) :press))
(is (eql (mouse-event-button e) :left))
(is (= (mouse-event-x e) 10))
(is (= (mouse-event-y e) 5))))
;; ── TextInput Tests ─────────────────────────────────────────────
(test text-input-empty
"A newly created text-input has empty value and cursor at 0."
(let ((in (make-text-input)))
(is (string= (text-input-value in) ""))
(is (= (text-input-cursor in) 0))))
(test text-input-insert-char
"Inserting a character appends and moves cursor."
(let ((in (make-text-input)))
(handle-text-input in (make-key-event :key :a :code (char-code #\a)))
(is (string= (text-input-value in) "a"))
(is (= (text-input-cursor in) 1))))
(test text-input-insert-multiple
"Inserting multiple characters works left to right."
(let ((in (make-text-input)))
(handle-text-input in (make-key-event :key :h :code (char-code #\h)))
(handle-text-input in (make-key-event :key :e :code (char-code #\e)))
(handle-text-input in (make-key-event :key :l :code (char-code #\l)))
(handle-text-input in (make-key-event :key :l :code (char-code #\l)))
(handle-text-input in (make-key-event :key :o :code (char-code #\o)))
(is (string= (text-input-value in) "hello"))
(is (= (text-input-cursor in) 5))))
(test text-input-backspace
"Backspace removes the character before the cursor."
(let ((in (make-text-input :value "ab" :cursor 2)))
(handle-text-input in (make-key-event :key :backspace))
(is (string= (text-input-value in) "a"))
(is (= (text-input-cursor in) 1))))
(test text-input-backspace-at-start
"Backspace at position 0 does nothing."
(let ((in (make-text-input :value "ab" :cursor 0)))
(handle-text-input in (make-key-event :key :backspace))
(is (string= (text-input-value in) "ab"))
(is (= (text-input-cursor in) 0))))
(test text-input-delete
"Delete removes the character at the cursor."
(let ((in (make-text-input :value "abc" :cursor 1)))
(handle-text-input in (make-key-event :key :delete))
(is (string= (text-input-value in) "ac"))
(is (= (text-input-cursor in) 1))))
(test text-input-cursor-left-right
"Cursor moves left and right."
(let ((in (make-text-input :value "ab" :cursor 2)))
(handle-text-input in (make-key-event :key :left))
(is (= (text-input-cursor in) 1))
(handle-text-input in (make-key-event :key :right))
(is (= (text-input-cursor in) 2))))
(test text-input-cursor-bounds
"Cursor cannot move past start or end."
(let ((in (make-text-input :value "ab" :cursor 0)))
(handle-text-input in (make-key-event :key :left))
(is (= (text-input-cursor in) 0))
(setf (text-input-cursor in) 2)
(handle-text-input in (make-key-event :key :right))
(is (= (text-input-cursor in) 2))))
(test text-input-home-end
"Home moves to start, End moves to end."
(let ((in (make-text-input :value "hello" :cursor 3)))
(handle-text-input in (make-key-event :key :home))
(is (= (text-input-cursor in) 0))
(handle-text-input in (make-key-event :key :end))
(is (= (text-input-cursor in) 5))))
(test text-input-max-length
"Max-length prevents inserting beyond the limit."
(let ((in (make-text-input :max-length 3)))
(handle-text-input in (make-key-event :key :a :code (char-code #\a)))
(handle-text-input in (make-key-event :key :b :code (char-code #\b)))
(handle-text-input in (make-key-event :key :c :code (char-code #\c)))
(handle-text-input in (make-key-event :key :d :code (char-code #\d)))
(is (string= (text-input-value in) "abc"))))
(test text-input-placeholder
"Placeholder is stored but does not affect value."
(let ((in (make-text-input :placeholder "Type here...")))
(is (string= (text-input-placeholder in) "Type here..."))
(is (string= (text-input-value in) ""))))
(test text-input-on-submit
"On-submit callback fires on Enter."
(let ((result (list nil)))
(let ((in (make-text-input :value "hello"
:on-submit (lambda (v) (setf (car result) v)))))
(handle-text-input in (make-key-event :key :enter))
(is (string= (car result) "hello")))))
(test text-input-ctrl-a-e
"Ctrl+A moves to home, Ctrl+E moves to end."
(let ((in (make-text-input :value "abc" :cursor 2)))
(handle-text-input in (make-key-event :key :a :ctrl t))
(is (= (text-input-cursor in) 0))
(handle-text-input in (make-key-event :key :e :ctrl t))
(is (= (text-input-cursor in) 3))))
(test text-input-insert-in-middle
"Inserting in the middle of text shifts rest right."
(let ((in (make-text-input :value "ab" :cursor 1)))
(handle-text-input in (make-key-event :key :x :code (char-code #\x)))
(is (string= (text-input-value in) "axb"))
(is (= (text-input-cursor in) 2))))
(test text-input-dirty-on-insert
"Inserting marks the widget dirty."
(let ((in (make-text-input)))
(mark-clean in)
(handle-text-input in (make-key-event :key :a :code (char-code #\a)))
(is-true (dirty-p in))))
;; ── Textarea Tests ──────────────────────────────────────────────
(test textarea-empty
"New textarea has empty value and cursor at (0,0)."
(let ((a (make-textarea)))
(is (string= (textarea-value a) ""))
(is (= (textarea-cursor-row a) 0))
(is (= (textarea-cursor-col a) 0))))
(test textarea-newline
"Enter inserts a newline."
(let ((a (make-textarea)))
(handle-textarea-input a (make-key-event :key :a :code (char-code #\a)))
(handle-textarea-input a (make-key-event :key :enter))
(handle-textarea-input a (make-key-event :key :b :code (char-code #\b)))
(is (string= (textarea-value a) "a
b"))))
(test textarea-cursor-up-down
"Cursor moves between lines maintaining column position."
(let ((a (make-textarea :value "abc
de
fghi")))
(setf (textarea-cursor-row a) 1)
(setf (textarea-cursor-col a) 1)
(handle-textarea-input a (make-key-event :key :up))
(is (= (textarea-cursor-row a) 0))
(is (= (textarea-cursor-col a) 1))
(handle-textarea-input a (make-key-event :key :down))
(is (= (textarea-cursor-row a) 1))
(is (= (textarea-cursor-col a) 1))))
(test textarea-cursor-up-down-bounds
"Cursor cannot move past first or last line."
(let ((a (make-textarea :value "a
b")))
(handle-textarea-input a (make-key-event :key :up))
(is (= (textarea-cursor-row a) 0))
(setf (textarea-cursor-row a) 1)
(handle-textarea-input a (make-key-event :key :down))
(is (= (textarea-cursor-row a) 1))))
(test textarea-backspace-joins-lines
"Backspace at start of a line joins with previous."
(let ((a (make-textarea :value "hello
world")))
(setf (textarea-cursor-row a) 1)
(setf (textarea-cursor-col a) 0)
(handle-textarea-input a (make-key-event :key :backspace))
(is (string= (textarea-value a) "helloworld"))))
(test textarea-undo
"Ctrl+Z undoes the last edit."
(let ((a (make-textarea)))
(handle-textarea-input a (make-key-event :key :a :code (char-code #\a)))
(handle-textarea-input a (make-key-event :key :z :ctrl t))
(is (string= (textarea-value a) ""))))
(test textarea-undo-redo
"Ctrl+Y redoes an undone edit."
(let ((a (make-textarea)))
(handle-textarea-input a (make-key-event :key :a :code (char-code #\a)))
(handle-textarea-input a (make-key-event :key :z :ctrl t))
(handle-textarea-input a (make-key-event :key :y :ctrl t))
(is (string= (textarea-value a) "a"))))
;; ── Keybinding Tests ────────────────────────────────────────────
(test keymap-simple
"A keymap dispatches to its handler on matching event."
(let ((called nil))
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+p . ,(lambda (e)
(declare (ignore e))
(setf called t))))))
(is-true (dispatch-key-event (make-key-event :key :p :ctrl t)))
(is-true called)))
(test keymap-no-match
"Non-matching event returns nil."
(let ((called nil))
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+p . ,(lambda (e)
(declare (ignore e))
(setf called t))))))
(is-false (dispatch-key-event (make-key-event :key :a)))
(is-false called)))
(test keymap-fallback
"Event not in local falls through to global."
(let ((global-called nil))
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+q . ,(lambda (e)
(declare (ignore e))
(setf global-called t))))))
(dispatch-key-event (make-key-event :key :q :ctrl t))
(is-true global-called)))
(test key-spec-simple
"Keyword key-spec matches key+ctrl."
(is-true (key-match-p :ctrl+p (make-key-event :key :p :ctrl t)))
(is-false (key-match-p :ctrl+p (make-key-event :key :a :ctrl t)))
(is-false (key-match-p :ctrl+p (make-key-event :key :p))))
(test defkeymap-macro
"defkeymap macro registers a keymap."
(let ((called nil))
(eval `(defkeymap :global
(:ctrl+q ,(lambda (e) (declare (ignore e)) (setf called t)))))
(dispatch-key-event (make-key-event :key :q :ctrl t))
(is-true called)))(in-package #:cl-tui.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))))
;;; ---------------------------------------------------------------------------
;;; Global variables for rendering pipeline (set by application)
;;; ---------------------------------------------------------------------------
(defvar *current-backend* nil
"The active backend used for rendering.")
(defvar *current-theme* nil
"The active theme used for semantic color resolution.")
;;; ---------------------------------------------------------------------------
;;; 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))
(button nil :type (or keyword nil))
(x 0 :type fixnum)
(y 0 :type fixnum)
(raw nil :type (or string null)))
;;; ---------------------------------------------------------------------------
;;; Terminal raw mode
;;; ---------------------------------------------------------------------------
(defun save-terminal-state ()
(sb-posix:tcgetattr 0))
(defun make-raw-termios (termios)
(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 ()
(let ((raw (make-raw-termios (save-terminal-state))))
(sb-posix:tcsetattr 0 sb-posix:tcsanow raw)
raw))
(defun restore-terminal-state (termios)
(sb-posix:tcsetattr 0 sb-posix:tcsanow termios))
(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)
(if timeout
(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-raw-byte (aref buf 0)))))
(sb-posix:syscall-error ()
(return-from read-raw-byte nil)))
(sleep 0.01))
nil)
(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 ()
(let ((params '())
(raw (make-array 0 :element-type '(unsigned-byte 8)
:fill-pointer 0 :adjustable t))
(current 0))
(loop
(let ((b (read-raw-byte)))
(unless b (return (values nil nil nil)))
(vector-push-extend b raw)
(cond
((and (>= b #x30) (<= b #x3f))
(if (char= (code-char b) #\;)
(progn (push current params) (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)))
(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)))
;;; ---------------------------------------------------------------------------
;;; 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)))))
;;; ---------------------------------------------------------------------------
;;; Escape sequence reader
;;; ---------------------------------------------------------------------------
(defun %read-escape-sequence ()
(let ((b (read-raw-byte)))
(unless b
(return-from %read-escape-sequence
(make-key-event :key :escape :raw (string #\Esc))))
(case b
;; SS3: ESC O X
(#x4f
(let ((b2 (read-raw-byte)))
(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)))))
;; CSI: ESC [ ...
(#x5b
(multiple-value-bind (params final-byte) (parse-csi-params)
(if (null final-byte)
(make-key-event :key :escape :raw (string #\Esc))
(if (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))
(wheel (logand p0 #x40)))
(make-mouse-event
:type (if motion :drag :press)
:button (cond (wheel (if (zerop (logand p0 #x01))
:wheel-up :wheel-down))
((= button 0) :left)
((= button 1) :middle)
((= button 2) :right)
(t :none))
:x x :y y :raw (format nil "~C[<~d;~d;~d~C" #\Esc p0 x y (code-char final-byte))))
(let* ((tilde-p (char= (code-char final-byte) #\~))
(param (or p0 0))
(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))))))
(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))))))))))
;; ESC ESC
(#x1b
(make-key-event :key :escape :alt t :raw "\\e\\e"))
;; ESC + printable = Alt+key
(t
(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))))))))
;;; ---------------------------------------------------------------------------
;;; Top-level event reader
;;; ---------------------------------------------------------------------------
(defun %read-event (&key timeout)
(let ((b (read-raw-byte :timeout timeout)))
(unless b
(return-from %read-event nil))
(case b
(#x1b
(%read-escape-sequence))
(#x09
(make-key-event :key :tab :code #x09))
(#x0a
(make-key-event :key :enter :code #x0a))
(#x0d
(make-key-event :key :enter :code #x0d))
((#x7f #x08)
(make-key-event :key :backspace :code b))
((and (>= b #x01) (<= b #x1a))
(let ((key (intern (string-upcase (string (code-char (+ b #x60)))) :keyword)))
(make-key-event :key key :ctrl t :code b)))
(#x1c (make-key-event :key :backslash :ctrl t :code b))
(#x1d (make-key-event :key :rbracket :ctrl t :code b))
(#x1e (make-key-event :key :caret :ctrl t :code b))
(#x1f (make-key-event :key :underscore :ctrl t :code b))
((and (>= b #x20) (<= b #x7e))
(let ((ch (code-char b)))
(make-key-event :key (intern (string (string-upcase ch)) :keyword)
:code b)))
(t
(make-key-event :key :unknown :code b :raw (string (code-char b)))))))
;;; ---------------------------------------------------------------------------
;;; Backend integration
;;; ---------------------------------------------------------------------------
(defmethod read-event ((b cl-tui.backend:backend) &key timeout)
(declare (ignore b))
(when (probe-file "/dev/stdin")
(%read-event :timeout timeout)))(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))))
(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)))
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))))
;;; ---------------------------------------------------------------------------
;;; 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 (stub — proper rendering uses theme + backend)
;;; ---------------------------------------------------------------------------
(defmethod render ((in text-input) (backend t))
"Render a text-input widget. Full rendering requires *current-backend*,
*current-theme*, and the rendering pipeline. This is a no-op stub for
unit testing the widget logic."
(declare (ignore in backend))
(values))(in-package #:cl-tui.input)
;;; ---------------------------------------------------------------------------
;;; Utility: split string (local copy for dependency-free operation)
;;; ---------------------------------------------------------------------------
(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))))
;;; ---------------------------------------------------------------------------
;;; Textarea class
;;; ---------------------------------------------------------------------------
(defclass textarea (dirty-mixin)
((value :initform "" :initarg :value :accessor textarea-value :type string)
(cursor-row :initform 0 :accessor textarea-cursor-row :type fixnum)
(cursor-col :initform 0 :accessor textarea-cursor-col :type fixnum)
(selection-start :initform nil :accessor textarea-selection-start)
(undo-stack :initform (make-array 100 :fill-pointer 0)
:accessor textarea-undo-stack)
(redo-stack :initform (make-array 100 :fill-pointer 0)
:accessor textarea-redo-stack)
(on-submit :initform nil :initarg :on-submit :accessor textarea-on-submit)
(layout-node :initform (make-layout-node) :accessor textarea-layout-node)
(focusable :initform t :accessor textarea-focusable)))
(defun make-textarea (&key value on-submit)
(make-instance 'textarea
:value (or value "")
:on-submit on-submit))
;;; ---------------------------------------------------------------------------
;;; Line helpers
;;; ---------------------------------------------------------------------------
(defun textarea-lines (ta)
"Split value into lines."
(%split-string (textarea-value ta) #\Newline))
(defun textarea-line-count (ta)
"Number of lines in value."
(length (textarea-lines ta)))
(defun textarea-ensure-cursor (ta)
"Clamp cursor to valid range."
(let ((lines (textarea-lines ta)))
(setf (textarea-cursor-row ta)
(max 0 (min (textarea-cursor-row ta) (1- (length lines)))))
(let ((line-len (length (nth (textarea-cursor-row ta) lines))))
(setf (textarea-cursor-col ta)
(max 0 (min (textarea-cursor-col ta) line-len))))))
;;; ---------------------------------------------------------------------------
;;; Utility: join strings with newline
;;; ---------------------------------------------------------------------------
(defun %join-lines (lines)
"Join a sequence of strings with newlines."
(with-output-to-string (s)
(loop for line across (if (listp lines) (coerce lines 'vector) lines)
for first = t then nil
do (unless first (write-char #\Newline s))
(write-string line s))))
;;; ---------------------------------------------------------------------------
;;; Text manipulation
;;; ---------------------------------------------------------------------------
(defun textarea-insert-char (ta char)
"Insert CHAR at the cursor position."
(textarea-push-undo ta)
(let* ((lines (coerce (textarea-lines ta) 'vector))
(row (textarea-cursor-row ta))
(col (textarea-cursor-col ta)))
(if (< row (length lines))
(let* ((line (aref lines row))
(new-line (concatenate 'string
(subseq line 0 col)
(string char)
(subseq line col))))
(setf (aref lines row) new-line)
(setf (textarea-value ta)
(%join-lines lines))
(incf (textarea-cursor-col ta))
(mark-dirty ta))
(progn
(setf (textarea-value ta)
(concatenate 'string (textarea-value ta) (string char)))
(incf (textarea-cursor-col ta))
(mark-dirty ta)))))
(defun textarea-newline (ta)
"Insert a newline at the cursor."
(textarea-push-undo ta)
(let* ((lines (coerce (textarea-lines ta) 'vector))
(row (textarea-cursor-row ta))
(col (textarea-cursor-col ta)))
(if (< row (length lines))
(let* ((line (aref lines row))
(before (subseq line 0 col))
(after (subseq line col)))
(setf (aref lines row) before)
(let ((new-lines (concatenate 'vector
(subseq lines 0 (1+ row))
(vector after)
(subseq lines (1+ row)))))
(setf (textarea-value ta)
(%join-lines new-lines)))
(incf (textarea-cursor-row ta))
(setf (textarea-cursor-col ta) 0)
(mark-dirty ta))
(progn
(setf (textarea-value ta)
(concatenate 'string (textarea-value ta) (string #\Newline)))
(incf (textarea-cursor-row ta))
(setf (textarea-cursor-col ta) 0)
(mark-dirty ta)))))
(defun textarea-backspace (ta)
"Delete character before cursor."
(textarea-push-undo ta)
(let* ((lines (coerce (textarea-lines ta) 'vector))
(row (textarea-cursor-row ta))
(col (textarea-cursor-col ta)))
(cond
((and (zerop row) (zerop col))
nil) ;; nothing to delete
((zerop col)
;; Join with previous line
(let* ((prev (aref lines (1- row)))
(curr (aref lines row))
(new-pos (length prev)))
(setf (aref lines (1- row))
(concatenate 'string prev curr))
(let ((new-lines (concatenate 'vector
(subseq lines 0 row)
(subseq lines (1+ row)))))
(setf (textarea-value ta)
(%join-lines new-lines)))
(decf (textarea-cursor-row ta))
(setf (textarea-cursor-col ta) new-pos)
(mark-dirty ta)))
(t
(let* ((line (aref lines row))
(new-line (concatenate 'string
(subseq line 0 (1- col))
(subseq line col))))
(setf (aref lines row) new-line)
(setf (textarea-value ta)
(%join-lines lines))
(decf (textarea-cursor-col ta))
(mark-dirty ta))))))
;;; ---------------------------------------------------------------------------
;;; Cursor movement
;;; ---------------------------------------------------------------------------
(defun textarea-move-up (ta)
(decf (textarea-cursor-row ta))
(textarea-ensure-cursor ta))
(defun textarea-move-down (ta)
(incf (textarea-cursor-row ta))
(textarea-ensure-cursor ta))
;;; ---------------------------------------------------------------------------
;;; Undo/redo
;;; ---------------------------------------------------------------------------
(defun textarea-push-undo (ta)
"Save current value on undo stack."
(let ((stack (textarea-undo-stack ta)))
(when (>= (length stack) (array-total-size stack))
(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)
"Process a key-event on a textarea widget."
(cond
((key-event-ctrl event)
(case (key-event-key event)
(:z (textarea-undo ta))
(:y (textarea-redo ta))
;; Ctrl+A/E: home/end
(:a (setf (textarea-cursor-col ta) 0))
(:e (let ((lines (textarea-lines ta)))
(when (< (textarea-cursor-row ta) (length lines))
(setf (textarea-cursor-col ta)
(length (nth (textarea-cursor-row ta) lines))))))
(t nil)))
(t
(case (key-event-key event)
(:left (decf (textarea-cursor-col ta))
(textarea-ensure-cursor ta))
(:right (incf (textarea-cursor-col ta))
(textarea-ensure-cursor ta))
(:up (textarea-move-up ta))
(:down (textarea-move-down ta))
(:home (setf (textarea-cursor-col ta) 0))
(:end (let ((lines (textarea-lines ta)))
(when (< (textarea-cursor-row ta) (length lines))
(setf (textarea-cursor-col ta)
(length (nth (textarea-cursor-row ta) lines))))))
(:enter (let ((cb (textarea-on-submit ta)))
(if cb
(funcall cb (textarea-value ta))
(textarea-newline ta))))
(:backspace (textarea-backspace ta))
(:delete (let* ((lines (textarea-lines ta))
(row (textarea-cursor-row ta))
(col (textarea-cursor-col ta))
(line (nth row lines)))
(when (and line (< col (length line)))
(textarea-push-undo ta)
(setf (nth row lines)
(concatenate 'string
(subseq line 0 col)
(subseq line (1+ col))))
(setf (textarea-value ta)
(%join-lines lines))
(mark-dirty ta))))
;; Character insertion
(otherwise
(let ((ch (code-char (key-event-code event))))
(when (and ch (graphic-char-p ch))
(textarea-insert-char ta ch))))))))
;;; ---------------------------------------------------------------------------
;;; Rendering (stub — proper rendering uses theme + backend)
;;; ---------------------------------------------------------------------------
(defmethod render ((ta textarea) (backend t))
"Render a textarea widget. Full rendering requires *current-backend*,
*current-theme*, and the rendering pipeline. This is a no-op stub for
unit testing the widget logic."
(declare (ignore ta backend))
(values))(in-package #:cl-tui.input)
;;; ---------------------------------------------------------------------------
;;; Key map struct
;;; ---------------------------------------------------------------------------
(defstruct keymap
(name nil :type (or keyword null))
(bindings nil :type list)
(parent nil :type (or keymap null)))
;;; ---------------------------------------------------------------------------
;;; Global keymap registry
;;; ---------------------------------------------------------------------------
(defparameter *keymaps* (make-hash-table :test #'equal))
(defparameter *chord-timeout* 0.5)
;;; ---------------------------------------------------------------------------
;;; Key spec matching
;;; ---------------------------------------------------------------------------
(defun key-match-p (spec event)
"T if SPEC matches EVENT. Spec is :ctrl+p (modifier+key keyword)
or (:ctrl+p) for single-spec in a list, or (:ctrl+x :ctrl+s) for chords."
(etypecase spec
;; Keyword like :ctrl+p, :alt+f, :enter, :space, :f1
(keyword
(let* ((name (string spec))
(plus (position #\+ name)))
(if plus
;; Modified key: :ctrl+p → mod-str="CTRL", key-str="P"
(let ((mod-str (subseq name 0 plus))
(key-str (subseq name (1+ plus))))
(and (eql (intern key-str :keyword)
(key-event-key event))
(cond
((string= mod-str "CTRL") (key-event-ctrl event))
((string= mod-str "ALT") (key-event-alt event))
((string= mod-str "SHIFT") (key-event-shift event))
(t t))))
;; Plain keyword: :enter, :escape, :f1, etc.
(eql spec (key-event-key event)))))
;; List: (:ctrl+p) or (:ctrl+x :ctrl+s)
(list
(when spec
(key-match-p (first spec) event)))))
;;; ---------------------------------------------------------------------------
;;; Dispatch
;;; ---------------------------------------------------------------------------
(defun dispatch-key-event (event &key component)
(labels ((try-keymap (km)
(when km
(loop for (spec . handler) in (keymap-bindings km)
thereis (when (key-match-p spec event)
(funcall handler event)
t))))
(find-keymap (name)
(gethash name *keymaps*)))
(or (and component
(let ((km (component-keymap component)))
(when km (try-keymap km))))
(try-keymap (find-keymap :local))
(try-keymap (find-keymap :global)))))
;;; ---------------------------------------------------------------------------
;;; defkeymap macro
;;; ---------------------------------------------------------------------------
(defmacro defkeymap (name &body bindings)
`(setf (gethash ',name *keymaps*)
(make-keymap :name ',name
:bindings (list ,@(loop for b in bindings
collect (if (consp (cdr b))
`(cons ',(car b) ,(cadr b))
`(cons ',(car b) ,(cdr b))))))))
;;; --- Component protocol integration ---
(defgeneric component-keymap (component)
(:method ((c t)) nil))(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))