fix: use read-char-no-hang instead of cl-tty read-raw-byte
- Replaced read-event/read-raw-byte with read-char-no-hang from *standard-input* for reliable non-blocking terminal input - Added escape sequence decoding (CSI sequences for arrows, PageUp/Dn, Home, End, F-keys) - Added Ctrl+letter handling (0x01-0x1a mapped to :CTRL-X keywords) - Added direct key dispatch for Ctrl+P (palette), Ctrl+B (sidebar), Ctrl+L (redraw), Ctrl+Q (quit), Ctrl+D/F/G, PageUp/Dn, Home/End - Fixed cl-tty read-raw-byte to check poll result before reading - Initial render before main loop so startup messages appear immediately - All 237 tests pass
This commit is contained in:
@@ -924,59 +924,86 @@ Event handlers + daemon I/O + main loop.
|
||||
(setf (st :connected) nil
|
||||
(st :busy) nil)
|
||||
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
|
||||
(multiple-value-bind (type data)
|
||||
(cl-tty.input:read-event be :timeout 0)
|
||||
(cond
|
||||
((eq type :resize)
|
||||
(multiple-value-setq (w h) (cl-tty.backend:backend-size be))
|
||||
(setf (st :dirty) (list t t t)))
|
||||
(data
|
||||
(let ((ch (typecase data
|
||||
(cl-tty.input:key-event
|
||||
(cl-tty.input:key-event-key data))
|
||||
(t data))))
|
||||
;; Read key input from *standard-input* (non-blocking)
|
||||
(let* ((raw-ch (read-char-no-hang *standard-input* nil nil))
|
||||
(ch (and raw-ch
|
||||
(let ((code (char-code raw-ch)))
|
||||
(cond
|
||||
;; Ctrl+letter (0x01-0x1a)
|
||||
((and (>= code 1) (<= code 26))
|
||||
(intern (string-upcase (format nil "CTRL-~a" (code-char (+ code #x60)))) :keyword))
|
||||
;; Escape — try to read CSI sequence
|
||||
((= code 27)
|
||||
(let ((next (read-char-no-hang *standard-input* nil nil)))
|
||||
(cond
|
||||
((null next) :escape)
|
||||
((char= next #\[)
|
||||
(let* ((buf (make-array 0 :fill-pointer 0 :element-type 'character))
|
||||
(c (read-char-no-hang *standard-input* nil nil)))
|
||||
(loop while (and c (not (alpha-char-p c)) (char/= c #\~))
|
||||
do (vector-push c buf)
|
||||
(setf c (read-char-no-hang *standard-input* nil nil)))
|
||||
(let ((param (if (> (length buf) 0) (parse-integer buf :junk-allowed t) nil))
|
||||
(term (or c nil)))
|
||||
(cond
|
||||
((char= term #\A) :up)
|
||||
((char= term #\B) :down)
|
||||
((char= term #\C) :right)
|
||||
((char= term #\D) :left)
|
||||
((char= term #\H) :home)
|
||||
((char= term #\F) :end)
|
||||
((and (char= term #\~) (eql param 5)) :ppage)
|
||||
((and (char= term #\~) (eql param 6)) :npage)
|
||||
((and (char= term #\~) (eql param 1)) :home)
|
||||
((and (char= term #\~) (eql param 4)) :end)
|
||||
(t :escape)))))
|
||||
((char= next #\O)
|
||||
(let ((c (read-char-no-hang *standard-input* nil nil)))
|
||||
(case c
|
||||
(#\H :home)
|
||||
(#\F :end)
|
||||
(t :escape))))
|
||||
(t :escape))))
|
||||
;; Enter (CR or LF)
|
||||
((or (= code 13) (= code 10)) :enter)
|
||||
;; Tab
|
||||
((= code 9) :tab)
|
||||
;; Backspace
|
||||
((or (= code 127) (= code 8)) :backspace)
|
||||
;; Printable
|
||||
(t raw-ch))))))
|
||||
(when ch
|
||||
(cond
|
||||
((st :dialog-stack)
|
||||
(let* ((dlg (car (st :dialog-stack)))
|
||||
(sel (cl-tty.dialog:dialog-content dlg)))
|
||||
(cond
|
||||
((st :dialog-stack)
|
||||
(let* ((dlg (car (st :dialog-stack)))
|
||||
(sel (cl-tty.dialog:dialog-content dlg)))
|
||||
(cond
|
||||
((eql ch :escape)
|
||||
(pop (st :dialog-stack))
|
||||
(setf (st :minibuffer-active) nil)
|
||||
(setf (st :command-palette-active) nil)
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
((member ch '(:up :down))
|
||||
(if (eql ch :up) (cl-tty.select:select-prev sel)
|
||||
(cl-tty.select:select-next sel)))
|
||||
((member ch '(:enter 13 10 #\Newline #\Return))
|
||||
(let* ((filtered (cl-tty.select:select-filtered-options sel))
|
||||
(idx (cl-tty.select:select-selected-index sel))
|
||||
(item (when (< idx (length filtered))
|
||||
(third (nth idx filtered)))))
|
||||
(when item
|
||||
(let ((cb (cl-tty.select:select-on-select sel)))
|
||||
(when cb (funcall cb item))))))
|
||||
((and (characterp ch) (graphic-char-p ch))
|
||||
(setf (cl-tty.select:select-filter sel)
|
||||
(concatenate 'string (or (cl-tty.select:select-filter sel) "") (string ch))))
|
||||
((member ch '(:backspace 127 8))
|
||||
(let ((f (cl-tty.select:select-filter sel)))
|
||||
(when (> (length f) 0)
|
||||
(setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f)))))))
|
||||
;; Forward printable keys to on-key for input buffer
|
||||
(when (and (characterp ch) (graphic-char-p ch))
|
||||
(on-key ch))))
|
||||
((cl-tty.input:mouse-event-p data)
|
||||
(let ((btn (cl-tty.input:mouse-event-button data)))
|
||||
(cond
|
||||
((eql btn :scroll-up)
|
||||
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
|
||||
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 3))))
|
||||
(setf (st :dirty) (list nil t nil)))
|
||||
((eql btn :scroll-down)
|
||||
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 3)))
|
||||
(setf (st :dirty) (list nil t nil))))))
|
||||
(t (on-key ch)))))))
|
||||
((eql ch :escape)
|
||||
(pop (st :dialog-stack))
|
||||
(setf (st :minibuffer-active) nil)
|
||||
(setf (st :command-palette-active) nil)
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
((member ch '(:up :down))
|
||||
(if (eql ch :up) (cl-tty.select:select-prev sel)
|
||||
(cl-tty.select:select-next sel)))
|
||||
((member ch '(:enter 13 10 #\Newline #\Return))
|
||||
(let* ((filtered (cl-tty.select:select-filtered-options sel))
|
||||
(idx (cl-tty.select:select-selected-index sel))
|
||||
(item (when (< idx (length filtered))
|
||||
(third (nth idx filtered)))))
|
||||
(when item
|
||||
(let ((cb (cl-tty.select:select-on-select sel)))
|
||||
(when cb (funcall cb item))))))
|
||||
((and (characterp ch) (graphic-char-p ch))
|
||||
(setf (cl-tty.select:select-filter sel)
|
||||
(concatenate 'string (or (cl-tty.select:select-filter sel) "") (string ch))))
|
||||
((member ch '(:backspace 127 8))
|
||||
(let ((f (cl-tty.select:select-filter sel)))
|
||||
(when (> (length f) 0)
|
||||
(setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f)))))))
|
||||
(when (and (characterp ch) (graphic-char-p ch))
|
||||
(on-key ch))))
|
||||
(t (on-key ch))))))
|
||||
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
|
||||
(cl-tty.backend:backend-clear be)
|
||||
(view-status be w h)
|
||||
@@ -1020,7 +1047,7 @@ Event handlers + daemon I/O + main loop.
|
||||
nil :bold sel-p)
|
||||
(incf y-off)))))))
|
||||
(sleep 0.1))))
|
||||
(disconnect-daemon)))
|
||||
(disconnect-daemon))
|
||||
#+END_SRC
|
||||
|
||||
* Test Suite
|
||||
|
||||
Reference in New Issue
Block a user