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

fix: draw-border renders titles in modern and simple backends (title, title-align respected)

Browse Source
This commit is contained in:
Hermes Agent
2026-05-12 13:46:42 +00:00
parent b21daa99b8
commit bb1717a43d
3 changed files with 64 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
backend/modern.lisp
View File

@@ -191,7 +191,6 @@ as a fallback when a keyword is not in *named-colors*.")
(defmethod draw-border ((b modern-backend) x y width height (defmethod draw-border ((b modern-backend) x y width height
&key style fg bg title title-align) &key style fg bg title title-align)
(declare (ignore title title-align))
(let* ((s (or style :single)) (let* ((s (or style :single))
(tl (border-char s :top-left)) (tl (border-char s :top-left))
(tr (border-char s :top-right)) (tr (border-char s :top-right))
@@ -202,17 +201,42 @@ as a fallback when a keyword is not in *named-colors*.")
(fg-esc (sgr-fg fg)) (fg-esc (sgr-fg fg))
(bg-esc (sgr-bg bg)) (bg-esc (sgr-bg bg))
(reset (sgr-attr :reset)) (reset (sgr-attr :reset))
(top (concatenate 'string (inner-width (- width 2))
fg-esc bg-esc tl (hc (char h 0))
(make-string (- width 2) :initial-element (char h 0)) (top (if (and title (plusp (length title)))
tr reset (string #\Newline))) (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 (mid (concatenate 'string
fg-esc bg-esc v fg-esc bg-esc v
(make-string (- width 2) :initial-element #\Space) (make-string inner-width :initial-element #\Space)
v reset (string #\Newline))) v reset (string #\Newline)))
(bot (concatenate 'string (bot (concatenate 'string
fg-esc bg-esc bl fg-esc bg-esc bl
(make-string (- width 2) :initial-element (char h 0)) (make-string inner-width :initial-element hc)
br reset))) br reset)))
(backend-write b top) (backend-write b top)
(loop repeat (- height 2) do (backend-write b mid)) (loop repeat (- height 2) do (backend-write b mid))

45
backend/simple.lisp
View File

@@ -41,24 +41,39 @@ POS is :top-left, :top-right, :bottom-left, :bottom-right,
(defmethod draw-border ((b simple-backend) x y width height (defmethod draw-border ((b simple-backend) x y width height
&key style fg bg title title-align) &key style fg bg title title-align)
(declare (ignore style fg bg title-align)) (declare (ignore style fg bg))
(let ((h (%simple-border-char :horizontal)) (let ((h (%simple-border-char :horizontal))
(v (%simple-border-char :vertical))) (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)))
;; Position cursor with newlines and spaces (no escape sequences) ;; Position cursor with newlines and spaces (no escape sequences)
(dotimes (row y) (backend-write b (string #\Newline))) (dotimes (row y) (backend-write b (string #\Newline)))
;; Top edge with optional title ;; Top edge with optional title
(backend-write b (make-string x :initial-element #\space)) (backend-write b (make-string x :initial-element #\space))
(if title (backend-write b (string tl))
(let* ((tlen (length title)) (if (and title (plusp (length title)))
(space-left (- width tlen 2)) (let* ((align (or title-align :left))
(left (max 0 (floor space-left 2))) (inner-width (- width 2))
(right (max 0 (- space-left left)))) (max-tlen (- inner-width 2))
(backend-write b (make-string left :initial-element h)) (tlen (min (length title) max-tlen))
(backend-write b (string #\space)) (trunc-title (subseq title 0 tlen)))
(backend-write b title) (ecase align
(backend-write b (string #\space)) (:left
(backend-write b (make-string right :initial-element h))) (backend-write b (string #\Space))
(backend-write b (make-string width :initial-element h))) (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 ;; 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 (string #\Newline))
@@ -69,7 +84,9 @@ POS is :top-left, :top-right, :bottom-left, :bottom-right,
;; Bottom edge ;; Bottom edge
(backend-write b (string #\Newline)) (backend-write b (string #\Newline))
(backend-write b (make-string x :initial-element #\space)) (backend-write b (make-string x :initial-element #\space))
(backend-write b (make-string width :initial-element h)))) (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 (defmethod draw-rect ((b simple-backend) x y width height
&key bg) &key bg)

4
backend/tests.lisp
View File

@@ -46,7 +46,7 @@
(draw-border b 0 0 5 3 :style :single) (draw-border b 0 0 5 3 :style :single)
(shutdown-backend b) (shutdown-backend b)
(let ((out (get-output-stream-string s))) (let ((out (get-output-stream-string s)))
(is (search "-----" out) "top edge should have 5 dashes") (is (search "+---+" out) "top edge should have +---+")
(is (search "| |" out) "middle row should have pipe sides")))) (is (search "| |" out) "middle row should have pipe sides"))))
(test simple-backend-draw-rounded (test simple-backend-draw-rounded
@@ -57,7 +57,7 @@
(shutdown-backend b) (shutdown-backend b)
(let ((out (get-output-stream-string s))) (let ((out (get-output-stream-string s)))
;; Rounded falls back to ASCII — identical output to single ;; Rounded falls back to ASCII — identical output to single
(is (search "-----" out) "rounded style produces same dashes as single")))) (is (search "+---+" out) "rounded style produces same dashes as single"))))
(test simple-backend-draw-link (test simple-backend-draw-link
"simple-backend renders link as plain text" "simple-backend renders link as plain text"