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

fix: threaded keyboard reader, key events via queue

Browse Source 
- Keyboard input now runs in a separate bordeaux-thread that
  reads from fd 0 via blocking read-char and queues :key events
- Main loop processes :key events from drain-queue alongside
  :daemon and :disconnected events
- Removed blocking read-char/with-timeout from main loop (caused
  freeze when with-timeout couldn't interrupt the read syscall)
- Added full dialog key routing in the key event handler
- Added debug logging for key events (tui-keys.log)
This commit is contained in:
Amr Gharbeia
2026-05-14 10:32:46 -04:00
parent a8f8d841a4
commit 0ad9d3bdb5
1 changed files with 77 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -864,6 +864,30 @@
(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)
(let ((tty (sb-sys:make-fd-stream 0 :input t :buffering :none))) (let ((tty (sb-sys:make-fd-stream 0 :input t :buffering :none)))
;; Keyboard reader thread: reads from fd 0 via blocking read-char
;; and queues :key events for the main loop to process.
(bt:make-thread
(lambda ()
(loop
(let* ((raw-ch (read-char tty nil nil)))
(unless raw-ch (return)) ; EOF → stream closed, exit
(let ((code (char-code raw-ch)))
(queue-event
(list :type :key
:payload (list :code code
: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)))))))))
:name "tui-keyboard")
;; Log backend info and terminal dimensions ;; Log backend info and terminal dimensions
(let ((backend-type (if (typep be 'cl-tty.backend:modern-backend) (let ((backend-type (if (typep be 'cl-tty.backend:modern-backend)
"modern" "simple"))) "modern" "simple")))
@@ -880,74 +904,60 @@
(theme-color :separator) nil) (theme-color :separator) nil)
(loop while (st :running) do (loop while (st :running) do
(dolist (ev (drain-queue)) (dolist (ev (drain-queue))
(cond (cond
((eq (getf ev :type) :daemon) ((eq (getf ev :type) :daemon)
(on-daemon-msg (getf ev :payload))) (on-daemon-msg (getf ev :payload)))
((eq (getf ev :type) :disconnected) ((eq (getf ev :type) :disconnected)
(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 via blocking read-char with 0.1s timeout ((eq (getf ev :type) :key)
;; (sb-unix:unix-simple-poll returns NIL on fd 0 in this SBCL, (let* ((payload (getf ev :payload))
;; so read-char-no-hang and read-event never fire. Raw blocking (ch (getf payload :ch)))
;; read-char with sb-ext:with-timeout is the reliable fallback.) (with-open-file (d "/tmp/tui-keys.log"
(handler-case :direction :output :if-exists :append
(sb-ext:with-timeout 0.1 :if-does-not-exist :create)
(let* ((raw-ch (read-char tty nil 'eof)) (format d "KEY EVENT ch=~s type=~s~%" ch (type-of ch)))
(code (when (characterp raw-ch) (char-code raw-ch)))) (case ch
(when code (:CTRL-Q (setf (st :running) nil))
(let ((ch (cond (:CTRL-P (command-palette-show-commands))
((= code 13) :enter) (:CTRL-B (setf (st :sidebar-visible) (not (st :sidebar-visible)))
((= code 10) :enter) (setf (st :dirty) (list t t nil)))
((= code 27) :escape) (:CTRL-L (setf (st :dirty) (list t t t)))
((= code 9) :tab) (t (if (st :dialog-stack)
((or (= code 127) (= code 8)) :backspace) (let* ((dlg (car (st :dialog-stack)))
((and (>= code 1) (<= code 26)) (sel (cl-tty.dialog:dialog-content dlg)))
(intern (string-upcase (cond
(format nil "CTRL-~a" ((eql ch :escape)
(code-char (+ #x60 code)))) (pop (st :dialog-stack))
:keyword)) (setf (st :minibuffer-active) nil)
(t raw-ch)))) (setf (st :command-palette-active) nil)
(case ch (setf (st :dirty) (list t t nil)))
(:CTRL-Q (setf (st :running) nil)) ((member ch '(:up :down))
(:CTRL-P (command-palette-show-commands)) (if (eql ch :up)
(:CTRL-B (setf (st :sidebar-visible) (not (st :sidebar-visible))) (cl-tty.select:select-prev sel)
(setf (st :dirty) (list t t nil))) (cl-tty.select:select-next sel)))
(:CTRL-L (setf (st :dirty) (list t t t))) ((member ch '(:enter 13 10))
(t (if (st :dialog-stack) (let* ((filtered (cl-tty.select:select-filtered-options sel))
(let* ((dlg (car (st :dialog-stack))) (idx (cl-tty.select:select-selected-index sel))
(sel (cl-tty.dialog:dialog-content dlg))) (item (when (< idx (length filtered))
(cond (third (nth idx filtered)))))
((eql ch :escape) (when item
(pop (st :dialog-stack)) (let ((cb (cl-tty.select:select-on-select sel)))
(setf (st :minibuffer-active) nil) (when cb (funcall cb item))))))
(setf (st :command-palette-active) nil) ((and (characterp ch) (graphic-char-p ch))
(setf (st :dirty) (list t t nil))) (setf (cl-tty.select:select-filter sel)
((member ch '(:up :down)) (concatenate 'string
(if (eql ch :up) (or (cl-tty.select:select-filter sel) "")
(cl-tty.select:select-prev sel) (string ch))))
(cl-tty.select:select-next sel))) ((member ch '(:backspace 127 8))
((member ch '(:enter 13 10)) (let ((f (cl-tty.select:select-filter sel)))
(let* ((filtered (cl-tty.select:select-filtered-options sel)) (when (> (length f) 0)
(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) (setf (cl-tty.select:select-filter sel)
(concatenate 'string (subseq f 0 (1- f))))))))
(or (cl-tty.select:select-filter sel) "") (on-key ch))))))))
(string ch)))) ;; Keyboard input now comes via events; no blocking read needed
((member ch '(:backspace 127 8)) ;; Re-query terminal size once after daemon handshake
(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
(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))
(setf (st :dirty) (list t t t)) (setf (st :dirty) (list t t t))