Compare commits
4 Commits
3cbcfd2d75
...
feature/v0
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
d4aba6ef06 | ||
|
|
b3b191529a | ||
|
|
38ee561625 | ||
|
|
84e8482fec |
@@ -201,6 +201,28 @@ Checklist:
|
||||
- [X] Suspend/resume-backend protocol methods (ARCHITECTURE.org spec)
|
||||
- [X] Slot modes (defslot :mode parameter)
|
||||
|
||||
** v1.1.0: SGR Mouse Event Parsing
|
||||
|
||||
DONE. ~read-event~ now decodes SGR extended mouse sequences
|
||||
(~ESC[<Cb;Cx;CyM/m~) into structured ~mouse-event~ structs, where previously
|
||||
they fell through as ~:unknown~ key events and printed as control characters.
|
||||
|
||||
What was added:
|
||||
- ~%read-digits~ — reads multi-digit numeric parameters from raw terminal
|
||||
bytes, handling arbitrary-length values (e.g. coordinates > 99)
|
||||
- ~%parse-sgr-mouse~ — full SGR mouse decoder: button code → keyword
|
||||
(~:left~, ~:middle~, ~:right~, ~:scroll-up~, ~:scroll-down~, ~:drag~),
|
||||
press/release detection, 1-based → 0-based coordinate conversion
|
||||
- ~parse-csi-sequence~ detects the ~~<~~ marker byte (0x3C) and delegates
|
||||
to ~%parse-sgr-mouse~ instead of treating the sequence as keyboard input
|
||||
|
||||
The mouse enable/disable sequences were already sent by
|
||||
~initialize-backend~/~shutdown-backend~ (lines 126-128, 139-141 of
|
||||
~modern.lisp~). The parsing gap was the only missing piece.
|
||||
|
||||
Test coverage: 461 unit tests + 32 integration tests, all at 100%.
|
||||
Org source: ~org/text-input.org~ (tangled to ~src/components/input.lisp~).
|
||||
|
||||
** Feature Reference
|
||||
|
||||
| Phase | Component | Lines | Release | Status |
|
||||
|
||||
@@ -196,6 +196,7 @@ via ~sb-posix~ directly.
|
||||
#:with-raw-terminal
|
||||
;; Event reading
|
||||
#:read-event
|
||||
#:*terminal-resized-p*
|
||||
;; UTF-8 input support
|
||||
#:utf8-decode
|
||||
;; TextInput
|
||||
@@ -510,27 +511,101 @@ different byte prefix from the CSI form ~ESC [ A~ through ~ESC [ D~.
|
||||
:alt t :code b1))))))
|
||||
#+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
|
||||
|
||||
~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:
|
||||
- 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
|
||||
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
|
||||
extended sequences) or the terminator itself.
|
||||
- If it's not a digit, it may be a modifier byte or the terminator itself.
|
||||
|
||||
The ~extended~ array accumulates raw parameter bytes for sequences where
|
||||
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
|
||||
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
|
||||
(defun parse-csi-sequence ()
|
||||
(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))
|
||||
(push (- b 48) acc)
|
||||
(return (values (reverse acc) b)))))))
|
||||
(let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))
|
||||
(b2 (read-raw-byte))
|
||||
(params (if (and (>= b2 48) (<= b2 57))
|
||||
(multiple-value-bind (p term) (read-param (lambda () (read-raw-byte)))
|
||||
(setf (fill-pointer extended) (length p))
|
||||
(replace extended p)
|
||||
(values p term))
|
||||
(progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte)))))))
|
||||
(destructuring-bind (params terminator) params
|
||||
(parse-csi-params params terminator extended)))))
|
||||
(let* ((b2 (read-raw-byte)))
|
||||
(if (= b2 60) ;; < — SGR mouse marker
|
||||
(%parse-sgr-mouse)
|
||||
(let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))
|
||||
(params (if (and (>= b2 48) (<= b2 57))
|
||||
(multiple-value-bind (p term) (read-param (lambda () (read-raw-byte)))
|
||||
(setf (fill-pointer extended) (length p))
|
||||
(replace extended p)
|
||||
(values p term))
|
||||
(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
|
||||
|
||||
** UTF-8 decoder
|
||||
@@ -686,6 +763,27 @@ after handling the resize.
|
||||
(setf *terminal-resized-p* t))))
|
||||
#+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
|
||||
|
||||
~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
|
||||
(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")
|
||||
(%read-event :timeout timeout)))
|
||||
#+END_SRC
|
||||
@@ -2062,4 +2165,22 @@ The test suite is tangled to ~../tests/input-tests.lisp~ and covers:
|
||||
(remhash :local *keymaps*)
|
||||
(is-false (gethash :global *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
|
||||
|
||||
@@ -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.")
|
||||
(: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)
|
||||
(:method ((b backend))
|
||||
(values 80 24)))
|
||||
|
||||
@@ -20,6 +20,7 @@
|
||||
#:capable-p
|
||||
;; Constructors
|
||||
#:make-simple-backend
|
||||
#:with-terminal
|
||||
;; Modern backend
|
||||
#:modern-backend #:make-modern-backend
|
||||
;; Detection
|
||||
|
||||
@@ -15,6 +15,7 @@
|
||||
#:with-raw-terminal
|
||||
;; Event reading
|
||||
#:read-event
|
||||
#:*terminal-resized-p*
|
||||
;; UTF-8 input support
|
||||
#:utf8-decode
|
||||
;; TextInput
|
||||
|
||||
@@ -110,22 +110,64 @@
|
||||
(t (make-key-event :key (intern (string-upcase (string (code-char b1))) :keyword)
|
||||
: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 ()
|
||||
(flet ((read-param (next-fn) (let ((acc nil))
|
||||
(loop for b = (funcall next-fn)
|
||||
do (if (and (>= b 48) (<= b 57))
|
||||
(push (- b 48) acc)
|
||||
(return (values (reverse acc) b)))))))
|
||||
(let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))
|
||||
(b2 (read-raw-byte))
|
||||
(params (if (and (>= b2 48) (<= b2 57))
|
||||
(multiple-value-bind (p term) (read-param (lambda () (read-raw-byte)))
|
||||
(setf (fill-pointer extended) (length p))
|
||||
(replace extended p)
|
||||
(values p term))
|
||||
(progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte)))))))
|
||||
(destructuring-bind (params terminator) params
|
||||
(parse-csi-params params terminator extended)))))
|
||||
(let* ((b2 (read-raw-byte)))
|
||||
(if (= b2 60) ;; < — SGR mouse marker
|
||||
(%parse-sgr-mouse)
|
||||
(let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))
|
||||
(params (if (and (>= b2 48) (<= b2 57))
|
||||
(multiple-value-bind (p term) (read-param (lambda () (read-raw-byte)))
|
||||
(setf (fill-pointer extended) (length p))
|
||||
(replace extended p)
|
||||
(values p term))
|
||||
(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)
|
||||
(case (length bytes)
|
||||
@@ -185,7 +227,24 @@
|
||||
(declare (ignore signal info context))
|
||||
(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)
|
||||
(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")
|
||||
(%read-event :timeout timeout)))
|
||||
|
||||
@@ -389,3 +389,21 @@
|
||||
(remhash :local *keymaps*)
|
||||
(is-false (gethash :global *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))))
|
||||
|
||||
Reference in New Issue
Block a user