#+TITLE: cl-tui v0.5.0 — Text Input + Keybinding System #+STARTUP: content * 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 #+BEGIN_SRC lisp (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)))) #+END_SRC * 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 #+BEGIN_SRC lisp (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)))) #+END_SRC * 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 #+BEGIN_SRC lisp (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")))) #+END_SRC * 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 #+BEGIN_SRC lisp (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))) #+END_SRC * Implementation ** Input Infrastructure #+BEGIN_SRC lisp (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))) #+END_SRC #+BEGIN_SRC lisp :tangle ../src/components/input.lisp (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))) #+END_SRC #+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp (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)) #+END_SRC #+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp (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)) #+END_SRC #+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp (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)) #+END_SRC #+BEGIN_SRC lisp :tangle ../src/components/input-package.lisp (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)) #+END_SRC