86 KiB
cl-tty v0.5.0 — Text Input + Keybinding System
- Text Input System
- Contract
- Package
- Input Reader Core
- Textarea Widget
- Text Input Widget
- Keybinding System
- Tests
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 — structs generate inline accessors, key/ctrl/alt are fixnum/boolean slots that never need CLOS dispatch.- 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 want different modes.
- The parser reads one byte at a time through a state machine, not a buffer-at-once approach. This keeps the implementation simple and handles arbitrary interleaving of terminal output with input.
- SBCL's
defstructgenerates keyword constructors by default — we use them directly without custom:constructoroverrides. - CSI sequences are parsed via a two-pass approach: first collect params and terminator, then look up in tables. This separates concerns — the byte-level parsing is distinct from the semantic mapping.
- The 50ms timeout on escape sequence detection resolves the classic ambiguity between a lone Escape key press and the start of a CSI/SS3 sequence. If a byte arrives within 50ms, it's an escape sequence; if not, the user pressed Escape.
- UTF-8 decoding uses a direct bit-manipulation approach rather than a table-driven decoder. For the terminal input use case (short sequences of 2-4 bytes), the simpler code is both faster and more readable.
key-event-codeexists alongsidekey-event-keyto carry the raw character code.:keyis a semantic keyword (:a, :enter, :up) while:codeis the numeric code point or byte value. This separation is essential for printable character insertion —handle-text-inputuseskey-event-codewithcode-char, notkey-event-keywhich is always uppercased (and thus useless for case-sensitive insertion).- The undo/redo system uses fill-pointer vectors as stacks, capped at 100 entries. Oldest entries are evicted when the stack fills. This avoids consing on every keystroke while bounding memory use.
Contract
(key-event key ctrl alt shift code raw text) — struct.
make-key-event :key :enter :ctrl nil creates a key-press event.
key-event-key returns the keyword (:a, :enter, :space,
:up, :f1, etc.).
(mouse-event type button x y raw) — struct.
type is :press, :release, or :drag.
button is :left, :middle, :right, :wheel-up, or :wheel-down.
%split-string string separator → list of strings.
Split a string at each occurrence of SEPARATOR character.
Used internally to split textarea lines.
*current-backend*, *current-theme* — special variables.
Set by the application's main loop. Used by widget render methods
to draw themselves.
save-terminal-state → termios. Capture current terminal settings.
set-raw-mode → termios. Disable ICANON, ECHO, ISIG, IEXTEN. VMIN=1, VTIME=0.
restore-terminal-state termios — restore saved settings.
with-raw-terminal &body body — macro. Save → set raw → body → restore
(via unwind-protect).
read-raw-byte &key timeout → (values byte-or-nil reason).
Read one byte from fd 0. Blocks indefinitely when timeout=NIL.
Returns (values byte NIL) on success, (values NIL :TIMEOUT) on timeout,
(values NIL :EOF) when stdin is closed or /dev/null.
parse-csi-params → (values params final-byte raw-string).
Read bytes from stdin until a final CSI byte (0x40-0x7E).
Returns list of parameter numbers, the final byte, and the raw string.
parse-sgr-mouse raw → mouse-event or NIL.
Parse "ESC[<Cx;Cy;M/m" format into a structured mouse event.
Converts button codes (0=left, 1=middle, 2=right, 32=motion)
and tracks press vs release vs drag.
%read-escape-sequence → key-event or :eof.
Called after reading ESC (0x1b). Uses a 50ms timeout on the first
follow-up byte to resolve Escape ambiguity (lone Escape vs start of
CSI/SS3 sequence). Dispatches:
- timeout → :escape key event
- ESC O X → SS3 (F1-F4)
- ESC [ … → CSI (cursors, function keys, mouse)
- ESC ESC → Alt+Escape
- ESC printable → Alt+letter
%read-event &key timeout → key-event, mouse-event, :eof, or NIL.
Top-level reader. Handles:
- Printable ASCII (0x20-0x7e) → key :A, :B, …, :~
- Ctrl letters (0x01-0x1a) → :A with ctrl=T
- Tab (0x09), Enter (0x0a, 0x0d)
- Backspace (0x7f, 0x08)
- Escape (0x1b) → delegates to
%read-escape-sequence - High bytes (UTF-8, etc.) → :unknown
:key is always uppercase (interred in KEYWORD package)
to match how the reader interns keyword literals.
read-event (b backend) &key timeout — defmethod.
Backend protocol integration. Probes /dev/stdin and calls %read-event.
text-input — widget class. slots: value, cursor, placeholder,
max-length, on-submit, layout-node, focusable. Inherits dirty-mixin.
make-text-input ... — constructor.
handle-text-input input event — process a key-event:
- Ctrl+A/E → home/end
- Ctrl+W → delete word before
- Ctrl+U → delete to line start
- Ctrl+K → delete to line end
- :enter → on-submit callback
- :left/:right/:home/:end → cursor movement
- :backspace/:delete → char deletion
- printable chars → insert at cursor
textarea — widget class. slots: value, cursor-row, cursor-col,
selection-start, undo/redo stacks (fill-pointer vectors), on-submit,
layout-node, focusable. Inherits dirty-mixin.
make-textarea ... — constructor.
handle-textarea-input ta event — process a key-event:
- All TextInput operations plus:
- Ctrl+Z → undo, Ctrl+Y → redo
- Ctrl+A/E → home/end on current line
- :up/:down → line navigation
- :enter → newline (or on-submit if set)
- :left/:right/:home/:end → cursor movement
- :delete → char at cursor
- :backspace → joins lines at start, deletes char otherwise
%join-lines lines → string.
Join a sequence of strings with #\Newline separators.
Handles both lists and vectors (used throughout textarea).
keymap — struct. slots: name, bindings (alist), parent.
*keymaps* — hash table (test: equal), maps keyword names to keymaps.
*chord-timeout* — seconds (default 0.5).
key-match-p spec event → boolean.
SPEC is a keyword like :ctrl+p (modifier+key, split on +)
or a list like (:ctrl+p) for wrapped specs.
Modified keys match mod-str with string=? — not ~case (EQL trap).
dispatch-key-event event &key component → boolean (handled?).
Routes through: focused-component → :local → :global keymaps.
defkeymap name &body bindings — macro.
Registers a keymap. Each binding: (:ctrl+p . handler-fn).
component-keymap component — generic (returns nil by default).
Package
input-package.lisp
The package uses :cl-tty.backend for backend protocol (draw-text, etc.),
:cl-tty.box for dirty-mixin and rendering pipeline,
and :cl-tty.layout for layout-node.
I export everything users of the input system need: key events, mouse events, terminal raw mode, TextInput, Textarea, and the keybinding system.
save-terminal-state, set-raw-mode, restore-terminal-state, and
with-raw-terminal are declared in the export list for forward compatibility
— they belong in this module once implemented, and exporting them from the
start avoids package redefinition churn. The current system does not yet call
raw mode from within the input module; consumers manage raw mode themselves
via sb-posix directly.
(defpackage :cl-tty.input
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.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
#:*terminal-resized-p*
;; UTF-8 input support
#:utf8-decode
;; 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-lines
#: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))Input Reader Core
This section contains all the terminal input reading machinery: raw byte reads, escape sequence parsing, CSI sequence handling, UTF-8 decoding, and the top-level event dispatch.
All blocks tangle to ../src/components/input.lisp. The first block
includes the in-package form; subsequent blocks contain only the
individual definition.
Utility: %split-string
A simple loop-based split. I avoid using split-sequence from Quicklisp
to keep dependencies minimal — the framework already depends on fiveam and
sb-posix, and adding another dep just for one function is wasteful.
The loop collects subsequences between occurrences of SEPARATOR. The
while pos guard prevents an empty trailing element. For an empty string,
this returns ("") (one empty string), which is the correct behavior for
textarea line splitting — a blank document has one empty line.
This is the first block tangling to input.lisp, so it includes the
in-package form that all subsequent blocks share.
(in-package #:cl-tty.input)
(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 rendering variables
*current-backend* and *current-theme* are special variables set by the
application's main loop. Widget render methods use them to draw themselves.
Defining them here rather than in the rendering module keeps the dependency
clean — input widgets depend on rendering, not the other way around.
(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
I chose defstruct over defclass for key events because structs give
inline accessors and value semantics. Every keystroke creates one, and
in the hot path (terminal parsing) we don't want CLOS dispatch overhead.
Key observation about SBCL's defstruct: it generates a keyword constructor
by default. (make-key-event :key :a :ctrl t) is valid out of the box.
I initially wrote a custom (:constructor ...) wrapper and spent hours
debugging argument mismatches — avoid that trap.
The code slot carries the raw character code (or code point for UTF-8
sequences). The raw slot carries the raw byte(s) as a string for debugging
or passthrough. The text slot is reserved for composed text input (IME).
key-event-key is always a keyword interned in the KEYWORD package,
uppercased. This means :a (not :A) for the letter 'a', :enter for
Enter, :up for the up arrow. The uppercasing convention matches how the
Common Lisp reader interns keyword literals, so (eql (key-event-key e)
:a) works exactly as written.
key-event-code exists alongside key-event-key because the key keyword
loses information needed for character insertion: :a could be uppercase
or lowercase, but code preserves the actual code point. The
handle-text-input function uses code-char on the code slot to get the
true character for insertion.
(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
Mouse events are a separate struct because they carry fundamentally different data: button (left/middle/right/wheel), coordinates (x, y), and event type (press/release/drag). Combining them with key-event would waste slots and complicate accessor semantics.
The mouse parser (parse-sgr-mouse) converts from the SGR extended
mouse protocol format (ESC[<Cx;Cy;M/m) into this struct. The type
field is :press, :release, or :drag, determined by whether the button
code includes the motion bit (bit 5). Coordinates are 1-indexed from
the terminal; no adjustment is performed here.
(defstruct mouse-event
(type nil :type (or keyword null))
(button nil :type (or keyword null))
(x 0 :type fixnum)
(y 0 :type fixnum))CSI tilde table
The *csi-tilde-table* maps numeric parameters from ESC[…~~ sequences
to semantic key names. These are the "application mode" cursor and editing
keys: Home, Insert, Delete, End, Page Up/Down, and F-keys F1-F20.
The tilde-terminated form (ESC[1~ = Home, ESC[2~ = Insert, etc.) is
the modern xterm format, as opposed to the single-letter terminators used
by VT100-style sequences (ESC[H = Home, ESC[F = End). Modern terminal
emulators emit the tilde form for most keys; we handle both.
(defparameter *csi-tilde-table*
'((1 . :home) (2 . :insert) (3 . :delete) (4 . :end)
(5 . :page-up) (6 . :page-down)
(11 . :f1) (12 . :f2) (13 . :f3) (14 . :f4)
(15 . :f5) (17 . :f6) (18 . :f7) (19 . :f8)
(20 . :f9) (21 . :f10) (23 . :f11) (24 . :f12)))CSI key table
The *csi-key-table* maps single-letter terminators from ESC[…letter~
sequences to semantic key names. These are the VT100/VT220-style cursor
and editing keys: A=up, B=down, C=right, D=left, F=end, H=home, plus
F1-F4 via P/Q/R/S and back-tab via Z.
These terminators come from the original DEC VT series and are still
emitted by most terminal emulators in "normal" (non-application) cursor
key mode. The :back-tab mapping for Z handles Shift+Tab, which some
emulators report as ESC[Z.
(defparameter *csi-key-table*
'((#\A . :up) (#\B . :down) (#\C . :right) (#\D . :left)
(#\F . :end) (#\H . :home)
(#\P . :f1) (#\Q . :f2) (#\R . :f3) (#\S . :f4)
(#\Z . :back-tab)))CSI parameter parser
parse-csi-params takes the numeric parameter list, the terminator
character, and the extended parameter vector, then constructs the
appropriate key-event.
The function handles three cases:
- Tilde-terminated sequences (
ESC[1~): look up the numeric parameter in*csi-tilde-table*. - Key-terminated sequences (
ESC[A,ESC[1;5B): look up the terminator character in*csi-key-table*and extract modifier information from the second parameter. - Unicode/u-terminated sequences (
ESC[NNNNu): decode a direct code point, used by kitty's keyboard protocol for unambiguous character reporting.
Modifier encoding follows the xterm convention: Shift=1, Alt=2, Ctrl=4. The extended parameter vector carries the raw parameter bytes for sequences where modifiers appear in a non-standard position.
(defun parse-csi-params (params terminator extended)
(let* ((key (if (find terminator '(#\~ #\u))
(cdr (assoc (first params) *csi-tilde-table*))
(cdr (assoc terminator *csi-key-table*))))
(modifier (when (and (> (length params) 1) (not (find terminator '(#\~ #\u))))
(second params)))
(actual-modifier (when (> (length extended) 1) (second extended)))
(ctrl nil) (alt nil) (shift nil))
(when modifier
(setf shift (logtest modifier 1)
alt (logtest modifier 2)
ctrl (logtest modifier 4)))
(when actual-modifier
(setf shift (or shift (logtest actual-modifier 1))
alt (or alt (logtest actual-modifier 2))
ctrl (or ctrl (logtest actual-modifier 4))))
(if (eql terminator #\u)
(let ((code (first params)))
(make-key-event :key :codepoint :code code
:ctrl ctrl :alt alt :shift shift
:raw (string (code-char code))))
(make-key-event :key (or key :unknown)
:ctrl ctrl :alt alt :shift shift
:raw (format nil "~C[~{~d~};~d~C" #\Esc params terminator)))))Raw byte reader
read-raw-byte is the lowest-level I/O function in the input system.
It reads exactly one byte from file descriptor 0 (stdin) using SBCL's
sb-unix:unix-read, bypassing the standard CL stream layer.
Why bypass read-char and listen? CL streams buffer input, which
interferes with the byte-at-a-time state machine of escape sequence
parsing. Once the stream has buffered bytes, listen may return T even
though the next byte belongs to a different sequence. Direct unix-read
gives us precise control over how many bytes we consume.
The timeout keyword uses sb-unix:unix-simple-poll to implement
non-blocking reads with a configurable deadline. This is critical for
the 50ms escape sequence ambiguity resolution in %read-escape-sequence.
Memory management: we allocate a 1-byte alien buffer, read into it, then
free-alien in an unwind-protect to prevent leaks even if the read
is interrupted by a signal.
(defun read-raw-byte (&key timeout)
(let* ((buf (sb-alien:make-alien sb-alien:unsigned-char 1))
(fd 0))
(unwind-protect
(if timeout
(progn (sb-unix:unix-simple-poll fd :input timeout)
(let ((n (sb-unix:unix-read fd buf 1)))
(if (= n 1) (sb-alien:deref buf 0) (values nil :eof))))
(let ((n (sb-unix:unix-read fd buf 1)))
(if (= n 1) (sb-alien:deref buf 0) (values nil :eof))))
(sb-alien:free-alien buf))))Escape sequence reader
%read-escape-sequence is called after the top-level reader has consumed
byte 0x1b (Escape). Its job is to resolve the classic terminal ambiguity:
is this a lone Escape key press, or the start of a multi-byte escape
sequence (CSI, SS3, etc.)?
The resolution strategy uses a 50ms timeout on the first follow-up byte:
- No byte within 50ms → the user pressed Escape. Return
:escape. - Byte is 0x5b ([) → CSI sequence. Delegate to
parse-csi-sequence. - Byte is 0x4f (O) → SS3 sequence. Read one more byte for F1-F4 or shifted cursor keys.
- Byte is 0x7f (DEL) → Alt+Backspace (a common terminal convention).
- Byte is < 0x20 → Ctrl+letter with Alt modifier.
- Any other byte → Alt+letter.
Why 50ms? This value is the de facto standard across terminal emulators and TUI frameworks. It's long enough that human key repeat rates (typ. 30-50ms between key repeat events) won't falsely trigger escape sequence detection, but short enough that the Escape key feels responsive. The Linux kernel's default key repeat rate uses a similar timing.
The SS3 path handles shifted cursor keys that some emulators report as
ESC O A through ESC O D (shifted up/down/right/left). These use a
different byte prefix from the CSI form ESC [ A through ESC [ D.
(defun %read-escape-sequence ()
(flet ((read-next (&optional (timeout nil))
(let ((b (read-raw-byte :timeout timeout)))
(unless b (return-from %read-escape-sequence
(make-key-event :key :escape :code 27)))
b)))
(let ((b1 (read-next 0.05)))
(cond
((null b1) (make-key-event :key :escape :code 27))
((= b1 79) (let ((b2 (read-next)))
(case b2
(80 (make-key-event :key :f1))
(81 (make-key-event :key :f2))
(82 (make-key-event :key :f3))
(83 (make-key-event :key :f4))
(72 (make-key-event :key :home))
(70 (make-key-event :key :end))
(65 (make-key-event :key :up :shift t))
(66 (make-key-event :key :down :shift t))
(67 (make-key-event :key :right :shift t))
(68 (make-key-event :key :left :shift t))
(otherwise (make-key-event :key :unknown :raw (string (code-char b2)))))))
((= b1 91) (parse-csi-sequence))
((= b1 127) (make-key-event :key :alt-backspace))
((< b1 32)
(let ((c (code-char (+ b1 96))))
(make-key-event :key (intern (string-upcase (string c)) :keyword)
:alt t :code b1)))
(t (make-key-event :key (intern (string-upcase (string (code-char b1))) :keyword)
:alt t :code b1))))))CSI sequence parser
parse-csi-sequence reads and parses a full Control Sequence Introducer
sequence: ESC [ (param) (terminator).
The function implements a recursive descent parser for the CSI grammar:
- Read the first byte after
ESC [. - If it's a digit (0x30-0x39), collect all consecutive digits as the first parameter, then the next non-digit byte is the terminator.
- If it's not a digit, it may be a modifier byte (0x3B = semicolon, in extended sequences) or the terminator itself.
The extended array accumulates raw parameter bytes for sequences where
the modifier appears after the primary parameter in an extended format
(e.g., ESC [ 1 ; 5 A where 5 encodes Ctrl+Shift). This array is passed
to parse-csi-params for modifier extraction.
The two-pass approach (parse bytes → look up semantics) cleanly separates the byte-level parsing concern from the key-mapping concern, making both easier to test and debug independently.
(defun parse-csi-sequence ()
(flet ((read-param (next-fn) (let ((acc nil))
(loop for b = (funcall next-fn)
do (if (and (>= b 48) (<= b 57))
(push (- b 48) acc)
(return (values (reverse acc) b)))))))
(let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))
(b2 (read-raw-byte))
(params (if (and (>= b2 48) (<= b2 57))
(multiple-value-bind (p term) (read-param (lambda () (read-raw-byte)))
(setf (fill-pointer extended) (length p))
(replace extended p)
(values p term))
(progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte)))))))
(destructuring-bind (params terminator) params
(parse-csi-params params terminator extended)))))UTF-8 decoder
utf8-decode converts a list of raw bytes (2 to 4 of them) into a Unicode
code point. It validates the byte sequence against the UTF-8 encoding rules
and returns nil for invalid sequences.
UTF-8 encoding structure:
- 2-byte: 110xxxxx 10xxxxxx (U+0080 through U+07FF)
- 3-byte: 1110xxxx 10xxxxxx 10xxxxxx (U+0800 through U+FFFF)
- 4-byte: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx (U+10000 through U+10FFFF)
Each case performs:
- Range validation on the leading byte (ensuring it's in the correct pattern).
- Continuation byte validation (each must be 10xxxxxx, i.e., 0x80-0xBF).
- Bit masking and shifting to extract the code point.
This approach is intentionally simple and table-free. For terminal input,
sequences are always short (2-4 bytes), dispatched by the leading byte
category (%read-event classifies them), so a compact case form is both
efficient and easy to audit for correctness.
Overlong sequences (e.g., encoding ASCII in 2+ bytes) are rejected because
the range checks on the leading byte exclude them: a 2-byte sequence with
b0=0xC0 would have (= #xc2 b0 #xdf) fail since 0xC0 < 0xC2.
(defun utf8-decode (bytes)
(case (length bytes)
(2 (let ((b0 (first bytes)) (b1 (second bytes)))
(when (and (<= #xc2 b0 #xdf) (<= #x80 b1 #xbf))
(+ (ash (logand b0 #x1f) 6) (logand b1 #x3f)))))
(3 (let ((b0 (first bytes)) (b1 (second bytes)) (b2 (third bytes)))
(when (and (<= #xe0 b0 #xef) (<= #x80 b1 #xbf) (<= #x80 b2 #xbf))
(+ (ash (logand b0 #x0f) 12) (ash (logand b1 #x3f) 6) (logand b2 #x3f)))))
(4 (let ((b0 (first bytes)) (b1 (second bytes)) (b2 (third bytes)) (b3 (fourth bytes)))
(when (and (<= #xf0 b0 #xf4) (<= #x80 b1 #xbf) (<= #x80 b2 #xbf) (<= #x80 b3 #xbf))
(+ (ash (logand b0 #x07) 18) (ash (logand b1 #x3f) 12)
(ash (logand b2 #x3f) 6) (logand b3 #x3f)))))
(t nil)))Top-level event reader
%read-event is the main entry point for terminal input parsing. It reads
one byte, classifies it, and returns an appropriate event.
The classification hierarchy:
~x1b (Escape) → delegate to ~%read-escape-sequence.~x09 (Tab) → ~:tabwith code ~~x09.~x0a (LF) or ~~x0d (CR) → ~:enter.~x7f (DEL) or ~~x08 (BS) → ~:backspace.- Byte range ~~x01-~~x1a → Ctrl+letter (Ctrl+A through Ctrl+Z). The offset ~~x60 converts the control code to its corresponding printable character: ~~x01 + ~~x60 = #\a = code 97.
- ~~x1c-~~x1f → Ctrl+\ through Ctrl+_ with specific key names.
- Byte range ~~x20-~~x7e → printable ASCII, interned as keyword (uppercased).
- Byte >= ~~xc2 → Start of UTF-8 multi-byte sequence. Read the
continuation bytes (up to 3 more) with a 500ms timeout each.
If enough valid bytes arrive, decode via
utf8-decode. - Anything else →
:unknown.
The Ctrl+letter mapping (~~x01-~~x1a → Ctrl+A..Ctrl+Z) follows the
standard ASCII control code layout where Ctrl+letter subtracts 0x60
from the uppercase letter's code point. For example, Ctrl+A (SOH) is
~x01, and ~~x01 + ~~x60 = 97 = #\a, which interns as ~:a.
Why 500ms for UTF-8 continuation byte timeout? This is intentionally longer than the 50ms escape-sequence timeout. UTF-8 sequences are streamed in real time from the terminal; if we're too aggressive, we might cut off a multi-byte character during a slow paste or network connection. The 500ms gives the terminal ample time to deliver all bytes.
(defun %read-event (&key timeout)
(multiple-value-bind (b reason) (read-raw-byte :timeout timeout)
(unless b (return-from %read-event (if (eq reason :eof) :eof nil)))
(cond
((= b #x1b) (%read-escape-sequence))
((= b #x09) (make-key-event :key :tab :code #x09))
((= b #x0a) (make-key-event :key :enter :code #x0a))
((= b #x0d) (make-key-event :key :enter :code #x0d))
((or (= b #x7f) (= b #x08)) (make-key-event :key :backspace :code b))
((and (>= b #x01) (<= b #x1a))
(let ((key (intern (string-upcase (string (code-char (+ b #x60)))) :keyword)))
(make-key-event :key key :ctrl t :code b)))
((= b #x1c) (make-key-event :key :backslash :ctrl t :code b))
((= b #x1d) (make-key-event :key :rbracket :ctrl t :code b))
((= b #x1e) (make-key-event :key :caret :ctrl t :code b))
((= b #x1f) (make-key-event :key :underscore :ctrl t :code b))
((and (>= b #x20) (<= b #x7e))
(let ((ch (code-char b)))
(make-key-event :key (intern (string (string-upcase ch)) :keyword) :code b)))
((>= b #xc2)
(let* ((n (cond ((<= b #xdf) 2) ((<= b #xef) 3) (t 4)))
(bytes (list b)))
(loop for i from 1 below n
for b2 = (multiple-value-bind (byte reason) (read-raw-byte :timeout 0.5)
(declare (ignore reason)) byte)
while (and b2 (<= #x80 b2 #xbf))
do (push b2 bytes))
(setf bytes (nreverse bytes))
(if (= (length bytes) n)
(let ((cp (utf8-decode bytes)))
(if cp (make-key-event :key :codepoint :code cp :raw (map 'string #'code-char bytes))
(make-key-event :key :unknown :raw (map 'string #'code-char bytes))))
(make-key-event :key :unknown :raw (map 'string #'code-char bytes)))))
(t (make-key-event :key :unknown :code b :raw (string (code-char b)))))))Terminal resize detection
*terminal-resized-p* is a flag set by a SIGWINCH signal handler.
When the terminal emulator window is resized, the kernel sends SIGWINCH
to the foreground process group. SBCL's signal handling facility
(sb-sys:enable-interrupt) lets us install a handler that sets this
flag.
The main event loop should check this flag after each %read-event
call and, if set, query the new terminal dimensions and redraw. The
flag is not automatically cleared — the consumer must set it to nil
after handling the resize.
(defvar *terminal-resized-p* nil)#+sbcl
(eval-when (:load-toplevel :execute)
(sb-sys:enable-interrupt sb-posix:sigwinch
(lambda (signal info context)
(declare (ignore signal info context))
(setf *terminal-resized-p* t))))Backend protocol integration
read-event is a defmethod on the backend generic function, part of the
cl-tty backend protocol. This allows the same application code to read
input regardless of which backend is active.
The implementation probes /dev/stdin (which is a symlink to the actual
terminal device when stdin is a terminal) and, if it exists, delegates to
%read-event. The (declare (ignore b)) means this method ignores the
backend instance — terminal input is independent of the output backend.
This method is deliberately simple: it's a thin wrapper that adapts the
%read-event API to the backend protocol's read-event generic function.
All the complexity lives in %read-event and its callees.
(defmethod read-event ((b cl-tty.backend:backend) &key timeout)
;; Check for pending terminal resize before reading input.
;; The SIGWINCH handler sets *terminal-resized-p* asynchronously.
(when *terminal-resized-p*
(setf *terminal-resized-p* nil)
(multiple-value-bind (w h) (backend-size b)
(return-from read-event (values :resize (cons w h)))))
(when (probe-file "/dev/stdin")
(%read-event :timeout timeout)))Textarea Widget
The textarea is a multi-line text editing widget with undo/redo support, cursor movement across lines, and line-based operations (newline, join, delete at line boundaries).
All blocks tangle to ../src/components/textarea.lisp.
Textarea class definition
The textarea class inherits from dirty-mixin (from cl-tty.box) for
automatic dirty-flag tracking used by the rendering pipeline. Key slots:
value: The full text content as a single string with embedded newlines.cursor-row/cursor-col: The cursor position in row/column coordinates. Row 0 is the first line ofvalue; col 0 is the first character of that line.selection-start: Cursor position when a selection began (nil when no selection).undo-stack/redo-stack: Fill-pointer vectors (capacity 100) for linear undo/redo. The fill-pointer acts as a stack pointer —vector-pushpushes,vector-poppops, and resetting the fill-pointer to 0 clears.on-submit: Optional callback invoked on Enter when set. If nil, Enter inserts a newline.layout-node: Position/size info for the rendering system.focusable: Whether this widget can receive keyboard focus.
Why fill-pointer vectors instead of lists for undo/redo? Vectors provide
O(1) indexed access, bounded memory (capacity 100), and vector-push
avoids consing on every keystroke. The eviction strategy (oldest entries
shift out when full) keeps memory bounded.
This is the first block tangling to textarea.lisp, so it includes the
in-package form.
(in-package #:cl-tty.input)
(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)))Textarea constructor
make-textarea is a convenience constructor that wraps make-instance
with sensible defaults. It accepts :value and :on-submit keyword
arguments, defaulting value to the empty string if not provided.
The constructor is a separate function rather than a :constructor
option on defclass because it needs to normalize the value argument
(or value "") — a pattern that would clutter the class definition.
(defun make-textarea (&key value on-submit)
(make-instance 'textarea
:value (or value "")
:on-submit on-submit))Line helpers
The textarea-lines function splits the value into a list of lines.
It delegates to %split-string (defined in input.lisp) with #\Newline
as the separator. For an empty string, this returns ("") — one empty
line, which is the correct representation of a blank document.
textarea-line-count is a simple wrapper for the number of lines.
It's used by cursor movement functions to clamp the cursor row.
(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)))Cursor clamping
textarea-ensure-cursor clamps the cursor position to valid ranges
after any operation that might move it out of bounds. It:
- Clamps
cursor-rowto [0, line-count-1]. - Clamps
cursor-colto [0, current-line-length].
This function is called after every cursor movement and after edits that change line structure (newline, backspace joining lines). It also marks the widget dirty, ensuring the renderer picks up the cursor position change.
(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)))))
(mark-dirty ta))Line joiner utility
%join-lines is the inverse of %split-string: it takes a sequence of
strings (list or vector) and joins them with #\Newline separators. It
uses with-output-to-string for efficient string construction.
The function handles both lists and vectors because different parts of
the textarea code work with different representations — textarea-lines
returns a list, but the insertion/backspace code operates on vectors
for efficient element replacement.
(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))))Character insertion
textarea-insert-char inserts a single character at the cursor position
within the current line. The algorithm:
- Push undo state (so the insertion can be undone).
- Split the value into lines (coerced to vector for indexed access).
- If the cursor row is within the current line count, insert the character into that line at the cursor column by concatenating the prefix, the character, and the suffix.
- If the cursor row is beyond the last line (shouldn't happen with proper cursor clamping, but handled defensively), append the character to the end of the full value.
The function updates cursor-col by 1 after insertion and marks the
widget dirty.
(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)))))Newline insertion
textarea-newline splits the current line at the cursor column and
inserts a newline character between the two halves.
Algorithm:
- Push undo state.
- Split the value into lines (coerced to vector).
- If the cursor row is valid, split the current line into
before(characters before cursor) andafter(characters after). - Replace the current line with
beforeand insertafteras a new line immediately after. - Move cursor to the start of the new line (row+1, col=0).
- If the cursor row is beyond the last line, simply append a newline.
- Mark dirty.
(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)))))Backspace
textarea-backspace handles both character deletion and line joining:
- At (0,0): nothing to delete — return nil.
- At column 0 (start of a non-first line): join the current line with the previous line. Cursor moves to the end of the previous line.
- At any other column: delete the character before the cursor within the current line.
The line-joining behavior is what distinguishes multi-line backspace from single-line backspace. When the cursor is at column 0 of a line, backspace conceptually "pulls" that line up to the end of the previous line, removing the newline character between them.
All paths push undo state before modifying the value.
(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: up/down
textarea-move-up and textarea-move-down move the cursor between lines
while preserving the column position as much as possible. The decrement
or increment on cursor-row may produce a row outside the valid range,
but textarea-ensure-cursor clamps it immediately afterward.
The column preservation is implicit: textarea-ensure-cursor clamps
the column to the new line's length, so if the user was at column 10
on a long line and moves up to a shorter 5-character line, the column
clamps to 5. This matches how most editors handle column preservation
— the column "remembers" its position but is constrained by line length.
(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 system
The undo system uses fill-pointer vectors as bounded stacks (capacity 100). Each edit pushes the current value onto the undo stack before modifying it.
textarea-push-undo: Saves the current value onto the undo stack.
If the stack is full (fill-pointer >= total-size), it shifts all entries
left by one (dropping the oldest) and decrements the fill-pointer, making
room for the new entry. It then pushes the current value and clears the
redo stack (any new edit invalidates the redo history).
textarea-undo: Pops the most recent value from the undo stack, pushes
the current value onto the redo stack, restores the popped value, and
clamps the cursor via textarea-ensure-cursor.
textarea-redo: Pops the most recent value from the redo stack, pushes
the current value onto the undo stack, restores the popped value, and
clamps the cursor.
Why clear the redo stack on new edits? This is the standard "linear undo" model — once you make a new edit after undoing, the redo history is discarded because the edit graph has branched. Implementing a full tree undo would be significantly more complex and is unnecessary for a TUI textarea.
(defun textarea-push-undo (ta)
"Save current value on undo stack."
(let ((stack (textarea-undo-stack ta)))
(when (>= (length stack) (array-total-size stack))
(loop for i from 1 below (length stack)
do (setf (aref stack (1- i)) (aref stack i)))
(decf (fill-pointer stack)))
(vector-push (textarea-value ta) stack)
(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)))))Textarea key event handler
handle-textarea-input is the main event dispatcher for the textarea.
It processes key-event instances and delegates to the appropriate
textarea operation or performs inline actions.
Ctrl+key bindings:
- Ctrl+Z → undo
- Ctrl+Y → redo
- Ctrl+A → home (move cursor-col to 0 on current line)
- Ctrl+E → end (move cursor-col to end of current line)
Unmodified key bindings:
- :left/:right → column movement with cursor clamping
- :up/:down → row movement with cursor clamping
- :home/:end → column extremes
- :enter → on-submit callback if set, otherwise insert newline
- :backspace → delete before cursor / join lines
- :delete → delete at cursor (character under cursor)
- Other printable characters → insert at cursor via
key-event-code
The printable character insertion uses code-char on key-event-code
rather than looking at key-event-key. This is because key-event-key
is always an uppercase keyword (:a for both 'a' and 'A'), but the
code preserves the actual character.
(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)
(textarea-ensure-cursor ta))
(: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))))
(textarea-ensure-cursor ta)))
(: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))))))))Textarea rendering
render for textarea draws the visible portion of the text content
within the widget's layout bounds. It:
- Retrieves the layout node for position and size.
- Splits the value into lines.
- Loops over the visible lines (up to the available height).
- For each line, draws it at the correct position, truncating to the available width.
The render method iterates max-lines (minimum of total lines and
available height) to avoid drawing outside the widget boundaries.
Each line is truncated to w characters to prevent horizontal overflow.
Cursor rendering is handled by the focus/selection rendering layer, not by this method. This keeps the render method simple — it just paints text.
(defmethod render ((ta textarea) (backend t))
"Render textarea lines at layout position."
(let* ((ln (textarea-layout-node ta))
(x (if ln (layout-node-x ln) 0))
(y (if ln (layout-node-y ln) 0))
(w (if ln (layout-node-width ln) 80))
(h (if ln (layout-node-height ln) 24))
(lines (textarea-lines ta))
(max-lines (min (length lines) h)))
(loop for i from 0 below max-lines
for line in lines
do (draw-text backend x (+ y i)
(subseq line 0 (min (length line) w))
nil nil))))Text Input Widget
TextInput is a single-line text editing widget with cursor movement, character insertion/deletion, word deletion, and emacs-style keyboard shortcuts.
All blocks tangle to ../src/components/text-input.lisp.
Text input class definition
The TextInput class inherits from dirty-mixin for automatic dirty
tracking. Slots:
value: The text content (single line, no newline characters).cursor: The cursor position as a 0-indexed integer offset from the start ofvalue.placeholder: Text displayed whenvalueis empty, giving the user a hint about what to type.max-length: Optional maximum character count. When set, insertions beyond this limit are silently rejected.on-submit: Callback invoked with the current value when Enter is pressed.layout-node: Position/size info for rendering.focusable: Whether this widget can receive keyboard focus.
This is the first block tangling to text-input.lisp, so it includes the
in-package form.
(in-package #:cl-tty.input)
(defclass text-input (dirty-mixin)
((value :initform "" :initarg :value :accessor text-input-value
:type string)
(cursor :initform 0 :initarg :cursor :accessor text-input-cursor
:type fixnum)
(placeholder :initform "" :initarg :placeholder
:accessor text-input-placeholder :type string)
(max-length :initform nil :initarg :max-length
:accessor text-input-max-length)
(on-submit :initform nil :initarg :on-submit
:accessor text-input-on-submit)
(layout-node :initform (make-layout-node) :accessor text-input-layout-node)
(focusable :initform t :accessor text-input-focusable)))Text input constructor
make-text-input wraps make-instance with keyword arguments and
sensible defaults. Each optional parameter has a fallback: value
defaults to "", cursor to 0, placeholder to "", and max-length
and on-submit to nil (disabled).
The (or value "") pattern ensures the value is always a string,
even if the caller passes nil. This eliminates a class of nil-pointer
errors in string operations downstream.
(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))Character insertion
text-input-insert inserts a character at the cursor position within
the single-line value. The algorithm:
- Check
max-length: if set and the value is already at the limit, return immediately (the character is silently dropped). - Construct the new value by concatenating the prefix (before cursor), the new character, and the suffix (after cursor).
- Increment the cursor by 1.
- Mark the widget dirty.
This is a pure insert — it does not replace the character at the cursor; it shifts subsequent characters right. For overwrite behavior, the caller would need a different function.
(defun text-input-insert (input char)
(let* ((val (text-input-value input))
(pos (text-input-cursor input))
(max (text-input-max-length input)))
(when (and max (>= (length val) max)) (return-from text-input-insert))
(setf (text-input-value input) (concatenate 'string (subseq val 0 pos) (string char) (subseq val pos)))
(incf (text-input-cursor input))
(mark-dirty input)))Backspace
text-input-backspace deletes the character immediately before the
cursor. If the cursor is at position 0, nothing happens.
The algorithm concatenates the prefix (up to one before cursor) with the suffix (from cursor onward), effectively removing the character at cursor-1. The cursor is decremented by 1.
(defun text-input-backspace (input)
(let* ((val (text-input-value input)) (pos (text-input-cursor input)))
(when (zerop pos) (return-from text-input-backspace))
(setf (text-input-value input) (concatenate 'string (subseq val 0 (1- pos)) (subseq val pos)))
(decf (text-input-cursor input))
(mark-dirty input)))Delete
text-input-delete removes the character at the cursor position.
If the cursor is at or beyond the end of the value, nothing happens.
The algorithm concatenates the prefix (up to cursor) with the suffix (from cursor+1 onward), removing the character at cursor without moving the cursor position.
This contrasts with backspace, which removes the character before cursor and decrements the cursor.
(defun text-input-delete (input)
(let* ((val (text-input-value input)) (pos (text-input-cursor input)))
(when (>= pos (length val)) (return-from text-input-delete))
(setf (text-input-value input) (concatenate 'string (subseq val 0 pos) (subseq val (1+ pos))))
(mark-dirty input)))Cursor movement: left/right
text-input-move-left and text-input-move-right move the cursor by
one character position, clamped to [0, length]. Left movement stops at
0; right movement stops at the end of the value.
Each movement function marks the widget dirty so the renderer redraws the cursor position.
(defun text-input-move-left (input)
(when (plusp (text-input-cursor input)) (decf (text-input-cursor input)))
(mark-dirty input))(defun text-input-move-right (input)
(when (< (text-input-cursor input) (length (text-input-value input))) (incf (text-input-cursor input)))
(mark-dirty input))Cursor movement: home/end
text-input-move-home moves the cursor to position 0 (start of value).
text-input-move-end moves the cursor to the end of the value.
These are the programmatic equivalents of the Home and End keys and are also used by the Ctrl+A and Ctrl+E keybindings.
(defun text-input-move-home (input)
(setf (text-input-cursor input) 0)
(mark-dirty input))(defun text-input-move-end (input)
(setf (text-input-cursor input) (length (text-input-value input)))
(mark-dirty input))Word-delete before cursor
text-input-delete-word-before implements Ctrl+W / Emacs backward-kill-word.
It deletes from the cursor position backward to the previous word boundary.
The algorithm:
- Find the last non-space character before the cursor (
start). If none exists,startis 0. - Find the last space character before
start. If none,word-startis 0. -
Compute
delete-start: the position from which to start deleting.- If word-start is 0 and the first character is non-space (or start is 0), delete from 0.
- Otherwise, delete from one past the last space (i.e., the start of the word before the cursor).
A "word" here is defined as a run of non-space characters. This matches the shell/Emacs convention for Ctrl+W rather than an English word boundary (which would involve punctuation handling).
(defun text-input-delete-word-before (input)
(let* ((val (text-input-value input)) (pos (text-input-cursor input)))
(when (zerop pos) (return-from text-input-delete-word-before))
(let* ((start (or (position-if (lambda (c) (not (char= c #\Space))) val :end pos :from-end t) 0))
(word-start (or (and (plusp start) (position #\Space val :end start :from-end t)) 0))
(delete-start (if (and (zerop word-start) (or (char/= (char val 0) #\Space) (zerop start)))
0
(if (zerop start) (1+ word-start) (1+ (or (position #\Space val :end start :from-end t) 0))))))
(setf (text-input-value input) (concatenate 'string (subseq val 0 delete-start) (subseq val pos)))
(setf (text-input-cursor input) delete-start)
(mark-dirty input))))Text input key event handler
handle-text-input is the main event dispatcher for TextInput.
Ctrl+key bindings (Emacs-style):
- Ctrl+A → move to home (start of line)
- Ctrl+E → move to end
- Ctrl+W → delete word before cursor
- Ctrl+U → delete from cursor to start of line
- Ctrl+K → delete from cursor to end of line
Unmodified key bindings:
- :left/:right → cursor movement
- :home/:end → extremes
- :backspace/:delete → character deletion
- :enter → invoke on-submit callback with current value
- :tab/:escape → ignored (no-op)
- Other → insert as printable character via
key-event-code
The printable character check uses graphic-char-p to ensure only
visible characters (letters, digits, punctuation, symbols) are
inserted. Control characters and spaces are handled by their specific
key bindings.
(defun handle-text-input (input event)
(cond
((key-event-ctrl event)
(case (key-event-key event)
(:a (text-input-move-home input))
(:e (text-input-move-end input))
(:w (text-input-delete-word-before input))
(:u (progn (setf (text-input-value input) (subseq (text-input-value input) (text-input-cursor input)))
(setf (text-input-cursor input) 0) (mark-dirty input)))
(:k (progn (setf (text-input-value input) (subseq (text-input-value input) 0 (text-input-cursor input)))
(mark-dirty input)))
(t nil)))
(t
(case (key-event-key event)
(:left (text-input-move-left input))
(:right (text-input-move-right input))
(:home (text-input-move-home input))
(:end (text-input-move-end input))
(:backspace (text-input-backspace input))
(:delete (text-input-delete input))
(:enter (let ((cb (text-input-on-submit input))) (when cb (funcall cb (text-input-value input)))))
(:tab nil) (:escape nil)
(otherwise (let ((ch (code-char (key-event-code event))))
(when (and ch (graphic-char-p ch)) (text-input-insert input ch))))))))Text input rendering
render for TextInput draws the current value (or placeholder if the
value is empty) at the widget's layout position, truncated to the
available width.
Rendering steps:
- Retrieve the layout node for position (x, y) and width (w).
- Determine display text: if value is non-empty, use it; otherwise use the placeholder (or empty string if placeholder is also empty).
- Truncate the display text to the available width.
- Draw the truncated text at (x, y) using the backend's
draw-text. - Draw the cursor as a block character ("█") at the cursor position if the value is non-empty.
The cursor is a solid block ("█") drawn at the cursor column offset from the text start. If the cursor is beyond the truncated display width, it's clamped to the last visible position.
(defmethod render ((in text-input) (backend t))
(let* ((ln (text-input-layout-node in))
(x (if ln (layout-node-x ln) 0)) (y (if ln (layout-node-y ln) 0))
(w (if ln (layout-node-width ln) 80))
(value (text-input-value in)) (cursor (text-input-cursor in))
(display (if (plusp (length value)) value (or (text-input-placeholder in) "")))
(truncated (subseq display 0 (min (length display) w))))
(draw-text backend x y truncated nil nil)
(when (plusp (length value))
(let ((cursor-col (min cursor (length truncated))))
(draw-text backend (+ x cursor-col) y "█" :bright-white nil)))))Keybinding System
The keybinding system provides a flexible dispatch mechanism for routing keystrokes to handler functions through layered keymaps. Keymaps are named and stored in a global registry, allowing components to install local keymaps that fall through to global keymaps.
All blocks tangle to ../src/components/keybindings.lisp.
Keymap struct
The keymap struct is a simple data container with three slots:
name: A keyword identifier (e.g.,:global,:local).bindings: An alist of (spec . handler) pairs.parent: An optional parent keymap for inheritance (reserved for future use — currently the fallback chain is handled by name-based lookup indispatch-key-event, not by theparentslot).
Like key-event, this is a struct rather than a class because keymaps
are created frequently and never need CLOS dispatch on their own — all
polymorphism is handled by the dispatch function.
This is the first block tangling to keybindings.lisp, so it includes
the in-package form.
(in-package #:cl-tty.input)
(defstruct keymap
(name nil :type (or keyword null))
(bindings nil :type list)
(parent nil :type (or keymap null)))Global keymap registry
*keymaps* is a hash table mapping keyword names (:global, :local)
to keymap instances. The equal test allows string-keyword flexibility
(though in practice all keys are keywords).
*chord-timeout* is a 0.5-second timeout reserved for future multi-key
chord support (e.g., (:ctrl+x :ctrl+s)). Currently only single-key
specs work; the timeout and list-of-lists spec syntax are placeholders
for the eventual chord implementation.
(defparameter *keymaps* (make-hash-table :test #'equal))(defparameter *chord-timeout* 0.5)Key spec matching
key-match-p compares a key specification (spec) against a key-event.
The spec can be:
-
A keyword, like
:ctrl+p,:alt+f,:enter,:f1.- If the keyword contains
+, the part before+is the modifier (CTRL, ALT, or SHIFT) and the part after is the key. - Modifier names are matched case-insensitively with
string=?, avoiding thecaseEQL trap (where:CTRL+pand:ctrl+pwould be different symbols). - If no
+, the keyword is matched againstkey-event-keydirectly.
- If the keyword contains
-
A list, like
(:ctrl+p)or(:ctrl+x :ctrl+s).- Currently only the first element is matched; the list form exists for future chord support.
The modifier matching uses string=? on the modifier part because
:CTRL+p and :Ctrl+p should both match Ctrl events. Using eql
on the keyword would make them different specifiers, which is unexpected
for users writing :ctrl+p in their keymaps.
(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)))))Event dispatch
dispatch-key-event is the main entry point for the keybinding system.
It implements a three-level lookup chain:
- Component keymap (:keyword parameter): If the caller supplies a
component, the function callscomponent-keymapon it to get a component-specific keymap. Matches in this keymap take highest priority. - :local keymap: Look up the
:localkeymap in*keymaps*. This is typically installed by the active "screen" or "mode" (e.g., a help overlay might have its own local keymap). - :global keymap: Look up the
:globalkeymap. This is the catch-all for application-wide bindings.
Each level iterates the keymap's bindings alist and returns t as soon
as a matching handler is found and called. If no binding matches at any
level, returns nil.
Important caveat: This function is NOT called automatically by the demo's
event loop or widget event handlers. Users who want keymap-based dispatch
MUST call dispatch-key-event explicitly in their own event loops, e.g.:
(defun handle-event (event) (or (dispatch-key-event event) (handle-text-input my-input event) …))
Chords ((:ctrl+x :ctrl+s)) are not yet supported; only single
key specs work. The *chord-timeout* variable and list-of-lists syntax
are reserved for future implementation.
(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
defkeymap is a convenience macro that registers a keymap in the global
*keymaps* hash table. Syntax:
(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 keymap protocol
component-keymap is a generic function that returns a keymap instance
for a given component, or nil if the component has no keymap. The default
method on t returns nil, meaning components must explicitly define a
method to participate in the keymap system.
This generic function allows the dispatch system to query any object for its keymap, enabling per-component keybinding customization without requiring components to inherit from a specific base class.
;;; --- Component protocol integration ---
(defgeneric component-keymap (component)
(:method ((c t)) nil))Tests
The test suite is tangled to ../tests/input-tests.lisp and covers:
- Key event construction and accessor correctness
- Mouse event construction and accessor correctness
- UTF-8 decoding (Latin-1 supplement, Euro sign, emoji, invalid sequences)
- TextInput operations (insert, backspace, delete, cursor movement, home/end, max-length, placeholder, on-submit, Ctrl+A/E, insertion in middle, dirty tracking)
- Textarea operations (empty, newline, cursor up/down, bounds, backspace line-joining, undo, redo)
- Keybinding dispatch (simple match, no match, fallthrough, key-spec matching with all modifiers, list-form specs, return values, empty keymap, local-over-global, multiple bindings, defkeymap macro)
(defpackage :cl-tty-input-test
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export #:run-tests))
(in-package :cl-tty-input-test)
(def-suite input-suite :description "Text input and keybinding tests")
(in-suite input-suite)
(defun run-tests ()
(let ((result (run 'input-suite)))
(fiveam:explain! result)
(uiop:quit 0)))
;; ── Key Event Tests ─────────────────────────────────────────────
(test key-event-construction
"A key-event can be created and queried."
(let ((e (make-key-event :key :a :ctrl t :alt nil)))
(is (eql (key-event-key e) :a))
(is-true (key-event-ctrl e))
(is-false (key-event-alt e))))
(test key-event-defaults
"Fields default to NIL/nil."
(let ((e (make-key-event :key :space)))
(is (eql (key-event-key e) :space))
(is-false (key-event-ctrl e))
(is-false (key-event-alt e))
(is-false (key-event-shift e))))
(test mouse-event-construction
"A mouse-event can be created and queried."
(let ((e (make-mouse-event :type :press :button :left :x 10 :y 5)))
(is (eql (mouse-event-type e) :press))
(is (eql (mouse-event-button e) :left))
(is (= (mouse-event-x e) 10))
(is (= (mouse-event-y e) 5))))
;; ── UTF-8 Decode Tests ──────────────────────────────────────────
(test utf8-decode-latin1-supplement
"0xC3 0xA9 (é) decodes to code point 233."
(is (= (cl-tty.input:utf8-decode '(#xc3 #xa9)) 233)))
(test utf8-decode-euro-sign
"0xE2 0x82 0xAC (€) decodes to code point 8364."
(is (= (cl-tty.input:utf8-decode '(#xe2 #x82 #xac)) 8364)))
(test utf8-decode-emoji
"0xF0 0x9F 0x92 0xA9 (💩) decodes to code point 128169."
(is (= (cl-tty.input:utf8-decode '(#xf0 #x9f #x92 #xa9)) 128169)))
(test utf8-decode-invalid-short
"Invalid byte 0x80 alone returns nil."
(is-false (cl-tty.input:utf8-decode '(#x80))))
(test utf8-decode-invalid-overlong
"Overlong 2-byte sequence 0xC0 0x80 returns nil."
(is-false (cl-tty.input:utf8-decode '(#xc0 #x80))))
;; ── 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) (format nil "a~Cb" #\Newline)))))
(test textarea-cursor-up-down
"Cursor moves between lines maintaining column position."
(let ((a (make-textarea :value (format nil "abc~Cde~Cfghi" #\Newline #\Newline))))
(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 (format nil "a~Cb" #\Newline))))
(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 (format nil "hello~Cworld" #\Newline))))
(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 ────────────────────────────────────────────
;; These tests verify the keymap dispatch system works correctly
;; when wired up. Note: dispatch-key-event is NOT called by the
;; demo's event loop — users MUST call it explicitly in their own
;; event loops if they want to use the defkeymap/dispatch-key-event
;; system. See src/components/keybindings.lisp for details.
;;
;; Chords ((:ctrl+x :ctrl+s)) are not yet supported; only single
;; key specs work. The *chord-timeout* variable and list-of-lists
;; syntax are reserved for future implementation.
(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 key-spec-alt-modifier
"Alt modifier is matched correctly."
(is-true (key-match-p :alt+x (make-key-event :key :x :alt t)))
(is-false (key-match-p :alt+x (make-key-event :key :x)))
(is-false (key-match-p :alt+x (make-key-event :key :x :ctrl t))))
(test key-spec-shift-modifier
"Shift modifier is matched correctly."
(is-true (key-match-p :shift+tab (make-key-event :key :tab :shift t)))
(is-false (key-match-p :shift+tab (make-key-event :key :tab))))
(test key-spec-plain
"Plain key spec matches unmodified keys."
(is-true (key-match-p :enter (make-key-event :key :enter)))
(is-true (key-match-p :escape (make-key-event :key :escape)))
(is-false (key-match-p :enter (make-key-event :key :escape))))
(test key-spec-list-form
"List-form spec (:ctrl+p) matches same as keyword :ctrl+p."
(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))))
(test dispatch-return-value-match
"dispatch-key-event returns T on matching binding."
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+p . ,(lambda (e) (declare (ignore e)))))))
(is-true (dispatch-key-event (make-key-event :key :p :ctrl t))))
(test dispatch-return-value-no-match
"dispatch-key-event returns NIL when no binding matches."
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+p . ,(lambda (e) (declare (ignore e)))))))
(is-false (dispatch-key-event (make-key-event :key :a))))
(test dispatch-empty-keymap
"dispatch-key-event returns NIL on empty keymap."
(setf (gethash :global *keymaps*) (make-keymap :name :global))
(is-false (dispatch-key-event (make-key-event :key :a))))
(test dispatch-local-overrides-global
"Local keymap takes priority over global."
(let ((local-called nil) (global-called nil))
(setf (gethash :local *keymaps*)
(make-keymap :name :local
:bindings `((:ctrl+p . ,(lambda (e)
(declare (ignore e))
(setf local-called t))))))
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+p . ,(lambda (e)
(declare (ignore e))
(setf global-called t))))))
(is-true (dispatch-key-event (make-key-event :key :p :ctrl t)))
(is-true local-called)
(is-false global-called)))
(test dispatch-multiple-bindings
"dispatch-key-event finds the right binding among many."
(let ((called nil))
(setf (gethash :global *keymaps*)
(make-keymap :name :global
:bindings `((:ctrl+a . (lambda (e) (declare (ignore e))))
(:ctrl+b . (lambda (e) (declare (ignore e))))
(:ctrl+c . ,(lambda (e)
(declare (ignore e))
(setf called t)))
(:ctrl+d . (lambda (e) (declare (ignore e)))))))
(is-true (dispatch-key-event (make-key-event :key :c :ctrl t)))
(is-true called)))
(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)))
(test defkeymap-macro-with-list-spec
"defkeymap macro works with list-form specs."
(let ((called nil))
(eval `(defkeymap :global
((:ctrl+w) ,(lambda (e) (declare (ignore e)) (setf called t)))))
(dispatch-key-event (make-key-event :key :w :ctrl t))
(is-true called)))
;; cleanup after keybinding tests
(test keybinding-cleanup-global
"Clean up global keymap after testing."
(remhash :global *keymaps*)
(remhash :local *keymaps*)
(is-false (gethash :global *keymaps*))
(is-false (gethash :local *keymaps*)))
;; cleanup after keybinding tests
(test keybinding-cleanup-global
"Clean up global keymap after testing."
(remhash :global *keymaps*)
(remhash :local *keymaps*)
(is-false (gethash :global *keymaps*))
(is-false (gethash :local *keymaps*)))
(test resize-event-check
"read-event returns :resize when *terminal-resized-p* is set"
(let ((b (make-instance 'cl-tty.backend:backend)))
(setf cl-tty.input:*terminal-resized-p* t)
(multiple-value-bind (type data) (cl-tty.input:read-event b :timeout 0)
(is (eq :resize type))
(is (consp data))
(is (integerp (car data)))
(is (integerp (cdr data))))
(is-false cl-tty.input:*terminal-resized-p*)))
(test with-terminal-macro-expands
"with-terminal macro expands and compiles"
(is (macro-function 'cl-tty.backend:with-terminal))
(let ((expanded (macroexpand-1 '(cl-tty.backend:with-terminal (be)
(print be)))))
(is (listp expanded))))