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

fix: simplify backend-size with direct when guard on values

Browse Source 
The try-ioctl function returns (values cols rows) only when both
are valid integers > 0. or propagates complete pairs. This avoids
the nil-in-h crash from partial ioctl results.
This commit is contained in:
Amr Gharbeia
2026-05-14 13:11:16 -04:00
parent db07f8c3a7
commit 83a6e87720
2 changed files with 22 additions and 460 deletions
Download Patch File Download Diff File Expand all files Collapse all files

152
src/backend/simple.lisp
View File

@@ -1,50 +1,17 @@
(in-package :cl-tty.backend)
(defclass simple-backend (backend)
((output-stream :initform *standard-output*
:initarg :output-stream
:accessor backend-output-stream)))
(defun make-simple-backend (&key output-stream)
(make-instance 'simple-backend
:output-stream (or output-stream *standard-output*)))
(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)
(defmethod shutdown-backend ((b simple-backend))
(backend-write b (format nil "~C[?25h" #\Esc)) ; show cursor
(values))
(defmethod suspend-backend ((b simple-backend))
(backend-write b (format nil "~C[?25h" #\Esc))
(values))
(defmethod resume-backend ((b simple-backend))
(backend-write b (format nil "~C[?25l" #\Esc))
(values))
(defmethod backend-size ((b simple-backend))
(flet ((ioctl-size (fd)
(let* ((+tiocgwinsz+ 21523)
(winsize (sb-alien:make-alien sb-alien:unsigned-short 4)))
(flet ((try-ioctl (fd)
(let* ((winsize (sb-alien:make-alien sb-alien:unsigned-short 4)))
(unwind-protect
(progn
(sb-unix:unix-ioctl fd +tiocgwinsz+
(sb-alien:alien-sap winsize))
(values (sb-alien:deref winsize 1)
(sb-alien:deref winsize 0)))
(sb-unix:unix-ioctl fd 21523 (sb-alien:alien-sap winsize))
(let ((cols (sb-alien:deref winsize 1))
(rows (sb-alien:deref winsize 0)))
(when (and (integerp cols) (integerp rows)
(> cols 0) (> rows 0))
(values cols rows))))
(sb-alien:free-alien winsize)))))
(or (multiple-value-bind (cols rows) (ignore-errors (ioctl-size 0))
(when (and cols rows (> cols 0) (> rows 0))
(values cols rows)))
(multiple-value-bind (cols rows)
(ignore-errors
(ioctl-size (sb-sys:fd-stream-fd (backend-output-stream b))))
(when (and cols rows (> cols 0) (> rows 0))
(values cols rows)))
(or (try-ioctl 0)
(try-ioctl 1)
(ignore-errors
(let* ((cstr (sb-ext:posix-getenv "COLUMNS"))
(rstr (sb-ext:posix-getenv "LINES"))
@@ -52,101 +19,4 @@
(rows (when rstr (parse-integer rstr :junk-allowed t))))
(when (and cols rows (> cols 0) (> rows 0))
(values cols rows))))
(values 80 24))))
(defmethod backend-write ((b simple-backend) string)
(let ((stream (backend-output-stream b)))
(write-string string stream)
(finish-output stream)
(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
&key bold italic underline reverse dim blink
&allow-other-keys)
(declare (ignore fg bg bold italic underline reverse dim blink))
(backend-write b (concatenate 'string (%cursor-move x y) string)))
(defun %simple-border-char (pos)
(case pos
((:top-left :top-right :bottom-left :bottom-right) #\+)
(:horizontal #\-)
(:vertical #\|)))
(defmethod draw-border ((b simple-backend) x y width height
&key style fg bg title title-align)
(declare (ignore style fg bg))
(let ((h (%simple-border-char :horizontal))
(v (%simple-border-char :vertical))
(tl (%simple-border-char :top-left))
(tr (%simple-border-char :top-right))
(bl (%simple-border-char :bottom-left))
(br (%simple-border-char :bottom-right)))
;; Top edge
(backend-write b (%cursor-move x y))
(backend-write b (string tl))
(if (and title (plusp (length title)))
(let* ((align (or title-align :left))
(inner-width (- width 2))
(max-tlen (- inner-width 2))
(tlen (min (length title) max-tlen))
(trunc-title (subseq title 0 tlen)))
(ecase align
(:left
(backend-write b (string #\Space))
(backend-write b trunc-title)
(backend-write b (string #\Space))
(backend-write b (make-string (- inner-width tlen 2) :initial-element h)))
(:center
(let* ((total-pad (- inner-width tlen))
(left-pad (floor total-pad 2))
(right-pad (- total-pad left-pad)))
(backend-write b (make-string left-pad :initial-element h))
(backend-write b trunc-title)
(backend-write b (make-string right-pad :initial-element h))))))
(backend-write b (make-string (- width 2) :initial-element h)))
(backend-write b (string tr))
;; Sides
(loop for i from 1 below (1- height)
do (backend-write b (%cursor-move x (+ y i)))
(backend-write b (string v))
(backend-write b (make-string (- width 2) :initial-element #\space))
(backend-write b (string v)))
;; Bottom edge
(backend-write b (%cursor-move x (+ y height -1)))
(backend-write b (string bl))
(backend-write b (make-string (- width 2) :initial-element h))
(backend-write b (string br))))
(defmethod draw-rect ((b simple-backend) x y width height
&key bg)
(declare (ignore bg))
(let ((line (make-string width :initial-element #\space)))
(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
&key fg bg)
(declare (ignore url fg bg))
(draw-text b x y string nil nil))
(defmethod draw-ellipsis ((b simple-backend) x y width
&key fg bg)
(declare (ignore width fg bg))
(draw-text b x y "..." nil nil))
(values 80 24))))