fix: use :input :interactive for stty size subprocess

SBCL's stdin during --load is the load file, NOT the terminal.
When uiop:run-program creates a subprocess, it inherits this
stdin, so 'stty size' reads from the load file and fails.
:input :interactive opens /dev/tty for the child's stdin,
matching the behavior of 'stty size' from an interactive shell.
This commit is contained in:
2026-05-14 14:24:55 -04:00
parent 4b1ff3ed0f
commit 31f864471c
2 changed files with 54 additions and 58 deletions

View File

@@ -162,32 +162,43 @@ as a fallback when a keyword is not in *named-colors*.")
(values))
(defmethod backend-size ((b modern-backend))
(or ;; stty size via subprocess — most reliable across all systems.
;; Returns "ROWS COLS". Uses explicit /dev/tty to bypass any
;; stdin redirection from uiop:run-program.
(ignore-errors
(let* ((out (uiop:run-program '("sh" "-c" "stty size < /dev/tty")
:output :string
:ignore-error-status t))
(parts (and out (uiop:split-string
(string-trim '(#\newline #\space) out)))))
(when (and parts (= (length parts) 2))
(let ((rows (parse-integer (first parts) :junk-allowed t))
(cols (parse-integer (second parts) :junk-allowed t)))
(when (and rows cols (> rows 0) (> cols 0))
(values cols rows))))))
(or ;; stty size via subprocess — most reliable across all systems.
;; Returns "ROWS COLS". Uses :input :interactive so the subprocess
;; opens /dev/tty for its stdin (SBCL's stdin is the load file).
(multiple-value-bind (cols rows)
(ignore-errors
(let* ((out (uiop:run-program '("stty" "size")
:output :string
:input :interactive
:ignore-error-status t))
(parts (and out (uiop:split-string
(string-trim '(#\newline #\space) out)))))
(when parts
(let ((a (parse-integer (first parts) :junk-allowed t))
(b (when (cdr parts) (parse-integer (second parts) :junk-allowed t))))
(if (and a b (> a 0) (> b 0))
;; stty returns "ROWS COLS"
(values b a)
;; stty returned only one value — treat as cols
(when (and a (> a 0))
(values a nil)))))))
(when (and cols rows (> cols 0) (> rows 0))
(values cols rows)))
;; ioctl on stdout fd — fast, correct after SIGWINCH at runtime.
(ignore-errors
(let* ((+tiocgwinsz+ 21523) ; 0x5413 on Linux
(winsize (sb-alien:make-alien sb-alien:unsigned-short 4)))
(unwind-protect
(progn
(sb-unix:unix-ioctl (sb-sys:fd-stream-fd (backend-output-stream b))
+tiocgwinsz+
(sb-alien:alien-sap winsize))
(values (sb-alien:deref winsize 1) ;; cols
(sb-alien:deref winsize 0))) ;; rows
(sb-alien:free-alien winsize))))
(multiple-value-bind (cols rows)
(ignore-errors
(let* ((+tiocgwinsz+ 21523) ; 0x5413 on Linux
(winsize (sb-alien:make-alien sb-alien:unsigned-short 4)))
(unwind-protect
(progn
(sb-unix:unix-ioctl (sb-sys:fd-stream-fd (backend-output-stream b))
+tiocgwinsz+
(sb-alien:alien-sap winsize))
(values (sb-alien:deref winsize 1) ;; cols
(sb-alien:deref winsize 0))) ;; rows
(sb-alien:free-alien winsize))))
(when (and cols rows (> cols 0) (> rows 0))
(values cols rows)))
;; Direct ioctl on /dev/tty — opens the real controlling terminal.
(ignore-errors
(let ((tty-fd (sb-unix:unix-open "/dev/tty" 0 0))) ; O_RDONLY

View File

@@ -23,39 +23,24 @@
(defmethod backend-size ((b simple-backend))
(or ;; stty size via subprocess — most reliable across all systems.
(ignore-errors
(let* ((out (uiop:run-program '("sh" "-c" "stty size < /dev/tty")
:output :string
:ignore-error-status t))
(parts (and out (uiop:split-string
(string-trim '(#\newline #\space) out)))))
(when (and parts (= (length parts) 2))
(let ((rows (parse-integer (first parts) :junk-allowed t))
(cols (parse-integer (second parts) :junk-allowed t)))
(when (and rows cols (> rows 0) (> cols 0))
(values cols rows))))))
(ignore-errors
(let* ((+tiocgwinsz+ 21523)
(winsize (sb-alien:make-alien sb-alien:unsigned-short 4)))
(unwind-protect
(progn
(sb-unix:unix-ioctl (sb-sys:fd-stream-fd
(backend-output-stream b))
+tiocgwinsz+
(sb-alien:alien-sap winsize))
(values (sb-alien:deref winsize 1)
(sb-alien:deref winsize 0)))
(sb-alien:free-alien winsize))))
;; stty size via subprocess — reliable on every Unix.
(ignore-errors
(let* ((out (uiop:run-program '("sh" "-c" "stty size < /dev/tty")
:output :string
:ignore-error-status t))
(parts (and out (uiop:split-string
(string-trim '(#\newline #\space) out)))))
(when (and parts (= (length parts) 2))
(let ((rows (parse-integer (first parts) :junk-allowed t))
(cols (parse-integer (second parts) :junk-allowed t)))
(multiple-value-bind (cols rows)
(ignore-errors
(let* ((out (uiop:run-program '("stty" "size")
:output :string
:input :interactive
:ignore-error-status t))
(parts (and out (uiop:split-string
(string-trim '(#\newline #\space) out)))))
(when parts
(let ((a (parse-integer (first parts) :junk-allowed t))
(b (when (cdr parts) (parse-integer (second parts) :junk-allowed t))))
(if (and a b (> a 0) (> b 0))
(values b a) ; stty returns "ROWS COLS"
(when (and a (> a 0))
(values a nil)))))))
(when (and cols rows (> cols 0) (> rows 0))
(values cols rows)))
(multiple-value-bind (cols rows)
(when (and rows cols (> rows 0) (> cols 0))
(values cols rows))))))
(ignore-errors