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

fix: use return-from for env var fallback (or discards secondary values)

Browse Source 
or in Common Lisp only preserves the primary value — secondary
values from the truthy branch are lost. return-from preserves
all values, so both cols and rows are returned correctly.
This commit is contained in:
Amr Gharbeia
2026-05-14 15:03:00 -04:00
parent 36fbe81441
commit b44b4b6aa0
2 changed files with 21 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

37
src/backend/modern.lisp
View File

@@ -162,23 +162,17 @@ as a fallback when a keyword is not in *named-colors*.")
(values)) (values))
(defmethod backend-size ((b modern-backend)) (defmethod backend-size ((b modern-backend))
(or ;; ioctl on fd 0 (stdin) — the parent's own terminal, which IS ;; MY_TERM_COLS/MY_TERM_ROWS — set by the passepartout script
;; the real controlling terminal when running from a shell. ;; before exec sbcl. Check FIRST with return-from so both
(multiple-value-bind (cols rows) ;; values (cols and rows) are preserved (or discards secondaries).
(ignore-errors (let ((cstr (sb-ext:posix-getenv "MY_TERM_COLS"))
(let ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4))) (rstr (sb-ext:posix-getenv "MY_TERM_ROWS")))
(unwind-protect (when (and cstr rstr)
(let ((ok (sb-unix:unix-ioctl 0 21523 (let ((cols (parse-integer cstr :junk-allowed t))
(sb-alien:alien-sap winsize)))) (rows (parse-integer rstr :junk-allowed t)))
(when ok
(let ((c (sb-alien:deref winsize 1))
(r (sb-alien:deref winsize 0)))
(when (and c r (> c 0) (> r 0))
(values c r)))))
(sb-alien:free-alien winsize))))
(when (and cols rows (> cols 0) (> rows 0)) (when (and cols rows (> cols 0) (> rows 0))
(values cols rows))) (return-from backend-size (values cols rows))))))
;; ioctl on stdout fd — fast, correct after SIGWINCH at runtime. (or
(multiple-value-bind (cols rows) (multiple-value-bind (cols rows)
(ignore-errors (ignore-errors
(let* ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4))) (let* ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4)))
@@ -204,16 +198,7 @@ as a fallback when a keyword is not in *named-colors*.")
(let ((cols (sb-alien:deref winsize 1)) (let ((cols (sb-alien:deref winsize 1))
(rows (sb-alien:deref winsize 0))) (rows (sb-alien:deref winsize 0)))
(values cols rows))))) (values cols rows)))))
(sb-unix:unix-close tty-fd))))) (sb-unix:unix-close tty-fd)))))
;; MY_TERM_COLS/MY_TERM_LINES — set by the passepartout script
;; before exec sbcl. SBCL strips COLUMNS/LINES but leaves these.
(ignore-errors
(let* ((cstr (sb-ext:posix-getenv "MY_TERM_COLS"))
(rstr (sb-ext:posix-getenv "MY_TERM_LINES"))
(cols (when cstr (parse-integer cstr :junk-allowed t)))
(rows (when rstr (parse-integer rstr :junk-allowed t))))
(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)

19
src/backend/simple.lisp
View File

@@ -22,6 +22,15 @@
(values)) (values))
(defmethod backend-size ((b simple-backend)) (defmethod backend-size ((b simple-backend))
;; MY_TERM_COLS/MY_TERM_ROWS — set by the passepartout script.
;; Check with return-from to preserve both values.
(let ((cstr (sb-ext:posix-getenv "MY_TERM_COLS"))
(rstr (sb-ext:posix-getenv "MY_TERM_ROWS")))
(when (and cstr rstr)
(let ((cols (parse-integer cstr :junk-allowed t))
(rows (parse-integer rstr :junk-allowed t)))
(when (and cols rows (> cols 0) (> rows 0))
(return-from backend-size (values cols rows))))))
(or ;; ioctl on fd 0 (stdin) — the parent's own terminal. (or ;; ioctl on fd 0 (stdin) — the parent's own terminal.
(multiple-value-bind (cols rows) (multiple-value-bind (cols rows)
(ignore-errors (ignore-errors
@@ -62,15 +71,7 @@
(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))
(sb-unix:unix-close tty-fd))))) (sb-unix:unix-close tty-fd)))))
;; MY_TERM_COLS/MY_TERM_LINES — set by the passepartout script.
(ignore-errors
(let* ((cstr (sb-ext:posix-getenv "MY_TERM_COLS"))
(rstr (sb-ext:posix-getenv "MY_TERM_LINES"))
(cols (when cstr (parse-integer cstr :junk-allowed t)))
(rows (when rstr (parse-integer rstr :junk-allowed t))))
(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)