From 1df078a2352738214b4b43e1ccee1a0401ae7f7b Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Fri, 15 May 2026 13:43:42 -0400 Subject: [PATCH] fix: all CSI parser reads need timeout, select-next skips all categorized items MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - %read-escape-sequence: increase b1 timeout 0.05→0.1, pass timeout to parse-csi-sequence and all read-next calls (OCR branch was using nil timeout, blocking forever) - parse-csi-sequence: accept :timeout keyword, pass to all read-raw-byte calls, return :escape on timeout instead of blocking - %read-digits: accept timeout, check nil from read-raw-byte before (>= b 48) - %parse-sgr-mouse: accept timeout, return nil if first byte times out - read-param in parse-csi-sequence: check b for nil before comparing - parse-csi-params: map Kitty protocol u-terminator cursor codes (1=up, 2=down, 3=right, 4=left, 5=page-up, 6=page-down) before falling to :codepoint. Convert terminator byte to char via code-char for key table lookups. - select-next/select-prev: remove (not (getf opt :category)) check. All items have :category in the unified command list, so navigation skipped every item and selection stayed at index 0 permanently. --- src/components/input.lisp | 72 +++++++++++++++++++++++++------------- src/components/select.lisp | 8 ++--- 2 files changed, 50 insertions(+), 30 deletions(-) diff --git a/src/components/input.lisp b/src/components/input.lisp index 7eafa6f..e0c59fe 100644 --- a/src/components/input.lisp +++ b/src/components/input.lisp @@ -44,8 +44,18 @@ (defun parse-csi-params (params terminator extended) (let* ((term-char (code-char terminator)) - (key (if (find term-char '(#\~ #\u)) - (cdr (assoc (first params) *csi-tilde-table*)) + (tilde-key (when (find term-char '(#\~ #\u)) + (cdr (assoc (first params) *csi-tilde-table*)))) + ;; If tilde/u lookup fails, try direct csi-key-table match (ESC[A etc.) + ;; For u-terminator with cursor codes (1=up,2=down,3=right,4=left) that + ;; aren't in *csi-tilde-table* (which maps 1→:home,2→:insert,3→:delete...), + ;; handle them explicitly before falling through to :codepoint. + (key (or tilde-key + (and (eql term-char #\u) + (case (first params) + (1 :up) (2 :down) (3 :right) (4 :left) + (5 :page-up) (6 :page-down) + (otherwise (cdr (assoc (first params) *csi-tilde-table*))))) (cdr (assoc term-char *csi-key-table*)))) (modifier (when (and (> (length params) 1) (not (find term-char '(#\~ #\u)))) (second params))) @@ -59,7 +69,8 @@ (setf shift (or shift (logtest actual-modifier 1)) alt (or alt (logtest actual-modifier 2)) ctrl (or ctrl (logtest actual-modifier 4)))) - (if (eql term-char #\u) + (if (and (eql term-char #\u) (not key)) + ;; Kitty protocol with unknown codepoint — send as :codepoint (let ((code (first params))) (make-key-event :key :codepoint :code code :ctrl ctrl :alt alt :shift shift @@ -70,6 +81,7 @@ (format nil "~C[~{~d~};~d" #\Esc params terminator) ""))))) + (defun read-raw-byte (&key timeout) (let* ((buf (make-array 1 :element-type '(unsigned-byte 8))) (fd 0) @@ -85,16 +97,16 @@ (let ((n (sb-unix:unix-read fd sap 1))) (if (= n 1) (aref buf 0) (values nil :eof)))))))) -(defun %read-escape-sequence () - (flet ((read-next (&optional (timeout nil)) - (let ((b (read-raw-byte :timeout timeout))) +(defun %read-escape-sequence (&optional (timeout 0.1)) + (flet ((read-next (&optional (to timeout)) + (let ((b (read-raw-byte :timeout to))) (unless b (return-from %read-escape-sequence (make-key-event :key :escape :code 27))) b))) - (let ((b1 (read-next 0.05))) + (let ((b1 (read-next timeout))) (cond ((null b1) (make-key-event :key :escape :code 27)) - ((= b1 79) (let ((b2 (read-next))) + ((= b1 79) (let ((b2 (read-next timeout))) (case b2 (80 (make-key-event :key :f1)) (81 (make-key-event :key :f2)) @@ -107,7 +119,7 @@ (67 (make-key-event :key :right :shift t)) (68 (make-key-event :key :left :shift t)) (otherwise (make-key-event :key :unknown :raw (string (code-char b2))))))) - ((= b1 91) (parse-csi-sequence)) + ((= b1 91) (parse-csi-sequence :timeout timeout)) ((= b1 127) (make-key-event :key :alt-backspace)) ((< b1 32) (let ((c (code-char (+ b1 96)))) @@ -116,15 +128,15 @@ (t (make-key-event :key (intern (string-upcase (string (code-char b1))) :keyword) :alt t :code b1)))))) -(defun %read-digits (&optional (initial-bytes nil)) +(defun %read-digits (&optional (initial-bytes nil) (timeout 0.5)) "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)) + (loop for b = (read-raw-byte :timeout timeout) + while (and b (>= b 48) (<= b 57)) do (push (- b 48) acc) finally (return (values (if acc (reduce (lambda (n d) (+ (* n 10) d)) @@ -132,15 +144,16 @@ Returns (values number terminator-byte)." 0) b))))) -(defun %parse-sgr-mouse () +(defun %parse-sgr-mouse (&optional (timeout 0.5)) "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)) + (let ((b (read-raw-byte :timeout timeout))) + (unless b (return-from %parse-sgr-mouse nil)) + (multiple-value-bind (cb sep1) (%read-digits (list b) timeout) (declare (ignore sep1)) - (multiple-value-bind (cx sep2) (%read-digits) + (multiple-value-bind (cx sep2) (%read-digits nil timeout) (declare (ignore sep2)) - (multiple-value-bind (cy term) (%read-digits) + (multiple-value-bind (cy term) (%read-digits nil timeout) (let ((button (cond ((= cb 0) :left) ((= cb 1) :middle) @@ -156,24 +169,35 @@ Returns a mouse-event struct." (make-mouse-event :type type :button button :x (- cx 1) :y (- cy 1)))))))) -(defun parse-csi-sequence () +(defun parse-csi-sequence (&key (timeout 0.1)) (flet ((read-param (next-fn) (let ((acc nil)) (loop for b = (funcall next-fn) - do (if (and (>= b 48) (<= b 57)) + do (if (and b (>= b 48) (<= b 57)) (push (- b 48) acc) (return (values (reverse acc) b))))))) - (let* ((b2 (read-raw-byte))) + (let* ((b2 (read-raw-byte :timeout timeout))) + (unless b2 (return-from parse-csi-sequence + (make-key-event :key :escape :code 27))) (if (= b2 60) ;; < — SGR mouse marker - (%parse-sgr-mouse) + (or (%parse-sgr-mouse timeout) + (make-key-event :key :escape :code 27)) (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))) + (multiple-value-bind (p term) (read-param (lambda () + (read-raw-byte :timeout timeout))) + (unless term (return-from parse-csi-sequence + (make-key-event :key :escape :code 27))) (setf (fill-pointer extended) (length p)) (replace extended p) (values p term)) (progn (vector-push-extend b2 extended) - (read-param (lambda () (read-raw-byte))))) + (multiple-value-bind (p term) + (read-param (lambda () + (read-raw-byte :timeout timeout))) + (unless term (return-from parse-csi-sequence + (make-key-event :key :escape :code 27))) + (values p term)))) (parse-csi-params params terminator extended))))))) (defun utf8-decode (bytes) @@ -194,7 +218,7 @@ Returns a mouse-event struct." (multiple-value-bind (b reason) (read-raw-byte :timeout timeout) (unless b (return-from %read-event (if (eq reason :eof) :eof nil))) (cond - ((= b #x1b) (%read-escape-sequence)) + ((= b #x1b) (%read-escape-sequence timeout)) ((= b #x09) (make-key-event :key :tab :code #x09)) ((= b #x0a) (make-key-event :key :enter :code #x0a)) ((= b #x0d) (make-key-event :key :enter :code #x0d)) diff --git a/src/components/select.lisp b/src/components/select.lisp index 6bafd64..fddb69f 100644 --- a/src/components/select.lisp +++ b/src/components/select.lisp @@ -58,29 +58,25 @@ (max 0 (min (select-selected-index sel) (1- count))))))) (defun select-next (sel) - "Move selection to next non-category option. Wraps at end." + "Move selection to next option. Wraps at end." (let* ((filtered (select-filtered-options sel)) (count (length filtered)) (current (select-selected-index sel))) (when (plusp count) (loop for i from 1 below count for idx = (mod (+ current i) count) - for opt = (third (nth idx filtered)) - when (not (getf opt :category)) do (setf (select-selected-index sel) idx) (mark-dirty sel) (return))))) (defun select-prev (sel) - "Move selection to previous non-category option. Wraps at start." + "Move selection to previous option. Wraps at start." (let* ((filtered (select-filtered-options sel)) (count (length filtered)) (current (select-selected-index sel))) (when (plusp count) (loop for i from 1 below count for idx = (mod (- current i) count) - for opt = (third (nth idx filtered)) - when (not (getf opt :category)) do (setf (select-selected-index sel) idx) (mark-dirty sel) (return)))))