2198 lines
92 KiB
Org Mode
2198 lines
92 KiB
Org Mode
#+TITLE: cl-tty 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 — 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 ~defstruct~ generates keyword constructors by default — we use
|
|
them directly without custom ~:constructor~ overrides.
|
|
- 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-code~ exists alongside ~key-event-key~ to carry the raw
|
|
character code. ~:key~ is a semantic keyword (:a, :enter, :up) while
|
|
~:code~ is the numeric code point or byte value. This separation is
|
|
essential for printable character insertion — ~handle-text-input~ uses
|
|
~key-event-code~ with ~code-char~, not ~key-event-key~ which 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input-package.lisp
|
|
(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
|
|
#:text-input-insert #:text-input-backspace #:text-input-delete
|
|
#:text-input-move-left #:text-input-move-right
|
|
#:text-input-move-home #:text-input-move-end
|
|
#:text-input-delete-word-before
|
|
#: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))
|
|
#+END_SRC
|
|
|
|
* 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(defvar *current-backend* nil
|
|
"The active backend used for rendering.")
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(defvar *current-theme* nil
|
|
"The active theme used for semantic color resolution.")
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(defstruct mouse-event
|
|
(type nil :type (or keyword null))
|
|
(button nil :type (or keyword null))
|
|
(x 0 :type fixnum)
|
|
(y 0 :type fixnum))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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:
|
|
1. Tilde-terminated sequences (~ESC[1~~): look up the numeric parameter
|
|
in ~*csi-tilde-table*~.
|
|
2. 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.
|
|
3. 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
** 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 use ~sb-sys:with-pinned-objects~ to pin a 1-byte
|
|
~make-array~ vector in memory, obtain its SAP via ~sb-sys:vector-sap~,
|
|
and read directly into the backing storage. This avoids alien allocation
|
|
and manual ~free-alien~ while keeping the GC from moving the buffer
|
|
during the ~unix-read~ syscall.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(defun read-raw-byte (&key timeout)
|
|
(let* ((buf (make-array 1 :element-type '(unsigned-byte 8)))
|
|
(fd 0)
|
|
(timeout-ms (when timeout (max 1 (round (* timeout 1000))))))
|
|
(sb-sys:with-pinned-objects (buf)
|
|
(let ((sap (sb-sys:vector-sap buf)))
|
|
(if timeout-ms
|
|
(progn (sb-unix:unix-simple-poll fd :input timeout-ms)
|
|
(let ((n (sb-unix:unix-read fd sap 1)))
|
|
(if (= n 1) (aref buf 0) (values nil :eof))))
|
|
(let ((n (sb-unix:unix-read fd sap 1)))
|
|
(if (= n 1) (aref buf 0) (values nil :eof))))))))
|
|
#+END_SRC
|
|
|
|
** 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~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(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))))))
|
|
#+END_SRC
|
|
|
|
** SGR mouse parser
|
|
|
|
The SGR extended mouse protocol sends events in the format
|
|
~ESC [ < Cb ; Cx ; Cy M/m~ where:
|
|
|
|
- ~<~ is the SGR marker byte (0x3C)
|
|
- ~Cb~ is the button code (0=left, 1=middle, 2=right, 32+=motion/drag,
|
|
64=scroll-up, 65=scroll-down)
|
|
- ~Cx~, ~Cy~ are the 1-based coordinates
|
|
- ~M~ (0x4D) = press, ~m~ (0x6D) = release
|
|
|
|
The parser splits the byte stream into the three numeric parameters by
|
|
reading digits until a non-digit byte is encountered (~%read-digits~),
|
|
then converts the button code and press/release flag into a ~mouse-event~.
|
|
|
|
*** Digit reader
|
|
|
|
~%read-digits~ reads bytes from the raw terminal input until the first
|
|
non-digit byte, handling an optional list of initial bytes that were
|
|
already consumed by the caller. Returns the parsed integer and the
|
|
terminator byte.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(defun %read-digits (&optional (initial-bytes nil))
|
|
"Read bytes until a non-digit is encountered.
|
|
Returns (values number terminator-byte)."
|
|
(let ((acc nil))
|
|
(dolist (b initial-bytes)
|
|
(when (and (>= b 48) (<= b 57))
|
|
(push (- b 48) acc)))
|
|
(loop for b = (read-raw-byte)
|
|
while (and (>= b 48) (<= b 57))
|
|
do (push (- b 48) acc)
|
|
finally (return (values (if acc
|
|
(reduce (lambda (n d) (+ (* n 10) d))
|
|
(reverse acc))
|
|
0)
|
|
b)))))
|
|
#+END_SRC
|
|
|
|
*** Mouse event parser
|
|
|
|
~%parse-sgr-mouse~ is called after ~ESC[<~ has been consumed by
|
|
~parse-csi-sequence~ (which detects the SGR marker byte). It reads the
|
|
three semicolon-separated parameters using ~%read-digits~ and constructs
|
|
a ~mouse-event~ struct with proper button and type classification.
|
|
|
|
Coordinates are converted from 1-based (terminal protocol) to 0-based
|
|
(framebuffer convention) by subtracting 1 from both x and y.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(defun %parse-sgr-mouse ()
|
|
"Parse SGR mouse escape sequence: ESC [ < Cb ; Cx ; Cy M/m
|
|
Returns a mouse-event struct."
|
|
(let ((b (read-raw-byte)))
|
|
(multiple-value-bind (cb sep1) (%read-digits (list b))
|
|
(declare (ignore sep1))
|
|
(multiple-value-bind (cx sep2) (%read-digits)
|
|
(declare (ignore sep2))
|
|
(multiple-value-bind (cy term) (%read-digits)
|
|
(let ((button (cond
|
|
((= cb 0) :left)
|
|
((= cb 1) :middle)
|
|
((= cb 2) :right)
|
|
((= cb 64) :scroll-up)
|
|
((= cb 65) :scroll-down)
|
|
((>= cb 32) :drag)
|
|
(t :left)))
|
|
(type (cond
|
|
((= term 77) :press)
|
|
((= term 109) :release)
|
|
(t :press))))
|
|
(make-mouse-event :type type :button button
|
|
:x (- cx 1) :y (- cy 1))))))))
|
|
|
|
#+END_SRC
|
|
|
|
** CSI sequence parser
|
|
|
|
~parse-csi-sequence~ reads and parses a full Control Sequence Introducer
|
|
sequence: ~ESC [ (param) (terminator)~ or SGR mouse events: ~ESC [ < Cb ; Cx ; Cy M/m~.
|
|
|
|
The function implements a recursive descent parser for the CSI grammar:
|
|
- Read the first byte after ~ESC [~.
|
|
- If it's ~~<~~ (0x3C), the sequence is an SGR mouse event — delegate to
|
|
~%parse-sgr-mouse~ which returns a ~mouse-event~ struct.
|
|
- 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 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(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* ((b2 (read-raw-byte)))
|
|
(if (= b2 60) ;; < — SGR mouse marker
|
|
(%parse-sgr-mouse)
|
|
(let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))
|
|
(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)))))))
|
|
#+END_SRC
|
|
|
|
** 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:
|
|
1. Range validation on the leading byte (ensuring it's in the correct pattern).
|
|
2. Continuation byte validation (each must be 10xxxxxx, i.e., 0x80-0xBF).
|
|
3. 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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:
|
|
1. ~~x1b (Escape) → delegate to ~%read-escape-sequence~.
|
|
2. ~~x09 (Tab) → ~:tab~ with code ~~x09.
|
|
3. ~~x0a (LF) or ~~x0d (CR) → ~:enter~.
|
|
4. ~~x7f (DEL) or ~~x08 (BS) → ~:backspace~.
|
|
5. 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.
|
|
6. ~~x1c-~~x1f → Ctrl+\ through Ctrl+_ with specific key names.
|
|
7. Byte range ~~x20-~~x7e → printable ASCII, interned as keyword
|
|
(uppercased).
|
|
8. 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~.
|
|
9. 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(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)))))))
|
|
#+END_SRC
|
|
|
|
** 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 ~:sb-posix~ module must be ~require~d first so that the
|
|
~sb-posix:sigwinch~ constant is available.
|
|
|
|
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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(defvar *terminal-resized-p* nil)
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
#+sbcl
|
|
(eval-when (:load-toplevel :execute)
|
|
(require :sb-posix)
|
|
(sb-sys:enable-interrupt sb-posix:sigwinch
|
|
(lambda (signal info context)
|
|
(declare (ignore signal info context))
|
|
(setf *terminal-resized-p* t))))
|
|
#+END_SRC
|
|
|
|
** Raw terminal mode
|
|
|
|
Most terminal applications need raw mode (no echo, character-by-character
|
|
input). SBCL's ~SB-POSIX:WITH-RAW-TERMINAL~ is not available in all builds
|
|
(e.g. Debian-packaged SBCL 2.5.x). This implementation uses ~stty~ for
|
|
portability.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(defun %raw-mode-on ()
|
|
(uiop:run-program '("stty" "raw" "-echo" "-echoe" "-echok" "-onlcr")
|
|
:output nil :error-output nil :ignore-error-status t))
|
|
|
|
(defun %raw-mode-off ()
|
|
(uiop:run-program '("stty" "sane")
|
|
:output nil :error-output nil :ignore-error-status t))
|
|
|
|
(defmacro with-raw-terminal (&body body)
|
|
"Execute BODY with the terminal in raw mode."
|
|
`(unwind-protect
|
|
(progn (%raw-mode-on) ,@body)
|
|
(%raw-mode-off)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
* 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 of ~value~; 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-push~
|
|
pushes, ~vector-pop~ pops, 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(defun make-textarea (&key value on-submit)
|
|
(make-instance 'textarea
|
|
:value (or value "")
|
|
:on-submit on-submit))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(defun textarea-lines (ta)
|
|
"Split value into lines."
|
|
(%split-string (textarea-value ta) #\Newline))
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(defun textarea-line-count (ta)
|
|
"Number of lines in value."
|
|
(length (textarea-lines ta)))
|
|
#+END_SRC
|
|
|
|
** Cursor clamping
|
|
|
|
~textarea-ensure-cursor~ clamps the cursor position to valid ranges
|
|
after any operation that might move it out of bounds. It:
|
|
1. Clamps ~cursor-row~ to [0, line-count-1].
|
|
2. Clamps ~cursor-col~ to [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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(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))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Character insertion
|
|
|
|
~textarea-insert-char~ inserts a single character at the cursor position
|
|
within the current line. The algorithm:
|
|
|
|
1. Push undo state (so the insertion can be undone).
|
|
2. Split the value into lines (coerced to vector for indexed access).
|
|
3. 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.
|
|
4. 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
** Newline insertion
|
|
|
|
~textarea-newline~ splits the current line at the cursor column and
|
|
inserts a newline character between the two halves.
|
|
|
|
Algorithm:
|
|
1. Push undo state.
|
|
2. Split the value into lines (coerced to vector).
|
|
3. If the cursor row is valid, split the current line into ~before~
|
|
(characters before cursor) and ~after~ (characters after).
|
|
4. Replace the current line with ~before~ and insert ~after~ as a
|
|
new line immediately after.
|
|
5. Move cursor to the start of the new line (row+1, col=0).
|
|
6. If the cursor row is beyond the last line, simply append a newline.
|
|
7. Mark dirty.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
** Backspace
|
|
|
|
~textarea-backspace~ handles both character deletion and line joining:
|
|
|
|
1. At (0,0): nothing to delete — return nil.
|
|
2. 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.
|
|
3. 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(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))))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(defun textarea-move-up (ta)
|
|
(decf (textarea-cursor-row ta))
|
|
(textarea-ensure-cursor ta))
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(defun textarea-move-down (ta)
|
|
(incf (textarea-cursor-row ta))
|
|
(textarea-ensure-cursor ta))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(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))))))))
|
|
#+END_SRC
|
|
|
|
** Textarea rendering
|
|
|
|
~render~ for textarea draws the visible portion of the text content
|
|
within the widget's layout bounds. It:
|
|
|
|
1. Retrieves the layout node for position and size.
|
|
2. Splits the value into lines.
|
|
3. Loops over the visible lines (up to the available height).
|
|
4. 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/textarea.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
* 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 of ~value~.
|
|
- ~placeholder~: Text displayed when ~value~ is 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(in-package #:cl-tty.input)
|
|
|
|
(defclass text-input (dirty-mixin)
|
|
((value :initform "" :initarg :value :accessor text-input-value
|
|
:type string)
|
|
(cursor :initform 0 :initarg :cursor :accessor text-input-cursor
|
|
:type fixnum)
|
|
(placeholder :initform "" :initarg :placeholder
|
|
:accessor text-input-placeholder :type string)
|
|
(max-length :initform nil :initarg :max-length
|
|
:accessor text-input-max-length)
|
|
(on-submit :initform nil :initarg :on-submit
|
|
:accessor text-input-on-submit)
|
|
(layout-node :initform (make-layout-node) :accessor text-input-layout-node)
|
|
(focusable :initform t :accessor text-input-focusable)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(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))
|
|
#+END_SRC
|
|
|
|
** Character insertion
|
|
|
|
~text-input-insert~ inserts a character at the cursor position within
|
|
the single-line value. The algorithm:
|
|
|
|
1. Check ~max-length~: if set and the value is already at the limit,
|
|
return immediately (the character is silently dropped).
|
|
2. Construct the new value by concatenating the prefix (before cursor),
|
|
the new character, and the suffix (after cursor).
|
|
3. Increment the cursor by 1.
|
|
4. 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(defun text-input-move-left (input)
|
|
(when (plusp (text-input-cursor input)) (decf (text-input-cursor input)))
|
|
(mark-dirty input))
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(defun text-input-move-right (input)
|
|
(when (< (text-input-cursor input) (length (text-input-value input))) (incf (text-input-cursor input)))
|
|
(mark-dirty input))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(defun text-input-move-home (input)
|
|
(setf (text-input-cursor input) 0)
|
|
(mark-dirty input))
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(defun text-input-move-end (input)
|
|
(setf (text-input-cursor input) (length (text-input-value input)))
|
|
(mark-dirty input))
|
|
#+END_SRC
|
|
|
|
** 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:
|
|
1. Find the last non-space character before the cursor (~start~).
|
|
If none exists, ~start~ is 0.
|
|
2. Find the last space character before ~start~. If none, ~word-start~ is 0.
|
|
3. 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).
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(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))))))))
|
|
#+END_SRC
|
|
|
|
** 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:
|
|
1. Retrieve the layout node for position (x, y) and width (w).
|
|
2. Determine display text: if value is non-empty, use it; otherwise
|
|
use the placeholder (or empty string if placeholder is also empty).
|
|
3. Truncate the display text to the available width.
|
|
4. Draw the truncated text at (x, y) using the backend's ~draw-text~.
|
|
5. 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text-input.lisp
|
|
(defmethod render ((in text-input) (backend t))
|
|
(let* ((ln (text-input-layout-node in))
|
|
(x (if ln (layout-node-x ln) 0)) (y (if ln (layout-node-y ln) 0))
|
|
(w (if ln (layout-node-width ln) 80))
|
|
(value (text-input-value in)) (cursor (text-input-cursor in))
|
|
(display (if (plusp (length value)) value (or (text-input-placeholder in) "")))
|
|
(truncated (subseq display 0 (min (length display) w))))
|
|
(draw-text backend x y truncated nil nil)
|
|
(when (plusp (length value))
|
|
(let ((cursor-col (min cursor (length truncated))))
|
|
(draw-text backend (+ x cursor-col) y "█" :bright-white nil)))))
|
|
#+END_SRC
|
|
|
|
* 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 in ~dispatch-key-event~, not by the ~parent~ slot).
|
|
|
|
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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
|
(in-package #:cl-tty.input)
|
|
|
|
(defstruct keymap
|
|
(name nil :type (or keyword null))
|
|
(bindings nil :type list)
|
|
(parent nil :type (or keymap null)))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
|
(defparameter *keymaps* (make-hash-table :test #'equal))
|
|
#+END_SRC
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
|
(defparameter *chord-timeout* 0.5)
|
|
#+END_SRC
|
|
|
|
** Key spec matching
|
|
|
|
~key-match-p~ compares a key specification (spec) against a ~key-event~.
|
|
The spec can be:
|
|
|
|
1. 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 the ~case~ EQL trap (where ~:CTRL+p~ and ~:ctrl+p~ would
|
|
be different symbols).
|
|
- If no ~+~, the keyword is matched against ~key-event-key~ directly.
|
|
2. 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
** Event dispatch
|
|
|
|
~dispatch-key-event~ is the main entry point for the keybinding system.
|
|
It implements a three-level lookup chain:
|
|
|
|
1. **Component keymap** (:keyword parameter): If the caller supplies a
|
|
~component~, the function calls ~component-keymap~ on it to get a
|
|
component-specific keymap. Matches in this keymap take highest priority.
|
|
2. **:local keymap**: Look up the ~:local~ keymap in ~*keymaps*~. This
|
|
is typically installed by the active "screen" or "mode" (e.g., a
|
|
help overlay might have its own local keymap).
|
|
3. **:global keymap**: Look up the ~:global~ keymap. 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
** defkeymap macro
|
|
|
|
~defkeymap~ is a convenience macro that registers a keymap in the global
|
|
~*keymaps*~ hash table. Syntax:
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
|
(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))))))))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/keybindings.lisp
|
|
;;; --- Component protocol integration ---
|
|
(defgeneric component-keymap (component)
|
|
(:method ((c t)) nil))
|
|
#+END_SRC
|
|
|
|
* 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)
|
|
|
|
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/input-tests.lisp
|
|
(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))))
|
|
#+END_SRC
|