amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: replace stty/tput fallback with direct ioctl on /dev/tty

Browse Source 
uiop:run-program can inherit different terminal state than the
interactive shell. Opening /dev/tty directly and calling ioctl
on that fd is equivalent to what the shell's stty does, and
works regardless of SBCL's fd inheritance quirks.
This commit is contained in:
Amr Gharbeia
2026-05-14 13:56:16 -04:00
parent 9b472e281f
commit 37f83db35e
2 changed files with 27 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
src/backend/modern.lisp
View File

@@ -173,32 +173,21 @@ as a fallback when a keyword is not in *named-colors*.")
(values (sb-alien:deref winsize 1) ;; cols (values (sb-alien:deref winsize 1) ;; cols
(sb-alien:deref winsize 0))) ;; rows (sb-alien:deref winsize 0))) ;; rows
(sb-alien:free-alien winsize)))) (sb-alien:free-alien winsize))))
;; stty size — reliable across all shells and terminals. ;; Direct ioctl on /dev/tty — opens the real controlling terminal,
;; SBCL strips COLUMNS/LINES from the environment, so env var ;; bypassing any fd weirdness from SBCL's subprocess or stream setup.
;; fallbacks won't work for those names.
(ignore-errors (ignore-errors
(let* ((out (uiop:run-program '("stty" "size") (let ((tty-fd (sb-unix:unix-open "/dev/tty" sb-unix:o-rdwr 0)))
:output :string (when tty-fd
:ignore-error-status t)) (unwind-protect
(parts (and out (uiop:split-string (let* ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4)))
(string-trim '(#\newline #\space) out))))) (sb-unix:unix-ioctl tty-fd 21523 (sb-alien:alien-sap winsize))
(when (and parts (= (length parts) 2)) (let ((cols (sb-alien:deref winsize 1))
(let ((rows (parse-integer (first parts) :junk-allowed t)) (rows (sb-alien:deref winsize 0)))
(cols (parse-integer (second parts) :junk-allowed t))) (sb-alien:free-alien winsize)
(when (and rows cols (> rows 0) (> cols 0)) (when (and (integerp cols) (integerp rows)
(values cols rows)))))) (> cols 0) (> rows 0))
;; tput — final shell fallback for esoteric terminals (values cols rows))))
(ignore-errors (sb-unix:unix-close tty-fd)))))
(let* ((out (uiop:run-program '("sh" "-c" "tput cols 2>/dev/null; tput lines 2>/dev/null")
:output :string
:ignore-error-status t))
(parts (and out (uiop:split-string
(string-trim '(#\newline #\space) out)))))
(when (and parts (= (length parts) 2))
(let ((cols (parse-integer (first parts) :junk-allowed t))
(rows (parse-integer (second parts) :junk-allowed t)))
(when (and rows cols (> rows 0) (> cols 0))
(values cols rows))))))
(values 80 24))) (values 80 24)))
(defmethod backend-write ((b modern-backend) string) (defmethod backend-write ((b modern-backend) string)

36
src/backend/simple.lisp
View File

@@ -34,30 +34,20 @@
(values (sb-alien:deref winsize 1) (values (sb-alien:deref winsize 1)
(sb-alien:deref winsize 0))) (sb-alien:deref winsize 0)))
(sb-alien:free-alien winsize)))) (sb-alien:free-alien winsize))))
;; stty size — reliable across all shells and terminals. ;; Direct ioctl on /dev/tty — opens the real controlling terminal.
(ignore-errors (ignore-errors
(let* ((out (uiop:run-program '("stty" "size") (let ((tty-fd (sb-unix:unix-open "/dev/tty" sb-unix:o-rdwr 0)))
:output :string (when tty-fd
:ignore-error-status t)) (unwind-protect
(parts (and out (uiop:split-string (let* ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4)))
(string-trim '(#\newline #\space) out))))) (sb-unix:unix-ioctl tty-fd 21523 (sb-alien:alien-sap winsize))
(when (and parts (= (length parts) 2)) (let ((cols (sb-alien:deref winsize 1))
(let ((rows (parse-integer (first parts) :junk-allowed t)) (rows (sb-alien:deref winsize 0)))
(cols (parse-integer (second parts) :junk-allowed t))) (sb-alien:free-alien winsize)
(when (and rows cols (> rows 0) (> cols 0)) (when (and (integerp cols) (integerp rows)
(values cols rows)))))) (> cols 0) (> rows 0))
;; tput — final shell fallback (values cols rows))))
(ignore-errors (sb-unix:unix-close tty-fd)))))
(let* ((out (uiop:run-program '("sh" "-c" "tput cols 2>/dev/null; tput lines 2>/dev/null")
:output :string
:ignore-error-status t))
(parts (and out (uiop:split-string
(string-trim '(#\newline #\space) out)))))
(when (and parts (= (length parts) 2))
(let ((cols (parse-integer (first parts) :junk-allowed t))
(rows (parse-integer (second parts) :junk-allowed t)))
(when (and rows cols (> rows 0) (> cols 0))
(values cols rows))))))
(values 80 24))) (values 80 24)))
(defmethod backend-write ((b simple-backend) string) (defmethod backend-write ((b simple-backend) string)