From 0ad9d3bdb52665c6eabedf7479f4ca77cb3c471c Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Thu, 14 May 2026 10:32:46 -0400 Subject: [PATCH] fix: threaded keyboard reader, key events via queue - 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) --- lisp/channel-tui-main.lisp | 144 ++++++++++++++++++++----------------- 1 file changed, 77 insertions(+), 67 deletions(-) diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index 93347a2..3368b4b 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -864,6 +864,30 @@ (cl-tty.input:with-raw-terminal (cl-tty.backend:with-terminal (be w h) (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 (let ((backend-type (if (typep be 'cl-tty.backend:modern-backend) "modern" "simple"))) @@ -880,74 +904,60 @@ (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 blocking read-char with 0.1s timeout - ;; (sb-unix:unix-simple-poll returns NIL on fd 0 in this SBCL, - ;; so read-char-no-hang and read-event never fire. Raw blocking - ;; read-char with sb-ext:with-timeout is the reliable fallback.) - (handler-case - (sb-ext:with-timeout 0.1 - (let* ((raw-ch (read-char tty nil 'eof)) - (code (when (characterp raw-ch) (char-code raw-ch)))) - (when code - (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 (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)) + (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 *")) + ((eq (getf ev :type) :key) + (let* ((payload (getf ev :payload)) + (ch (getf payload :ch))) + (with-open-file (d "/tmp/tui-keys.log" + :direction :output :if-exists :append + :if-does-not-exist :create) + (format d "KEY EVENT ch=~s type=~s~%" ch (type-of 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) - (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 + (subseq f 0 (1- f)))))))) + (on-key ch)))))))) + ;; Keyboard input now comes via events; no blocking read needed + ;; Re-query terminal size once after daemon handshake (when (and (st :connected) (st :daemon-version) (not (st :size-queried))) (multiple-value-setq (w h) (cl-tty.backend:backend-size be)) (setf (st :dirty) (list t t t))