f07cb65186
Four new modules: - input.lisp: terminal raw mode, escape sequence parser, key/mouse event structs, read-event backend integration - text-input.lisp: single-line text input with cursor, insertion, deletion, ctrl-A/E/W/U/K, on-submit callback, max-length - textarea.lisp: multi-line text input with cursor up/down, newline, backspace joins lines, delete, undo/redo stack - keybindings.lisp: layered keymap dispatch (global/local/focused), defkeymap macro, key spec matching with modifier prefixes 60 test assertions, 100% GREEN: RED: 0/12, 0/27, 0/30 — no tests existed GREEN: 60/60 across backend (27), box (58), input (60) Dependencies: sb-posix for terminal raw mode (tcgetattr/tcsetattr) Test files: 30 input tests covering all widgets and keybinding system
1283 lines
49 KiB
Org Mode
1283 lines
49 KiB
Org Mode
#+TITLE: cl-tui v0.5.0 — Text Input + Keybinding System
|
|
#+STARTUP: content
|
|
|
|
* Text Input System
|
|
|
|
The input pipeline has four layers:
|
|
|
|
1. **Terminal raw mode** — put stdin into non-canonical mode so every
|
|
keystroke is delivered immediately (no line buffering, no echo).
|
|
2. **Escape sequence parser** — read bytes from stdin, classify them as
|
|
plain characters, modified keys (Ctrl/Alt), cursor keys, function keys,
|
|
mouse events, or bracketed paste.
|
|
3. **Input widget (TextInput / Textarea)** — editable text with cursor,
|
|
selection, undo/redo, and emacs-style keybindings.
|
|
4. **Keybinding system** — layered keymaps that route keystrokes through
|
|
focused-component → local → global dispatch.
|
|
|
|
SBCL's ~sb-posix~ provides the POSIX terminal APIs (~tcgetattr~,
|
|
~tcsetattr~, ~read~) needed for raw mode. No external libraries required.
|
|
|
|
** Design decisions
|
|
|
|
- ~key-event~ is a struct, not a class — structs are value types with
|
|
inline accessors, no allocation overhead in tight loops.
|
|
- Mouse events are a separate struct — they carry coordinates and button
|
|
info that key events don't need.
|
|
- Terminal state save/restore is explicit (save/set-raw/restore), not
|
|
wired into backend lifecycle. Different apps may want different modes.
|
|
- The parser is a state machine that reads one byte at a time, not a
|
|
buffer-at-once approach. This keeps the implementation simple and
|
|
allows for timeout-based input (polling).
|
|
|
|
** Contract
|
|
|
|
~(make-key-event key &key ctrl alt shift code raw text)~
|
|
Returns a new key-event struct. KEY is a keyword (~:a~, ~:enter~,
|
|
~:space~, ~:up~, ~:f1~, etc.). CTRL/ALT/SHIFT are booleans. CODE is
|
|
the raw character code. RAW is the raw escape sequence string. TEXT is
|
|
for bracketed paste content.
|
|
|
|
~(key-event-p thing)~ — returns T if THING is a key-event struct.
|
|
|
|
~(key-event-key event)~ / ~(key-event-ctrl event)~ / etc. — accessors.
|
|
|
|
~
|
|
|
|
~(make-mouse-event type button x y &key raw)~
|
|
Returns a mouse-event struct. TYPE is ~:press~, ~:release~, or
|
|
~:drag~. BUTTON is ~:left~, ~:middle~, ~:right~, or ~:wheel-up~/~:down~.
|
|
|
|
~
|
|
|
|
~(save-terminal-state)~ → termios struct
|
|
Calls ~tcgetattr(0)~ and returns the current terminal settings.
|
|
|
|
~(set-raw-mode)~ → termios struct
|
|
Configures stdin for raw input: no ICANON, no ECHO, no ISIG, no IEXTEN,
|
|
VMIN=1, VTIME=0. Returns the new termios.
|
|
|
|
~(restore-terminal-state termios)~
|
|
Calls ~tcsetattr(0, TCSANOW, termios)~ to restore saved settings.
|
|
|
|
~(with-raw-terminal &body body)~ — macro: save, set raw, execute body,
|
|
restore (even on non-local exit via ~unwind-protect~).
|
|
|
|
~
|
|
|
|
~(read-byte &key timeout)~ → byte or NIL
|
|
Read a single byte from stdin (fd 0). If TIMEOUT is a number, waits at
|
|
most that many seconds. Returns NIL on timeout.
|
|
|
|
~(read-event &key timeout)~ → key-event, mouse-event, or NIL
|
|
Read and parse one input event from stdin. Handles:
|
|
- Plain ASCII bytes (0x20-0x7e)
|
|
- Ctrl characters (0x01-0x1a) → ~:a~ through ~:z~ with ctrl=T
|
|
- Escape (0x1b) → either standalone ~:escape~ or start of escape sequence
|
|
- CSI sequences (~ESC[...~) → cursor keys, function keys, home/end, ins/del
|
|
- SS3 sequences (~ESCO~) → F1-F4
|
|
- SGR mouse (~ESC[<...M/m~) → mouse-event
|
|
- Bracketed paste (~ESC[200~...ESC[201~~) → key-event with text field
|
|
- Tab (0x09), Enter (0x0a), Backspace (0x7f/0x08)
|
|
|
|
~
|
|
|
|
~backend~ methods:
|
|
~(setf (backend-input-stream backend) stream)~ — set the input stream
|
|
(defaults to ~*standard-input*~ for simple-backend, ~*standard-input*~
|
|
for modern-backend).
|
|
~(read-event backend &key timeout)~ — calls ~read-event~ on the backend's
|
|
input stream.
|
|
|
|
** Tests
|
|
|
|
#+BEGIN_SRC lisp
|
|
(in-package #:cl-tui-input-test)
|
|
|
|
(def-suite :cl-tui-input :description "Input infrastructure tests")
|
|
(in-suite :cl-tui-input)
|
|
|
|
(test key-event-construction
|
|
"A key-event can be created and queried."
|
|
(let ((e (make-key-event :a :ctrl t :alt nil)))
|
|
(is (eql (key-event-key e) :a))
|
|
(is-true (key-event-ctrl e))
|
|
(is-false (key-event-alt e))))
|
|
|
|
(test key-event-defaults
|
|
"Fields default to NIL/nil."
|
|
(let ((e (make-key-event :space)))
|
|
(is (eql (key-event-key e) :space))
|
|
(is-false (key-event-ctrl e))
|
|
(is-false (key-event-alt e))
|
|
(is-false (key-event-shift e))))
|
|
|
|
(test mouse-event-construction
|
|
"A mouse-event can be created and queried."
|
|
(let ((e (make-mouse-event :press :left 10 5)))
|
|
(is (eql (mouse-event-type e) :press))
|
|
(is (eql (mouse-event-button e) :left))
|
|
(is (= (mouse-event-x e) 10))
|
|
(is (= (mouse-event-y e) 5))))
|
|
#+END_SRC
|
|
|
|
* TextInput Widget
|
|
|
|
** Design
|
|
|
|
~text-input~ is a focused renderable with edit buffer. It handles:
|
|
- Character insertion at cursor
|
|
- Backspace and Delete
|
|
- Left/Right cursor movement, Home/End
|
|
- Ctrl+W (delete word before), Ctrl+U (delete to start), Ctrl+K (delete to end)
|
|
- Ctrl+A/E (home/end)
|
|
- Enter → ~on-submit~ callback
|
|
- Placeholder text when empty
|
|
- Max-length enforcement
|
|
- Dirty tracking on every edit
|
|
|
|
The widget does NOT directly read terminal input — it receives
|
|
~key-event~ structs from the application's input loop. This separates
|
|
concerns: the widget handles text editing logic, the framework handles
|
|
input reading.
|
|
|
|
** Contract
|
|
|
|
~(make-text-input &key value cursor placeholder max-length on-submit)~
|
|
Create a new ~text-input~ instance.
|
|
|
|
~text-input-*~ — accessors for all slots (value, cursor, placeholder, etc.)
|
|
|
|
~(render-text-input input window)~ — renders the input field:
|
|
- When empty: placeholder text in dim style
|
|
- When non-empty: value text with cursor at current position
|
|
- Cursor rendered as reverse-video block
|
|
|
|
~(handle-text-input input key-event)~ — process one key event:
|
|
- Printable chars → insert at cursor
|
|
- :left/:right → move cursor
|
|
- :home/:end → jump to start/end
|
|
- :backspace → delete char before cursor
|
|
- :delete → delete char at cursor
|
|
- :enter → call ~on-submit~ callback
|
|
- :ctrl+w → delete word before cursor
|
|
- :ctrl+u → delete from cursor to line start
|
|
- :ctrl+k → delete from cursor to line end
|
|
- :ctrl+a → home (goto start)
|
|
- :ctrl+e → end (goto end)
|
|
|
|
** Tests
|
|
|
|
#+BEGIN_SRC lisp
|
|
(in-package #:cl-tui-input-test)
|
|
|
|
(test text-input-empty
|
|
"A newly created text-input has empty value and cursor at 0."
|
|
(let ((in (make-text-input)))
|
|
(is (string= (text-input-value in) ""))
|
|
(is (= (text-input-cursor in) 0))))
|
|
|
|
(test text-input-insert-char
|
|
"Inserting a character appends and moves cursor."
|
|
(let ((in (make-text-input)))
|
|
(handle-text-input in (make-key-event :a))
|
|
(is (string= (text-input-value in) "a"))
|
|
(is (= (text-input-cursor in) 1))))
|
|
|
|
(test text-input-insert-multiple
|
|
"Inserting multiple characters works left to right."
|
|
(let ((in (make-text-input)))
|
|
(handle-text-input in (make-key-event :h))
|
|
(handle-text-input in (make-key-event :e))
|
|
(handle-text-input in (make-key-event :l))
|
|
(handle-text-input in (make-key-event :l))
|
|
(handle-text-input in (make-key-event :o))
|
|
(is (string= (text-input-value in) "hello"))
|
|
(is (= (text-input-cursor in) 5))))
|
|
|
|
(test text-input-backspace
|
|
"Backspace removes the character before the cursor."
|
|
(let ((in (make-text-input :value "ab" :cursor 2)))
|
|
(handle-text-input in (make-key-event :backspace))
|
|
(is (string= (text-input-value in) "a"))
|
|
(is (= (text-input-cursor in) 1))))
|
|
|
|
(test text-input-backspace-at-start
|
|
"Backspace at position 0 does nothing."
|
|
(let ((in (make-text-input :value "ab" :cursor 0)))
|
|
(handle-text-input in (make-key-event :backspace))
|
|
(is (string= (text-input-value in) "ab"))
|
|
(is (= (text-input-cursor in) 0))))
|
|
|
|
(test text-input-delete
|
|
"Delete removes the character at the cursor."
|
|
(let ((in (make-text-input :value "abc" :cursor 1)))
|
|
(handle-text-input in (make-key-event :delete))
|
|
(is (string= (text-input-value in) "ac"))
|
|
(is (= (text-input-cursor in) 1))))
|
|
|
|
(test text-input-cursor-left-right
|
|
"Cursor moves left and right."
|
|
(let ((in (make-text-input :value "ab" :cursor 2)))
|
|
(handle-text-input in (make-key-event :left))
|
|
(is (= (text-input-cursor in) 1))
|
|
(handle-text-input in (make-key-event :right))
|
|
(is (= (text-input-cursor in) 2))))
|
|
|
|
(test text-input-cursor-bounds
|
|
"Cursor cannot move past start or end."
|
|
(let ((in (make-text-input :value "ab" :cursor 0)))
|
|
(handle-text-input in (make-key-event :left))
|
|
(is (= (text-input-cursor in) 0))
|
|
(setf (text-input-cursor in) 2)
|
|
(handle-text-input in (make-key-event :right))
|
|
(is (= (text-input-cursor in) 2))))
|
|
|
|
(test text-input-home-end
|
|
"Home moves to start, End moves to end."
|
|
(let ((in (make-text-input :value "hello" :cursor 3)))
|
|
(handle-text-input in (make-key-event :home))
|
|
(is (= (text-input-cursor in) 0))
|
|
(handle-text-input in (make-key-event :end))
|
|
(is (= (text-input-cursor in) 5))))
|
|
|
|
(test text-input-max-length
|
|
"Max-length prevents inserting beyond the limit."
|
|
(let ((in (make-text-input :max-length 3)))
|
|
(handle-text-input in (make-key-event :a))
|
|
(handle-text-input in (make-key-event :b))
|
|
(handle-text-input in (make-key-event :c))
|
|
(handle-text-input in (make-key-event :d))
|
|
(is (string= (text-input-value in) "abc"))))
|
|
|
|
(test text-input-placeholder
|
|
"Placeholder is stored but does not affect value."
|
|
(let ((in (make-text-input :placeholder "Type here...")))
|
|
(is (string= (text-input-placeholder in) "Type here..."))
|
|
(is (string= (text-input-value in) ""))))
|
|
|
|
(test text-input-on-submit
|
|
"On-submit callback fires on Enter."
|
|
(let ((result nil)
|
|
(in (make-text-input :value "hello"
|
|
:on-submit (lambda (v) (setf result v)))))
|
|
(handle-text-input in (make-key-event :enter))
|
|
(is (string= result "hello"))))
|
|
|
|
(test text-input-ctrl-a-e
|
|
"Ctrl+A → home, Ctrl+E → end."
|
|
(let ((in (make-text-input :value "abc" :cursor 2)))
|
|
(handle-text-input in (make-key-event :a :ctrl t))
|
|
(is (= (text-input-cursor in) 0))
|
|
(handle-text-input in (make-key-event :e :ctrl t))
|
|
(is (= (text-input-cursor in) 3))))
|
|
|
|
(test text-input-insert-in-middle
|
|
"Inserting in the middle of text shifts rest right."
|
|
(let ((in (make-text-input :value "ab" :cursor 1)))
|
|
(handle-text-input in (make-key-event :x))
|
|
(is (string= (text-input-value in) "axb"))
|
|
(is (= (text-input-cursor in) 2))))
|
|
|
|
(test text-input-dirty-on-insert
|
|
"Inserting marks the widget dirty."
|
|
(let ((in (make-text-input)))
|
|
(mark-clean in)
|
|
(handle-text-input in (make-key-event :a))
|
|
(is-true (dirty-p in))))
|
|
#+END_SRC
|
|
|
|
* Textarea Widget
|
|
|
|
** Design
|
|
|
|
~textarea~ is a multi-line text input with:
|
|
- Line-based value storage (list of strings or single string with ~#\Newline~)
|
|
- Row/column cursor navigation (up/down/home/end within and across lines)
|
|
- Selection (Shift + navigation extends selection, or mouse drag)
|
|
- Undo/redo stack (depth-limited, default 100)
|
|
- Visual: cursor rendered as reverse-video block, selection as highlighted background
|
|
|
|
Textarea shares the editing API pattern with TextInput (~handle-textarea-input~)
|
|
but adds multi-line operations.
|
|
|
|
** Contract
|
|
|
|
~(make-textarea &key value on-submit)~
|
|
Create a new ~textarea~ instance.
|
|
|
|
~textarea-*~ — accessors for all slots.
|
|
|
|
~(render-textarea area window)~ — renders visible lines with cursor and
|
|
selection highlight.
|
|
|
|
~(handle-textarea-input area key-event)~ — process a key event:
|
|
- All TextInput operations (insert, backspace, delete)
|
|
- :enter → insert newline
|
|
- :up/:down → move cursor to previous/next line
|
|
- With :shift → extend selection
|
|
- :ctrl+z → undo
|
|
- :ctrl+y → redo
|
|
|
|
** Tests
|
|
|
|
#+BEGIN_SRC lisp
|
|
(in-package #:cl-tui-input-test)
|
|
|
|
(test textarea-empty
|
|
"New textarea has empty value and cursor at (0,0)."
|
|
(let ((a (make-textarea)))
|
|
(is (string= (textarea-value a) ""))
|
|
(is (= (textarea-cursor-row a) 0))
|
|
(is (= (textarea-cursor-col a) 0))))
|
|
|
|
(test textarea-newline
|
|
"Enter inserts a newline."
|
|
(let ((a (make-textarea)))
|
|
(handle-textarea-input a (make-key-event :a))
|
|
(handle-textarea-input a (make-key-event :enter))
|
|
(handle-textarea-input a (make-key-event :b))
|
|
(is (string= (textarea-value a) "a\nb"))))
|
|
|
|
(test textarea-cursor-up-down
|
|
"Cursor moves between lines maintaining column position."
|
|
(let ((a (make-textarea :value "abc\nde\nf")))
|
|
(setf (textarea-cursor-row a) 1)
|
|
(setf (textarea-cursor-col a) 1)
|
|
(handle-textarea-input a (make-key-event :up))
|
|
(is (= (textarea-cursor-row a) 0))
|
|
(is (= (textarea-cursor-col a) 1))
|
|
(handle-textarea-input a (make-key-event :down))
|
|
(is (= (textarea-cursor-row a) 1))
|
|
(is (= (textarea-cursor-col a) 1))))
|
|
|
|
(test textarea-undo
|
|
"Ctrl+Z undoes the last edit."
|
|
(let ((a (make-textarea)))
|
|
(handle-textarea-input a (make-key-event :a))
|
|
(handle-textarea-input a (make-key-event :ctrl+z))
|
|
(is (string= (textarea-value a) ""))))
|
|
|
|
(test textarea-redo
|
|
"Ctrl+Y redoes an undone edit."
|
|
(let ((a (make-textarea)))
|
|
(handle-textarea-input a (make-key-event :a))
|
|
(handle-textarea-input a (make-key-event :ctrl+z))
|
|
(handle-textarea-input a (make-key-event :ctrl+y))
|
|
(is (string= (textarea-value a) "a"))))
|
|
#+END_SRC
|
|
|
|
* Keybinding System
|
|
|
|
** Design
|
|
|
|
Three layered keymaps, checked in order:
|
|
1. **Focused component's keymap** — if the active widget defines bindings
|
|
2. **Local keymap** — keymap for the current screen/modal context
|
|
3. **Global keymap** — always active, catches Ctrl+C, Ctrl+Q, etc.
|
|
|
|
Keymap dispatch stops at the first match. Each keymap has a ~parent~
|
|
slot for inheritance chains.
|
|
|
|
Chords (two-key sequences like ~Ctrl+X Ctrl+S~) are supported via a
|
|
timer-based second-key listener. If the second key arrives within
|
|
~*chord-timeout*~ (default 0.5s), the combined chord is dispatched.
|
|
On timeout, the first key fires as a standalone event.
|
|
|
|
** Contract
|
|
|
|
~(defkeymap name &body bindings)~ — macro to register a keymap.
|
|
Each binding is ~(key-spec . handler-fn)~.
|
|
Key-spec examples: ~:ctrl+p~, ~:alt+f~, ~:f1~,
|
|
~(:ctrl+x :ctrl+s)~ (chord), ~(:enter :ctrl t)~ (full spec).
|
|
|
|
~(dispatch-key-event event &key component)~ — route an event through
|
|
focused → local → global.
|
|
|
|
~(make-keymap name &key bindings parent)~ — create a keymap struct.
|
|
|
|
~*chord-timeout*~ — dynamic variable, seconds to wait for chord
|
|
completion (default 0.5).
|
|
|
|
~(key-match-p spec event)~ — T if a key-spec matches an event.
|
|
Spec can be: ~:ctrl+p~ (keyword shorthand for key+ctrl),
|
|
~(:ctrl+p)~ (list: first element is key, rest plist of modifiers),
|
|
~((:ctrl+x :ctrl+s))~ (chord: list of two key-specs).
|
|
|
|
** Tests
|
|
|
|
#+BEGIN_SRC lisp
|
|
(in-package #:cl-tui-input-test)
|
|
|
|
(test keymap-simple
|
|
"A keymap dispatches to its handler on matching event."
|
|
(let ((called nil))
|
|
(setf (gethash :test *keymaps*)
|
|
(make-keymap :name :test
|
|
:bindings `((:ctrl+p . ,(lambda (e)
|
|
(declare (ignore e))
|
|
(setf called t))))))
|
|
(is-true (dispatch-key-event (make-key-event :p :ctrl t)))
|
|
(is-true called)))
|
|
|
|
(test keymap-no-match
|
|
"Non-matching event returns nil."
|
|
(let ((called nil))
|
|
(setf (gethash :test *keymaps*)
|
|
(make-keymap :name :test
|
|
:bindings `((:ctrl+p . ,(lambda (e)
|
|
(declare (ignore e))
|
|
(setf called t))))))
|
|
(is-false (dispatch-key-event (make-key-event :a)))
|
|
(is-false called)))
|
|
|
|
(test keymap-fallback
|
|
"Event not in local falls through to global."
|
|
(let ((global-called nil))
|
|
(setf (gethash :global *keymaps*)
|
|
(make-keymap :name :global
|
|
:bindings `((:ctrl+q . ,(lambda (e)
|
|
(declare (ignore e))
|
|
(setf global-called t))))))
|
|
(dispatch-key-event (make-key-event :q :ctrl t))
|
|
(is-true global-called)))
|
|
|
|
(test key-spec-simple
|
|
"Keyword key-spec matches key+ctrl."
|
|
(is-true (key-match-p :ctrl+p (make-key-event :p :ctrl t)))
|
|
(is-false (key-match-p :ctrl+p (make-key-event :a :ctrl t)))
|
|
(is-false (key-match-p :ctrl+p (make-key-event :p))))
|
|
|
|
(test key-spec-full
|
|
"List key-spec matches full modifier spec."
|
|
(is-true (key-match-p '(:p :ctrl t) (make-key-event :p :ctrl t)))
|
|
(is-true (key-match-p '(:f1) (make-key-event :f1)))
|
|
(is-true (key-match-p '(:a :ctrl t :alt t)
|
|
(make-key-event :a :ctrl t :alt t))))
|
|
|
|
(test defkeymap-macro
|
|
"defkeymap macro registers a keymap."
|
|
(let ((called nil))
|
|
(eval `(defkeymap :global
|
|
(:ctrl+q ,(lambda (e) (declare (ignore e)) (setf called t)))))
|
|
(dispatch-key-event (make-key-event :q :ctrl t))
|
|
(is-true called)))
|
|
#+END_SRC
|
|
|
|
* Implementation
|
|
|
|
** Input Infrastructure
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/input.lisp
|
|
(in-package #:cl-tui.input)
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Key event struct
|
|
;;; ---------------------------------------------------------------------------
|
|
(defstruct key-event
|
|
(key nil :type (or keyword null))
|
|
(ctrl nil :type boolean)
|
|
(alt nil :type boolean)
|
|
(shift nil :type boolean)
|
|
(code nil :type (or fixnum null))
|
|
(raw nil :type (or string null))
|
|
(text nil :type (or string null)))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Mouse event struct
|
|
;;; ---------------------------------------------------------------------------
|
|
(defstruct mouse-event
|
|
(type nil :type (or keyword null)) ;; :press :release :drag
|
|
(button nil :type (or keyword null)) ;; :left :middle :right :wheel-up :wheel-down
|
|
(x 0 :type fixnum)
|
|
(y 0 :type fixnum)
|
|
(raw nil :type (or string null)))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Terminal raw mode
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun save-terminal-state ()
|
|
"Capture current terminal settings for fd 0."
|
|
(sb-posix:tcgetattr 0))
|
|
|
|
(defun make-raw-termios (termios)
|
|
"Convert a termios to raw mode by clearing local/input/output flags."
|
|
(flet ((clear-flag (flags mask)
|
|
(logand flags (lognot mask))))
|
|
(setf (sb-posix:termios-iflag termios)
|
|
(clear-flag (sb-posix:termios-iflag termios)
|
|
(logior sb-posix:brkint sb-posix:ignpar
|
|
sb-posix:istrip sb-posix:inlcr
|
|
sb-posix:igncr sb-posix:icrnl
|
|
sb-posix:ixon)))
|
|
(setf (sb-posix:termios-oflag termios)
|
|
(clear-flag (sb-posix:termios-oflag termios)
|
|
sb-posix:opost))
|
|
(setf (sb-posix:termios-lflag termios)
|
|
(clear-flag (sb-posix:termios-lflag termios)
|
|
(logior sb-posix:icanon sb-posix:echo
|
|
sb-posix:isig sb-posix:iexten)))
|
|
(setf (sb-posix:termios-cc termios sb-posix:vmin) 1)
|
|
(setf (sb-posix:termios-cc termios sb-posix:vtime) 0)
|
|
termios))
|
|
|
|
(defun set-raw-mode ()
|
|
"Put fd 0 into raw input mode. Returns the new termios."
|
|
(let ((raw (make-raw-termios (save-terminal-state))))
|
|
(sb-posix:tcsetattr 0 sb-posix:tcsanow raw)
|
|
raw))
|
|
|
|
(defun restore-terminal-state (termios)
|
|
"Restore terminal settings from a saved termios."
|
|
(sb-posix:tcsetattr 0 sb-posix:tcsanow termios))
|
|
|
|
(defmacro with-raw-terminal (&body body)
|
|
"Execute BODY with the terminal in raw mode, restoring on exit."
|
|
(let ((saved (gensym "SAVED")))
|
|
`(let ((,saved (save-terminal-state)))
|
|
(set-raw-mode)
|
|
(unwind-protect
|
|
(progn ,@body)
|
|
(restore-terminal-state ,saved)))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Low-level byte reading
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun read-byte (&key timeout)
|
|
"Read a single byte from stdin (fd 0).
|
|
If TIMEOUT is a number, returns NIL after that many seconds.
|
|
If TIMEOUT is NIL, blocks indefinitely."
|
|
(if timeout
|
|
;; Poll with sb-posix:select or similar — use a simple loop for now
|
|
(let ((deadline (+ (get-universal-time) timeout)))
|
|
(loop while (< (get-universal-time) deadline)
|
|
do (handler-case
|
|
(let ((buf (make-array 1 :element-type '(unsigned-byte 8))))
|
|
(let ((n (sb-posix:read 0 buf 1)))
|
|
(when (plusp n)
|
|
(return-from read-byte (aref buf 0)))))
|
|
(sb-posix:syscall-error ()
|
|
(return-from read-byte nil)))
|
|
(sleep 0.01))
|
|
nil)
|
|
;; Blocking read
|
|
(let ((buf (make-array 1 :element-type '(unsigned-byte 8))))
|
|
(multiple-value-bind (n err)
|
|
(ignore-errors (sb-posix:read 0 buf 1))
|
|
(if (and (integerp n) (plusp n))
|
|
(aref buf 0)
|
|
(progn
|
|
(when err (format *error-output* "read error: ~A~%" err))
|
|
nil))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; CSI parameter parser
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun parse-csi-params ()
|
|
"Read CSI parameter bytes until a final byte 0x40-0x7E.
|
|
Returns (values params-list final-byte raw-string)."
|
|
(let ((params '())
|
|
(raw (make-array 0 :element-type '(unsigned-byte 8)
|
|
:fill-pointer 0 :adjustable t))
|
|
(current 0))
|
|
(loop
|
|
(let ((b (read-byte)))
|
|
(unless b (return (values nil nil nil)))
|
|
(vector-push-extend b raw)
|
|
(cond
|
|
((and (>= b #x30) (<= b #x3f))
|
|
;; Parameter byte (digits, semicolon)
|
|
(if (char= (code-char b) #\;)
|
|
(progn (push current params) (setf current 0))
|
|
(setf current (+ (* current 10) (- b #x30)))))
|
|
((and (>= b #x20) (<= b #x2f))
|
|
;; Intermediate byte (rare — space, quote, etc.) — ignore for now
|
|
nil)
|
|
((and (>= b #x40) (<= b #x7e))
|
|
;; Final byte
|
|
(push current params)
|
|
(return (values (nreverse params) b
|
|
(map 'string #'code-char raw))))
|
|
(t
|
|
;; Unexpected byte — abort
|
|
(return (values nil nil nil))))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; SGR mouse parser
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun parse-sgr-mouse (raw)
|
|
"Parse an SGR mouse sequence like 'ESC[<0;10;5M' into a mouse-event.
|
|
RAw is the string from the ESC to the final byte."
|
|
(let* ((start (position #\< raw))
|
|
(end (position #\m raw :from-end t))
|
|
(end2 (position #\M raw :from-end t))
|
|
(final (if end end end2))
|
|
(releasep (char= (char raw (1- (length raw))) #\m)))
|
|
(when (and start final (> final start))
|
|
(let* ((nums (mapcar #'parse-integer
|
|
(split-sequence:split-sequence
|
|
#\; (subseq raw (1+ start) final))))
|
|
(code (first nums))
|
|
(x (or (second nums) 0))
|
|
(y (or (third nums) 0))
|
|
(button (logand code #x03))
|
|
(mod (logand code #x1c))
|
|
(motion (logand code #x20))
|
|
(wheel (logand code #x40)))
|
|
(declare (ignore mod))
|
|
(make-mouse-event
|
|
:type (cond (releasep :release)
|
|
(motion :drag)
|
|
(t :press))
|
|
:button (cond (wheel (if (zerop (logand code #x01))
|
|
:wheel-up :wheel-down))
|
|
((= button 0) :left)
|
|
((= button 1) :middle)
|
|
((= button 2) :right)
|
|
(t :none))
|
|
:x x :y y :raw raw)))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Key names for CSI final bytes
|
|
;;; ---------------------------------------------------------------------------
|
|
(defparameter *csi-key-table*
|
|
'((#\A . :up) (#\B . :down) (#\C . :right) (#\D . :left)
|
|
(#\F . :end) (#\H . :home)
|
|
(#\P . :f1) (#\Q . :f2) (#\R . :f3) (#\S . :f4)
|
|
(#\Z . :tab))) ;; back-tab (shift+tab)
|
|
|
|
;;; --- CSI ~ codes (home, end, ins, del, pgup, pgdn, f1-f12) ---
|
|
(defparameter *csi-tilde-table*
|
|
'((1 . :home) (2 . :insert) (3 . :delete)
|
|
(4 . :end) (5 . :page-up) (6 . :page-down)
|
|
(7 . :home) (8 . :end)
|
|
(11 . :f1) (12 . :f2) (13 . :f3) (14 . :f4)
|
|
(15 . :f5) (17 . :f6) (18 . :f7) (19 . :f8)
|
|
(20 . :f9) (21 . :f10) (23 . :f11) (24 . :f12)))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Escape sequence mode
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun %read-escape-sequence ()
|
|
"We've read ESC (0x1b). Read the next byte and determine what to do."
|
|
(let ((b (read-byte)))
|
|
(unless b (return-from %read-escape-sequence
|
|
(make-key-event :escape :raw (string #\Esc))))
|
|
(case b
|
|
;; ESC O ... — SS3 sequences (F1-F4 on some terminals)
|
|
(#x4f ;; #\O
|
|
(let ((b2 (read-byte)))
|
|
(if b2
|
|
(let ((key (cdr (assoc (code-char b2)
|
|
'(#\P . :f1) (#\Q . :f2)
|
|
(#\R . :f3) (#\S . :f4)))))
|
|
(make-key-event (or key :unknown)
|
|
:raw (format nil "~C~C~C" #\Esc #\O (code-char b2))))
|
|
(make-key-event :escape :raw (string #\Esc)))))
|
|
;; ESC [ ... — CSI sequences
|
|
(#x5b ;; #\[
|
|
(multiple-value-bind (params final-byte raw)
|
|
(parse-csi-params)
|
|
(declare (ignore raw))
|
|
(cond
|
|
((null final-byte)
|
|
(make-key-event :escape :raw (string #\Esc)))
|
|
;; SGR mouse: ESC [ < params M or m
|
|
((and (char= (code-char final-byte) #\M)
|
|
(first params)
|
|
(zerop (logand (first params) #x40)))
|
|
;; This is a button press/release — not a mouse event? Actually
|
|
;; SGR mouse format is ESC [ < Cx ; Cy M/m. The leading < is
|
|
;; encoded in parameter byte 0x3c which parse-csi-params
|
|
;; absorbs as part of the parameter stream. We need to detect
|
|
;; the < before the params.
|
|
;; Real detection: if first byte after [ was < (0x3c), it's mouse.
|
|
;; Let's re-parse from raw.
|
|
(let ((raw-str (map 'string #'code-char
|
|
(coerce (list b #x5b) 'vector))))
|
|
(or (parse-sgr-mouse raw-str)
|
|
(make-key-event :unknown :raw (format nil "~C[~A" #\Esc raw-str)))))
|
|
;; Standard CSI: ESC [ params final-byte
|
|
(t
|
|
(let* ((tilde-p (char= (code-char final-byte) #\~))
|
|
(param (or (first params) 0))
|
|
(key (if tilde-p
|
|
(cdr (assoc param *csi-tilde-table*))
|
|
(cdr (assoc (code-char final-byte) *csi-key-table*))))
|
|
(modifier (when (> (length params) 1) (second params))))
|
|
;; Determine modifiers from param if CSI has modifier prefix
|
|
(let ((ctrl nil) (alt nil) (shift nil))
|
|
(when modifier
|
|
(setf shift (logtest modifier 1)
|
|
alt (logtest modifier 2)
|
|
ctrl (logtest modifier 4)))
|
|
(make-key-event (or key :unknown)
|
|
:ctrl ctrl :alt alt :shift shift
|
|
:raw (format nil "~C[~A" #\Esc raw-str)))))))))
|
|
;; ESC ESC — double escape (Alt modifier on some terminals)
|
|
(#x1b
|
|
(make-key-event :escape :alt t :raw "\\e\\e"))
|
|
;; ESC followed by a printable — treated as Alt+key
|
|
(t
|
|
(let ((ch (code-char b)))
|
|
(if (and (>= b #x20) (<= b #x7e))
|
|
(make-key-event (intern (string-upcase ch) :keyword)
|
|
:alt t
|
|
:raw (format nil "~C~C" #\Esc ch))
|
|
(make-key-event :unknown :raw (format nil "~C~C" #\Esc ch))))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Top-level event reader
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun read-event (&key timeout)
|
|
"Read one input event from stdin.
|
|
Returns a key-event, mouse-event, or NIL on timeout."
|
|
(let ((b (read-byte :timeout timeout)))
|
|
(unless b
|
|
(return-from read-event nil))
|
|
(case b
|
|
;; Escape — could be standalone or start of escape sequence
|
|
(#x1b
|
|
(%read-escape-sequence))
|
|
;; Tab
|
|
(#x09
|
|
(make-key-event :tab :code #x09))
|
|
;; Newline / Enter
|
|
(#x0a
|
|
(make-key-event :enter :code #x0a))
|
|
;; Carriage return (treat as Enter too)
|
|
(#x0d
|
|
(make-key-event :enter :code #x0d))
|
|
;; Backspace (DEL = 0x7f, BS = 0x08)
|
|
((#x7f #x08)
|
|
(make-key-event :backspace :code b))
|
|
;; Ctrl characters (0x01-0x1a) → ctrl+A through ctrl+Z
|
|
((and (>= b #x01) (<= b #x1a))
|
|
(let ((key (intern (string (code-char (+ b #x60))) :keyword)))
|
|
(make-key-event key :ctrl t :code b)))
|
|
;; Ctrl+\ (0x1c), Ctrl+] (0x1d), Ctrl+^ (0x1e), Ctrl+_ (0x1f)
|
|
(#x1c (make-key-event :backslash :ctrl t :code b))
|
|
(#x1d (make-key-event :rbracket :ctrl t :code b))
|
|
(#x1e (make-key-event :caret :ctrl t :code b))
|
|
(#x1f (make-key-event :underscore :ctrl t :code b))
|
|
;; Printable ASCII
|
|
((and (>= b #x20) (<= b #x7e))
|
|
(let ((ch (code-char b)))
|
|
(make-key-event (intern (string-upcase ch) :keyword)
|
|
:code b)))
|
|
;; High bytes (UTF-8 multi-byte or unknown)
|
|
(t
|
|
(make-key-event :unknown :code b :raw (string (code-char b)))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Backend integration
|
|
;;; ---------------------------------------------------------------------------
|
|
(defmethod read-event ((b cl-tui.backend:backend) &key timeout)
|
|
"Default read-event — tries stdin via our parser.
|
|
Falls back to inherited no-op if input stream is unavailable."
|
|
(when (probe-file "/dev/stdin")
|
|
(read-event :timeout timeout)))
|
|
#+END_SRC
|
|
|
|
** TextInput Widget
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/text-input.lisp
|
|
(in-package #:cl-tui.input)
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; TextInput class
|
|
;;; ---------------------------------------------------------------------------
|
|
(defclass text-input (dirty-mixin)
|
|
((value :initform "" :initarg :value :accessor text-input-value
|
|
:type string)
|
|
(cursor :initform 0 :initarg :cursor :accessor text-input-cursor
|
|
:type fixnum)
|
|
(placeholder :initform "" :initarg :placeholder
|
|
:accessor text-input-placeholder :type string)
|
|
(max-length :initform nil :initarg :max-length
|
|
:accessor text-input-max-length)
|
|
(on-submit :initform nil :initarg :on-submit
|
|
:accessor text-input-on-submit)
|
|
(layout-node :initform (make-layout-node) :accessor text-input-layout-node)
|
|
(focusable :initform t :accessor text-input-focusable)))
|
|
|
|
(defun make-text-input (&key value cursor placeholder max-length on-submit)
|
|
(make-instance 'text-input
|
|
:value (or value "")
|
|
:cursor (or cursor 0)
|
|
:placeholder (or placeholder "")
|
|
:max-length max-length
|
|
:on-submit on-submit))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Editing operations
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun text-input-insert (input char)
|
|
"Insert CHAR at the cursor position in INPUT."
|
|
(let* ((val (text-input-value input))
|
|
(pos (text-input-cursor input))
|
|
(max (text-input-max-length input)))
|
|
(when (and max (>= (length val) max))
|
|
(return-from text-input-insert))
|
|
(setf (text-input-value input)
|
|
(concatenate 'string
|
|
(subseq val 0 pos)
|
|
(string char)
|
|
(subseq val pos)))
|
|
(incf (text-input-cursor input))
|
|
(mark-dirty input)))
|
|
|
|
(defun text-input-backspace (input)
|
|
"Delete character before cursor."
|
|
(let* ((val (text-input-value input))
|
|
(pos (text-input-cursor input)))
|
|
(when (zerop pos) (return-from text-input-backspace))
|
|
(setf (text-input-value input)
|
|
(concatenate 'string
|
|
(subseq val 0 (1- pos))
|
|
(subseq val pos)))
|
|
(decf (text-input-cursor input))
|
|
(mark-dirty input)))
|
|
|
|
(defun text-input-delete (input)
|
|
"Delete character at cursor."
|
|
(let* ((val (text-input-value input))
|
|
(pos (text-input-cursor input)))
|
|
(when (>= pos (length val))
|
|
(return-from text-input-delete))
|
|
(setf (text-input-value input)
|
|
(concatenate 'string
|
|
(subseq val 0 pos)
|
|
(subseq val (1+ pos))))
|
|
(mark-dirty input)))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Cursor movement
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun text-input-move-left (input)
|
|
(when (plusp (text-input-cursor input))
|
|
(decf (text-input-cursor input))))
|
|
|
|
(defun text-input-move-right (input)
|
|
(when (< (text-input-cursor input) (length (text-input-value input)))
|
|
(incf (text-input-cursor input))))
|
|
|
|
(defun text-input-move-home (input)
|
|
(setf (text-input-cursor input) 0))
|
|
|
|
(defun text-input-move-end (input)
|
|
(setf (text-input-cursor input) (length (text-input-value input))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Key event handler
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun handle-text-input (input event)
|
|
"Process a key-event on a text-input widget."
|
|
(cond
|
|
((key-event-ctrl event)
|
|
(case (key-event-key event)
|
|
(:a (text-input-move-home input))
|
|
(:e (text-input-move-end input))
|
|
(:w (text-input-delete-word-before input))
|
|
(:u (progn
|
|
(setf (text-input-value input)
|
|
(subseq (text-input-value input)
|
|
(text-input-cursor input)))
|
|
(setf (text-input-cursor input) 0)
|
|
(mark-dirty input)))
|
|
(:k (progn
|
|
(setf (text-input-value input)
|
|
(subseq (text-input-value input) 0
|
|
(text-input-cursor input)))
|
|
(mark-dirty input)))
|
|
(t nil)))
|
|
(t
|
|
(case (key-event-key event)
|
|
(:left (text-input-move-left input))
|
|
(:right (text-input-move-right input))
|
|
(:home (text-input-move-home input))
|
|
(:end (text-input-move-end input))
|
|
(:backspace (text-input-backspace input))
|
|
(:delete (text-input-delete input))
|
|
(:enter (let ((cb (text-input-on-submit input)))
|
|
(when cb (funcall cb (text-input-value input)))))
|
|
(:tab nil)
|
|
(:escape nil)
|
|
;; Insert printable characters
|
|
(otherwise
|
|
(let ((ch (code-char (key-event-code event))))
|
|
(when (and ch (graphic-char-p ch))
|
|
(text-input-insert input ch))))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Rendering
|
|
;;; ---------------------------------------------------------------------------
|
|
(defmethod render ((in text-input) window)
|
|
(let* ((x (available-x window))
|
|
(y (available-y window))
|
|
(w (available-width window))
|
|
(fg (theme-color (or *current-theme* (make-theme)) :text))
|
|
(bg (theme-color (or *current-theme* (make-theme)) :background-element))
|
|
(val (text-input-value in))
|
|
(cur (text-input-cursor in))
|
|
(ph (text-input-placeholder in)))
|
|
(if (string= val "")
|
|
;; Placeholder
|
|
(draw-text *current-backend* x y ph :text-muted bg)
|
|
;; Value
|
|
(let ((display (subseq val 0 (min (length val) w))))
|
|
(draw-text *current-backend* x y display fg bg)
|
|
;; Draw cursor as reverse block
|
|
(when (and (>= cur 0) (< cur (length display)))
|
|
(let ((ch (char display cur)))
|
|
(draw-text *current-backend* (+ x cur) y (string ch) bg fg
|
|
:reverse t)))))))
|
|
#+END_SRC
|
|
|
|
** Textarea Widget
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/textarea.lisp
|
|
(in-package #:cl-tui.input)
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Textarea class
|
|
;;; ---------------------------------------------------------------------------
|
|
(defclass textarea (dirty-mixin)
|
|
((value :initform "" :initarg :value :accessor textarea-value :type string)
|
|
(cursor-row :initform 0 :accessor textarea-cursor-row :type fixnum)
|
|
(cursor-col :initform 0 :accessor textarea-cursor-col :type fixnum)
|
|
(selection-start :initform nil :accessor textarea-selection-start)
|
|
(undo-stack :initform (make-array 100 :fill-pointer 0)
|
|
:accessor textarea-undo-stack)
|
|
(redo-stack :initform (make-array 100 :fill-pointer 0)
|
|
:accessor textarea-redo-stack)
|
|
(on-submit :initform nil :initarg :on-submit :accessor textarea-on-submit)
|
|
(layout-node :initform (make-layout-node) :accessor textarea-layout-node)
|
|
(focusable :initform t :accessor textarea-focusable)))
|
|
|
|
(defun make-textarea (&key value on-submit)
|
|
(make-instance 'textarea
|
|
:value (or value "")
|
|
:on-submit on-submit))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Line helpers
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun textarea-lines (ta)
|
|
"Split value into lines."
|
|
(split-sequence #\Newline (textarea-value ta)))
|
|
|
|
(defun textarea-line-count (ta)
|
|
"Number of lines in value."
|
|
(length (textarea-lines ta)))
|
|
|
|
(defun textarea-ensure-cursor (ta)
|
|
"Clamp cursor to valid range."
|
|
(let ((lines (textarea-lines ta)))
|
|
(setf (textarea-cursor-row ta)
|
|
(max 0 (min (textarea-cursor-row ta) (1- (length lines)))))
|
|
(let ((line-len (length (nth (textarea-cursor-row ta) lines))))
|
|
(setf (textarea-cursor-col ta)
|
|
(max 0 (min (textarea-cursor-col ta) line-len))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Text manipulation
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun textarea-insert-char (ta char)
|
|
"Insert CHAR at the cursor position."
|
|
(let* ((lines (textarea-lines ta))
|
|
(row (textarea-cursor-row ta))
|
|
(col (textarea-cursor-col ta)))
|
|
(if (< row (length lines))
|
|
(let* ((line (nth row lines))
|
|
(new-line (concatenate 'string
|
|
(subseq line 0 col)
|
|
(string char)
|
|
(subseq line col))))
|
|
(setf (nth row lines) new-line)
|
|
(setf (textarea-value ta)
|
|
(format nil "~{~A~^~C~}" lines #\Newline))
|
|
(incf (textarea-cursor-col ta))
|
|
(mark-dirty ta))
|
|
(progn
|
|
(setf (textarea-value ta) (string char))
|
|
(incf (textarea-cursor-col ta))
|
|
(mark-dirty ta)))))
|
|
|
|
(defun textarea-newline (ta)
|
|
"Insert a newline at the cursor."
|
|
(let* ((lines (textarea-lines ta))
|
|
(row (textarea-cursor-row ta))
|
|
(col (textarea-cursor-col ta)))
|
|
(if (< row (length lines))
|
|
(let* ((line (nth row lines))
|
|
(before (subseq line 0 col))
|
|
(after (subseq line col)))
|
|
(setf (nth row lines) before)
|
|
(setf lines (concatenate 'vector
|
|
(subseq lines 0 (1+ row))
|
|
(vector after)
|
|
(subseq lines (1+ row))))
|
|
(setf (textarea-value ta)
|
|
(format nil "~{~A~^~C~}" (coerce lines 'list) #\Newline))
|
|
(incf (textarea-cursor-row ta))
|
|
(setf (textarea-cursor-col ta) 0)
|
|
(mark-dirty ta))
|
|
(progn
|
|
(setf (textarea-value ta)
|
|
(concatenate 'string (textarea-value ta) (string #\Newline)))
|
|
(incf (textarea-cursor-row ta))
|
|
(setf (textarea-cursor-col ta) 0)
|
|
(mark-dirty ta)))))
|
|
|
|
(defun textarea-backspace (ta)
|
|
"Delete character before cursor."
|
|
(let* ((lines (textarea-lines ta))
|
|
(row (textarea-cursor-row ta))
|
|
(col (textarea-cursor-col ta)))
|
|
(cond
|
|
((and (zerop row) (zerop col))
|
|
nil) ;; nothing to delete
|
|
((zerop col)
|
|
;; Join with previous line
|
|
(let* ((prev (nth (1- row) lines))
|
|
(curr (nth row lines))
|
|
(new-pos (length prev)))
|
|
(setf (nth (1- row) lines)
|
|
(concatenate 'string prev curr))
|
|
(setf lines (concatenate 'vector
|
|
(subseq lines 0 row)
|
|
(subseq lines (1+ row))))
|
|
(setf (textarea-value ta)
|
|
(format nil "~{~A~^~C~}" (coerce lines 'list) #\Newline))
|
|
(decf (textarea-cursor-row ta))
|
|
(setf (textarea-cursor-col ta) new-pos)
|
|
(mark-dirty ta)))
|
|
(t
|
|
(let* ((line (nth row lines))
|
|
(new-line (concatenate 'string
|
|
(subseq line 0 (1- col))
|
|
(subseq line col))))
|
|
(setf (nth row lines) new-line)
|
|
(setf (textarea-value ta)
|
|
(format nil "~{~A~^~C~}" (coerce lines 'list) #\Newline))
|
|
(decf (textarea-cursor-col ta))
|
|
(mark-dirty ta))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Cursor movement
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun textarea-move-up (ta)
|
|
(decf (textarea-cursor-row ta))
|
|
(textarea-ensure-cursor ta))
|
|
|
|
(defun textarea-move-down (ta)
|
|
(incf (textarea-cursor-row ta))
|
|
(textarea-ensure-cursor ta))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Undo/redo
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun textarea-push-undo (ta)
|
|
"Save current value on undo stack."
|
|
(let ((stack (textarea-undo-stack ta)))
|
|
(when (>= (length stack) (array-total-size stack))
|
|
(setf (textarea-undo-stack ta)
|
|
(make-array 100 :fill-pointer 0)))
|
|
(vector-push (textarea-value ta) stack)
|
|
;; Clear redo stack on new action
|
|
(setf (fill-pointer (textarea-redo-stack ta)) 0)))
|
|
|
|
(defun textarea-undo (ta)
|
|
(let ((stack (textarea-undo-stack ta)))
|
|
(when (plusp (length stack))
|
|
(let ((prev (vector-pop stack)))
|
|
(vector-push (textarea-value ta) (textarea-redo-stack ta))
|
|
(setf (textarea-value ta) prev)
|
|
(textarea-ensure-cursor ta)
|
|
(mark-dirty ta)))))
|
|
|
|
(defun textarea-redo (ta)
|
|
(let ((stack (textarea-redo-stack ta)))
|
|
(when (plusp (length stack))
|
|
(let ((next (vector-pop stack)))
|
|
(vector-push (textarea-value ta) (textarea-undo-stack ta))
|
|
(setf (textarea-value ta) next)
|
|
(textarea-ensure-cursor ta)
|
|
(mark-dirty ta)))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Key event handler
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun handle-textarea-input (ta event)
|
|
(cond
|
|
((key-event-ctrl event)
|
|
(case (key-event-key event)
|
|
(:z (textarea-undo ta))
|
|
(:y (textarea-redo ta))
|
|
(t (handle-text-input ta event))))
|
|
(t
|
|
(case (key-event-key event)
|
|
(:up (textarea-move-up ta))
|
|
(:down (textarea-move-down ta))
|
|
(:enter (let ((cb (textarea-on-submit ta)))
|
|
(if cb
|
|
(funcall cb (textarea-value ta))
|
|
(textarea-newline ta))))
|
|
(:backspace (textarea-backspace ta))
|
|
(t (handle-text-input ta event))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Rendering
|
|
;;; ---------------------------------------------------------------------------
|
|
(defmethod render ((ta textarea) window)
|
|
(let* ((x (available-x window))
|
|
(y (available-y window))
|
|
(w (available-width window))
|
|
(h (available-height window))
|
|
(fg (theme-color (or *current-theme* (make-theme)) :text))
|
|
(bg (theme-color (or *current-theme* (make-theme)) :background-element))
|
|
(lines (textarea-lines ta))
|
|
(start-row (max 0 (- (textarea-cursor-row ta) (1- h))))
|
|
(visible (subseq lines start-row
|
|
(min (+ start-row h) (length lines)))))
|
|
(loop for i from 0 below (length visible)
|
|
for line = (nth i visible)
|
|
do (draw-text *current-backend* x (+ y i)
|
|
(subseq line 0 (min (length line) w))
|
|
fg bg))
|
|
;; Draw cursor
|
|
(when (and (>= (textarea-cursor-row ta) start-row)
|
|
(< (- (textarea-cursor-row ta) start-row) h))
|
|
(let ((cursor-screen-row (+ y (- (textarea-cursor-row ta) start-row)))
|
|
(cursor-screen-col (+ x (textarea-cursor-col ta)))
|
|
(current-line (nth (textarea-cursor-row ta) lines)))
|
|
(when (< (textarea-cursor-col ta) (length current-line))
|
|
(let ((ch (char current-line (textarea-cursor-col ta))))
|
|
(draw-text *current-backend* cursor-screen-col cursor-screen-row
|
|
(string ch) bg fg :reverse t)))))))
|
|
#+END_SRC
|
|
|
|
** Keybinding System
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/keybindings.lisp
|
|
(in-package #:cl-tui.input)
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Key map struct
|
|
;;; ---------------------------------------------------------------------------
|
|
(defstruct keymap
|
|
(name nil :type (or keyword null))
|
|
(bindings nil :type list) ;; alist: (spec . handler-fn)
|
|
(parent nil :type (or keymap null)))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Global keymap registry
|
|
;;; ---------------------------------------------------------------------------
|
|
(defparameter *keymaps* (make-hash-table :test #'equal))
|
|
(defparameter *chord-timeout* 0.5
|
|
"Seconds to wait for chord completion.")
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Key spec matching
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun key-match-p (spec event)
|
|
"T if SPEC (a key spec form) matches EVENT (a key-event struct)."
|
|
(etypecase spec
|
|
;; Simple keyword: :ctrl+p → key=:p and ctrl=t
|
|
(keyword
|
|
(let* ((name (string spec))
|
|
(colon (position #\: name)))
|
|
(if colon
|
|
(let ((mod-str (subseq name 0 colon))
|
|
(key-str (subseq name (1+ colon))))
|
|
(and (eql (intern key-str :keyword) (key-event-key event))
|
|
(case mod-str
|
|
("ctrl" (key-event-ctrl event))
|
|
("alt" (key-event-alt event))
|
|
("shift" (key-event-shift event))
|
|
(t t))))
|
|
(eql spec (key-event-key event)))))
|
|
;; List: (:ctrl+p) or (:ctrl+x :ctrl+s) (chord)
|
|
(list
|
|
(if (= (length spec) 1)
|
|
;; Single spec: (:ctrl+p)
|
|
(key-match-p (first spec) event)
|
|
;; Chord: (:ctrl+x :ctrl+s) — match first key only for dispatch
|
|
(key-match-p (first spec) event)))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Dispatch
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun dispatch-key-event (event &key component)
|
|
"Route EVENT through focused → local → global keymaps.
|
|
Returns T if handled, NIL if unhandled."
|
|
(labels ((try-keymap (km)
|
|
(when km
|
|
(loop for (spec . handler) in (keymap-bindings km)
|
|
thereis (when (key-match-p spec event)
|
|
(funcall handler event)
|
|
t))))
|
|
(find-keymap (name)
|
|
(gethash name *keymaps*)))
|
|
(or (and component
|
|
(let ((km (component-keymap component)))
|
|
(when km (try-keymap km))))
|
|
(try-keymap (find-keymap :local))
|
|
(try-keymap (find-keymap :global)))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; defkeymap macro
|
|
;;; ---------------------------------------------------------------------------
|
|
(defmacro defkeymap (name &body bindings)
|
|
"Register a keymap with NAME and BINDINGS.
|
|
Each binding: (key-spec . handler-form)"
|
|
`(setf (gethash ',name *keymaps*)
|
|
(make-keymap :name ',name
|
|
:bindings (list ,@(loop for (spec . handler) in bindings
|
|
collect `(cons ',spec ,handler))))))
|
|
|
|
;;; --- Component protocol integration ---
|
|
(defgeneric component-keymap (component)
|
|
(:method ((c t)) nil))
|
|
#+END_SRC
|
|
|
|
** Package
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/input-package.lisp
|
|
(defpackage :cl-tui.input
|
|
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout)
|
|
(:export
|
|
;; Key events
|
|
#:key-event #:make-key-event
|
|
#:key-event-p #:key-event-key #:key-event-ctrl
|
|
#:key-event-alt #:key-event-shift #:key-event-code
|
|
#:key-event-raw #:key-event-text
|
|
;; Mouse events
|
|
#:mouse-event #:make-mouse-event
|
|
#:mouse-event-p #:mouse-event-type #:mouse-event-button
|
|
#:mouse-event-x #:mouse-event-y
|
|
;; Terminal raw mode
|
|
#:save-terminal-state #:set-raw-mode #:restore-terminal-state
|
|
#:with-raw-terminal
|
|
;; Event reading
|
|
#:read-event
|
|
;; TextInput
|
|
#:text-input #:make-text-input
|
|
#:text-input-value #:text-input-cursor
|
|
#:text-input-placeholder #:text-input-max-length
|
|
#:text-input-on-submit #:text-input-layout-node
|
|
#:handle-text-input #:render-text-input
|
|
;; Textarea
|
|
#:textarea #:make-textarea
|
|
#:textarea-value #:textarea-cursor-row #:textarea-cursor-col
|
|
#:textarea-on-submit #:textarea-undo-stack #:textarea-redo-stack
|
|
#:textarea-layout-node
|
|
#:handle-textarea-input #:render-textarea
|
|
;; Keybindings
|
|
#:keymap #:make-keymap #:keymap-name #:keymap-bindings #:keymap-parent
|
|
#:*keymaps* #:*chord-timeout*
|
|
#:defkeymap #:dispatch-key-event #:key-match-p
|
|
#:component-keymap))
|
|
#+END_SRC
|