fix: /dev/tty input, gate test code, fix code-char bug
- Replaced cl-tty read-event with direct read-char-no-hang from /dev/tty for reliable input (avoids unix-simple-poll fd 0 issue) - Added (let ((tty ...)) wrapper to open /dev/tty once at startup - Fixed (code-char raw-ch) bug: raw-ch is already a CHARACTER - Fixed one extra close paren that closed (let ((ch ...)) early - Gated fiveam test section behind #+passepartout-tests reader conditional to prevent crash on TUI startup when fiveam not loaded
This commit is contained in:
@@ -908,73 +908,45 @@ Event handlers + daemon I/O + main loop.
|
||||
(add-msg :system "* Swank unavailable *"))))
|
||||
(cl-tty.input:with-raw-terminal
|
||||
(cl-tty.backend:with-terminal (be w h)
|
||||
;; Initial render
|
||||
(cl-tty.backend:backend-clear be)
|
||||
(view-status be w h)
|
||||
(view-chat be w h)
|
||||
(view-input be w h)
|
||||
(cl-tty.backend:draw-text be 0 (- h 4) (make-string w :initial-element #\─)
|
||||
(theme-color :separator) nil)
|
||||
(loop while (st :running) do
|
||||
(dolist (ev (drain-queue))
|
||||
(cond
|
||||
((eq (getf ev :type) :daemon)
|
||||
(on-daemon-msg (getf ev :payload)))
|
||||
((eq (getf ev :type) :disconnected)
|
||||
(setf (st :connected) nil
|
||||
(st :busy) nil)
|
||||
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
|
||||
;; Read key input via cl-tty read-event (blocks until data)
|
||||
(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 (if (cl-tty.input:key-event-p data)
|
||||
(cl-tty.input:key-event-key data)
|
||||
data)))
|
||||
(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))
|
||||
(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)))))))
|
||||
(let ((tty (open "/dev/tty" :direction :input)))
|
||||
;; Initial render
|
||||
(cl-tty.backend:backend-clear be)
|
||||
(view-status be w h)
|
||||
(view-chat be w h)
|
||||
(view-input be w h)
|
||||
(cl-tty.backend:draw-text be 0 (- h 4) (make-string w :initial-element #\─)
|
||||
(theme-color :separator) nil)
|
||||
(loop while (st :running) do
|
||||
(dolist (ev (drain-queue))
|
||||
(cond
|
||||
((eq (getf ev :type) :daemon)
|
||||
(on-daemon-msg (getf ev :payload)))
|
||||
((eq (getf ev :type) :disconnected)
|
||||
(setf (st :connected) nil
|
||||
(st :busy) nil)
|
||||
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
|
||||
;; Read key input from /dev/tty (non-blocking)
|
||||
(let ((raw-ch (read-char-no-hang tty nil nil)))
|
||||
(when raw-ch
|
||||
(let ((code (char-code raw-ch)))
|
||||
(let ((ch (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 raw-ch))))
|
||||
(case ch
|
||||
(:CTRL-Q (setf (st :running) nil))
|
||||
(:CTRL-P (command-palette-show-commands))
|
||||
(:CTRL-B (setf (st :sidebar-visible) (not (st :sidebar-visible)))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
(:CTRL-L (setf (st :dirty) (list t t t)))
|
||||
(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)
|
||||
@@ -1016,9 +988,10 @@ Event handlers + daemon I/O + main loop.
|
||||
(sel-p (theme-color :accent))
|
||||
(t (theme-color :agent-fg)))
|
||||
nil :bold sel-p)
|
||||
(incf y-off)))))))
|
||||
(sleep 0.1))))
|
||||
(disconnect-daemon)))
|
||||
(incf y-off)))))))
|
||||
(sleep 0.1))))
|
||||
(close tty))
|
||||
(disconnect-daemon)))
|
||||
#+END_SRC
|
||||
|
||||
* Test Suite
|
||||
|
||||
Reference in New Issue
Block a user