a294f21c70
CRITICAL: Remove (declare (ignore w)) from textarea render (textarea.lisp:251) w is used for horizontal truncation on the next line. Declaring it ignored while using it is undefined behavior in CL (SBCL warns). HIGH: hit-test recurses into children (mouse.lisp:18-34) Was returning the root component for any click within its bounds, ignoring nested widgets entirely. Now checks component-children first, returning the deepest match. MEDIUM: Select/TabBar position hardcoded to (0,0) Both rendered at terminal origin regardless of layout position. Now read layout-node-x/y for absolute positioning. MEDIUM: Text-input truncation missing Render drew full value string even when exceeding widget width. Now truncates to (min (length display) w). MEDIUM: X10 mouse release detection added (input.lisp:219-226) X10 encoding uses button=3 for release. Was detecting all events as press/drag. Now checks button=3 → :release. MEDIUM: parse-csi-params handles private markers (input.lisp:128-131) < = > ? characters (0x3c-0x3f) treated as parameter start markers instead of accumulating bogus digit values. Latent trap removed. Deferred (pre-existing design): - Scrollbox visibility cy vs orig-y: match for column layout (common case) - Nested scrollbox coordinates: assumes sequential layout positions - text-input cursor drawing: feature, not bugfix 392 tests pass.
256 lines
10 KiB
Common Lisp
256 lines
10 KiB
Common Lisp
(in-package #:cl-tty.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-string (textarea-value ta) #\Newline))
|
|
|
|
(defun textarea-line-count (ta)
|
|
"Number of lines in value."
|
|
(length (textarea-lines ta)))
|
|
|
|
(defun textarea-ensure-cursor (ta)
|
|
"Clamp cursor to valid range."
|
|
(let ((lines (textarea-lines ta)))
|
|
(setf (textarea-cursor-row ta)
|
|
(max 0 (min (textarea-cursor-row ta) (1- (length lines)))))
|
|
(let ((line-len (length (nth (textarea-cursor-row ta) lines))))
|
|
(setf (textarea-cursor-col ta)
|
|
(max 0 (min (textarea-cursor-col ta) line-len))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Utility: join strings with newline
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun %join-lines (lines)
|
|
"Join a sequence of strings with newlines."
|
|
(with-output-to-string (s)
|
|
(loop for line across (if (listp lines) (coerce lines 'vector) lines)
|
|
for first = t then nil
|
|
do (unless first (write-char #\Newline s))
|
|
(write-string line s))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Text manipulation
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun textarea-insert-char (ta char)
|
|
"Insert CHAR at the cursor position."
|
|
(textarea-push-undo ta)
|
|
(let* ((lines (coerce (textarea-lines ta) 'vector))
|
|
(row (textarea-cursor-row ta))
|
|
(col (textarea-cursor-col ta)))
|
|
(if (< row (length lines))
|
|
(let* ((line (aref lines row))
|
|
(new-line (concatenate 'string
|
|
(subseq line 0 col)
|
|
(string char)
|
|
(subseq line col))))
|
|
(setf (aref lines row) new-line)
|
|
(setf (textarea-value ta)
|
|
(%join-lines lines))
|
|
(incf (textarea-cursor-col ta))
|
|
(mark-dirty ta))
|
|
(progn
|
|
(setf (textarea-value ta)
|
|
(concatenate 'string (textarea-value ta) (string char)))
|
|
(incf (textarea-cursor-col ta))
|
|
(mark-dirty ta)))))
|
|
|
|
(defun textarea-newline (ta)
|
|
"Insert a newline at the cursor."
|
|
(textarea-push-undo ta)
|
|
(let* ((lines (coerce (textarea-lines ta) 'vector))
|
|
(row (textarea-cursor-row ta))
|
|
(col (textarea-cursor-col ta)))
|
|
(if (< row (length lines))
|
|
(let* ((line (aref lines row))
|
|
(before (subseq line 0 col))
|
|
(after (subseq line col)))
|
|
(setf (aref lines row) before)
|
|
(let ((new-lines (concatenate 'vector
|
|
(subseq lines 0 (1+ row))
|
|
(vector after)
|
|
(subseq lines (1+ row)))))
|
|
(setf (textarea-value ta)
|
|
(%join-lines new-lines)))
|
|
(incf (textarea-cursor-row ta))
|
|
(setf (textarea-cursor-col ta) 0)
|
|
(mark-dirty ta))
|
|
(progn
|
|
(setf (textarea-value ta)
|
|
(concatenate 'string (textarea-value ta) (string #\Newline)))
|
|
(incf (textarea-cursor-row ta))
|
|
(setf (textarea-cursor-col ta) 0)
|
|
(mark-dirty ta)))))
|
|
|
|
(defun textarea-backspace (ta)
|
|
"Delete character before cursor."
|
|
(textarea-push-undo ta)
|
|
(let* ((lines (coerce (textarea-lines ta) 'vector))
|
|
(row (textarea-cursor-row ta))
|
|
(col (textarea-cursor-col ta)))
|
|
(cond
|
|
((and (zerop row) (zerop col))
|
|
nil) ;; nothing to delete
|
|
((zerop col)
|
|
;; Join with previous line
|
|
(let* ((prev (aref lines (1- row)))
|
|
(curr (aref lines row))
|
|
(new-pos (length prev)))
|
|
(setf (aref lines (1- row))
|
|
(concatenate 'string prev curr))
|
|
(let ((new-lines (concatenate 'vector
|
|
(subseq lines 0 row)
|
|
(subseq lines (1+ row)))))
|
|
(setf (textarea-value ta)
|
|
(%join-lines new-lines)))
|
|
(decf (textarea-cursor-row ta))
|
|
(setf (textarea-cursor-col ta) new-pos)
|
|
(mark-dirty ta)))
|
|
(t
|
|
(let* ((line (aref lines row))
|
|
(new-line (concatenate 'string
|
|
(subseq line 0 (1- col))
|
|
(subseq line col))))
|
|
(setf (aref lines row) new-line)
|
|
(setf (textarea-value ta)
|
|
(%join-lines lines))
|
|
(decf (textarea-cursor-col ta))
|
|
(mark-dirty ta))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Cursor movement
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun textarea-move-up (ta)
|
|
(decf (textarea-cursor-row ta))
|
|
(textarea-ensure-cursor ta))
|
|
|
|
(defun textarea-move-down (ta)
|
|
(incf (textarea-cursor-row ta))
|
|
(textarea-ensure-cursor ta))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Undo/redo
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun textarea-push-undo (ta)
|
|
"Save current value on undo stack."
|
|
(let ((stack (textarea-undo-stack ta)))
|
|
(when (>= (length stack) (array-total-size stack))
|
|
(loop for i from 1 below (length stack)
|
|
do (setf (aref stack (1- i)) (aref stack i)))
|
|
(decf (fill-pointer stack)))
|
|
(vector-push (textarea-value ta) stack)
|
|
(setf (fill-pointer (textarea-redo-stack ta)) 0)))
|
|
|
|
(defun textarea-undo (ta)
|
|
(let ((stack (textarea-undo-stack ta)))
|
|
(when (plusp (length stack))
|
|
(let ((prev (vector-pop stack)))
|
|
(vector-push (textarea-value ta) (textarea-redo-stack ta))
|
|
(setf (textarea-value ta) prev)
|
|
(textarea-ensure-cursor ta)
|
|
(mark-dirty ta)))))
|
|
|
|
(defun textarea-redo (ta)
|
|
(let ((stack (textarea-redo-stack ta)))
|
|
(when (plusp (length stack))
|
|
(let ((next (vector-pop stack)))
|
|
(vector-push (textarea-value ta) (textarea-undo-stack ta))
|
|
(setf (textarea-value ta) next)
|
|
(textarea-ensure-cursor ta)
|
|
(mark-dirty ta)))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Key event handler
|
|
;;; ---------------------------------------------------------------------------
|
|
(defun handle-textarea-input (ta event)
|
|
"Process a key-event on a textarea widget."
|
|
(cond
|
|
((key-event-ctrl event)
|
|
(case (key-event-key event)
|
|
(:z (textarea-undo ta))
|
|
(:y (textarea-redo ta))
|
|
;; Ctrl+A/E: home/end
|
|
(:a (setf (textarea-cursor-col ta) 0))
|
|
(:e (let ((lines (textarea-lines ta)))
|
|
(when (< (textarea-cursor-row ta) (length lines))
|
|
(setf (textarea-cursor-col ta)
|
|
(length (nth (textarea-cursor-row ta) lines))))))
|
|
(t nil)))
|
|
(t
|
|
(case (key-event-key event)
|
|
(:left (decf (textarea-cursor-col ta))
|
|
(textarea-ensure-cursor ta))
|
|
(:right (incf (textarea-cursor-col ta))
|
|
(textarea-ensure-cursor ta))
|
|
(:up (textarea-move-up ta))
|
|
(:down (textarea-move-down ta))
|
|
(:home (setf (textarea-cursor-col ta) 0))
|
|
(:end (let ((lines (textarea-lines ta)))
|
|
(when (< (textarea-cursor-row ta) (length lines))
|
|
(setf (textarea-cursor-col ta)
|
|
(length (nth (textarea-cursor-row ta) lines))))))
|
|
(:enter (let ((cb (textarea-on-submit ta)))
|
|
(if cb
|
|
(funcall cb (textarea-value ta))
|
|
(textarea-newline ta))))
|
|
(:backspace (textarea-backspace ta))
|
|
(:delete (let* ((lines (textarea-lines ta))
|
|
(row (textarea-cursor-row ta))
|
|
(col (textarea-cursor-col ta))
|
|
(line (nth row lines)))
|
|
(when (and line (< col (length line)))
|
|
(textarea-push-undo ta)
|
|
(setf (nth row lines)
|
|
(concatenate 'string
|
|
(subseq line 0 col)
|
|
(subseq line (1+ col))))
|
|
(setf (textarea-value ta)
|
|
(%join-lines lines))
|
|
(mark-dirty ta))))
|
|
;; Character insertion
|
|
(otherwise
|
|
(let ((ch (code-char (key-event-code event))))
|
|
(when (and ch (graphic-char-p ch))
|
|
(textarea-insert-char ta ch))))))))
|
|
|
|
;;; ---------------------------------------------------------------------------
|
|
;;; Rendering
|
|
;;; ---------------------------------------------------------------------------
|
|
(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))))
|