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)))
(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 terminator *csi-key-table*))))
(modifier (when (and (> (length params) 1) (not (find terminator '(#\~ #\u))))
(cdr (assoc term-char *csi-key-table*))))
(modifier (when (and (> (length params) 1) (not (find term-char '(#\~ #\u))))
(second params)))
(actual-modifier (when (> (length extended) 1) (second extended)))
(ctrl nil) (alt nil) (shift nil))
@@ -58,14 +59,16 @@
(setf shift (or shift (logtest actual-modifier 1))
alt (or alt (logtest actual-modifier 2))
ctrl (or ctrl (logtest actual-modifier 4))))
(if (eql terminator #\u)
(if (eql term-char #\u)
(let ((code (first params)))
(make-key-event :key :codepoint :code code
:ctrl ctrl :alt alt :shift shift
:raw (string (code-char code))))
(make-key-event :key (or key :unknown)
: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)
(let* ((buf (make-array 1 :element-type '(unsigned-byte 8)))
@@ -74,9 +77,11 @@
(sb-sys:with-pinned-objects (buf)
(let ((sap (sb-sys:vector-sap buf)))
(if timeout-ms
(progn (sb-unix:unix-simple-poll fd :input timeout-ms)
(let ((n (sb-unix:unix-read fd sap 1)))
(if (= n 1) (aref buf 0) (values nil :eof))))
(let ((poll-result (sb-unix:unix-simple-poll fd :input timeout-ms)))
(if (and poll-result (plusp poll-result))
(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)))
(if (= n 1) (aref buf 0) (values nil :eof))))))))
@@ -160,14 +165,15 @@ Returns a mouse-event struct."
(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
(let ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0)))
(multiple-value-bind (params terminator)
(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)))))
(parse-csi-params params terminator extended)))))))
(defun utf8-decode (bytes)