amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix: blocking read-char with with-timeout, dialog key routing

Browse Source 
- Replaced read-event (broken on fd 0 in this SBCL) with direct
  blocking read-char wrapped in sb-ext:with-timeout 0.1
- This gives reliable key input + periodic wakeup for daemon messages
- Added dialog key routing back (escape to close, up/down, enter to
  select, character filtering, backspace)
- Fixed # of closing parens to match new structure
- Removed debug logging
This commit is contained in:
Amr Gharbeia
2026-05-14 09:41:43 -04:00
parent 21d054bc38
commit ec38589237
1 changed files with 69 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

96
lisp/channel-tui-main.lisp
View File

@@ -863,11 +863,12 @@
(add-msg :system "* Swank unavailable *")))) (add-msg :system "* Swank unavailable *"))))
(cl-tty.input:with-raw-terminal (cl-tty.input:with-raw-terminal
(cl-tty.backend:with-terminal (be w h) (cl-tty.backend:with-terminal (be w h)
;; Log backend info and terminal dimensions (let ((tty (sb-sys:make-fd-stream 0 :input t :buffering :none)))
(let ((backend-type (if (typep be 'cl-tty.backend:modern-backend) ;; Log backend info and terminal dimensions
"modern" "simple"))) (let ((backend-type (if (typep be 'cl-tty.backend:modern-backend)
(add-msg :system (format nil "* ~a backend ~dx~d *" backend-type w h))) "modern" "simple")))
;; Initial render (add-msg :system (format nil "* ~a backend ~dx~d *" backend-type w h)))
;; Initial render
(cl-tty.backend:backend-clear be) (cl-tty.backend:backend-clear be)
(view-status be w h) (view-status be w h)
(view-chat be w h) (view-chat be w h)
@@ -884,26 +885,66 @@
(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 via cl-tty read-event (10ms timeout) ;; Read key input via cl-tty read-event (10ms timeout)
(multiple-value-bind (type data) ;; Read key input via blocking read-char with 0.1s timeout
(cl-tty.input:read-event be :timeout 0.01) ;; (sb-unix:unix-simple-poll returns NIL on fd 0 in this SBCL,
(when (eq type :resize) ;; so read-char-no-hang and read-event never fire. Raw blocking
(multiple-value-setq (w h) (cl-tty.backend:backend-size be)) ;; read-char with sb-ext:with-timeout is the reliable fallback.)
(setf (st :dirty) (list t t t))) (handler-case
(when data (sb-ext:with-timeout 0.1
(let* ((ke data) (let* ((raw-ch (read-char tty nil 'eof))
(ch (if (cl-tty.input:key-event-p ke) (code (when (characterp raw-ch) (char-code raw-ch))))
(let ((k (cl-tty.input:key-event-key ke))) (when code
(if (cl-tty.input:key-event-ctrl ke) (let ((ch (cond
(intern (format nil "CTRL-~a" k) :keyword) ((= code 13) :enter)
k)) ((= code 10) :enter)
ke))) ((= code 27) :escape)
(case ch ((= code 9) :tab)
(:CTRL-Q (setf (st :running) nil)) ((or (= code 127) (= code 8)) :backspace)
(:CTRL-P (command-palette-show-commands)) ((and (>= code 1) (<= code 26))
(:CTRL-B (setf (st :sidebar-visible) (not (st :sidebar-visible))) (intern (string-upcase
(setf (st :dirty) (list t t nil))) (format nil "CTRL-~a"
(:CTRL-L (setf (st :dirty) (list t t t))) (code-char (+ #x60 code))))
(t (on-key ch)))))) :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 (if (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))
(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))))))))
(on-key ch))))))))
(sb-ext:timeout ()))
;; Re-query terminal size once after daemon handshake ;; Re-query terminal size once after daemon handshake
(when (and (st :connected) (st :daemon-version) (not (st :size-queried))) (when (and (st :connected) (st :daemon-version) (not (st :size-queried)))
(multiple-value-setq (w h) (cl-tty.backend:backend-size be)) (multiple-value-setq (w h) (cl-tty.backend:backend-size be))
@@ -951,8 +992,9 @@
(t (theme-color :agent-fg))) (t (theme-color :agent-fg)))
nil :bold sel-p) nil :bold sel-p)
(incf y-off))))))) (incf y-off)))))))
(sleep 0.1)))) (sleep 0.1)))
(disconnect-daemon))) (close tty)))
(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))