From ce9bf7781a388d1f0c4040b2b4498fcf470511f2 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Fri, 15 May 2026 13:09:09 -0400 Subject: [PATCH] fix: parse-csi-sequence multi-value capture, read-raw-byte timeout, format args - 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 --- src/components/input.lisp | 38 ++++++++++++++++++++++---------------- 1 file changed, 22 insertions(+), 16 deletions(-) diff --git a/src/components/input.lisp b/src/components/input.lisp index 93cfc52..6b6d9f0 100644 --- a/src/components/input.lisp +++ b/src/components/input.lisp @@ -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)