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

fix: use blocking read-char via listen for reliable input

Browse Source 
read-char-no-hang on fd 0 streams never returns data because
sb-unix:unix-simple-poll on fd 0 returns NIL in this SBCL
environment. Switched to (listen tty) + (read-char tty) which
blocks until a key is pressed — correct interactive TUI behavior.
Also switched from (open "/dev/tty") to
(sb-sys:make-fd-stream 0 :input t :buffering :none) to directly
read from stdin.
This commit is contained in:
Amr Gharbeia
2026-05-14 09:02:02 -04:00
parent 11cb466d4f
commit 1884372660
2 changed files with 22 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -864,7 +864,7 @@
(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)
(let ((tty (open "/dev/tty" :direction :input))) (let ((tty (sb-sys:make-fd-stream 0 :input t :buffering :none)))
;; Initial render ;; Initial render
(cl-tty.backend:backend-clear be) (cl-tty.backend:backend-clear be)
(view-status be w h) (view-status be w h)
@@ -887,22 +887,26 @@
(setf cl-tty.input::*terminal-resized-p* nil) (setf cl-tty.input::*terminal-resized-p* nil)
(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))))
;; Read key input from /dev/tty (non-blocking) ;; Read key input from fd 0 (blocking via listen + read-char)
(let ((raw-ch (read-char-no-hang tty nil nil))) ;; Note: sb-unix:unix-simple-poll on fd 0 returns NIL in this
;; SBCL environment, so read-char-no-hang never fires. Use
;; blocking read-char instead — the TUI loop sleeps 0.1s
;; between renders anyway.
(let ((raw-ch (when (listen tty) (read-char tty nil nil))))
(when raw-ch (when raw-ch
(let ((code (char-code raw-ch))) (let ((code (char-code raw-ch)))
(let ((ch (cond (let ((ch (cond
((= code 13) :enter) ((= code 13) :enter)
((= code 10) :enter) ((= code 10) :enter)
((= code 27) :escape) ((= code 27) :escape)
((= code 9) :tab) ((= code 9) :tab)
((or (= code 127) (= code 8)) :backspace) ((or (= code 127) (= code 8)) :backspace)
((and (>= code 1) (<= code 26)) ((and (>= code 1) (<= code 26))
(intern (string-upcase (format nil "CTRL-~a" (intern (string-upcase (format nil "CTRL-~a"
(code-char (+ #x60 code)))) (code-char (+ #x60 code))))
:keyword)) :keyword))
(t raw-ch)))) (t raw-ch))))
(case ch (case ch
(:CTRL-Q (setf (st :running) nil)) (:CTRL-Q (setf (st :running) nil))
(:CTRL-P (command-palette-show-commands)) (:CTRL-P (command-palette-show-commands))
(:CTRL-B (setf (st :sidebar-visible) (not (st :sidebar-visible))) (:CTRL-B (setf (st :sidebar-visible) (not (st :sidebar-visible)))

6
org/channel-tui-main.org
View File

@@ -908,7 +908,7 @@ Event handlers + daemon I/O + main loop.
(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)
(let ((tty (open "/dev/tty" :direction :input))) (let ((tty (sb-sys:make-fd-stream 0 :input t :buffering :none)))
;; Initial render ;; Initial render
(cl-tty.backend:backend-clear be) (cl-tty.backend:backend-clear be)
(view-status be w h) (view-status be w h)
@@ -931,8 +931,8 @@ Event handlers + daemon I/O + main loop.
(setf cl-tty.input::*terminal-resized-p* nil) (setf cl-tty.input::*terminal-resized-p* nil)
(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))))
;; Read key input from /dev/tty (non-blocking) ;; Read key input from fd 0 (blocking via listen + read-char)
(let ((raw-ch (read-char-no-hang tty nil nil))) (let ((raw-ch (when (listen tty) (read-char tty nil nil))))
(when raw-ch (when raw-ch
(let ((code (char-code raw-ch))) (let ((code (char-code raw-ch)))
(let ((ch (cond (let ((ch (cond