d5caaf296d
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.
111 lines
5.1 KiB
Common Lisp
111 lines
5.1 KiB
Common 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)))
|
|
|
|
(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))
|
|
|
|
(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)))
|
|
|
|
(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)))
|
|
|
|
(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)))
|
|
|
|
(defun text-input-move-left (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)))
|
|
(mark-dirty input))
|
|
|
|
(defun text-input-move-home (input)
|
|
(setf (text-input-cursor input) 0)
|
|
(mark-dirty input))
|
|
|
|
(defun text-input-move-end (input)
|
|
(setf (text-input-cursor input) (length (text-input-value input)))
|
|
(mark-dirty input))
|
|
|
|
(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))))
|
|
|
|
(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))))))))
|
|
|
|
(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)))))
|