fix: restore read-event for reliable input, working TUI

- Replaced read-char-no-hang/stdin-input with cl-tty read-event
  (blocks until data, works regardless of --load stream)
- Added initial render before main loop via direct-to-backend
- Added read-event resize handling
- Removed stale fasl/crash/theme files
- Fixed paren balance in tui-main
- TUI starts, accepts input, daemon responds (msgs:3->4)
- 237 tests pass
This commit is contained in:
2026-05-13 20:46:44 -04:00
parent ce3e8ed44c
commit a9705253a5
2 changed files with 100 additions and 158 deletions

View File

@@ -880,86 +880,57 @@
(setf (st :connected) nil (setf (st :connected) nil
(st :busy) nil) (st :busy) nil)
(add-msg :system "* Connection lost — type /reconnect to retry *")))) (add-msg :system "* Connection lost — type /reconnect to retry *"))))
;; Read key input from *standard-input* (non-blocking) ;; Read key input via cl-tty read-event (blocks until data)
(let* ((raw-ch (read-char-no-hang *standard-input* nil nil)) (multiple-value-bind (type data)
(ch (and raw-ch (cl-tty.input:read-event be :timeout 0)
(let ((code (char-code raw-ch))) (cond
(cond ((eq type :resize)
;; Ctrl+letter (0x01-0x1a) (multiple-value-setq (w h) (cl-tty.backend:backend-size be))
((and (>= code 1) (<= code 26)) (setf (st :dirty) (list t t t)))
(intern (string-upcase (format nil "CTRL-~a" (code-char (+ code #x60)))) :keyword)) (data
;; Escape — try to read CSI sequence (let ((ch (if (cl-tty.input:key-event-p data)
((= code 27) (cl-tty.input:key-event-key data)
(let ((next (read-char-no-hang *standard-input* nil nil))) data)))
(cond (cond
((null next) :escape) ((st :dialog-stack)
((char= next #\[) (let* ((dlg (car (st :dialog-stack)))
(let* ((buf (make-array 0 :fill-pointer 0 :element-type 'character)) (sel (cl-tty.dialog:dialog-content dlg)))
(c (read-char-no-hang *standard-input* nil nil))) (cond
(loop while (and c (not (alpha-char-p c)) (char/= c #\~)) ((eql ch :escape)
do (vector-push c buf) (pop (st :dialog-stack))
(setf c (read-char-no-hang *standard-input* nil nil))) (setf (st :minibuffer-active) nil)
(let ((param (if (> (length buf) 0) (parse-integer buf :junk-allowed t) nil)) (setf (st :command-palette-active) nil)
(term (or c nil))) (setf (st :dirty) (list t t nil)))
(cond ((member ch '(:up :down))
((char= term #\A) :up) (if (eql ch :up) (cl-tty.select:select-prev sel)
((char= term #\B) :down) (cl-tty.select:select-next sel)))
((char= term #\C) :right) ((member ch '(:enter 13 10 #\Newline #\Return))
((char= term #\D) :left) (let* ((filtered (cl-tty.select:select-filtered-options sel))
((char= term #\H) :home) (idx (cl-tty.select:select-selected-index sel))
((char= term #\F) :end) (item (when (< idx (length filtered))
((and (char= term #\~) (eql param 5)) :ppage) (third (nth idx filtered)))))
((and (char= term #\~) (eql param 6)) :npage) (when item
((and (char= term #\~) (eql param 1)) :home) (let ((cb (cl-tty.select:select-on-select sel)))
((and (char= term #\~) (eql param 4)) :end) (when cb (funcall cb item))))))
(t :escape))))) ((and (characterp ch) (graphic-char-p ch))
((char= next #\O) (setf (cl-tty.select:select-filter sel)
(let ((c (read-char-no-hang *standard-input* nil nil))) (concatenate 'string (or (cl-tty.select:select-filter sel) "") (string ch))))
(case c ((member ch '(:backspace 127 8))
(#\H :home) (let ((f (cl-tty.select:select-filter sel)))
(#\F :end) (when (> (length f) 0)
(t :escape)))) (setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f)))))))
(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
((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)) (when (and (characterp ch) (graphic-char-p ch))
(on-key ch)))) (on-key ch))))
(t (on-key ch)))))) ((member ch '(:ppage :npage))
(if (eql ch :ppage)
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10))))
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10))))
(setf (st :dirty) (list nil t nil)))
((member ch '(:home :end))
(setf (st :scroll-offset) (if (eql ch :home) most-positive-fixnum 0))
(setf (st :dirty) (list nil t nil)))
(t (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) (when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
(cl-tty.backend:backend-clear be) (cl-tty.backend:backend-clear be)
(view-status be w h) (view-status be w h)
@@ -1003,7 +974,7 @@
nil :bold sel-p) nil :bold sel-p)
(incf y-off))))))) (incf y-off)))))))
(sleep 0.1)))) (sleep 0.1))))
(disconnect-daemon)) (disconnect-daemon)))
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (ql:quickload :fiveam :silent t))

View File

@@ -924,86 +924,57 @@ Event handlers + daemon I/O + main loop.
(setf (st :connected) nil (setf (st :connected) nil
(st :busy) nil) (st :busy) nil)
(add-msg :system "* Connection lost — type /reconnect to retry *")))) (add-msg :system "* Connection lost — type /reconnect to retry *"))))
;; Read key input from *standard-input* (non-blocking) ;; Read key input via cl-tty read-event (blocks until data)
(let* ((raw-ch (read-char-no-hang *standard-input* nil nil)) (multiple-value-bind (type data)
(ch (and raw-ch (cl-tty.input:read-event be :timeout 0)
(let ((code (char-code raw-ch))) (cond
(cond ((eq type :resize)
;; Ctrl+letter (0x01-0x1a) (multiple-value-setq (w h) (cl-tty.backend:backend-size be))
((and (>= code 1) (<= code 26)) (setf (st :dirty) (list t t t)))
(intern (string-upcase (format nil "CTRL-~a" (code-char (+ code #x60)))) :keyword)) (data
;; Escape — try to read CSI sequence (let ((ch (if (cl-tty.input:key-event-p data)
((= code 27) (cl-tty.input:key-event-key data)
(let ((next (read-char-no-hang *standard-input* nil nil))) data)))
(cond (cond
((null next) :escape) ((st :dialog-stack)
((char= next #\[) (let* ((dlg (car (st :dialog-stack)))
(let* ((buf (make-array 0 :fill-pointer 0 :element-type 'character)) (sel (cl-tty.dialog:dialog-content dlg)))
(c (read-char-no-hang *standard-input* nil nil))) (cond
(loop while (and c (not (alpha-char-p c)) (char/= c #\~)) ((eql ch :escape)
do (vector-push c buf) (pop (st :dialog-stack))
(setf c (read-char-no-hang *standard-input* nil nil))) (setf (st :minibuffer-active) nil)
(let ((param (if (> (length buf) 0) (parse-integer buf :junk-allowed t) nil)) (setf (st :command-palette-active) nil)
(term (or c nil))) (setf (st :dirty) (list t t nil)))
(cond ((member ch '(:up :down))
((char= term #\A) :up) (if (eql ch :up) (cl-tty.select:select-prev sel)
((char= term #\B) :down) (cl-tty.select:select-next sel)))
((char= term #\C) :right) ((member ch '(:enter 13 10 #\Newline #\Return))
((char= term #\D) :left) (let* ((filtered (cl-tty.select:select-filtered-options sel))
((char= term #\H) :home) (idx (cl-tty.select:select-selected-index sel))
((char= term #\F) :end) (item (when (< idx (length filtered))
((and (char= term #\~) (eql param 5)) :ppage) (third (nth idx filtered)))))
((and (char= term #\~) (eql param 6)) :npage) (when item
((and (char= term #\~) (eql param 1)) :home) (let ((cb (cl-tty.select:select-on-select sel)))
((and (char= term #\~) (eql param 4)) :end) (when cb (funcall cb item))))))
(t :escape))))) ((and (characterp ch) (graphic-char-p ch))
((char= next #\O) (setf (cl-tty.select:select-filter sel)
(let ((c (read-char-no-hang *standard-input* nil nil))) (concatenate 'string (or (cl-tty.select:select-filter sel) "") (string ch))))
(case c ((member ch '(:backspace 127 8))
(#\H :home) (let ((f (cl-tty.select:select-filter sel)))
(#\F :end) (when (> (length f) 0)
(t :escape)))) (setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f)))))))
(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
((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)) (when (and (characterp ch) (graphic-char-p ch))
(on-key ch)))) (on-key ch))))
(t (on-key ch)))))) ((member ch '(:ppage :npage))
(if (eql ch :ppage)
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10))))
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10))))
(setf (st :dirty) (list nil t nil)))
((member ch '(:home :end))
(setf (st :scroll-offset) (if (eql ch :home) most-positive-fixnum 0))
(setf (st :dirty) (list nil t nil)))
(t (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) (when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
(cl-tty.backend:backend-clear be) (cl-tty.backend:backend-clear be)
(view-status be w h) (view-status be w h)
@@ -1047,7 +1018,7 @@ Event handlers + daemon I/O + main loop.
nil :bold sel-p) nil :bold sel-p)
(incf y-off))))))) (incf y-off)))))))
(sleep 0.1)))) (sleep 0.1))))
(disconnect-daemon)) (disconnect-daemon)))
#+END_SRC #+END_SRC
* Test Suite * Test Suite