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

fix: set both dimensions from stty, add tput fallback, export shell vars

Browse Source 
- stty size returns 'rows cols'. Old code set only one dimension
  when both env vars were missing; new code sets both.
- Added tput cols/lines as final env-var fallback for systems
  where COLUMNS/LINES are not exported and stty is unavailable.
- Added 'export COLUMNS LINES' to the passepartout script so
  SBCL can read them from the environment.
This commit is contained in:
Amr Gharbeia
2026-05-14 13:36:54 -04:00
parent 03ffec75c8
commit 4fa7e98b80
2 changed files with 32 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
src/backend/modern.lisp
View File

@@ -180,7 +180,7 @@ as a fallback when a keyword is not in *named-colors*.")
(rstr (sb-ext:posix-getenv "LINES"))
(cols (when cstr (parse-integer cstr :junk-allowed t)))
(rows (when rstr (parse-integer rstr :junk-allowed t))))
;; If only one env var is set, get the other from stty
;; If env vars are missing, use stty size (rows cols)
(unless (and cols rows)
(let* ((out (uiop:run-program '("stty" "size")
:output :string
@@ -188,10 +188,22 @@ as a fallback when a keyword is not in *named-colors*.")
(parts (and out (uiop:split-string
(string-trim '(#\newline #\space) out)))))
(when (and parts (= (length parts) 2))
(let ((a (parse-integer (first parts) :junk-allowed t))
(b (parse-integer (second parts) :junk-allowed t)))
(when (and a b (> a 0) (> b 0))
(if cols (setf rows b) (setf cols a)))))))
(let ((stty-rows (parse-integer (first parts) :junk-allowed t))
(stty-cols (parse-integer (second parts) :junk-allowed t)))
(when (and stty-rows stty-cols (> stty-rows 0) (> stty-cols 0))
(unless cols (setf cols stty-cols))
(unless rows (setf rows stty-rows)))))))
;; If still missing, try tput as final shell fallback
(unless (and cols rows)
(let ((out (uiop:run-program '("sh" "-c" "tput cols 2>/dev/null; tput lines 2>/dev/null")
:output :string
:ignore-error-status t)))
(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)))

19
src/backend/simple.lisp
View File

@@ -46,10 +46,21 @@
(parts (and out (uiop:split-string
(string-trim '(#\newline #\space) out)))))
(when (and parts (= (length parts) 2))
(let ((a (parse-integer (first parts) :junk-allowed t))
(b (parse-integer (second parts) :junk-allowed t)))
(when (and a b (> a 0) (> b 0))
(if cols (setf rows b) (setf cols a)))))))
(let ((stty-rows (parse-integer (first parts) :junk-allowed t))
(stty-cols (parse-integer (second parts) :junk-allowed t)))
(when (and stty-rows stty-cols (> stty-rows 0) (> stty-cols 0))
(unless cols (setf cols stty-cols))
(unless rows (setf rows stty-rows)))))))
(unless (and cols rows)
(let ((out (uiop:run-program '("sh" "-c" "tput cols 2>/dev/null; tput lines 2>/dev/null")
:output :string
:ignore-error-status t)))
(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)))