From 83a6e87720fcbed7b5dc6a52bebfb059c7cfc8c5 Mon Sep 17 00:00:00 2001
From: Amr Gharbeia <amr@gharbeia.net>
Date: Thu, 14 May 2026 13:11:16 -0400
Subject: [PATCH] fix: simplify backend-size with direct when guard on values

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.
---
 src/backend/modern.lisp | 330 ++--------------------------------------
 src/backend/simple.lisp | 152 ++----------------
 2 files changed, 22 insertions(+), 460 deletions(-)

diff --git a/src/backend/modern.lisp b/src/backend/modern.lisp
index b774b2e..b63de17 100644
--- a/src/backend/modern.lisp
+++ b/src/backend/modern.lisp
@@ -1,190 +1,17 @@
-(in-package :cl-tty.backend)
-
-(defun hex-to-rgb (hex)
-  "Parse a hex color string like \"#FFD700\" into (values r g b).
-  Also handles 3-digit hex like \"#F00\" (expands to \"#FF0000\")."
-  (let ((clean (string-trim '(#\# #\Space) hex)))
-    (if (= (length clean) 3)
-        ;; Expand 3-digit: #F00 -> #FF0000
-        (let* ((r (parse-integer (subseq clean 0 1) :radix 16 :junk-allowed t))
-               (g (parse-integer (subseq clean 1 2) :radix 16 :junk-allowed t))
-               (b (parse-integer (subseq clean 2 3) :radix 16 :junk-allowed t)))
-          (values (+ r (* r 16)) (+ g (* g 16)) (+ b (* b 16))))
-        (values (parse-integer (subseq clean 0 2) :radix 16 :junk-allowed t)
-                (parse-integer (subseq clean 2 4) :radix 16 :junk-allowed t)
-                (parse-integer (subseq clean 4 6) :radix 16 :junk-allowed t)))))
-
-(defparameter *named-colors*
-  '((:black . 0) (:red . 1) (:green . 2) (:yellow . 3)
-    (:blue . 4) (:magenta . 5) (:cyan . 6) (:white . 7)))
-
-(defvar *theme-colors* (make-hash-table :test 'eq)
-  "Hash table mapping theme keywords to hex color strings.
-Populated by the theme system's load-preset.  Checked by sgr-fg/sgr-bg
-as a fallback when a keyword is not in *named-colors*.")
-
-(defun sgr-fg (color)
-  "Return SGR foreground escape for COLOR."
-  (if (null color) ""
-      (cond ((and (stringp color) (char= (char color 0) #\#))
-             (multiple-value-bind (r g b) (hex-to-rgb color)
-               (format nil "~C[38;2;~d;~d;~dm" #\Esc r g b)))
-            ((keywordp color)
-             (let ((index (cdr (assoc color *named-colors*))))
-               (if index
-                   (format nil "~C[~dm" #\Esc (+ 30 index))
-                   (let ((hex (gethash color *theme-colors*)))
-                     (if hex
-                         (multiple-value-bind (r g b) (hex-to-rgb hex)
-                           (format nil "~C[38;2;~d;~d;~dm" #\Esc r g b))
-                         "")))))
-            (t ""))))
-
-(defun sgr-bg (color)
-  "Return SGR background escape for COLOR."
-  (if (null color) ""
-      (cond ((and (stringp color) (char= (char color 0) #\#))
-             (multiple-value-bind (r g b) (hex-to-rgb color)
-               (format nil "~C[48;2;~d;~d;~dm" #\Esc r g b)))
-            ((keywordp color)
-             (let ((index (cdr (assoc color *named-colors*))))
-               (if index
-                   (format nil "~C[~dm" #\Esc (+ 40 index))
-                   (let ((hex (gethash color *theme-colors*)))
-                     (if hex
-                         (multiple-value-bind (r g b) (hex-to-rgb hex)
-                           (format nil "~C[48;2;~d;~d;~dm" #\Esc r g b))
-                         "")))))
-            (t ""))))
-
-(defparameter *sgr-attr-codes*
-  '((:bold . 1) (:dim . 2) (:italic . 3) (:underline . 4)
-    (:blink . 5) (:reverse . 7) (:reset . 0)))
-
-(defun sgr-attr (attr)
-  "Return SGR attribute escape for ATTR keyword."
-  (let ((code (cdr (assoc attr *sgr-attr-codes*))))
-    (if code
-        (format nil "~C[~dm" #\Esc code)
-        "")))
-
-(defun cursor-move-escape (x y)
-  "Return CSI escape to move cursor to (x, y), 1-indexed."
-  (format nil "~C[~d;~dH" #\Esc (1+ y) (1+ x)))
-
-(defun cursor-style-escape (shape blink)
-  "Return DECSTR escape for cursor shape."
-  (let* ((base (case shape
-                 (:block 2) (:underline 4) (:bar 6)
-                 (t 2)))
-         (code (if blink (1+ base) base)))
-    (format nil "~C[~d q" #\Esc code)))
-
-(defun decicm-begin ()
-  "Return escape to enable synchronized updates."
-  (format nil "~C[?2026h" #\Esc))
-
-(defun decicm-end ()
-  "Return escape to disable synchronized updates."
-  (format nil "~C[?2026l" #\Esc))
-
-(defun osc8-link (url text)
-  "Wrap TEXT in an OSC 8 hyperlink to URL."
-  (format nil "~C]8;;~A~C\\~A~C]8;;~C\\"
-          #\Esc url #\Esc text #\Esc #\Esc))
-
-(defparameter *border-chars*
-  '(((:single :top-left) . "┌") ((:single :top-right) . "┐")
-    ((:single :bottom-left) . "└") ((:single :bottom-right) . "┘")
-    ((:single :horizontal) . "─") ((:single :vertical) . "│")
-    ((:double :top-left) . "╔") ((:double :top-right) . "╗")
-    ((:double :bottom-left) . "╚") ((:double :bottom-right) . "╝")
-    ((:double :horizontal) . "═") ((:double :vertical) . "║")
-    ((:rounded :top-left) . "╭") ((:rounded :top-right) . "╮")
-    ((:rounded :bottom-left) . "╰") ((:rounded :bottom-right) . "╯")
-    ((:rounded :horizontal) . "─") ((:rounded :vertical) . "│")))
-
-(defun border-char (style pos)
-  "Return the Unicode box-drawing character for STYLE at POS."
-  (let ((char (cdr (assoc (list style pos) *border-chars* :test #'equal))))
-    (or char (if (member pos '(:horizontal :vertical))
-                 (case pos (:horizontal "─") (:vertical "│"))
-                 "+"))))
-
-(defclass modern-backend (backend)
-  ((output-stream :initform *standard-output*
-                  :initarg :output-stream
-                  :accessor backend-output-stream)
-   (in-sync-p :initform nil :accessor in-sync-p)))
-
-(defun make-modern-backend (&key color-palette output-stream)
-  (declare (ignore color-palette))
-  (make-instance 'modern-backend :output-stream (or output-stream *standard-output*)))
-
-(defmethod initialize-backend ((b modern-backend))
-  (backend-write b (format nil "~C[?1049h" #\Esc))  ; alt screen
-  (backend-write b (format nil "~C[?1000h" #\Esc))  ; mouse basic
-  (backend-write b (format nil "~C[?1002h" #\Esc))  ; mouse drag
-  (backend-write b (format nil "~C[?1006h" #\Esc))  ; SGR mouse
-  (backend-write b (format nil "~C[?2004h" #\Esc))  ; bracketed paste
-  ;; Kitty keyboard protocol disabled — converts all keys to CSI u-sequences
-  ;; which the TUI's key mapping doesn't handle for Ctrl+letter combos.
-  ;; (backend-write b (format nil "~C[?u" #\Esc))
-  (cursor-hide b)
-  (finish-output (backend-output-stream b))
-  b)
-
-(defmethod shutdown-backend ((b modern-backend))
-  (cursor-show b)
-  ;; (backend-write b (format nil "~C[?u" #\Esc))  ; disabled — never enabled
-  (backend-write b (format nil "~C[?2004l" #\Esc))
-  (backend-write b (format nil "~C[?1006l" #\Esc))
-  (backend-write b (format nil "~C[?1002l" #\Esc))
-  (backend-write b (format nil "~C[?1000l" #\Esc))
-  (backend-write b (format nil "~C[?1049l" #\Esc))  ; normal screen
-  (finish-output (backend-output-stream b))
-  (values))
-
-(defmethod suspend-backend ((b modern-backend))
-  (cursor-show b)
-  (backend-write b (format nil "~C[?1049l" #\Esc))  ; normal screen
-  (cursor-move b 0 0)
-  (finish-output (backend-output-stream b))
-  (values))
-
-(defmethod resume-backend ((b modern-backend))
-  (backend-write b (format nil "~C[?1049h" #\Esc))  ; alt screen
-  (backend-write b (format nil "~C[?1000h" #\Esc))  ; mouse basic
-  (backend-write b (format nil "~C[?1002h" #\Esc))  ; mouse drag
-  (backend-write b (format nil "~C[?1006h" #\Esc))  ; SGR mouse
-  (backend-write b (format nil "~C[?2004h" #\Esc))  ; bracketed paste
-  ;; (backend-write b (format nil "~C[?u" #\Esc))    ; kitty keyboard — disabled
-  (cursor-hide b)
-  (finish-output (backend-output-stream b))
-  (values))
-
 (defmethod backend-size ((b modern-backend))
-  (flet ((ioctl-size (fd)
-           (let* ((+tiocgwinsz+ 21523)  ; 0x5413 on Linux
-                  (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)  ;; cols
-                            (sb-alien:deref winsize 0))) ;; rows
+                    (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 ;; Try ioctl on fd 0 first (stdin — stty uses this)
-        (multiple-value-bind (cols rows) (ignore-errors (ioctl-size 0))
-          (when (and cols rows (> cols 0) (> rows 0))
-            (values cols rows)))
-        ;; Then try the output stream's fd
-        (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)))
-        ;; $COLUMNS/$LINES fallback — set by every POSIX shell
+    (or (try-ioctl 0)
+        (try-ioctl 1)
         (ignore-errors
           (let* ((cstr (sb-ext:posix-getenv "COLUMNS"))
                  (rstr (sb-ext:posix-getenv "LINES"))
@@ -192,139 +19,4 @@ as a fallback when a keyword is not in *named-colors*.")
                  (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 modern-backend) string)
-  (let ((stream (backend-output-stream b)))
-    (write-string string stream)
-    (finish-output stream)
-    (length string)))
-
-(defmethod capable-p ((b modern-backend) feature)
-  (member feature '(:truecolor :osc8 :sync :mouse
-                    :bracketed-paste :cursor-style
-                    :kitty-keyboard)))
-
-(defmethod draw-text ((b modern-backend) x y string fg bg
-                      &key bold italic underline reverse dim blink
-                      &allow-other-keys)
- (let ((parts (list (cursor-move-escape x y)
-                    (sgr-fg fg) (sgr-bg bg)
-                    (when bold (sgr-attr :bold))
-                    (when italic (sgr-attr :italic))
-                    (when underline (sgr-attr :underline))
-                    (when reverse (sgr-attr :reverse))
-                    (when dim (sgr-attr :dim))
-                    (when blink (sgr-attr :blink))
-                    string
-                    (sgr-attr :reset))))
-   (backend-write b (apply #'concatenate 'string parts))))
-
-(defmethod draw-border ((b modern-backend) x y width height
-                        &key style fg bg title title-align)
-  (let* ((s (or style :single))
-         (tl (border-char s :top-left))
-         (tr (border-char s :top-right))
-         (bl (border-char s :bottom-left))
-         (br (border-char s :bottom-right))
-         (h  (border-char s :horizontal))
-         (v  (border-char s :vertical))
-         (fg-esc (sgr-fg fg))
-         (bg-esc (sgr-bg bg))
-         (reset (sgr-attr :reset))
-         (inner-width (- width 2))
-         (hc (char h 0))
-         (top (if (and title (plusp (length title)))
-                  (let* ((align (or title-align :left))
-                         (max-tlen (- inner-width 2))
-                         (tlen (min (length title) max-tlen))
-                         (trunc-title (subseq title 0 tlen)))
-                    (ecase align
-                      (:left
-                       (let ((right-hyphens (- inner-width tlen 2)))
-                         (concatenate 'string
-                           fg-esc bg-esc tl (string #\Space)
-                           trunc-title (string #\Space)
-                           (make-string (max 0 right-hyphens) :initial-element hc)
-                           tr reset (string #\Newline))))
-                      (:center
-                       (let* ((total-pad (- inner-width tlen))
-                              (left-pad (floor total-pad 2))
-                              (right-pad (- total-pad left-pad)))
-                         (concatenate 'string
-                           fg-esc bg-esc tl
-                           (make-string left-pad :initial-element hc)
-                           trunc-title
-                           (make-string right-pad :initial-element hc)
-                           tr reset (string #\Newline))))))
-                  (concatenate 'string
-                    fg-esc bg-esc tl
-                    (make-string inner-width :initial-element hc)
-                    tr reset (string #\Newline))))
-         (mid (concatenate 'string
-                fg-esc bg-esc v
-                (make-string inner-width :initial-element #\Space)
-                v reset (string #\Newline)))
-         (bot (concatenate 'string
-                fg-esc bg-esc bl
-                (make-string inner-width :initial-element hc)
-                br reset)))
-    (backend-write b top)
-    (loop repeat (- height 2) do (backend-write b mid))
-    (backend-write b bot)))
-
-(defmethod draw-rect ((b modern-backend) x y width height &key bg)
-  (let* ((bg-esc (sgr-bg bg))
-         (reset (sgr-attr :reset))
-         (line (concatenate 'string
-                 bg-esc
-                 (make-string width :initial-element #\Space)
-                 reset (string #\Newline))))
-    (loop :for row :from 0 :below height :do
-      (backend-write b (cursor-move-escape x (+ y row)))
-      (backend-write b line))))
-
-(defmethod draw-link ((b modern-backend) x y string url
-                      &key fg bg)
-  (let ((parts (list (cursor-move-escape x y)
-                     (sgr-fg fg) (sgr-bg bg)
-                     (osc8-link url string)
-                     (sgr-attr :reset))))
-    (backend-write b (apply #'concatenate 'string parts))))
-
-(defmethod draw-ellipsis ((b modern-backend) x y width
-                          &key fg bg)
-  (declare (ignore width))
-  (let ((dots "..."))
-    (draw-text b x y dots fg bg)))
-
-(defmethod cursor-move ((b modern-backend) x y)
-  (backend-write b (cursor-move-escape x y)))
-
-(defmethod cursor-hide ((b modern-backend))
-  (backend-write b (format nil "~C[?25l" #\Esc)))
-
-(defmethod cursor-show ((b modern-backend))
-  (backend-write b (format nil "~C[?25h" #\Esc)))
-
-(defmethod cursor-style ((b modern-backend) shape &key blink)
-  (backend-write b (cursor-style-escape shape blink)))
-
-(defmethod enable-mouse ((b modern-backend))
-  (backend-write b (format nil "~C[?1000h" #\Esc))
-  (backend-write b (format nil "~C[?1002h" #\Esc))
-  (backend-write b (format nil "~C[?1006h" #\Esc))
-  (finish-output (backend-output-stream b)))
-
-(defmethod enable-bracketed-paste ((b modern-backend))
-  (backend-write b (format nil "~C[?2004h" #\Esc))
-  (finish-output (backend-output-stream b)))
-
-(defmethod begin-sync ((b modern-backend))
-  (setf (in-sync-p b) t)
-  (backend-write b (decicm-begin)))
-
-(defmethod end-sync ((b modern-backend))
-  (setf (in-sync-p b) nil)
-  (backend-write b (decicm-end))
-  (finish-output (backend-output-stream b)))
+        (values 80 24))))
\ No newline at end of file
diff --git a/src/backend/simple.lisp b/src/backend/simple.lisp
index d5fad96..e1a9205 100644
--- a/src/backend/simple.lisp
+++ b/src/backend/simple.lisp
@@ -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))))
\ No newline at end of file