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

fix: parse-csi-sequence multi-value capture, read-raw-byte timeout, format args

Browse Source 
- parse-csi-sequence: use multiple-value-bind to capture both params
  list and terminator byte (let* only takes primary value, discarding
  terminator, causing destructuring-bind to fail on empty list)
- parse-csi-params: convert terminator byte to char via code-char
  for key table lookups and comparisons
- read-raw-byte: check unix-simple-poll result before calling
  unix-read. When poll times out, returns nil immediately instead
  of blocking forever on unix-read
This commit is contained in:
Amr Gharbeia
2026-05-15 13:09:09 -04:00
parent de1864bd94
commit ce9bf7781a
1 changed files with 22 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
src/components/input.lisp
View File

@@ -43,10 +43,11 @@
(#\Z . :back-tab))) (#\Z . :back-tab)))
(defun parse-csi-params (params terminator extended) (defun parse-csi-params (params terminator extended)
(let* ((key (if (find terminator '(#\~ #\u)) (let* ((term-char (code-char terminator))
(key (if (find term-char '(#\~ #\u))
(cdr (assoc (first params) *csi-tilde-table*)) (cdr (assoc (first params) *csi-tilde-table*))
(cdr (assoc terminator *csi-key-table*)))) (cdr (assoc term-char *csi-key-table*))))
(modifier (when (and (> (length params) 1) (not (find terminator '(#\~ #\u)))) (modifier (when (and (> (length params) 1) (not (find term-char '(#\~ #\u))))
(second params))) (second params)))
(actual-modifier (when (> (length extended) 1) (second extended))) (actual-modifier (when (> (length extended) 1) (second extended)))
(ctrl nil) (alt nil) (shift nil)) (ctrl nil) (alt nil) (shift nil))
@@ -58,14 +59,16 @@
(setf shift (or shift (logtest actual-modifier 1)) (setf shift (or shift (logtest actual-modifier 1))
alt (or alt (logtest actual-modifier 2)) alt (or alt (logtest actual-modifier 2))
ctrl (or ctrl (logtest actual-modifier 4)))) ctrl (or ctrl (logtest actual-modifier 4))))
(if (eql terminator #\u) (if (eql term-char #\u)
(let ((code (first params))) (let ((code (first params)))
(make-key-event :key :codepoint :code code (make-key-event :key :codepoint :code code
:ctrl ctrl :alt alt :shift shift :ctrl ctrl :alt alt :shift shift
:raw (string (code-char code)))) :raw (string (code-char code))))
(make-key-event :key (or key :unknown) (make-key-event :key (or key :unknown)
:ctrl ctrl :alt alt :shift shift :ctrl ctrl :alt alt :shift shift
:raw (format nil "~C[~{~d~};~d~C" #\Esc params terminator))))) :raw (if (consp params)
(format nil "~C[~{~d~};~d" #\Esc params terminator)
"")))))
(defun read-raw-byte (&key timeout) (defun read-raw-byte (&key timeout)
(let* ((buf (make-array 1 :element-type '(unsigned-byte 8))) (let* ((buf (make-array 1 :element-type '(unsigned-byte 8)))
@@ -74,9 +77,11 @@
(sb-sys:with-pinned-objects (buf) (sb-sys:with-pinned-objects (buf)
(let ((sap (sb-sys:vector-sap buf))) (let ((sap (sb-sys:vector-sap buf)))
(if timeout-ms (if timeout-ms
(progn (sb-unix:unix-simple-poll fd :input timeout-ms) (let ((poll-result (sb-unix:unix-simple-poll fd :input timeout-ms)))
(let ((n (sb-unix:unix-read fd sap 1))) (if (and poll-result (plusp poll-result))
(if (= n 1) (aref buf 0) (values nil :eof)))) (let ((n (sb-unix:unix-read fd sap 1)))
(if (= n 1) (aref buf 0) (values nil :eof)))
(values nil nil)))
(let ((n (sb-unix:unix-read fd sap 1))) (let ((n (sb-unix:unix-read fd sap 1)))
(if (= n 1) (aref buf 0) (values nil :eof)))))))) (if (= n 1) (aref buf 0) (values nil :eof))))))))
@@ -160,14 +165,15 @@ Returns a mouse-event struct."
(let* ((b2 (read-raw-byte))) (let* ((b2 (read-raw-byte)))
(if (= b2 60) ;; < — SGR mouse marker (if (= b2 60) ;; < — SGR mouse marker
(%parse-sgr-mouse) (%parse-sgr-mouse)
(let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0)) (let ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0)))
(params (if (and (>= b2 48) (<= b2 57)) (multiple-value-bind (params terminator)
(multiple-value-bind (p term) (read-param (lambda () (read-raw-byte))) (if (and (>= b2 48) (<= b2 57))
(setf (fill-pointer extended) (length p)) (multiple-value-bind (p term) (read-param (lambda () (read-raw-byte)))
(replace extended p) (setf (fill-pointer extended) (length p))
(values p term)) (replace extended p)
(progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte))))))) (values p term))
(destructuring-bind (params terminator) params (progn (vector-push-extend b2 extended)
(read-param (lambda () (read-raw-byte)))))
(parse-csi-params params terminator extended))))))) (parse-csi-params params terminator extended)))))))
(defun utf8-decode (bytes) (defun utf8-decode (bytes)