diff --git a/org/backend-protocol.org b/org/backend-protocol.org index 3fbb0a9..a14b103 100644 --- a/org/backend-protocol.org +++ b/org/backend-protocol.org @@ -817,14 +817,71 @@ No-op — simple backend has no terminal state to restore. *** Backend Size (Simple) -Returns hard-coded 80x24 dimensions. A real implementation would use -ioctl or TIOCGWINSZ, but the simple backend avoids OS-specific calls -for maximum portability. +Queries actual terminal dimensions through a fallback chain, with +a hard-coded 80x24 at the end: + +1. **Env var pre-check** — ~MY_TERM_COLS~ / ~MY_TERM_ROWS~, set by the + calling script before ~exec sbcl~. Checked with ~return-from~ so that + /both/ values are preserved (Common Lisp's ~or~ discards secondary + values). +2. **ioctl on fd 0 (stdin)** — the parent's real terminal fd. +3. **ioctl on stdout** — fast and correct after SIGWINCH at runtime. +4. **ioctl on ~/dev/tty~** — fallback when stdin/stdout are pipes. +5. **~(values 80 24)~** — last resort. #+BEGIN_SRC lisp :tangle ../src/backend/simple.lisp (defmethod backend-size ((b simple-backend)) - ;; Try ioctl, fall back to 80x24 - (values 80 24)) + ;; MY_TERM_COLS/MY_TERM_ROWS — set by the calling 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. + (multiple-value-bind (cols rows) + (ignore-errors + (let ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4))) + (unwind-protect + (let ((ok (sb-unix:unix-ioctl 0 21523 + (sb-alien:alien-sap winsize)))) + (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)) + (values cols rows))) + ;; ioctl on stdout fd — fast, correct after SIGWINCH at runtime. + (multiple-value-bind (cols rows) + (ignore-errors + (let* ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4))) + (unwind-protect + (let ((ok (sb-unix:unix-ioctl + (sb-sys:fd-stream-fd (backend-output-stream b)) + 21523 (sb-alien:alien-sap winsize)))) + (when ok + (values (sb-alien:deref winsize 1) + (sb-alien:deref winsize 0)))) + (sb-alien:free-alien winsize)))) + (when (and cols rows (> cols 0) (> rows 0)) + (values cols rows))) + (ignore-errors + (let ((tty-fd (sb-unix:unix-open "/dev/tty" 0 0))) + (when (and tty-fd (numberp tty-fd) (> tty-fd 0)) + (unwind-protect + (let* ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4))) + (let ((ok (sb-unix:unix-ioctl tty-fd 21523 + (sb-alien:alien-sap winsize)))) + (when ok + (values (sb-alien:deref winsize 1) + (sb-alien:deref winsize 0)))) + (sb-alien:free-alien winsize)) + (sb-unix:unix-close tty-fd))))) + (values 80 24))) #+END_SRC *** Backend Write (Simple) diff --git a/org/modern-backend.org b/org/modern-backend.org index e0a7eaf..07b4278 100644 --- a/org/modern-backend.org +++ b/org/modern-backend.org @@ -642,27 +642,58 @@ is responsible for redrawing the full screen after resume. (values)) #+END_SRC -** Backend-size via ioctl +** Backend-size via ioctl and env vars *** backend-size -Uses TIOCGWINSZ (=0x5413= = 21523) to query actual terminal dimensions -from the kernel via =ioctl=. The =alien-sap= wrapper ensures -compatibility across SBCL versions. Returns (values cols rows). +Uses a fallback chain to determine terminal dimensions: + +1. **Env var pre-check** — ~MY_TERM_COLS~ / ~MY_TERM_ROWS~, set by + the calling script before ~exec sbcl~. Uses ~return-from~ to preserve + both values (~or~ discards secondary values). +2. **ioctl on stdout** — fast, correct after SIGWINCH at runtime. +3. **ioctl on ~/dev/tty~** — fallback when stdout is not a terminal. +4. **~(values 80 24)~** — last resort. #+BEGIN_SRC lisp :tangle ../src/backend/modern.lisp (defmethod backend-size ((b modern-backend)) - (or (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)))) + ;; MY_TERM_COLS/MY_TERM_ROWS — set by the calling script. + ;; Check FIRST with return-from so both values (cols and rows) + ;; are preserved (or discards secondaries). + (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 + (multiple-value-bind (cols rows) + (ignore-errors + (let* ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4))) + (unwind-protect + (let ((ok (sb-unix:unix-ioctl + (sb-sys:fd-stream-fd (backend-output-stream b)) + 21523 (sb-alien:alien-sap winsize)))) + (when ok + (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. + (ignore-errors + (let ((tty-fd (sb-unix:unix-open "/dev/tty" 0 0))) + (when (and tty-fd (numberp tty-fd) (> tty-fd 0)) + (unwind-protect + (let* ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4))) + (let ((ok (sb-unix:unix-ioctl tty-fd 21523 + (sb-alien:alien-sap winsize)))) + (when ok + (let ((cols (sb-alien:deref winsize 1)) + (rows (sb-alien:deref winsize 0))) + (values cols rows))))) + (sb-unix:unix-close tty-fd))))) (values 80 24))) #+END_SRC diff --git a/org/text-input.org b/org/text-input.org index 8395234..ea43c82 100644 --- a/org/text-input.org +++ b/org/text-input.org @@ -434,9 +434,11 @@ The ~timeout~ keyword uses ~sb-unix:unix-simple-poll~ to implement non-blocking reads with a configurable deadline. This is critical for the 50ms escape sequence ambiguity resolution in ~%read-escape-sequence~. -Memory management: we allocate a 1-byte alien buffer, read into it, then -~free-alien~ in an ~unwind-protect~ to prevent leaks even if the read -is interrupted by a signal. +Memory management: we use ~sb-sys:with-pinned-objects~ to pin a 1-byte +~make-array~ vector in memory, obtain its SAP via ~sb-sys:vector-sap~, +and read directly into the backing storage. This avoids alien allocation +and manual ~free-alien~ while keeping the GC from moving the buffer +during the ~unix-read~ syscall. #+BEGIN_SRC lisp :tangle ../src/components/input.lisp (defun read-raw-byte (&key timeout) @@ -744,7 +746,8 @@ connection. The 500ms gives the terminal ample time to deliver all bytes. When the terminal emulator window is resized, the kernel sends SIGWINCH to the foreground process group. SBCL's signal handling facility (~sb-sys:enable-interrupt~) lets us install a handler that sets this -flag. +flag. The ~:sb-posix~ module must be ~require~d first so that the +~sb-posix:sigwinch~ constant is available. The main event loop should check this flag after each ~%read-event~ call and, if set, query the new terminal dimensions and redraw. The @@ -758,6 +761,7 @@ after handling the resize. #+BEGIN_SRC lisp :tangle ../src/components/input.lisp #+sbcl (eval-when (:load-toplevel :execute) + (require :sb-posix) (sb-sys:enable-interrupt sb-posix:sigwinch (lambda (signal info context) (declare (ignore signal info context)) diff --git a/src/backend/modern.lisp b/src/backend/modern.lisp index dc848ef..5d1c056 100644 --- a/src/backend/modern.lisp +++ b/src/backend/modern.lisp @@ -162,9 +162,9 @@ as a fallback when a keyword is not in *named-colors*.") (values)) (defmethod backend-size ((b modern-backend)) - ;; MY_TERM_COLS/MY_TERM_ROWS — set by the passepartout script - ;; before exec sbcl. Check FIRST with return-from so both - ;; values (cols and rows) are preserved (or discards secondaries). + ;; MY_TERM_COLS/MY_TERM_ROWS — set by the calling script. + ;; Check FIRST with return-from so both values (cols and rows) + ;; are preserved (or discards secondaries). (let ((cstr (sb-ext:posix-getenv "MY_TERM_COLS")) (rstr (sb-ext:posix-getenv "MY_TERM_ROWS"))) (when (and cstr rstr) @@ -184,8 +184,8 @@ as a fallback when a keyword is not in *named-colors*.") (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))) + (when (and cols rows (> cols 0) (> rows 0)) + (values cols rows))) ;; Direct ioctl on /dev/tty. (ignore-errors (let ((tty-fd (sb-unix:unix-open "/dev/tty" 0 0))) @@ -198,7 +198,7 @@ as a fallback when a keyword is not in *named-colors*.") (let ((cols (sb-alien:deref winsize 1)) (rows (sb-alien:deref winsize 0))) (values cols rows))))) - (sb-unix:unix-close tty-fd))))) + (sb-unix:unix-close tty-fd))))) (values 80 24))) (defmethod backend-write ((b modern-backend) string) diff --git a/src/backend/simple.lisp b/src/backend/simple.lisp index c21fc73..a6e75ec 100644 --- a/src/backend/simple.lisp +++ b/src/backend/simple.lisp @@ -22,7 +22,7 @@ (values)) (defmethod backend-size ((b simple-backend)) - ;; MY_TERM_COLS/MY_TERM_ROWS — set by the passepartout script. + ;; MY_TERM_COLS/MY_TERM_ROWS — set by the calling 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"))) @@ -44,8 +44,8 @@ (when (and c r (> c 0) (> r 0)) (values c r))))) (sb-alien:free-alien winsize)))) - (when (and cols rows (> cols 0) (> rows 0)) - (values cols rows))) + (when (and cols rows (> cols 0) (> rows 0)) + (values cols rows))) ;; ioctl on stdout fd — fast, correct after SIGWINCH at runtime. (multiple-value-bind (cols rows) (ignore-errors @@ -58,8 +58,8 @@ (values (sb-alien:deref winsize 1) (sb-alien:deref winsize 0)))) (sb-alien:free-alien winsize)))) - (when (and cols rows (> cols 0) (> rows 0)) - (values cols rows))) + (when (and cols rows (> cols 0) (> rows 0)) + (values cols rows))) (ignore-errors (let ((tty-fd (sb-unix:unix-open "/dev/tty" 0 0))) (when (and tty-fd (numberp tty-fd) (> tty-fd 0)) @@ -71,7 +71,7 @@ (values (sb-alien:deref winsize 1) (sb-alien:deref winsize 0)))) (sb-alien:free-alien winsize)) - (sb-unix:unix-close tty-fd))))) + (sb-unix:unix-close tty-fd))))) (values 80 24))) (defmethod backend-write ((b simple-backend) string) diff --git a/src/components/input.lisp b/src/components/input.lisp index c25c125..93cfc52 100644 --- a/src/components/input.lisp +++ b/src/components/input.lisp @@ -65,8 +65,7 @@ :raw (string (code-char code)))) (make-key-event :key (or key :unknown) :ctrl ctrl :alt alt :shift shift - :raw (format nil "~C[~{~d~};~d~C" #\Esc params - (char-code terminator) terminator))))) + :raw (format nil "~C[~{~d~};~d~C" #\Esc params terminator))))) (defun read-raw-byte (&key timeout) (let* ((buf (make-array 1 :element-type '(unsigned-byte 8))) @@ -161,15 +160,15 @@ Returns a mouse-event struct." (let* ((b2 (read-raw-byte))) (if (= b2 60) ;; < — SGR mouse marker (%parse-sgr-mouse) - (let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0))) - (multiple-value-bind (params terminator) - (if (and (>= b2 48) (<= b2 57)) - (multiple-value-bind (p term) (read-param (lambda () (read-raw-byte))) - (setf (fill-pointer extended) (length p)) - (replace extended p) - (values p term)) - (progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte))))) - (parse-csi-params params terminator extended))))))) + (let* ((extended (make-array 8 :element-type 'fixnum :fill-pointer 0)) + (params (if (and (>= b2 48) (<= b2 57)) + (multiple-value-bind (p term) (read-param (lambda () (read-raw-byte))) + (setf (fill-pointer extended) (length p)) + (replace extended p) + (values p term)) + (progn (vector-push-extend b2 extended) (read-param (lambda () (read-raw-byte))))))) + (destructuring-bind (params terminator) params + (parse-csi-params params terminator extended))))))) (defun utf8-decode (bytes) (case (length bytes)