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)
This commit is contained in:
@@ -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))
|
||||
|
||||
Reference in New Issue
Block a user