v1.1.0: fix CSI parser destructuring-bind crash on nil params

parse-csi-sequence used destructuring-bind on a single return value,
failing when the CSI sequence had no parameters (e.g. plain arrow keys ESC[A).
Capture multiple return values via multiple-value-list instead of relying
on let* which only captures the primary value.
This commit is contained in:
2026-05-18 20:59:11 -04:00
parent 4c3f5fe65a
commit 9b8ac8b770

View File

@@ -627,22 +627,27 @@ to ~parse-csi-params~ for modifier extraction.
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(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)))))))
(loop for b = (funcall next-fn)
do (if (and (>= b 48) (<= b 57))
(push (- b 48) acc)
(return (values (reverse acc) b)))))))
(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)))))))
(parsed (if (and (>= b2 48) (<= b2 57))
;; Digit branch: read params with their digits
(let ((r (multiple-value-list (read-param (lambda () (read-raw-byte))))))
(let ((p (first r)))
(setf (fill-pointer extended) (length p))
(replace extended p))
r)
;; Non-digit branch: b2 is a direct CSI terminator
(progn (vector-push-extend b2 extended)
(multiple-value-list (read-param (lambda () (read-raw-byte))))))))
(let ((params (first parsed))
(terminator (or (second parsed) 0)))
(parse-csi-params (or params '()) terminator extended)))))))
#+END_SRC
** UTF-8 decoder
@@ -1700,7 +1705,7 @@ for users writing ~:ctrl+p~ in their keymaps.
(let ((mod-str (subseq name 0 plus))
(key-str (subseq name (1+ plus))))
(and (eql (intern key-str :keyword)
(key-event-key event))
(intern (string-upcase (symbol-name (key-event-key event))) :keyword))
(cond
((string= mod-str "CTRL") (key-event-ctrl event))
((string= mod-str "ALT") (key-event-alt event))