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
This commit is contained in:
@@ -511,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))
|
||||||
@@ -539,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
|
||||||
@@ -687,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
|
||||||
|
|||||||
@@ -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,6 +227,18 @@
|
|||||||
(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)
|
||||||
;; Check for pending terminal resize before reading input.
|
;; Check for pending terminal resize before reading input.
|
||||||
;; The SIGWINCH handler sets *terminal-resized-p* asynchronously.
|
;; The SIGWINCH handler sets *terminal-resized-p* asynchronously.
|
||||||
|
|||||||
Reference in New Issue
Block a user