c3c330dfff
CRITICAL: case b → cond in %read-event (input.lisp:280)
case with (and ...) predicate clauses treats keys as eql-compared
atoms — all range clauses were dead code. Every Ctrl+letter and
printable ASCII fell through to :unknown. text-input/textarea
widgets were non-functional with real terminal input. No test
coverage of %read-event masked this.
HIGH: Theme resolution wired (backend/modern.lisp, theme.lisp)
sgr-fg/sgr-bg now fall back to *theme-colors* hash for semantic
keywords (:accent, :text-muted, :background-element). *theme-colors*
exported from cl-tty.backend. load-preset populates it from preset
hex values. Previously all themed render output was invisible.
HIGH: SGR mouse parser wired (input.lisp:210-215)
parse-sgr-mouse was defined but never called. Now %read-escape-sequence
detects ESC[< prefix and routes to parse-sgr-mouse. Mouse drags,
releases, and scroll events now parse correctly.
MEDIUM: Rendering stubs replaced
- scrollbox: delegates to (render child backend) with position
offset via unwind-protect (was debug string 'child at ~D')
- text-input: draws value/placeholder at layout position
- textarea: draws visible lines at layout position
MEDIUM: hit-test uses component-layout-node (mouse.lisp:18-31)
Was checking nonexistent x/y/width/height slots. Now reads
layout-node-x/y/w/h via component-layout-node generic.
MEDIUM: test runner exit code (run-all-tests.lisp, cl-tty.asd)
run-all-tests.lisp exits 1 if any suite fails.
asdf:test-system exits 1 on failure.
Renamed :cl-tty-tests to :cl-tty/test (ASDF convention).
MEDIUM: draw-border respects x/y on simple-backend (simple.lisp:42-53)
Was writing to cursor position only. Now uses newlines+spaces
to reach specified coordinates (no escape sequences needed).
LOW: TabBar truncation off-by-one fixed (tabbar.lisp:47)
>= changed to > to avoid cutting tabs 2 chars early.
LOW: Scrollbar coordinates absolute (scrollbox.lisp:61-73)
Scrollbar drawn at viewport-relative (0,0). Now adds layout
node x/y offset for correct terminal positioning.
LOW: backend-write calls finish-output (modern.lisp:169)
LOW: load-preset no longer flips theme-mode (theme.lisp:43-45)
Mode toggle caused load-preset to load wrong variant on
second call.
All backported to org source files (org/text-input.org,
org/scrollbox-tabbar.org) so tangling produces matching .lisp.
392 tests pass, exit code 0.
171 lines
6.7 KiB
Common Lisp
171 lines
6.7 KiB
Common Lisp
(in-package #:cl-tty.input)
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; TextInput class
|
|
;;; ---------------------------------------------------------------------------
|
|
(defclass text-input (dirty-mixin)
|
|
((value :initform "" :initarg :value :accessor text-input-value
|
|
:type string)
|
|
(cursor :initform 0 :initarg :cursor :accessor text-input-cursor
|
|
:type fixnum)
|
|
(placeholder :initform "" :initarg :placeholder
|
|
:accessor text-input-placeholder :type string)
|
|
(max-length :initform nil :initarg :max-length
|
|
:accessor text-input-max-length)
|
|
(on-submit :initform nil :initarg :on-submit
|
|
:accessor text-input-on-submit)
|
|
(layout-node :initform (make-layout-node) :accessor text-input-layout-node)
|
|
(focusable :initform t :accessor text-input-focusable)))
|
|
|
|
(defun make-text-input (&key value cursor placeholder max-length on-submit)
|
|
(make-instance 'text-input
|
|
:value (or value "")
|
|
:cursor (or cursor 0)
|
|
:placeholder (or placeholder "")
|
|
:max-length max-length
|
|
:on-submit on-submit))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Editing operations
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun text-input-insert (input char)
|
|
"Insert CHAR at the cursor position in INPUT."
|
|
(let* ((val (text-input-value input))
|
|
(pos (text-input-cursor input))
|
|
(max (text-input-max-length input)))
|
|
(when (and max (>= (length val) max))
|
|
(return-from text-input-insert))
|
|
(setf (text-input-value input)
|
|
(concatenate 'string
|
|
(subseq val 0 pos)
|
|
(string char)
|
|
(subseq val pos)))
|
|
(incf (text-input-cursor input))
|
|
(mark-dirty input)))
|
|
|
|
(defun text-input-backspace (input)
|
|
"Delete character before cursor."
|
|
(let* ((val (text-input-value input))
|
|
(pos (text-input-cursor input)))
|
|
(when (zerop pos) (return-from text-input-backspace))
|
|
(setf (text-input-value input)
|
|
(concatenate 'string
|
|
(subseq val 0 (1- pos))
|
|
(subseq val pos)))
|
|
(decf (text-input-cursor input))
|
|
(mark-dirty input)))
|
|
|
|
(defun text-input-delete (input)
|
|
"Delete character at cursor."
|
|
(let* ((val (text-input-value input))
|
|
(pos (text-input-cursor input)))
|
|
(when (>= pos (length val))
|
|
(return-from text-input-delete))
|
|
(setf (text-input-value input)
|
|
(concatenate 'string
|
|
(subseq val 0 pos)
|
|
(subseq val (1+ pos))))
|
|
(mark-dirty input)))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Cursor movement
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun text-input-move-left (input)
|
|
(when (plusp (text-input-cursor input))
|
|
(decf (text-input-cursor input))))
|
|
|
|
(defun text-input-move-right (input)
|
|
(when (< (text-input-cursor input) (length (text-input-value input)))
|
|
(incf (text-input-cursor input))))
|
|
|
|
(defun text-input-move-home (input)
|
|
(setf (text-input-cursor input) 0))
|
|
|
|
(defun text-input-move-end (input)
|
|
(setf (text-input-cursor input) (length (text-input-value input))))
|
|
|
|
(defun text-input-delete-word-before (input)
|
|
"Delete from cursor back to previous word boundary."
|
|
(let* ((val (text-input-value input))
|
|
(pos (text-input-cursor input)))
|
|
(when (zerop pos)
|
|
(return-from text-input-delete-word-before))
|
|
(let* ((start (or (position-if (lambda (c) (not (char= c #\Space)))
|
|
val :end pos :from-end t)
|
|
0))
|
|
(word-start (or (and (plusp start)
|
|
(position #\Space val :end start :from-end t))
|
|
0))
|
|
(delete-start (if (and (zerop word-start)
|
|
(or (char/= (char val 0) #\Space)
|
|
(zerop start)))
|
|
0
|
|
(if (zerop start)
|
|
(1+ word-start)
|
|
(1+ (or (position #\Space val :end start :from-end t)
|
|
0))))))
|
|
(setf (text-input-value input)
|
|
(concatenate 'string
|
|
(subseq val 0 delete-start)
|
|
(subseq val pos)))
|
|
(setf (text-input-cursor input) delete-start)
|
|
(mark-dirty input))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Key event handler
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun handle-text-input (input event)
|
|
"Process a key-event on a text-input widget."
|
|
(cond
|
|
((key-event-ctrl event)
|
|
(case (key-event-key event)
|
|
(:a (text-input-move-home input))
|
|
(:e (text-input-move-end input))
|
|
(:w (text-input-delete-word-before input))
|
|
(:u (progn
|
|
(setf (text-input-value input)
|
|
(subseq (text-input-value input)
|
|
(text-input-cursor input)))
|
|
(setf (text-input-cursor input) 0)
|
|
(mark-dirty input)))
|
|
(:k (progn
|
|
(setf (text-input-value input)
|
|
(subseq (text-input-value input) 0
|
|
(text-input-cursor input)))
|
|
(mark-dirty input)))
|
|
(t nil)))
|
|
(t
|
|
(case (key-event-key event)
|
|
(:left (text-input-move-left input))
|
|
(:right (text-input-move-right input))
|
|
(:home (text-input-move-home input))
|
|
(:end (text-input-move-end input))
|
|
(:backspace (text-input-backspace input))
|
|
(:delete (text-input-delete input))
|
|
(:enter (let ((cb (text-input-on-submit input)))
|
|
(when cb (funcall cb (text-input-value input)))))
|
|
(:tab nil)
|
|
(:escape nil)
|
|
;; Insert printable characters
|
|
(otherwise
|
|
(let ((ch (code-char (key-event-code event))))
|
|
(when (and ch (graphic-char-p ch))
|
|
(text-input-insert input ch))))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Rendering
|
|
;;; ---------------------------------------------------------------------------
|
|
(defmethod render ((in text-input) (backend t))
|
|
"Render text-input value or placeholder at layout position."
|
|
(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) ""))))
|
|
(declare (ignore w cursor))
|
|
(draw-text backend x y display nil nil)))
|