fix: use cl-tty.input:read-event for keyboard input (proper CSI handling)

Replace the inline raw byte reader + CSI detection with
cl-tty.input:read-event which uses read-raw-byte (direct fd reads)
and properly parses CSI escape sequences, UTF-8, mouse events, etc.
Also fix: remove extra ) in (t nil) clause that was prematurely
closing the let* binding, causing the if form to receive 4 args.
This commit is contained in:
2026-05-15 13:09:17 -04:00
parent cc38e67d7c
commit bd72175d5b

View File

@@ -963,62 +963,36 @@ 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: poll with 0.1s timeout via listen (no sb-ext:timeout) ;; Keyboard reader via cl-tty.input:read-event (handles CSI/UTF-8/resize)
(dotimes (_ 10) (let ((ev (cl-tty.input:read-event be :timeout 0.1)))
(when (listen *standard-input*) (when ev
(let* ((raw-ch (read-char-no-hang *standard-input* nil nil)) (if (eq ev :resize)
(code (and raw-ch (char-code raw-ch))) (progn
(esc-seq (and (= code 27) (multiple-value-setq (w h) (cl-tty.backend:backend-size be))
(let ((b nil) (t2 nil)) (setq w (or (and (numberp w) (> w 0) w) 80)
(dotimes (_ 20) h (or (and (numberp h) (> h 0) h) 24))
(when (listen *standard-input*) (setf (st :dirty) (list t t t)))
(setq b (read-char *standard-input* nil nil)) (let* ((key (cl-tty.input:key-event-key ev))
(return)) (code (cl-tty.input:key-event-code ev))
(sleep 0.001)) (ctrl (cl-tty.input:key-event-ctrl ev))
(and b (char= b #\[) (ch (cond
(progn ((member key
(dotimes (_ 15) '(:up :down :right :left :escape :enter :tab
(when (listen *standard-input*) :backspace :home :end :delete
(setq t2 (read-char *standard-input* nil nil)) :page-up :page-down :insert))
(return)) key)
(sleep 0.001)) (ctrl
t) (ignore-errors
(case (and t2 (char-code t2)) (intern (format nil "CTRL-~a" key) :keyword)))
(65 :up) (66 :down) ((or (eq key :codepoint) code)
(67 :right) (68 :left) (or code 0))
(72 :home) (70 :end) (t nil))))
(otherwise :escape)))))))
(when raw-ch (when ch
(when esc-seq (queue-event
(add-msg :system (format nil "* CSI: ~s *" esc-seq))) (list :type :key
(queue-event :payload (list :code (or code 0) :ch ch))))))))
(list :type :key ;; Guard w and h before render (resize or other code may have set them to nil)
:payload (list :code code
: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)))))))
(return)))
(sleep 0.01))
;; 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) (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))
(when (and (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) (when (and (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))