fix: add CSI positioning and ioctl sizing to simple-backend

- backend-size now uses TIOCGWINSZ ioctl (like modern-backend)
- draw-text adds \033[row;colH CSI cursor positioning
- draw-rect fills background with space characters at position
- draw-border uses CSI positioning instead of raw newlines+spaces
- Added cursor-hide/cursor-show, cursor-move, initialize/shutdown
- Detection: broader DA1 check (any ANSI response, not just kitty)
- Detection: added TERM-based fallback for modern terminal detection
This commit is contained in:
2026-05-14 08:55:56 -04:00
parent 1637c3352c
commit e8b37f6268
2 changed files with 66 additions and 28 deletions

View File

@@ -31,13 +31,26 @@ TIMEOUT seconds. Returns the response string, or nil if no response."
response))) response)))
(defun detect-backend-by-da1 () (defun detect-backend-by-da1 ()
"Send DA1 (ESC[c) query and check for kitty terminal response code. "Send DA1 (ESC[c) query and check for any terminal response.
Returns T if terminal reports kitty compatibility codes." Returns T if the terminal responds to DA1 (indicating an ANSI-compatible terminal)."
(let ((response (query-terminal (format nil "~C[c" (code-char 27))))) (let ((response (query-terminal (format nil "~C[c" (code-char 27)))))
(when response (when response
;; DA1 response format: ESC [ ? digits ; digits c ;; Any DA1 response (ESC [ ? digits ... c) means the terminal
;; Kitty reports code 62 in the response ;; understands ANSI escape sequences — good enough for modern-backend
(search "?62" response)))) (> (length response) 0))))
(defun detect-backend-by-term ()
"Check TERM environment variable for modern terminal types.
Returns :modern if TERM contains xterm, tmux, screen, kitty,
alacritty, foot, wezterm, or ghostty."
(let ((term (sb-ext:posix-getenv "TERM")))
(when term
;; Known non-modern terms
(unless (or (string-equal term "dumb")
(string-equal term "dump")
(string-equal term "emacs")
(search "52" term)) ; VT52 — no ANSI
:modern))))
(defun detect-backend () (defun detect-backend ()
"Auto-detect the appropriate backend for the current terminal. "Auto-detect the appropriate backend for the current terminal.
@@ -47,6 +60,7 @@ Result is cached in *detected-backend* for subsequent calls."
(setf *detected-backend* (setf *detected-backend*
(if (and (detect-backend-by-tty) (if (and (detect-backend-by-tty)
(or (eql (detect-backend-by-env) :modern) (or (eql (detect-backend-by-env) :modern)
(detect-backend-by-da1))) (detect-backend-by-da1)
(eql (detect-backend-by-term) :modern)))
(make-modern-backend) (make-modern-backend)
(make-simple-backend))))) (make-simple-backend)))))

View File

@@ -10,20 +10,36 @@
:output-stream (or output-stream *standard-output*))) :output-stream (or output-stream *standard-output*)))
(defmethod initialize-backend ((b simple-backend)) (defmethod initialize-backend ((b simple-backend))
(backend-write b (format nil "~C[2J~C[H" #\Esc #\Esc)) ; clear + home
(backend-write b (format nil "~C[?25l" #\Esc)) ; hide cursor
b) b)
(defmethod shutdown-backend ((b simple-backend)) (defmethod shutdown-backend ((b simple-backend))
(backend-write b (format nil "~C[?25h" #\Esc)) ; show cursor
(values)) (values))
(defmethod suspend-backend ((b simple-backend)) (defmethod suspend-backend ((b simple-backend))
(backend-write b (format nil "~C[?25h" #\Esc))
(values)) (values))
(defmethod resume-backend ((b simple-backend)) (defmethod resume-backend ((b simple-backend))
(backend-write b (format nil "~C[?25l" #\Esc))
(values)) (values))
(defmethod backend-size ((b simple-backend)) (defmethod backend-size ((b simple-backend))
;; Try ioctl, fall back to 80x24 (or (ignore-errors
(values 80 24)) (let* ((+tiocgwinsz+ 21523)
(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)
(sb-alien:deref winsize 0)))
(sb-alien:free-alien winsize))))
(values 80 24)))
(defmethod backend-write ((b simple-backend) string) (defmethod backend-write ((b simple-backend) string)
(let ((stream (backend-output-stream b))) (let ((stream (backend-output-stream b)))
@@ -31,16 +47,29 @@
(finish-output stream) (finish-output stream)
(length string))) (length string)))
(defmethod capable-p ((b simple-backend) feature)
(declare (ignore feature))
nil)
(defun %cursor-move (x y)
(format nil "~C[~d;~dH" #\Esc (1+ y) (1+ x)))
(defmethod cursor-hide ((b simple-backend))
(backend-write b (format nil "~C[?25l" #\Esc)))
(defmethod cursor-show ((b simple-backend))
(backend-write b (format nil "~C[?25h" #\Esc)))
(defmethod cursor-move ((b simple-backend) x y)
(backend-write b (%cursor-move x y)))
(defmethod draw-text ((b simple-backend) x y string fg bg (defmethod draw-text ((b simple-backend) x y string fg bg
&key bold italic underline reverse dim blink &key bold italic underline reverse dim blink
&allow-other-keys) &allow-other-keys)
(declare (ignore x y fg bg bold italic underline reverse dim blink)) (declare (ignore fg bg bold italic underline reverse dim blink))
(backend-write b string)) (backend-write b (concatenate 'string (%cursor-move x y) string)))
(defun %simple-border-char (pos) (defun %simple-border-char (pos)
"Return ASCII border character at POS.
POS is :top-left, :top-right, :bottom-left, :bottom-right,
:horizontal, or :vertical."
(case pos (case pos
((:top-left :top-right :bottom-left :bottom-right) #\+) ((:top-left :top-right :bottom-left :bottom-right) #\+)
(:horizontal #\-) (:horizontal #\-)
@@ -55,10 +84,8 @@ POS is :top-left, :top-right, :bottom-left, :bottom-right,
(tr (%simple-border-char :top-right)) (tr (%simple-border-char :top-right))
(bl (%simple-border-char :bottom-left)) (bl (%simple-border-char :bottom-left))
(br (%simple-border-char :bottom-right))) (br (%simple-border-char :bottom-right)))
;; Position cursor with newlines and spaces (no escape sequences) ;; Top edge
(dotimes (row y) (backend-write b (string #\Newline))) (backend-write b (%cursor-move x y))
;; Top edge with optional title
(backend-write b (make-string x :initial-element #\space))
(backend-write b (string tl)) (backend-write b (string tl))
(if (and title (plusp (length title))) (if (and title (plusp (length title)))
(let* ((align (or title-align :left)) (let* ((align (or title-align :left))
@@ -83,23 +110,23 @@ POS is :top-left, :top-right, :bottom-left, :bottom-right,
(backend-write b (string tr)) (backend-write b (string tr))
;; Sides ;; Sides
(loop for i from 1 below (1- height) (loop for i from 1 below (1- height)
do (backend-write b (string #\Newline)) do (backend-write b (%cursor-move x (+ y i)))
(backend-write b (make-string x :initial-element #\space))
(backend-write b (string v)) (backend-write b (string v))
(backend-write b (make-string (- width 2) :initial-element #\space)) (backend-write b (make-string (- width 2) :initial-element #\space))
(backend-write b (string v))) (backend-write b (string v)))
;; Bottom edge ;; Bottom edge
(backend-write b (string #\Newline)) (backend-write b (%cursor-move x (+ y height -1)))
(backend-write b (make-string x :initial-element #\space))
(backend-write b (string bl)) (backend-write b (string bl))
(backend-write b (make-string (- width 2) :initial-element h)) (backend-write b (make-string (- width 2) :initial-element h))
(backend-write b (string br)))) (backend-write b (string br))))
(defmethod draw-rect ((b simple-backend) x y width height (defmethod draw-rect ((b simple-backend) x y width height
&key bg) &key bg)
(declare (ignore x y width height bg)) (declare (ignore bg))
;; On simple backend, background fill is a no-op (let ((line (make-string width :initial-element #\space)))
(values)) (loop for row from 0 below height
do (backend-write b (%cursor-move x (+ y row)))
(backend-write b line))))
(defmethod draw-link ((b simple-backend) x y string url (defmethod draw-link ((b simple-backend) x y string url
&key fg bg) &key fg bg)
@@ -109,7 +136,4 @@ POS is :top-left, :top-right, :bottom-left, :bottom-right,
(defmethod draw-ellipsis ((b simple-backend) x y width (defmethod draw-ellipsis ((b simple-backend) x y width
&key fg bg) &key fg bg)
(declare (ignore width fg bg)) (declare (ignore width fg bg))
;; Position using newlines+spaces (simple-backend pattern) (draw-text b x y "..." nil nil))
(dotimes (row y) (backend-write b (string #\Newline)))
(backend-write b (make-string x :initial-element #\Space))
(backend-write b "..."))