fix: replace cl-tty.input:read-event with direct read-raw-byte + inline CSI detection
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:
@@ -963,35 +963,47 @@ Returns T on success, nil on failure. Does NOT wait or retry."
|
||||
(setf (cl-tty.select:select-filter sel)
|
||||
(subseq f 0 (1- f))))))))
|
||||
(on-key ch))))))))
|
||||
;; Keyboard reader via cl-tty.input:read-event (handles CSI/UTF-8/resize)
|
||||
(let ((ev (cl-tty.input:read-event be :timeout 0.1)))
|
||||
(when ev
|
||||
(if (eq ev :resize)
|
||||
(progn
|
||||
(multiple-value-setq (w h) (cl-tty.backend:backend-size be))
|
||||
(setq w (or (and (numberp w) (> w 0) w) 80)
|
||||
h (or (and (numberp h) (> h 0) h) 24))
|
||||
(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))))))))
|
||||
;; Keyboard reader via read-raw-byte (proven CSI detection)
|
||||
(handler-case
|
||||
(let* ((b (cl-tty.input::read-raw-byte :timeout 0.1))
|
||||
(code b)
|
||||
(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))
|
||||
(setq w (or (and (numberp w) (> w 0) w) 80)
|
||||
h (or (and (numberp h) (> h 0) h) 24))
|
||||
(setf (st :dirty) (list t t t))))
|
||||
;; 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)
|
||||
h (or (and (numberp h) (> h 0) h) 24))
|
||||
|
||||
Reference in New Issue
Block a user