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
&key style fg bg title title-align)
(declare (ignore title title-align))
(let* ((s (or style :single))
(tl (border-char s :top-left))
(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))
(bg-esc (sgr-bg bg))
(reset (sgr-attr :reset))
(top (concatenate 'string
fg-esc bg-esc tl
(make-string (- width 2) :initial-element (char h 0))
tr reset (string #\Newline)))
(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 (- width 2) :initial-element #\Space)
(make-string inner-width :initial-element #\Space)
v reset (string #\Newline)))
(bot (concatenate 'string
fg-esc bg-esc bl
(make-string (- width 2) :initial-element (char h 0))
(make-string inner-width :initial-element hc)
br reset)))
(backend-write b top)
(loop repeat (- height 2) do (backend-write b mid))