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

fix: all CSI parser reads need timeout, select-next skips all categorized items

Browse Source 
- %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.
This commit is contained in:
Amr Gharbeia
2026-05-15 13:43:42 -04:00
parent 26e55e652f
commit 1df078a235
2 changed files with 50 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

72
src/components/input.lisp
View File

@@ -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))

8
src/components/select.lisp
View File

@@ -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)))))