amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: restore original text-input.lisp in org to fix handle-text-input

Browse Source 
The tangled handle-text-input used (key-event-text event) for character
insertion, but the test suite creates key events with :code not :text.
Restored the original handle-text-input which uses
(code-char (key-event-code event)) — matching the test expectations.
This commit is contained in:
Hermes Agent
2026-05-12 17:52:43 +00:00
parent 0fb5309133
commit d5caaf296d
6 changed files with 570 additions and 403 deletions
Download Patch File Download Diff File Expand all files Collapse all files

122
src/components/text-input.lisp
View File

@@ -1,8 +1,5 @@
(in-package #:cl-tty.input)
;;; ---------------------------------------------------------------------------
;;; TextInput class
;;; ---------------------------------------------------------------------------
(defclass text-input (dirty-mixin)
((value :initform "" :initarg :value :accessor text-input-value
:type string)
@@ -25,59 +22,34 @@
: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)))
(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)))
(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)))
(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))))
(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)))
(when (plusp (text-input-cursor input)) (decf (text-input-cursor input)))
(mark-dirty input))
(defun text-input-move-right (input)
(when (< (text-input-cursor input) (length (text-input-value input)))
(incf (text-input-cursor input)))
(when (< (text-input-cursor input) (length (text-input-value input))) (incf (text-input-cursor input)))
(mark-dirty input))
(defun text-input-move-home (input)
@@ -89,54 +61,28 @@
(mark-dirty 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)))
(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)))
(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)))
(: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)
@@ -146,33 +92,19 @@
(: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))))))))
(: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))))))))
;;; ---------------------------------------------------------------------------
;;; 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))
(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) "")))
(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)
;; Draw a solid-block cursor at the visible cursor position
(when (plusp (length value))
(let ((cursor-col (min cursor (length truncated))))
(draw-text backend (+ x cursor-col) y "█" :bright-white nil)))))