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

fix: remove env var fallback for COLUMNS/LINES (SBCL strips them)

Browse Source 
SBCL unconditionally strips COLUMNS and LINES from the environment,
so posix-getenv always returns nil for those names. stty size is
the reliable cross-platform fallback for terminal dimensions.
This commit is contained in:
Amr Gharbeia
2026-05-14 13:46:13 -04:00
parent 4fa7e98b80
commit 9b472e281f
2 changed files with 48 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
src/backend/modern.lisp
View File

@@ -173,39 +173,32 @@ 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))))
;; $COLUMNS/$LINES fallback — some systems return 80x24 from ;; stty size — reliable across all shells and terminals.
;; ioctl on stdout's fd even when the terminal is larger. ;; SBCL strips COLUMNS/LINES from the environment, so env var
;; fallbacks won't work for those names.
(ignore-errors (ignore-errors
(let* ((cstr (sb-ext:posix-getenv "COLUMNS")) (let* ((out (uiop:run-program '("stty" "size")
(rstr (sb-ext:posix-getenv "LINES")) :output :string
(cols (when cstr (parse-integer cstr :junk-allowed t))) :ignore-error-status t))
(rows (when rstr (parse-integer rstr :junk-allowed t)))) (parts (and out (uiop:split-string
;; If env vars are missing, use stty size (rows cols) (string-trim '(#\newline #\space) out)))))
(unless (and cols rows) (when (and parts (= (length parts) 2))
(let* ((out (uiop:run-program '("stty" "size") (let ((rows (parse-integer (first parts) :junk-allowed t))
:output :string (cols (parse-integer (second parts) :junk-allowed t)))
:ignore-error-status t)) (when (and rows cols (> rows 0) (> cols 0))
(parts (and out (uiop:split-string (values cols rows))))))
(string-trim '(#\newline #\space) out))))) ;; tput — final shell fallback for esoteric terminals
(when (and parts (= (length parts) 2)) (ignore-errors
(let ((stty-rows (parse-integer (first parts) :junk-allowed t)) (let* ((out (uiop:run-program '("sh" "-c" "tput cols 2>/dev/null; tput lines 2>/dev/null")
(stty-cols (parse-integer (second parts) :junk-allowed t))) :output :string
(when (and stty-rows stty-cols (> stty-rows 0) (> stty-cols 0)) :ignore-error-status t))
(unless cols (setf cols stty-cols)) (parts (and out (uiop:split-string
(unless rows (setf rows stty-rows))))))) (string-trim '(#\newline #\space) out)))))
;; If still missing, try tput as final shell fallback (when (and parts (= (length parts) 2))
(unless (and cols rows) (let ((cols (parse-integer (first parts) :junk-allowed t))
(let ((out (uiop:run-program '("sh" "-c" "tput cols 2>/dev/null; tput lines 2>/dev/null") (rows (parse-integer (second parts) :junk-allowed t)))
:output :string (when (and rows cols (> rows 0) (> cols 0))
:ignore-error-status t))) (values cols rows))))))
(when out
(let* ((parts (uiop:split-string (string-trim '(#\newline #\space) out)))
(a (when parts (parse-integer (first parts) :junk-allowed t)))
(b (when (cdr parts) (parse-integer (second parts) :junk-allowed t))))
(when a (setf cols a))
(when b (setf rows b))))))
(when (and cols rows (> cols 0) (> rows 0))
(values cols rows))))
(values 80 24))) (values 80 24)))
(defmethod backend-write ((b modern-backend) string) (defmethod backend-write ((b modern-backend) string)

51
src/backend/simple.lisp
View File

@@ -34,35 +34,30 @@
(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.
(ignore-errors (ignore-errors
(let* ((cstr (sb-ext:posix-getenv "COLUMNS")) (let* ((out (uiop:run-program '("stty" "size")
(rstr (sb-ext:posix-getenv "LINES")) :output :string
(cols (when cstr (parse-integer cstr :junk-allowed t))) :ignore-error-status t))
(rows (when rstr (parse-integer rstr :junk-allowed t)))) (parts (and out (uiop:split-string
(unless (and cols rows) (string-trim '(#\newline #\space) out)))))
(let* ((out (uiop:run-program '("stty" "size") (when (and parts (= (length parts) 2))
:output :string (let ((rows (parse-integer (first parts) :junk-allowed t))
:ignore-error-status t)) (cols (parse-integer (second parts) :junk-allowed t)))
(parts (and out (uiop:split-string (when (and rows cols (> rows 0) (> cols 0))
(string-trim '(#\newline #\space) out))))) (values cols rows))))))
(when (and parts (= (length parts) 2)) ;; tput — final shell fallback
(let ((stty-rows (parse-integer (first parts) :junk-allowed t)) (ignore-errors
(stty-cols (parse-integer (second parts) :junk-allowed t))) (let* ((out (uiop:run-program '("sh" "-c" "tput cols 2>/dev/null; tput lines 2>/dev/null")
(when (and stty-rows stty-cols (> stty-rows 0) (> stty-cols 0)) :output :string
(unless cols (setf cols stty-cols)) :ignore-error-status t))
(unless rows (setf rows stty-rows))))))) (parts (and out (uiop:split-string
(unless (and cols rows) (string-trim '(#\newline #\space) out)))))
(let ((out (uiop:run-program '("sh" "-c" "tput cols 2>/dev/null; tput lines 2>/dev/null") (when (and parts (= (length parts) 2))
:output :string (let ((cols (parse-integer (first parts) :junk-allowed t))
:ignore-error-status t))) (rows (parse-integer (second parts) :junk-allowed t)))
(when out (when (and rows cols (> rows 0) (> cols 0))
(let* ((parts (uiop:split-string (string-trim '(#\newline #\space) out))) (values cols rows))))))
(a (when parts (parse-integer (first parts) :junk-allowed t)))
(b (when (cdr parts) (parse-integer (second parts) :junk-allowed t))))
(when a (setf cols a))
(when b (setf rows b))))))
(when (and cols rows (> cols 0) (> rows 0))
(values cols rows))))
(values 80 24))) (values 80 24)))
(defmethod backend-write ((b simple-backend) string) (defmethod backend-write ((b simple-backend) string)