amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix: replace cl-tty.input:read-event with direct read-raw-byte + inline CSI detection

Browse Source 
cl-tty.input:read-event has bugs (CSI parser timeout causes :escape
to be returned for arrow keys). Replace with direct read-raw-byte
calls that are proven to work for CSI sequences. The inline detection:
- Read first byte with 100ms timeout
- If ESC (27), read two more bytes with 150ms timeout each
- Map 65→:up, 66→:down, 67→:right, 68→:left, etc.
- Other bytes converted via the same cond chain as before
Also re-add resize check (was handled by read-event).

Use handler-case around the reader to prevent any reader errors
from crashing the TUI. Re-add Swank *error-output* redirect.
This commit is contained in:
Amr Gharbeia
2026-05-15 15:23:12 -04:00
parent bd72175d5b
commit 8d9520a9cb
1 changed files with 41 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

64
org/channel-tui-main.org
View File

@@ -963,35 +963,47 @@ Returns T on success, nil on failure. Does NOT wait or retry."
(setf (cl-tty.select:select-filter sel) (setf (cl-tty.select:select-filter sel)
(subseq f 0 (1- f)))))))) (subseq f 0 (1- f))))))))
(on-key ch)))))))) (on-key ch))))))))
;; Keyboard reader via cl-tty.input:read-event (handles CSI/UTF-8/resize) ;; Keyboard reader via read-raw-byte (proven CSI detection)
(let ((ev (cl-tty.input:read-event be :timeout 0.1))) (handler-case
(when ev (let* ((b (cl-tty.input::read-raw-byte :timeout 0.1))
(if (eq ev :resize) (code b)
(progn (esc-seq (and (= code 27)
(let ((b2 (cl-tty.input::read-raw-byte :timeout 0.15)))
(when (= b2 91)
(let ((t2 (cl-tty.input::read-raw-byte :timeout 0.15)))
(and t2 (case t2
(65 :up) (66 :down)
(67 :right) (68 :left)
(72 :home) (70 :end)
(otherwise :escape)))))))))
(when b
(queue-event
(list :type :key
:payload (list :code (or code 0)
:ch (or esc-seq
(cond
((= code 13) :enter)
((= code 10) :enter)
((= code 27) :escape)
((= code 9) :tab)
((or (= code 127) (= code 8)) :backspace)
((and (>= code 1) (<= code 26))
(intern
(string-upcase
(format nil "CTRL-~a"
(code-char (+ #x60 code))))
:keyword))
(t code))))))))
(error (c)
(add-msg :system (format nil "* Reader error: ~a *" c))))
;; Check for terminal resize (SIGWINCH sets this flag)
(when (boundp 'cl-tty.input::*terminal-resized-p*)
(when cl-tty.input::*terminal-resized-p*
(setf cl-tty.input::*terminal-resized-p* nil)
(multiple-value-setq (w h) (cl-tty.backend:backend-size be)) (multiple-value-setq (w h) (cl-tty.backend:backend-size be))
(setq w (or (and (numberp w) (> w 0) w) 80) (setq w (or (and (numberp w) (> w 0) w) 80)
h (or (and (numberp h) (> h 0) h) 24)) h (or (and (numberp h) (> h 0) h) 24))
(setf (st :dirty) (list t t t))) (setf (st :dirty) (list t t t))))
(let* ((key (cl-tty.input:key-event-key ev))
(code (cl-tty.input:key-event-code ev))
(ctrl (cl-tty.input:key-event-ctrl ev))
(ch (cond
((member key
'(:up :down :right :left :escape :enter :tab
:backspace :home :end :delete
:page-up :page-down :insert))
key)
(ctrl
(ignore-errors
(intern (format nil "CTRL-~a" key) :keyword)))
((or (eq key :codepoint) code)
(or code 0))
(t nil))))
(when ch
(queue-event
(list :type :key
:payload (list :code (or code 0) :ch ch))))))))
;; Guard w and h before render (resize or other code may have set them to nil) ;; Guard w and h before render (resize or other code may have set them to nil)
(setq w (or (and (numberp w) (> w 0) w) 80) (setq w (or (and (numberp w) (> w 0) w) 80)
h (or (and (numberp h) (> h 0) h) 24)) h (or (and (numberp h) (> h 0) h) 24))