3 Commits

Author SHA1 Message Date
Hermes Agent
b3b191529a feat: SGR mouse event parsing in read-event
- Add %read-digits to read multi-digit parameters from raw terminal bytes
- Add %parse-sgr-mouse to decode ESC[<Cb;Cx;CyM/m SGR mouse sequences
  into mouse-event structs with :press/:release type and :left/:middle/
  :right/:scroll-up/:scroll-down/:drag button classification
- Modified parse-csi-sequence to detect the < marker (0x3C) and
  delegate to %parse-sgr-mouse instead of treating it as key input
- Coordinates converted from 1-based (terminal protocol) to 0-based
  (framebuffer convention)
- All 12 test suites pass at 100% (461 checks, no regressions)
- Org source (text-input.org) updated as the source of truth
2026-05-12 22:14:03 +00:00
Hermes Agent
38ee561625 v1.0.0: TUI support — resize events, with-terminal macro 2026-05-12 20:32:37 +00:00
Hermes Agent
84e8482fec v1.0.0: TUI support — resize events, with-terminal macro
- read-event now checks *terminal-resized-p* and returns :resize on SIGWINCH
- Added with-terminal convenience macro (detect → init → body → shutdown)
- Exported *terminal-resized-p* from cl-tty.input package
- Exported with-terminal from cl-tty.backend package
- Updated text-input.org with resize event integration and refactored tests
- Tests: 461 checks, 100% pass (93 input suite, +2 new test cases)
2026-05-12 20:28:55 +00:00
6 changed files with 260 additions and 29 deletions

View File

@@ -196,6 +196,7 @@ via ~sb-posix~ directly.
#:with-raw-terminal #:with-raw-terminal
;; Event reading ;; Event reading
#:read-event #:read-event
#:*terminal-resized-p*
;; UTF-8 input support ;; UTF-8 input support
#:utf8-decode #:utf8-decode
;; TextInput ;; TextInput
@@ -510,27 +511,101 @@ different byte prefix from the CSI form ~ESC [ A~ through ~ESC [ D~.
:alt t :code b1)))))) :alt t :code b1))))))
#+END_SRC #+END_SRC
** SGR mouse parser
The SGR extended mouse protocol sends events in the format
~ESC [ < Cb ; Cx ; Cy M/m~ where:
- ~<~ is the SGR marker byte (0x3C)
- ~Cb~ is the button code (0=left, 1=middle, 2=right, 32+=motion/drag,
64=scroll-up, 65=scroll-down)
- ~Cx~, ~Cy~ are the 1-based coordinates
- ~M~ (0x4D) = press, ~m~ (0x6D) = release
The parser splits the byte stream into the three numeric parameters by
reading digits until a non-digit byte is encountered (~%read-digits~),
then converts the button code and press/release flag into a ~mouse-event~.
*** Digit reader
~%read-digits~ reads bytes from the raw terminal input until the first
non-digit byte, handling an optional list of initial bytes that were
already consumed by the caller. Returns the parsed integer and the
terminator byte.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
(defun %read-digits (&optional (initial-bytes nil))
"Read bytes until a non-digit is encountered.
Returns (values number terminator-byte)."
(let ((acc nil))
(dolist (b initial-bytes)
(when (and (>= b 48) (<= b 57))
(push (- b 48) acc)))
(loop for b = (read-raw-byte)
while (and (>= b 48) (<= b 57))
do (push (- b 48) acc)
finally (return (values (if acc
(reduce (lambda (n d) (+ (* n 10) d))
(reverse acc))
0)
b)))))
#+END_SRC
*** Mouse event parser
~%parse-sgr-mouse~ is called after ~ESC[<~ has been consumed by
~parse-csi-sequence~ (which detects the SGR marker byte). It reads the
three semicolon-separated parameters using ~%read-digits~ and constructs
a ~mouse-event~ struct with proper button and type classification.
Coordinates are converted from 1-based (terminal protocol) to 0-based
(framebuffer convention) by subtracting 1 from both x and y.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
(defun %parse-sgr-mouse ()
"Parse SGR mouse escape sequence: ESC [ < Cb ; Cx ; Cy M/m
Returns a mouse-event struct."
(let ((b (read-raw-byte)))
(multiple-value-bind (cb sep1) (%read-digits (list b))
(declare (ignore sep1))
(multiple-value-bind (cx sep2) (%read-digits)
(declare (ignore sep2))
(multiple-value-bind (cy term) (%read-digits)
(let ((button (cond
((= cb 0) :left)
((= cb 1) :middle)
((= cb 2) :right)
((= cb 64) :scroll-up)
((= cb 65) :scroll-down)
((>= cb 32) :drag)
(t :left)))
(type (cond
((= term 77) :press)
((= term 109) :release)
(t :press))))
(make-mouse-event :type type :button button
:x (- cx 1) :y (- cy 1))))))))
#+END_SRC
** CSI sequence parser ** CSI sequence parser
~parse-csi-sequence~ reads and parses a full Control Sequence Introducer ~parse-csi-sequence~ reads and parses a full Control Sequence Introducer
sequence: ~ESC [ (param) (terminator)~. sequence: ~ESC [ (param) (terminator)~ or SGR mouse events: ~ESC [ < Cb ; Cx ; Cy M/m~.
The function implements a recursive descent parser for the CSI grammar: The function implements a recursive descent parser for the CSI grammar:
- Read the first byte after ~ESC [~. - Read the first byte after ~ESC [~.
- If it's ~~<~~ (0x3C), the sequence is an SGR mouse event — delegate to
~%parse-sgr-mouse~ which returns a ~mouse-event~ struct.
- If it's a digit (0x30-0x39), collect all consecutive digits as the first - If it's a digit (0x30-0x39), collect all consecutive digits as the first
parameter, then the next non-digit byte is the terminator. parameter, then the next non-digit byte is the terminator.
- If it's not a digit, it may be a modifier byte (0x3B = semicolon, in - If it's not a digit, it may be a modifier byte or the terminator itself.
extended sequences) or the terminator itself.
The ~extended~ array accumulates raw parameter bytes for sequences where The ~extended~ array accumulates raw parameter bytes for sequences where
the modifier appears after the primary parameter in an extended format the modifier appears after the primary parameter in an extended format
(e.g., ~ESC [ 1 ; 5 A~ where 5 encodes Ctrl+Shift). This array is passed (e.g., ~ESC [ 1 ; 5 A~ where 5 encodes Ctrl+Shift). This array is passed
to ~parse-csi-params~ for modifier extraction. to ~parse-csi-params~ for modifier extraction.
The two-pass approach (parse bytes → look up semantics) cleanly separates
the byte-level parsing concern from the key-mapping concern, making both
easier to test and debug independently.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp #+BEGIN_SRC lisp :tangle ../src/components/input.lisp
(defun parse-csi-sequence () (defun parse-csi-sequence ()
(flet ((read-param (next-fn) (let ((acc nil)) (flet ((read-param (next-fn) (let ((acc nil))
@@ -538,16 +613,18 @@ easier to test and debug independently.
do (if (and (>= b 48) (<= b 57)) do (if (and (>= b 48) (<= b 57))
(push (- b 48) acc) (push (- b 48) acc)
(return (values (reverse acc) b))))))) (return (values (reverse acc) b)))))))
(let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0)) (let* ((b2 (read-raw-byte)))
(b2 (read-raw-byte)) (if (= b2 60) ;; < — SGR mouse marker
(params (if (and (>= b2 48) (<= b2 57)) (%parse-sgr-mouse)
(multiple-value-bind (p term) (read-param (lambda () (read-raw-byte))) (let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))
(setf (fill-pointer extended) (length p)) (params (if (and (>= b2 48) (<= b2 57))
(replace extended p) (multiple-value-bind (p term) (read-param (lambda () (read-raw-byte)))
(values p term)) (setf (fill-pointer extended) (length p))
(progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte))))))) (replace extended p)
(destructuring-bind (params terminator) params (values p term))
(parse-csi-params params terminator extended))))) (progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte)))))))
(destructuring-bind (params terminator) params
(parse-csi-params params terminator extended)))))))
#+END_SRC #+END_SRC
** UTF-8 decoder ** UTF-8 decoder
@@ -686,6 +763,27 @@ after handling the resize.
(setf *terminal-resized-p* t)))) (setf *terminal-resized-p* t))))
#+END_SRC #+END_SRC
** Raw terminal mode
Most terminal applications need raw mode (no echo, character-by-character
input). SBCL's ~SB-POSIX:WITH-RAW-TERMINAL~ is not available in all builds
(e.g. Debian-packaged SBCL 2.5.x). This implementation uses ~stty~ for
portability.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
(defun %raw-mode-on ()
(uiop:run-program '("stty" "raw" "-echo" "-echoe" "-echok" "-onlcr") :output nil :error-output nil))
(defun %raw-mode-off ()
(uiop:run-program '("stty" "sane") :output nil :error-output nil))
(defmacro with-raw-terminal (&body body)
"Execute BODY with the terminal in raw mode."
`(unwind-protect
(progn (%raw-mode-on) ,@body)
(%raw-mode-off)))
#+END_SRC
** Backend protocol integration ** Backend protocol integration
~read-event~ is a ~defmethod~ on the backend generic function, part of the ~read-event~ is a ~defmethod~ on the backend generic function, part of the
@@ -703,7 +801,12 @@ All the complexity lives in ~%read-event~ and its callees.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp #+BEGIN_SRC lisp :tangle ../src/components/input.lisp
(defmethod read-event ((b cl-tty.backend:backend) &key timeout) (defmethod read-event ((b cl-tty.backend:backend) &key timeout)
(declare (ignore b)) ;; Check for pending terminal resize before reading input.
;; The SIGWINCH handler sets *terminal-resized-p* asynchronously.
(when *terminal-resized-p*
(setf *terminal-resized-p* nil)
(multiple-value-bind (w h) (backend-size b)
(return-from read-event (values :resize (cons w h)))))
(when (probe-file "/dev/stdin") (when (probe-file "/dev/stdin")
(%read-event :timeout timeout))) (%read-event :timeout timeout)))
#+END_SRC #+END_SRC
@@ -2062,4 +2165,22 @@ The test suite is tangled to ~../tests/input-tests.lisp~ and covers:
(remhash :local *keymaps*) (remhash :local *keymaps*)
(is-false (gethash :global *keymaps*)) (is-false (gethash :global *keymaps*))
(is-false (gethash :local *keymaps*))) (is-false (gethash :local *keymaps*)))
(test resize-event-check
"read-event returns :resize when *terminal-resized-p* is set"
(let ((b (make-instance 'cl-tty.backend:backend)))
(setf cl-tty.input:*terminal-resized-p* t)
(multiple-value-bind (type data) (cl-tty.input:read-event b :timeout 0)
(is (eq :resize type))
(is (consp data))
(is (integerp (car data)))
(is (integerp (cdr data))))
(is-false cl-tty.input:*terminal-resized-p*)))
(test with-terminal-macro-expands
"with-terminal macro expands and compiles"
(is (macro-function 'cl-tty.backend:with-terminal))
(let ((expanded (macroexpand-1 '(cl-tty.backend:with-terminal (be)
(print be)))))
(is (listp expanded))))
#+END_SRC #+END_SRC

View File

@@ -18,6 +18,37 @@ Called before SIGTSTP or similar suspension. Application should redraw after res
Called after SIGCONT or similar resume. Re-enables raw mode and backend features.") Called after SIGCONT or similar resume. Re-enables raw mode and backend features.")
(:method ((b backend)) (values))) (:method ((b backend)) (values)))
(defmacro with-terminal ((backend-var &optional cols-var rows-var)
&body body)
"Execute BODY with a fully initialized terminal backend.
DETECT-BACKEND, INITIALIZE-BACKEND, and SHUTDOWN-BACKEND are called
automatically. The backend instance is bound to BACKEND-VAR. If
COLS-VAR and ROWS-VAR are provided, they are bound to the terminal
dimensions at startup.
The caller should wrap this in SB-POSIX:WITH-RAW-TERMINAL (or
equivalent) if raw-mode input handling is needed.
Example:
(with-terminal (be cols rows)
(loop for ev = (read-event be :timeout 0.1)
while ev
do (format t \"~A~%\" ev))))"
(let ((be-sym (gensym "BE"))
(c-sym (gensym "COLS"))
(r-sym (gensym "ROWS")))
`(let* ((,be-sym (detect-backend))
,@(when cols-var `((,c-sym (nth-value 0 (backend-size ,be-sym)))))
,@(when rows-var `((,r-sym (nth-value 1 (backend-size ,be-sym))))))
(initialize-backend ,be-sym)
(unwind-protect
(let ((,backend-var ,be-sym)
,@(when cols-var `((,cols-var ,c-sym)))
,@(when rows-var `((,rows-var ,r-sym))))
,@body)
(shutdown-backend ,be-sym)))))
(defgeneric backend-size (backend) (defgeneric backend-size (backend)
(:method ((b backend)) (:method ((b backend))
(values 80 24))) (values 80 24)))

View File

@@ -20,6 +20,7 @@
#:capable-p #:capable-p
;; Constructors ;; Constructors
#:make-simple-backend #:make-simple-backend
#:with-terminal
;; Modern backend ;; Modern backend
#:modern-backend #:make-modern-backend #:modern-backend #:make-modern-backend
;; Detection ;; Detection

View File

@@ -15,6 +15,7 @@
#:with-raw-terminal #:with-raw-terminal
;; Event reading ;; Event reading
#:read-event #:read-event
#:*terminal-resized-p*
;; UTF-8 input support ;; UTF-8 input support
#:utf8-decode #:utf8-decode
;; TextInput ;; TextInput

View File

@@ -110,22 +110,64 @@
(t (make-key-event :key (intern (string-upcase (string (code-char b1))) :keyword) (t (make-key-event :key (intern (string-upcase (string (code-char b1))) :keyword)
:alt t :code b1)))))) :alt t :code b1))))))
(defun %read-digits (&optional (initial-bytes nil))
"Read bytes until a non-digit is encountered.
Returns (values number terminator-byte)."
(let ((acc nil))
(dolist (b initial-bytes)
(when (and (>= b 48) (<= b 57))
(push (- b 48) acc)))
(loop for b = (read-raw-byte)
while (and (>= b 48) (<= b 57))
do (push (- b 48) acc)
finally (return (values (if acc
(reduce (lambda (n d) (+ (* n 10) d))
(reverse acc))
0)
b)))))
(defun %parse-sgr-mouse ()
"Parse SGR mouse escape sequence: ESC [ < Cb ; Cx ; Cy M/m
Returns a mouse-event struct."
(let ((b (read-raw-byte)))
(multiple-value-bind (cb sep1) (%read-digits (list b))
(declare (ignore sep1))
(multiple-value-bind (cx sep2) (%read-digits)
(declare (ignore sep2))
(multiple-value-bind (cy term) (%read-digits)
(let ((button (cond
((= cb 0) :left)
((= cb 1) :middle)
((= cb 2) :right)
((= cb 64) :scroll-up)
((= cb 65) :scroll-down)
((>= cb 32) :drag)
(t :left)))
(type (cond
((= term 77) :press)
((= term 109) :release)
(t :press))))
(make-mouse-event :type type :button button
:x (- cx 1) :y (- cy 1))))))))
(defun parse-csi-sequence () (defun parse-csi-sequence ()
(flet ((read-param (next-fn) (let ((acc nil)) (flet ((read-param (next-fn) (let ((acc nil))
(loop for b = (funcall next-fn) (loop for b = (funcall next-fn)
do (if (and (>= b 48) (<= b 57)) do (if (and (>= b 48) (<= b 57))
(push (- b 48) acc) (push (- b 48) acc)
(return (values (reverse acc) b))))))) (return (values (reverse acc) b)))))))
(let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0)) (let* ((b2 (read-raw-byte)))
(b2 (read-raw-byte)) (if (= b2 60) ;; < — SGR mouse marker
(params (if (and (>= b2 48) (<= b2 57)) (%parse-sgr-mouse)
(multiple-value-bind (p term) (read-param (lambda () (read-raw-byte))) (let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))
(setf (fill-pointer extended) (length p)) (params (if (and (>= b2 48) (<= b2 57))
(replace extended p) (multiple-value-bind (p term) (read-param (lambda () (read-raw-byte)))
(values p term)) (setf (fill-pointer extended) (length p))
(progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte))))))) (replace extended p)
(destructuring-bind (params terminator) params (values p term))
(parse-csi-params params terminator extended))))) (progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte)))))))
(destructuring-bind (params terminator) params
(parse-csi-params params terminator extended)))))))
(defun utf8-decode (bytes) (defun utf8-decode (bytes)
(case (length bytes) (case (length bytes)
@@ -185,7 +227,24 @@
(declare (ignore signal info context)) (declare (ignore signal info context))
(setf *terminal-resized-p* t)))) (setf *terminal-resized-p* t))))
(defun %raw-mode-on ()
(uiop:run-program '("stty" "raw" "-echo" "-echoe" "-echok" "-onlcr") :output nil :error-output nil))
(defun %raw-mode-off ()
(uiop:run-program '("stty" "sane") :output nil :error-output nil))
(defmacro with-raw-terminal (&body body)
"Execute BODY with the terminal in raw mode."
`(unwind-protect
(progn (%raw-mode-on) ,@body)
(%raw-mode-off)))
(defmethod read-event ((b cl-tty.backend:backend) &key timeout) (defmethod read-event ((b cl-tty.backend:backend) &key timeout)
(declare (ignore b)) ;; Check for pending terminal resize before reading input.
;; The SIGWINCH handler sets *terminal-resized-p* asynchronously.
(when *terminal-resized-p*
(setf *terminal-resized-p* nil)
(multiple-value-bind (w h) (backend-size b)
(return-from read-event (values :resize (cons w h)))))
(when (probe-file "/dev/stdin") (when (probe-file "/dev/stdin")
(%read-event :timeout timeout))) (%read-event :timeout timeout)))

View File

@@ -389,3 +389,21 @@
(remhash :local *keymaps*) (remhash :local *keymaps*)
(is-false (gethash :global *keymaps*)) (is-false (gethash :global *keymaps*))
(is-false (gethash :local *keymaps*))) (is-false (gethash :local *keymaps*)))
(test resize-event-check
"read-event returns :resize when *terminal-resized-p* is set"
(let ((b (make-instance 'cl-tty.backend:backend)))
(setf cl-tty.input:*terminal-resized-p* t)
(multiple-value-bind (type data) (cl-tty.input:read-event b :timeout 0)
(is (eq :resize type))
(is (consp data))
(is (integerp (car data)))
(is (integerp (cdr data))))
(is-false cl-tty.input:*terminal-resized-p*)))
(test with-terminal-macro-expands
"with-terminal macro expands and compiles"
(is (macro-function 'cl-tty.backend:with-terminal))
(let ((expanded (macroexpand-1 '(cl-tty.backend:with-terminal (be)
(print be)))))
(is (listp expanded))))