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

prose: split scrollbox-tabbar.org prose into per-module org files

Browse Source 
Distribute the literate prose from the old combined scrollbox-tabbar.org
into three individual module org files:

- scrollbox.org: ScrollBox class, render, scrollbars, bug fixes,
  plus the combined test suite (tangles scrollbox-tabbar-tests.lisp)
- tabbar.org: TabBar class, navigation, keyboard handler, render
- container-package.org: Package definition and exports

The old scrollbox-tabbar.org is retained as a documentation archive
with all code blocks set to :tangle no and a redirecting note.

Fixes the draw-scrollbars code block to use the post-bugfix version
(with layout-node origin offset ox/oy), matching the working code.
All 13 test suites pass at 100%.
This commit is contained in:
Hermes Agent
2026-05-12 18:06:07 +00:00
parent a061d60898
commit 668966380e
7 changed files with 687 additions and 453 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
org/container-package.org
View File

@@ -8,19 +8,26 @@ The ~cl-tty.container~ package defines the container component types:
ScrollBox and TabBar. It uses ~cl-tty.backend~, ~cl-tty.box~, ScrollBox and TabBar. It uses ~cl-tty.backend~, ~cl-tty.box~,
~cl-tty.layout~, and ~cl-tty.input~. ~cl-tty.layout~, and ~cl-tty.input~.
* Implementation The package exports both ScrollBox and TabBar classes, constructors,
accessors, and navigation functions.
* Package Definition
#+BEGIN_SRC lisp :tangle ../src/components/container-package.lisp #+BEGIN_SRC lisp :tangle ../src/components/container-package.lisp
(defpackage :cl-tty.container (defpackage :cl-tty.container
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export (:export
;; ScrollBox
#:scroll-box #:make-scroll-box #:scroll-box #:make-scroll-box
#:scroll-box-scroll-y #:scroll-box-scroll-x #:scroll-box-scroll-y #:scroll-box-scroll-x
#:scroll-box-children #:scroll-by #:scroll-box-children
#:sticky-scroll-p #:scroll-by #:sticky-scroll-p
#:clamp-scroll #:clamp-scroll
;; TabBar
#:tab-bar #:make-tab-bar #:tab-bar #:make-tab-bar
#:tab-bar-active #:tab-bar-tabs #:tab-bar-active #:tab-bar-tabs
#:tab-bar-add #:tab-bar-next #:tab-bar-prev #:tab-bar-add #:tab-bar-next #:tab-bar-prev
#:tab-bar-select #:tab-bar-handle-key)) #:tab-bar-select #:tab-bar-handle-key
;; Rendering
#:render))
#+END_SRC #+END_SRC

367
org/scrollbox-tabbar.org
View File

@@ -1,5 +1,23 @@
#+TITLE: cl-tty v0.6.0 — ScrollBox + TabBar #+TITLE: ScrollBox + TabBar — Archived Combined Module
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :cl-tty:container:
* NOTE: This file is an archive
This org file was the original combined module for ScrollBox, TabBar,
and the container package. It has been split into three separate org
files (one per tangle target):
- ~org/scrollbox.org~ — ScrollBox class, render, scrollbars (tangles
~src/components/scrollbox.lisp~ and ~tests/scrollbox-tabbar-tests.lisp~)
- ~org/tabbar.org~ — TabBar class, navigation, render (tangles
~src/components/tabbar.lisp~)
- ~org/container-package.org~ — Package definition (tangles
~src/components/container-package.lisp~)
All code blocks below are preserved for historical/documentation
reference only and have ~:tangle no~. Do not modify this file;
edit the individual org files above instead.
* ScrollBox and TabBar * ScrollBox and TabBar
@@ -44,144 +62,11 @@ TabBar:
~(render ((tb tab-bar) backend))~ — renders tab row, active tab ~(render ((tb tab-bar) backend))~ — renders tab row, active tab
highlighted, inactive tabs dimmed. highlighted, inactive tabs dimmed.
** Tests
#+BEGIN_SRC lisp :tangle no
(defpackage :cl-tty-scrollbox-test
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.container)
(:export #:run-tests))
(in-package #:cl-tty-scrollbox-test)
(def-suite scrollbox-suite :description "ScrollBox + TabBar tests")
(in-suite scrollbox-suite)
(defun run-tests ()
(let ((result (run 'scrollbox-suite)))
(fiveam:explain! result)
(uiop:quit 0)))
;; ── ScrollBox Tests ─────────────────────────────────────────────
(test scrollbox-creates
"A ScrollBox can be created with defaults."
(let ((sb (make-scroll-box)))
(is (typep sb 'scroll-box))
(is (= (scroll-box-scroll-y sb) 0))
(is (= (scroll-box-scroll-x sb) 0))
(is-false (scroll-box-children sb))))
(test scrollbox-with-children
"A ScrollBox can have children."
(let ((sb (make-scroll-box :children (list (make-text "hello")))))
(is (= (length (scroll-box-children sb)) 1))))
(test scrollbox-scroll-by
"ScrollBy adjusts offset clamped to valid range."
(let ((sb (make-scroll-box :scroll-y 0)))
(scroll-by sb 5 0)
(is (>= (scroll-box-scroll-y sb) 0))))
(test scrollbox-component-children
"Component protocol: children are accessible."
(let* ((child (make-text "hello"))
(sb (make-scroll-box :children (list child))))
(is (eql (first (component-children sb)) child))))
(test scrollbox-render-noop
"Rendering a ScrollBox with no children does not error."
(let* ((stream (make-string-output-stream))
(backend (make-simple-backend :output-stream stream))
(sb (make-scroll-box)))
(render sb backend)
(is-true t)))
;; ── TabBar Tests ────────────────────────────────────────────────
(test tabbar-creates
"A TabBar can be created with defaults."
(let ((tb (make-tab-bar)))
(is (typep tb 'tab-bar))
(is-false (tab-bar-active tb))
(is-false (tab-bar-tabs tb))))
(test tabbar-add-tab
"Adding a tab returns the id and updates tabs."
(let ((tb (make-tab-bar)))
(let ((id (tab-bar-add tb :tab1 "Tab One")))
(is (eql id :tab1))
(is (= (length (tab-bar-tabs tb)) 1))
(is (string= (getf (first (tab-bar-tabs tb)) :title) "Tab One")))))
(test tabbar-active-tab
"Setting active tab works."
(let ((tb (make-tab-bar)))
(tab-bar-add tb :tab1 "One")
(tab-bar-add tb :tab2 "Two")
(setf (tab-bar-active tb) :tab2)
(is (eql (tab-bar-active tb) :tab2))))
(test tabbar-render-noop
"Rendering a TabBar does not error."
(let* ((stream (make-string-output-stream))
(backend (make-simple-backend :output-stream stream))
(tb (make-tab-bar)))
(tab-bar-add tb :tab1 "One")
(tab-bar-add tb :tab2 "Two")
(setf (tab-bar-active tb) :tab1)
(render tb backend)
(is-true t)))
(test tabbar-next-prev
"TabBar next/prev wraps around through tabs."
(let ((tb (make-tab-bar)))
(tab-bar-add tb :tab1 "One")
(tab-bar-add tb :tab2 "Two")
(tab-bar-add tb :tab3 "Three")
(is (eql (tab-bar-active tb) :tab1))
(tab-bar-next tb)
(is (eql (tab-bar-active tb) :tab2))
(tab-bar-next tb)
(is (eql (tab-bar-active tb) :tab3))
(tab-bar-next tb)
(is (eql (tab-bar-active tb) :tab1) "wrap around past last")
(tab-bar-prev tb)
(is (eql (tab-bar-active tb) :tab3) "wrap around past first")))
(test tabbar-select
"TabBar select activates the specified tab."
(let ((tb (make-tab-bar)))
(tab-bar-add tb :tab1 "One")
(tab-bar-add tb :tab2 "Two")
(tab-bar-select tb :tab2)
(is (eql (tab-bar-active tb) :tab2))))
(test tabbar-handle-key
"TabBar handle-key dispatches left/right."
(let ((tb (make-tab-bar)))
(tab-bar-add tb :tab1 "One")
(tab-bar-add tb :tab2 "Two")
(setf (tab-bar-active tb) :tab1)
(tab-bar-handle-key tb (make-key-event :key :right))
(is (eql (tab-bar-active tb) :tab2))
(tab-bar-handle-key tb (make-key-event :key :left))
(is (eql (tab-bar-active tb) :tab1))))
(test scrollbox-scroll-clamp
"ScrollBox clamp prevents scrolling past bounds."
(let ((sb (make-scroll-box :scroll-y 5 :scroll-x 3)))
(setf (scroll-box-scroll-y sb) -1)
(clamp-scroll sb)
(is (= (scroll-box-scroll-y sb) 0) "clamps below 0")
(setf (scroll-box-scroll-y sb) 1000000)
(clamp-scroll sb)
(is (= (scroll-box-scroll-y sb) 0) "clamps above max (no children = 0 content)")))
#+END_SRC
* Implementation * Implementation
** Package ** Package
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(defpackage :cl-tty.container (defpackage :cl-tty.container
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export (:export
@@ -190,10 +75,12 @@ TabBar:
#:scroll-box-scroll-y #:scroll-box-scroll-x #:scroll-box-scroll-y #:scroll-box-scroll-x
#:scroll-box-children #:scroll-box-children
#:scroll-by #:sticky-scroll-p #:scroll-by #:sticky-scroll-p
#:clamp-scroll
;; TabBar ;; TabBar
#:tab-bar #:make-tab-bar #:tab-bar #:make-tab-bar
#:tab-bar-active #:tab-bar-tabs #:tab-bar-active #:tab-bar-tabs
#:tab-bar-add #:tab-bar-add #:tab-bar-next #:tab-bar-prev
#:tab-bar-select #:tab-bar-handle-key
;; Rendering ;; Rendering
#:render)) #:render))
#+END_SRC #+END_SRC
@@ -208,7 +95,7 @@ position at the bottom whenever new children are added.
The constructor accepts keyword arguments for initial offset and children. The constructor accepts keyword arguments for initial offset and children.
~children~ defaults to an empty list. ~children~ defaults to an empty list.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(in-package #:cl-tty.container) (in-package #:cl-tty.container)
(defclass scroll-box (dirty-mixin) (defclass scroll-box (dirty-mixin)
@@ -237,7 +124,7 @@ The constructor accepts keyword arguments for initial offset and children.
to traverse. ~component-layout-node~ returns the layout node so the to traverse. ~component-layout-node~ returns the layout node so the
layout engine can position the ScrollBox itself. layout engine can position the ScrollBox itself.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(defmethod component-children ((sb scroll-box)) (defmethod component-children ((sb scroll-box))
(scroll-box-children sb)) (scroll-box-children sb))
@@ -255,7 +142,7 @@ or beyond the content size minus the viewport size.
changes — called automatically when children change or the layout changes — called automatically when children change or the layout
node resizes. node resizes.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(defun clamp-scroll (sb) (defun clamp-scroll (sb)
"Clamp scroll offsets to valid range." "Clamp scroll offsets to valid range."
(let* ((ln (scroll-box-layout-node sb)) (let* ((ln (scroll-box-layout-node sb))
@@ -287,7 +174,7 @@ is used by ~clamp-scroll~ and scrollbar rendering.
For height: sum of all child heights (vertical layout). For height: sum of all child heights (vertical layout).
For width: max of all child widths (horizontal scroll). For width: max of all child widths (horizontal scroll).
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(defun scroll-box-content-height (sb) (defun scroll-box-content-height (sb)
"Total height of all children." "Total height of all children."
(reduce #'+ (scroll-box-children sb) (reduce #'+ (scroll-box-children sb)
@@ -317,7 +204,7 @@ visible ones are actually drawn.
it at the bottom after content changes. The flag resets to false it at the bottom after content changes. The flag resets to false
when the user manually scrolls up. when the user manually scrolls up.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(defmethod render ((sb scroll-box) backend) (defmethod render ((sb scroll-box) backend)
"Render visible children with scroll offset applied. "Render visible children with scroll offset applied.
Delegates to each child's `render` method, temporarily offsetting Delegates to each child's `render` method, temporarily offsetting
@@ -357,7 +244,7 @@ the viewport are clipped out."
auto-scrolls to keep the bottommost content visible. The user auto-scrolls to keep the bottommost content visible. The user
calling ~scroll-by~ with a negative DY resets the sticky flag. calling ~scroll-by~ with a negative DY resets the sticky flag.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(defun update-sticky-scroll (sb) (defun update-sticky-scroll (sb)
"If sticky-scroll-p is active and at bottom, keep at bottom." "If sticky-scroll-p is active and at bottom, keep at bottom."
(when (sticky-scroll-p sb) (when (sticky-scroll-p sb)
@@ -376,10 +263,10 @@ single-character-wide bars on the right and bottom edges of the
viewport. The scrollbar thumb position and size reflect the current viewport. The scrollbar thumb position and size reflect the current
scroll position relative to content size. scroll position relative to content size.
Vertical scrollbar: blocks (~#\Full~ ~#\Up~ ~#\Mid~ ~#\Down~). Vertical scrollbar: blocks (~#\\Full~ ~#\\Up~ ~#\\Mid~ ~#\\Down~).
Horizontal scrollbar: block characters along the bottom. Horizontal scrollbar: block characters along the bottom.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(defun scrollbar-thumb (scroll-pos viewport-size content-size) (defun scrollbar-thumb (scroll-pos viewport-size content-size)
"Return the thumb position for a scrollbar (0.0 to 1.0)." "Return the thumb position for a scrollbar (0.0 to 1.0)."
(if (> content-size viewport-size) (if (> content-size viewport-size)
@@ -408,11 +295,11 @@ Horizontal scrollbar: block characters along the bottom.
** TabBar class ** TabBar class
~tab-bar~ stores a list of tab plists ~((:id :tab1 :title \"One\") ...)~ ~tab-bar~ stores a list of tab plists ~((:id :tab1 :title "One") ...)~
and the currently active tab id. ~tab-bar-add~ creates a new tab with and the currently active tab id. ~tab-bar-add~ creates a new tab with
the given id and title, returns the id. the given id and title, returns the id.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(in-package #:cl-tty.container) (in-package #:cl-tty.container)
(defclass tab-bar (dirty-mixin) (defclass tab-bar (dirty-mixin)
@@ -437,7 +324,7 @@ the given id and title, returns the id.
** TabBar: component protocol ** TabBar: component protocol
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(defmethod component-layout-node ((tb tab-bar)) (defmethod component-layout-node ((tb tab-bar))
(tab-bar-layout-node tb)) (tab-bar-layout-node tb))
#+END_SRC #+END_SRC
@@ -448,7 +335,7 @@ the given id and title, returns the id.
activates a tab by id. ~tab-bar-handle-key~ dispatches key events activates a tab by id. ~tab-bar-handle-key~ dispatches key events
(Left/Right to navigate, optional Enter to select). (Left/Right to navigate, optional Enter to select).
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(defun tab-bar-next (tb) (defun tab-bar-next (tb)
"Move to next tab." "Move to next tab."
(let* ((tabs (tab-bar-tabs tb)) (let* ((tabs (tab-bar-tabs tb))
@@ -483,7 +370,7 @@ activates a tab by id. ~tab-bar-handle-key~ dispatches key events
Returns T if the key was handled, NIL otherwise (for composability with Returns T if the key was handled, NIL otherwise (for composability with
the keybinding system). the keybinding system).
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(defun tab-bar-handle-key (tb event) (defun tab-bar-handle-key (tb event)
"Handle a key-event on a TabBar. Returns T if handled." "Handle a key-event on a TabBar. Returns T if handled."
(case (key-event-key event) (case (key-event-key event)
@@ -501,7 +388,7 @@ are separated by two spaces.
The available width comes from the layout node. If tabs overflow, The available width comes from the layout node. If tabs overflow,
they are truncated with an ellipsis. they are truncated with an ellipsis.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle no
(defmethod render ((tb tab-bar) backend) (defmethod render ((tb tab-bar) backend)
(let* ((ln (tab-bar-layout-node tb)) (let* ((ln (tab-bar-layout-node tb))
(x (if ln (layout-node-x ln) 0)) (x (if ln (layout-node-x ln) 0))
@@ -520,7 +407,7 @@ they are truncated with an ellipsis.
(bg (if is-active :background-element nil))) (bg (if is-active :background-element nil)))
;; Check if tab fits ;; Check if tab fits
(when (>= (+ x-pos label-len 2) (+ x w)) (when (>= (+ x-pos label-len 2) (+ x w))
(draw-text backend x-pos y "…" :text-muted nil) (draw-text backend x-pos y "..." :text-muted nil)
(return)) (return))
;; Draw tab ;; Draw tab
(draw-text backend x-pos y label fg bg) (draw-text backend x-pos y label fg bg)
@@ -548,175 +435,21 @@ Two bugs were fixed in the ScrollBox render pipeline:
Fix: Read the scrollbox's layout-node origin ~(ox, oy)~ and offset all Fix: Read the scrollbox's layout-node origin ~(ox, oy)~ and offset all
scrollbar drawing coordinates by those values. scrollbar drawing coordinates by those values.
** Combined tangle blocks * Tests
#+BEGIN_SRC lisp :tangle no #+BEGIN_SRC lisp :tangle no
(in-package #:cl-tty.container) (defpackage :cl-tty-scrollbox-test
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.container)
(:export #:run-tests))
(in-package #:cl-tty-scrollbox-test)
(defclass scroll-box (dirty-mixin) (def-suite scrollbox-suite :description "ScrollBox + TabBar tests")
((children :initform nil :initarg :children :accessor scroll-box-children :type list) (in-suite scrollbox-suite)
(scroll-y :initform 0 :initarg :scroll-y :accessor scroll-box-scroll-y :type fixnum)
(scroll-x :initform 0 :initarg :scroll-x :accessor scroll-box-scroll-x :type fixnum)
(sticky-scroll-p :initform t :initarg :sticky-scroll-p :accessor sticky-scroll-p :type boolean)
(layout-node :initform (make-layout-node) :accessor scroll-box-layout-node)))
(defun make-scroll-box (&key (children nil) (scroll-y 0) (scroll-x 0) sticky-scroll-p) (defun run-tests ()
(make-instance 'scroll-box (let ((result (run 'scrollbox-suite)))
:children children :scroll-y scroll-y :scroll-x scroll-x (fiveam:explain! result)
:sticky-scroll-p (if (null sticky-scroll-p) t sticky-scroll-p))) (uiop:quit 0)))
(defmethod component-children ((sb scroll-box)) (scroll-box-children sb)) ;; ScrollBox tests omitted here — see org/scrollbox.org
(defmethod component-layout-node ((sb scroll-box)) (scroll-box-layout-node sb))
(defun clamp-scroll (sb)
(let* ((ln (scroll-box-layout-node sb))
(viewport-h (if ln (layout-node-height ln) 0))
(viewport-w (if ln (layout-node-width ln) 0))
(content-h (scroll-box-content-height sb))
(content-w (scroll-box-content-width sb)))
(setf (scroll-box-scroll-y sb) (max 0 (min (scroll-box-scroll-y sb) (- content-h viewport-h))))
(setf (scroll-box-scroll-x sb) (max 0 (min (scroll-box-scroll-x sb) (- content-w viewport-w))))))
(defun scroll-by (sb dy dx)
(incf (scroll-box-scroll-y sb) dy) (incf (scroll-box-scroll-x sb) dx)
(clamp-scroll sb) (mark-dirty sb))
(defun scroll-box-content-height (sb)
(reduce #'+ (scroll-box-children sb)
:key (lambda (c) (let ((ln (component-layout-node c))) (if ln (max 1 (layout-node-height ln)) 1)))
:initial-value 0))
(defun scroll-box-content-width (sb)
(reduce #'max (scroll-box-children sb)
:key (lambda (c) (let ((ln (component-layout-node c))) (if ln (max 1 (layout-node-width ln)) 1)))
:initial-value 0))
(defmethod render ((sb scroll-box) backend)
"Render ScrollBox children within the viewport, offset by scroll position.
Children outside the viewport are skipped."
(let* ((ln (scroll-box-layout-node sb))
(vx 0) (vy 0)
(vw (if ln (layout-node-width ln) 80))
(vh (if ln (layout-node-height ln) 24))
(sy (scroll-box-scroll-y sb))
(sx (scroll-box-scroll-x sb)))
(dolist (child (scroll-box-children sb))
(let* ((cln (component-layout-node child))
(ch (if cln (layout-node-height cln) 1))
(cy vy))
;; Only render children that are visible in the viewport
(when (and (< (- cy sy) vh)
(> (+ (- cy sy) ch) 0))
;; Temporarily offset child's layout-node position for rendering
(let ((orig-x (if cln (layout-node-x cln) 0))
(orig-y (if cln (layout-node-y cln) 0)))
(when cln
(setf (layout-node-x cln) (- vx sx)
(layout-node-y cln) (- vy sy)))
(unwind-protect
(render child backend)
(when cln
(setf (layout-node-x cln) orig-x
(layout-node-y cln) orig-y)))))
(incf vy ch)))
(draw-scrollbars sb backend vw vh)))
(defun scrollbar-thumb (scroll-pos viewport-size content-size)
(if (> content-size viewport-size) (/ (float scroll-pos) (- content-size viewport-size)) 0.0))
(defun draw-scrollbars (sb backend viewport-w viewport-h)
(let* ((content-h (scroll-box-content-height sb)) (content-w (scroll-box-content-width sb))
(sy (scroll-box-scroll-y sb)) (sx (scroll-box-scroll-x sb))
(ln (scroll-box-layout-node sb))
(ox (if ln (layout-node-x ln) 0))
(oy (if ln (layout-node-y ln) 0)))
(when (> content-h viewport-h)
(let* ((thumb (scrollbar-thumb sy viewport-h content-h))
(thumb-pos (round (* thumb viewport-h))))
(draw-rect backend (+ ox (1- viewport-w)) oy 1 viewport-h :bg :bright-black)
(draw-text backend (+ ox (1- viewport-w)) (+ oy thumb-pos) "█" nil nil)))
(when (> content-w viewport-w)
(let* ((thumb (scrollbar-thumb sx viewport-w content-w))
(thumb-pos (round (* thumb viewport-w))))
(draw-rect backend ox (+ oy (1- viewport-h)) viewport-w 1 :bg :bright-black)
(draw-text backend (+ ox thumb-pos) (+ oy (1- viewport-h)) "█" nil nil)))))
(defun update-sticky-scroll (sb)
(when (sticky-scroll-p sb)
(let* ((content-h (scroll-box-content-height sb))
(ln (scroll-box-layout-node sb))
(viewport-h (if ln (layout-node-height ln) 24)))
(when (>= (scroll-box-scroll-y sb) (- content-h viewport-h 1))
(setf (scroll-box-scroll-y sb) (max 0 (- content-h viewport-h)))))))
#+END_SRC
#+BEGIN_SRC lisp :tangle no
(in-package #:cl-tty.container)
(defclass tab-bar (dirty-mixin)
((tabs :initform nil :initarg :tabs :accessor tab-bar-tabs :type list)
(active :initform nil :initarg :active :accessor tab-bar-active)
(layout-node :initform (make-layout-node) :accessor tab-bar-layout-node)
(focusable :initform t :accessor tab-bar-focusable)))
(defun make-tab-bar (&key tabs active)
(make-instance 'tab-bar :tabs (or tabs nil) :active active))
(defun tab-bar-add (tb id title)
(setf (tab-bar-tabs tb) (nconc (tab-bar-tabs tb) (list (list :id id :title title))))
(unless (tab-bar-active tb) (setf (tab-bar-active tb) id)) id)
(defmethod component-layout-node ((tb tab-bar)) (tab-bar-layout-node tb))
(defun tab-bar-next (tb)
(let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb))
(ids (mapcar (lambda (tab) (getf tab :id)) tabs))
(pos (position current ids)))
(when pos (let ((next (nth (mod (1+ pos) (length ids)) ids)))
(setf (tab-bar-active tb) next) (mark-dirty tb)))))
(defun tab-bar-prev (tb)
(let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb))
(ids (mapcar (lambda (tab) (getf tab :id)) tabs))
(pos (position current ids)))
(when pos (let ((prev (nth (mod (1- pos) (length ids)) ids)))
(setf (tab-bar-active tb) prev) (mark-dirty tb)))))
(defun tab-bar-select (tb id) (setf (tab-bar-active tb) id) (mark-dirty tb))
(defun tab-bar-handle-key (tb event)
(case (key-event-key event) (:left (tab-bar-prev tb) t) (:right (tab-bar-next tb) t) (t nil)))
(defmethod render ((tb tab-bar) backend)
(let* ((ln (tab-bar-layout-node tb))
(x (if ln (layout-node-x ln) 0))
(y (if ln (layout-node-y ln) 0))
(w (if ln (layout-node-width ln) 80))
(active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos x))
(dolist (tab tabs)
(let* ((id (getf tab :id)) (title (getf tab :title))
(label (format nil " ~A " title)) (label-len (length label))
(is-active (eql id active-id))
(fg (if is-active :accent :text-muted))
(bg (if is-active :background-element nil)))
(when (>= (+ x-pos label-len 2) w)
(draw-text backend x-pos y "..." :text-muted nil) (return))
(draw-text backend x-pos y label fg bg)
(incf x-pos (+ label-len 2)))))
(values))
#+END_SRC
#+BEGIN_SRC lisp :tangle no
(defpackage :cl-tty.container
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export
#:scroll-box #:make-scroll-box
#:scroll-box-scroll-y #:scroll-box-scroll-x
#:scroll-box-children #:scroll-by
#:sticky-scroll-p
#:clamp-scroll
#:tab-bar #:make-tab-bar
#:tab-bar-active #:tab-bar-tabs
#:tab-bar-add #:tab-bar-next #:tab-bar-prev
#:tab-bar-select #:tab-bar-handle-key))
#+END_SRC #+END_SRC

390
org/scrollbox.org
View File

@@ -6,52 +6,159 @@
ScrollBox is a container component that handles content larger than the ScrollBox is a container component that handles content larger than the
viewport. It provides scroll offsets, viewport culling (only renders viewport. It provides scroll offsets, viewport culling (only renders
visible children), and scrollbar rendering. visible children), scrollbar rendering, and sticky-scroll (auto-scroll
to bottom when new content arrives).
~scroll-box~ inherits ~dirty-mixin~ and implements the component protocol
(~render~, ~component-children~, ~component-layout-node~) so it works
with the rendering pipeline and layout engine.
** Contract
~(scroll-box &key scroll-y scroll-x width height children)~ → scroll-box
Create a ScrollBox container. CHILDREN is a list of components.
~scroll-y~ and ~scroll-x~ are the scroll offsets in lines.
~(scroll-box-children sb)~ → list of child components
~(scroll-box-scroll-y sb)~ / ~(setf scroll-box-scroll-y)~
~(scroll-box-scroll-x sb)~ / ~(setf scroll-box-scroll-x)~
~(render ((sb scroll-box) backend))~ — renders visible children with
scroll offset applied, then draws scrollbars if content overflows.
~(scroll-by sb dy dx)~ — adjust scroll offset by DY rows, DX columns.
Clamps to valid range (0 to content-size minus viewport-size).
~(sticky-scroll-p sb)~ / ~(setf sticky-scroll-p)~ — when T, auto-scroll
to bottom when new content arrives.
* Implementation * Implementation
** ScrollBox class
~scroll-box~ inherits from ~dirty-mixin~ for dirty tracking. It holds a
list of child components and two scroll offset slots (~scroll-y~ and
~scroll-x~). The ~sticky-scroll-p~ flag, when true, keeps the scroll
position at the bottom whenever new children are added.
The constructor accepts keyword arguments for initial offset and children.
~children~ defaults to an empty list.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp #+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
(in-package #:cl-tty.container) (in-package #:cl-tty.container)
(defclass scroll-box (dirty-mixin) (defclass scroll-box (dirty-mixin)
((children :initform nil :initarg :children :accessor scroll-box-children :type list) ((children :initform nil :initarg :children
(scroll-y :initform 0 :initarg :scroll-y :accessor scroll-box-scroll-y :type fixnum) :accessor scroll-box-children :type list)
(scroll-x :initform 0 :initarg :scroll-x :accessor scroll-box-scroll-x :type fixnum) (scroll-y :initform 0 :initarg :scroll-y
(sticky-scroll-p :initform t :initarg :sticky-scroll-p :accessor sticky-scroll-p :type boolean) :accessor scroll-box-scroll-y :type fixnum)
(scroll-x :initform 0 :initarg :scroll-x
:accessor scroll-box-scroll-x :type fixnum)
(sticky-scroll-p :initform t :initarg :sticky-scroll-p
:accessor sticky-scroll-p :type boolean)
(layout-node :initform (make-layout-node) :accessor scroll-box-layout-node))) (layout-node :initform (make-layout-node) :accessor scroll-box-layout-node)))
(defun make-scroll-box (&key (children nil) (scroll-y 0) (scroll-x 0) sticky-scroll-p) (defun make-scroll-box (&key (children nil) (scroll-y 0) (scroll-x 0)
sticky-scroll-p)
(make-instance 'scroll-box (make-instance 'scroll-box
:children children :scroll-y scroll-y :scroll-x scroll-x :children children
:scroll-y scroll-y
:scroll-x scroll-x
:sticky-scroll-p (if (null sticky-scroll-p) t sticky-scroll-p))) :sticky-scroll-p (if (null sticky-scroll-p) t sticky-scroll-p)))
#+END_SRC
(defmethod component-children ((sb scroll-box)) (scroll-box-children sb)) ** ScrollBox: component protocol
(defmethod component-layout-node ((sb scroll-box)) (scroll-box-layout-node sb))
~component-children~ returns the child list for the rendering pipeline
to traverse. ~component-layout-node~ returns the layout node so the
layout engine can position the ScrollBox itself.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
(defmethod component-children ((sb scroll-box))
(scroll-box-children sb))
(defmethod component-layout-node ((sb scroll-box))
(scroll-box-layout-node sb))
#+END_SRC
** ScrollBox: scroll-by
~scroll-by~ adjusts the scroll offset by delta rows and columns. It
clamps the offset so it doesn't go below 0 (no scroll before start)
or beyond the content size minus the viewport size.
~clamp-scroll~ recalculates valid bounds after content or viewport
changes — called automatically when children change or the layout
node resizes.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
(defun clamp-scroll (sb) (defun clamp-scroll (sb)
"Clamp scroll offsets to valid range."
(let* ((ln (scroll-box-layout-node sb)) (let* ((ln (scroll-box-layout-node sb))
(viewport-h (if ln (layout-node-height ln) 0)) (viewport-height (if ln (layout-node-height ln) 0))
(viewport-w (if ln (layout-node-width ln) 0)) (viewport-width (if ln (layout-node-width ln) 0))
(content-h (scroll-box-content-height sb)) (content-height (scroll-box-content-height sb))
(content-w (scroll-box-content-width sb))) (content-width (scroll-box-content-width sb)))
(setf (scroll-box-scroll-y sb) (max 0 (min (scroll-box-scroll-y sb) (- content-h viewport-h)))) (setf (scroll-box-scroll-y sb)
(setf (scroll-box-scroll-x sb) (max 0 (min (scroll-box-scroll-x sb) (- content-w viewport-w)))))) (max 0 (min (scroll-box-scroll-y sb)
(- content-height viewport-height))))
(setf (scroll-box-scroll-x sb)
(max 0 (min (scroll-box-scroll-x sb)
(- content-width viewport-width))))))
(defun scroll-by (sb dy dx) (defun scroll-by (sb dy dx)
(incf (scroll-box-scroll-y sb) dy) (incf (scroll-box-scroll-x sb) dx) "Scroll by DY rows and DX columns. Clamps to valid range."
(clamp-scroll sb) (mark-dirty sb)) (incf (scroll-box-scroll-y sb) dy)
(incf (scroll-box-scroll-x sb) dx)
(clamp-scroll sb)
(mark-dirty sb))
#+END_SRC
** ScrollBox: content size estimation
~scroll-box-content-height~ and ~scroll-box-content-width~ calculate
the total content size by summing child layout node dimensions. This
is used by ~clamp-scroll~ and scrollbar rendering.
For height: sum of all child heights (vertical layout).
For width: max of all child widths (horizontal scroll).
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
(defun scroll-box-content-height (sb) (defun scroll-box-content-height (sb)
"Total height of all children."
(reduce #'+ (scroll-box-children sb) (reduce #'+ (scroll-box-children sb)
:key (lambda (c) (let ((ln (component-layout-node c))) (if ln (max 1 (layout-node-height ln)) 1))) :key (lambda (c)
(let ((ln (component-layout-node c)))
(if ln (max 1 (layout-node-height ln)) 1)))
:initial-value 0)) :initial-value 0))
(defun scroll-box-content-width (sb) (defun scroll-box-content-width (sb)
"Maximum width among children."
(reduce #'max (scroll-box-children sb) (reduce #'max (scroll-box-children sb)
:key (lambda (c) (let ((ln (component-layout-node c))) (if ln (max 1 (layout-node-width ln)) 1))) :key (lambda (c)
(let ((ln (component-layout-node c)))
(if ln (max 1 (layout-node-width ln)) 1)))
:initial-value 0)) :initial-value 0))
#+END_SRC
** ScrollBox: rendering with viewport culling
~render~ iterates children, computes each child's position within
the viewport (adjusted for scroll offset), and only renders children
whose visible area intersects the viewport. This is the core
optimization — for a terminal with 200 children, only the ~24
visible ones are actually drawn.
~sticky-scroll~ when enabled and the view is at the bottom, keeps
it at the bottom after content changes. The flag resets to false
when the user manually scrolls up.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
(defmethod render ((sb scroll-box) backend) (defmethod render ((sb scroll-box) backend)
"Render visible children with scroll offset applied.
Delegates to each child's `render` method, temporarily offsetting
its layout-node position for the scroll offset. Children outside
the viewport are clipped out."
(let* ((ln (scroll-box-layout-node sb)) (let* ((ln (scroll-box-layout-node sb))
(vx 0) (vy 0) (vx 0) (vy 0)
(vw (if ln (layout-node-width ln) 80)) (vw (if ln (layout-node-width ln) 80))
@@ -59,35 +166,236 @@ visible children), and scrollbar rendering.
(sy (scroll-box-scroll-y sb)) (sy (scroll-box-scroll-y sb))
(sx (scroll-box-scroll-x sb))) (sx (scroll-box-scroll-x sb)))
(dolist (child (scroll-box-children sb)) (dolist (child (scroll-box-children sb))
(let* ((cln (component-layout-node child)) (ch (if cln (layout-node-height cln) 1)) (cy vy)) (let* ((cln (component-layout-node child))
(when (and (< (- cy sy) vh) (> (+ (- cy sy) ch) 0)) (ch (if cln (layout-node-height cln) 1))
(let ((orig-x (if cln (layout-node-x cln) 0)) (orig-y (if cln (layout-node-y cln) 0))) (cy vy))
(when cln (setf (layout-node-x cln) (- vx sx) (layout-node-y cln) (- vy sy))) ;; Only render children that are visible in the viewport
(unwind-protect (render child backend) (when (and (< (- cy sy) vh)
(when cln (setf (layout-node-x cln) orig-x (layout-node-y cln) orig-y))))) (> (+ (- cy sy) ch) 0))
;; Temporarily offset child's layout-node position for rendering
(let ((orig-x (if cln (layout-node-x cln) 0))
(orig-y (if cln (layout-node-y cln) 0)))
(when cln
(setf (layout-node-x cln) (- vx sx)
(layout-node-y cln) (- vy sy)))
(unwind-protect
(render child backend)
(when cln
(setf (layout-node-x cln) orig-x
(layout-node-y cln) orig-y)))))
(incf vy ch))) (incf vy ch)))
(draw-scrollbars sb backend vw vh))) (draw-scrollbars sb backend vw vh)))
#+END_SRC
(defun scrollbar-thumb (scroll-pos viewport-size content-size) ** ScrollBox: sticky scroll
(if (> content-size viewport-size) (/ (float scroll-pos) (- content-size viewport-size)) 0.0))
(defun draw-scrollbars (sb backend viewport-w viewport-h) ~sticky-scroll~ checks whether the view is at the bottom. If so,
(let* ((content-h (scroll-box-content-height sb)) (content-w (scroll-box-content-width sb)) auto-scrolls to keep the bottommost content visible. The user
(sy (scroll-box-scroll-y sb)) (sx (scroll-box-scroll-x sb)) calling ~scroll-by~ with a negative DY resets the sticky flag.
(ln (scroll-box-layout-node sb)) (ox (if ln (layout-node-x ln) 0)) (oy (if ln (layout-node-y ln) 0)))
(when (> content-h viewport-h)
(let* ((thumb (scrollbar-thumb sy viewport-h content-h)) (thumb-pos (round (* thumb viewport-h))))
(draw-rect backend (+ ox (1- viewport-w)) oy 1 viewport-h :bg :bright-black)
(draw-text backend (+ ox (1- viewport-w)) (+ oy thumb-pos) "█" nil nil)))
(when (> content-w viewport-w)
(let* ((thumb (scrollbar-thumb sx viewport-w content-w)) (thumb-pos (round (* thumb viewport-w))))
(draw-rect backend ox (+ oy (1- viewport-h)) viewport-w 1 :bg :bright-black)
(draw-text backend (+ ox thumb-pos) (+ oy (1- viewport-h)) "█" nil nil)))))
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
(defun update-sticky-scroll (sb) (defun update-sticky-scroll (sb)
"If sticky-scroll-p is active and at bottom, keep at bottom."
(when (sticky-scroll-p sb) (when (sticky-scroll-p sb)
(let* ((content-h (scroll-box-content-height sb)) (let* ((content-h (scroll-box-content-height sb))
(ln (scroll-box-layout-node sb)) (viewport-h (if ln (layout-node-height ln) 24))) (ln (scroll-box-layout-node sb))
(viewport-h (if ln (layout-node-height ln) 24)))
(when (>= (scroll-box-scroll-y sb) (- content-h viewport-h 1)) (when (>= (scroll-box-scroll-y sb) (- content-h viewport-h 1))
(setf (scroll-box-scroll-y sb) (max 0 (- content-h viewport-h))))))) (setf (scroll-box-scroll-y sb)
(max 0 (- content-h viewport-h)))))))
#+END_SRC
** ScrollBox: scrollbar rendering
~draw-scrollbars~ renders vertical and horizontal scrollbars as
single-character-wide bars on the right and bottom edges of the
viewport. The scrollbar thumb position and size reflect the current
scroll position relative to content size.
Vertical scrollbar: blocks (~#\\Full~ ~#\\Up~ ~#\\Mid~ ~#\\Down~).
Horizontal scrollbar: block characters along the bottom.
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
(defun scrollbar-thumb (scroll-pos viewport-size content-size)
"Return the thumb position for a scrollbar (0.0 to 1.0)."
(if (> content-size viewport-size)
(/ (float scroll-pos) (- content-size viewport-size))
0.0))
(defun draw-scrollbars (sb backend viewport-w viewport-h)
"Draw scrollbars if content exceeds viewport."
(let* ((content-h (scroll-box-content-height sb))
(content-w (scroll-box-content-width sb))
(sy (scroll-box-scroll-y sb))
(sx (scroll-box-scroll-x sb))
(ln (scroll-box-layout-node sb))
(ox (if ln (layout-node-x ln) 0))
(oy (if ln (layout-node-y ln) 0)))
;; Vertical scrollbar
(when (> content-h viewport-h)
(let* ((thumb (scrollbar-thumb sy viewport-h content-h))
(thumb-pos (round (* thumb viewport-h))))
(draw-rect backend (+ ox (1- viewport-w)) oy 1 viewport-h :bg :scrollbar-bg)
(draw-text backend (+ ox (1- viewport-w)) (+ oy thumb-pos) "█" nil nil)))
;; Horizontal scrollbar
(when (> content-w viewport-w)
(let* ((thumb (scrollbar-thumb sx viewport-w content-w))
(thumb-pos (round (* thumb viewport-w))))
(draw-rect backend ox (+ oy (1- viewport-h)) viewport-w 1 :bg :scrollbar-bg)
(draw-text backend (+ ox thumb-pos) (+ oy (1- viewport-h)) "█" nil nil)))))
#+END_SRC
** Bug Fixes (v1.0.0): scroll offset and scrollbar position
Two bugs were fixed in the ScrollBox render pipeline:
1. *Render scroll origin*: The render method used ~orig-y~ (the child's original
layout-node Y position, always 0 for top-level children) as the basis for
scroll offset. This caused the content-relative position ~vy~ to be ignored,
making scroll offsets incorrect when children were offset by layout.
Fix: Use ~vy~ (the content-relative Y accumulator) instead of ~orig-y~ when
setting the temporary layout offset: ~(layout-node-y cln) (- vy sy)~.
2. *Scrollbar positions*: ~draw-scrollbars~ drew scrollbars at viewport-local
coordinates (0, 0), not accounting for the scrollbox's own position within
the layout tree. Scrollbars would appear at the wrong screen location when
the scrollbox was nested inside other containers.
Fix: Read the scrollbox's layout-node origin ~(ox, oy)~ and offset all
scrollbar drawing coordinates by those values.
* Tests
Test suite for both ScrollBox and TabBar.
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp
(defpackage :cl-tty-scrollbox-test
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.container)
(:export #:run-tests))
(in-package #:cl-tty-scrollbox-test)
(def-suite scrollbox-suite :description "ScrollBox + TabBar tests")
(in-suite scrollbox-suite)
(defun run-tests ()
(let ((result (run 'scrollbox-suite)))
(fiveam:explain! result)
(uiop:quit 0)))
;; ── ScrollBox Tests ─────────────────────────────────────────────
(test scrollbox-creates
"A ScrollBox can be created with defaults."
(let ((sb (make-scroll-box)))
(is (typep sb 'scroll-box))
(is (= (scroll-box-scroll-y sb) 0))
(is (= (scroll-box-scroll-x sb) 0))
(is-false (scroll-box-children sb))))
(test scrollbox-with-children
"A ScrollBox can have children."
(let ((sb (make-scroll-box :children (list (make-text "hello")))))
(is (= (length (scroll-box-children sb)) 1))))
(test scrollbox-scroll-by
"ScrollBy adjusts offset clamped to valid range."
(let ((sb (make-scroll-box :scroll-y 0)))
(scroll-by sb 5 0)
(is (>= (scroll-box-scroll-y sb) 0))))
(test scrollbox-component-children
"Component protocol: children are accessible."
(let* ((child (make-text "hello"))
(sb (make-scroll-box :children (list child))))
(is (eql (first (component-children sb)) child))))
(test scrollbox-render-noop
"Rendering a ScrollBox with no children does not error."
(let* ((stream (make-string-output-stream))
(backend (make-simple-backend :output-stream stream))
(sb (make-scroll-box)))
(render sb backend)
(is-true t)))
;; ── TabBar Tests ────────────────────────────────────────────────
(test tabbar-creates
"A TabBar can be created with defaults."
(let ((tb (make-tab-bar)))
(is (typep tb 'tab-bar))
(is-false (tab-bar-active tb))
(is-false (tab-bar-tabs tb))))
(test tabbar-add-tab
"Adding a tab returns the id and updates tabs."
(let ((tb (make-tab-bar)))
(let ((id (tab-bar-add tb :tab1 "Tab One")))
(is (eql id :tab1))
(is (= (length (tab-bar-tabs tb)) 1))
(is (string= (getf (first (tab-bar-tabs tb)) :title) "Tab One")))))
(test tabbar-active-tab
"Setting active tab works."
(let ((tb (make-tab-bar)))
(tab-bar-add tb :tab1 "One")
(tab-bar-add tb :tab2 "Two")
(setf (tab-bar-active tb) :tab2)
(is (eql (tab-bar-active tb) :tab2))))
(test tabbar-render-noop
"Rendering a TabBar does not error."
(let* ((stream (make-string-output-stream))
(backend (make-simple-backend :output-stream stream))
(tb (make-tab-bar)))
(tab-bar-add tb :tab1 "One")
(tab-bar-add tb :tab2 "Two")
(setf (tab-bar-active tb) :tab1)
(render tb backend)
(is-true t)))
(test tabbar-next-prev
"TabBar next/prev wraps around through tabs."
(let ((tb (make-tab-bar)))
(tab-bar-add tb :tab1 "One")
(tab-bar-add tb :tab2 "Two")
(tab-bar-add tb :tab3 "Three")
(is (eql (tab-bar-active tb) :tab1))
(tab-bar-next tb)
(is (eql (tab-bar-active tb) :tab2))
(tab-bar-next tb)
(is (eql (tab-bar-active tb) :tab3))
(tab-bar-next tb)
(is (eql (tab-bar-active tb) :tab1) "wrap around past last")
(tab-bar-prev tb)
(is (eql (tab-bar-active tb) :tab3) "wrap around past first")))
(test tabbar-select
"TabBar select activates the specified tab."
(let ((tb (make-tab-bar)))
(tab-bar-add tb :tab1 "One")
(tab-bar-add tb :tab2 "Two")
(tab-bar-select tb :tab2)
(is (eql (tab-bar-active tb) :tab2))))
(test tabbar-handle-key
"TabBar handle-key dispatches left/right."
(let ((tb (make-tab-bar)))
(tab-bar-add tb :tab1 "One")
(tab-bar-add tb :tab2 "Two")
(setf (tab-bar-active tb) :tab1)
(tab-bar-handle-key tb (make-key-event :key :right))
(is (eql (tab-bar-active tb) :tab2))
(tab-bar-handle-key tb (make-key-event :key :left))
(is (eql (tab-bar-active tb) :tab1))))
(test scrollbox-scroll-clamp
"ScrollBox clamp prevents scrolling past bounds."
(let ((sb (make-scroll-box :scroll-y 5 :scroll-x 3)))
(setf (scroll-box-scroll-y sb) -1)
(clamp-scroll sb)
(is (= (scroll-box-scroll-y sb) 0) "clamps below 0")
(setf (scroll-box-scroll-y sb) 1000000)
(clamp-scroll sb)
(is (= (scroll-box-scroll-y sb) 0) "clamps above max (no children = 0 content)")))
#+END_SRC #+END_SRC

139
org/tabbar.org
View File

@@ -7,14 +7,38 @@
TabBar handles horizontal tab navigation with keyboard support. TabBar handles horizontal tab navigation with keyboard support.
Tabs are rendered as labeled items; the active tab is highlighted. Tabs are rendered as labeled items; the active tab is highlighted.
~tab-bar~ inherits ~dirty-mixin~ and implements the component protocol
(~render~, ~component-layout-node~) so it integrates with the rendering
pipeline and layout engine.
** Contract
~(tab-bar &key tabs active-tab)~ → tab-bar
TABS is a list of ~(id title)~ plists.
~(tab-bar-active tb)~ / ~(setf tab-bar-active)~ — currently active tab id.
~(tab-bar-tabs tb)~ — list of tab plists.
~(tab-bar-add tb id title)~ — add a tab. Returns the tab id.
~(render ((tb tab-bar) backend))~ — renders tab row, active tab
highlighted, inactive tabs dimmed.
* Implementation * Implementation
** TabBar class
~tab-bar~ stores a list of tab plists ~((:id :tab1 :title "One") ...)~
and the currently active tab id. ~tab-bar-add~ creates a new tab with
the given id and title, returns the id.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp #+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
(in-package #:cl-tty.container) (in-package #:cl-tty.container)
(defclass tab-bar (dirty-mixin) (defclass tab-bar (dirty-mixin)
((tabs :initform nil :initarg :tabs :accessor tab-bar-tabs :type list) ((tabs :initform nil :initarg :tabs
(active :initform nil :initarg :active :accessor tab-bar-active) :accessor tab-bar-tabs :type list)
(active :initform nil :initarg :active
:accessor tab-bar-active)
(layout-node :initform (make-layout-node) :accessor tab-bar-layout-node) (layout-node :initform (make-layout-node) :accessor tab-bar-layout-node)
(focusable :initform t :accessor tab-bar-focusable))) (focusable :initform t :accessor tab-bar-focusable)))
@@ -22,39 +46,108 @@ Tabs are rendered as labeled items; the active tab is highlighted.
(make-instance 'tab-bar :tabs (or tabs nil) :active active)) (make-instance 'tab-bar :tabs (or tabs nil) :active active))
(defun tab-bar-add (tb id title) (defun tab-bar-add (tb id title)
(setf (tab-bar-tabs tb) (nconc (tab-bar-tabs tb) (list (list :id id :title title)))) "Add a tab with ID and TITLE. Sets as active if first tab."
(unless (tab-bar-active tb) (setf (tab-bar-active tb) id)) id) (setf (tab-bar-tabs tb)
(nconc (tab-bar-tabs tb) (list (list :id id :title title))))
(unless (tab-bar-active tb)
(setf (tab-bar-active tb) id))
id)
#+END_SRC
(defmethod component-layout-node ((tb tab-bar)) (tab-bar-layout-node tb)) ** TabBar: component protocol
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
(defmethod component-layout-node ((tb tab-bar))
(tab-bar-layout-node tb))
#+END_SRC
** TabBar: navigation
~tab-bar-next~ and ~tab-bar-prev~ cycle through tabs. ~tab-bar-select~
activates a tab by id. ~tab-bar-handle-key~ dispatches key events
(Left/Right to navigate, optional Enter to select).
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
(defun tab-bar-next (tb) (defun tab-bar-next (tb)
(let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb)) "Move to next tab."
(ids (mapcar (lambda (tab) (getf tab :id)) tabs)) (pos (position current ids))) (let* ((tabs (tab-bar-tabs tb))
(when pos (let ((next (nth (mod (1+ pos) (length ids)) ids))) (current (tab-bar-active tb))
(setf (tab-bar-active tb) next) (mark-dirty tb))))) (ids (mapcar (lambda (tab) (getf tab :id)) tabs))
(pos (position current ids)))
(when pos
(let ((next (nth (mod (1+ pos) (length ids)) ids)))
(setf (tab-bar-active tb) next)
(mark-dirty tb)))))
(defun tab-bar-prev (tb) (defun tab-bar-prev (tb)
(let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb)) "Move to previous tab."
(ids (mapcar (lambda (tab) (getf tab :id)) tabs)) (pos (position current ids))) (let* ((tabs (tab-bar-tabs tb))
(when pos (let ((prev (nth (mod (1- pos) (length ids)) ids))) (current (tab-bar-active tb))
(setf (tab-bar-active tb) prev) (mark-dirty tb))))) (ids (mapcar (lambda (tab) (getf tab :id)) tabs))
(pos (position current ids)))
(when pos
(let ((prev (nth (mod (1- pos) (length ids)) ids)))
(setf (tab-bar-active tb) prev)
(mark-dirty tb)))))
(defun tab-bar-select (tb id) (setf (tab-bar-active tb) id) (mark-dirty tb)) (defun tab-bar-select (tb id)
"Select a tab by ID."
(setf (tab-bar-active tb) id)
(mark-dirty tb))
#+END_SRC
** TabBar: keyboard handler
~tab-bar-handle-key~ dispatches Left → previous tab, Right → next tab.
Returns T if the key was handled, NIL otherwise (for composability with
the keybinding system).
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
(defun tab-bar-handle-key (tb event) (defun tab-bar-handle-key (tb event)
(case (key-event-key event) (:left (tab-bar-prev tb) t) (:right (tab-bar-next tb) t) (t nil))) "Handle a key-event on a TabBar. Returns T if handled."
(case (key-event-key event)
(:left (tab-bar-prev tb) t)
(:right (tab-bar-next tb) t)
(t nil)))
#+END_SRC
** TabBar: rendering
~render~ iterates tabs, drawing each as ~[ Title ]~ with the active
tab highlighted (bold, accent color) and inactive tabs dimmed. Tabs
are separated by two spaces.
The available width comes from the layout node. If tabs overflow,
they are truncated with an ellipsis.
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.lisp
(defmethod render ((tb tab-bar) backend) (defmethod render ((tb tab-bar) backend)
(let* ((ln (tab-bar-layout-node tb)) (x (if ln (layout-node-x ln) 0)) (let* ((ln (tab-bar-layout-node tb))
(y (if ln (layout-node-y ln) 0)) (w (if ln (layout-node-width ln) 80)) (x (if ln (layout-node-x ln) 0))
(active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos x)) (y (if ln (layout-node-y ln) 0))
(w (if ln (layout-node-width ln) 80))
(active-id (tab-bar-active tb))
(tabs (tab-bar-tabs tb))
(x-pos x))
(dolist (tab tabs) (dolist (tab tabs)
(let* ((id (getf tab :id)) (title (getf tab :title)) (let* ((id (getf tab :id))
(label (format nil " ~A " title)) (label-len (length label)) (title (getf tab :title))
(label (format nil " ~A " title))
(label-len (length label))
(is-active (eql id active-id)) (is-active (eql id active-id))
(fg (if is-active :accent :text-muted)) (fg (if is-active :accent :text-muted))
(bg (if is-active :background-element nil))) (bg (if is-active :background-element nil)))
(when (>= (+ x-pos label-len 2) w) (draw-text backend x-pos y "..." :text-muted nil) (return)) ;; Check if tab fits
(draw-text backend x-pos y label fg bg) (incf x-pos (+ label-len 2))))) (when (>= (+ x-pos label-len 2) (+ x w))
(values)) (draw-text backend x-pos y "..." :text-muted nil)
(return))
;; Draw tab
(draw-text backend x-pos y label fg bg)
(incf x-pos (+ label-len 2))))
(values)))
#+END_SRC #+END_SRC
* Tests
TabBar tests are part of the combined scrollbox-tabbar test suite
defined in ~org/scrollbox.org~ (tangled to ~tests/scrollbox-tabbar-tests.lisp~).

10
src/components/container-package.lisp
View File

@@ -1,12 +1,16 @@
(defpackage :cl-tty.container (defpackage :cl-tty.container
(:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input) (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
(:export (:export
;; ScrollBox
#:scroll-box #:make-scroll-box #:scroll-box #:make-scroll-box
#:scroll-box-scroll-y #:scroll-box-scroll-x #:scroll-box-scroll-y #:scroll-box-scroll-x
#:scroll-box-children #:scroll-by #:scroll-box-children
#:sticky-scroll-p #:scroll-by #:sticky-scroll-p
#:clamp-scroll #:clamp-scroll
;; TabBar
#:tab-bar #:make-tab-bar #:tab-bar #:make-tab-bar
#:tab-bar-active #:tab-bar-tabs #:tab-bar-active #:tab-bar-tabs
#:tab-bar-add #:tab-bar-next #:tab-bar-prev #:tab-bar-add #:tab-bar-next #:tab-bar-prev
#:tab-bar-select #:tab-bar-handle-key)) #:tab-bar-select #:tab-bar-handle-key
;; Rendering
#:render))

138
src/components/scrollbox.lisp
View File

@@ -1,44 +1,72 @@
(in-package #:cl-tty.container) (in-package #:cl-tty.container)
(defclass scroll-box (dirty-mixin) (defclass scroll-box (dirty-mixin)
((children :initform nil :initarg :children :accessor scroll-box-children :type list) ((children :initform nil :initarg :children
(scroll-y :initform 0 :initarg :scroll-y :accessor scroll-box-scroll-y :type fixnum) :accessor scroll-box-children :type list)
(scroll-x :initform 0 :initarg :scroll-x :accessor scroll-box-scroll-x :type fixnum) (scroll-y :initform 0 :initarg :scroll-y
(sticky-scroll-p :initform t :initarg :sticky-scroll-p :accessor sticky-scroll-p :type boolean) :accessor scroll-box-scroll-y :type fixnum)
(scroll-x :initform 0 :initarg :scroll-x
:accessor scroll-box-scroll-x :type fixnum)
(sticky-scroll-p :initform t :initarg :sticky-scroll-p
:accessor sticky-scroll-p :type boolean)
(layout-node :initform (make-layout-node) :accessor scroll-box-layout-node))) (layout-node :initform (make-layout-node) :accessor scroll-box-layout-node)))
(defun make-scroll-box (&key (children nil) (scroll-y 0) (scroll-x 0) sticky-scroll-p) (defun make-scroll-box (&key (children nil) (scroll-y 0) (scroll-x 0)
sticky-scroll-p)
(make-instance 'scroll-box (make-instance 'scroll-box
:children children :scroll-y scroll-y :scroll-x scroll-x :children children
:scroll-y scroll-y
:scroll-x scroll-x
:sticky-scroll-p (if (null sticky-scroll-p) t sticky-scroll-p))) :sticky-scroll-p (if (null sticky-scroll-p) t sticky-scroll-p)))
(defmethod component-children ((sb scroll-box)) (scroll-box-children sb)) (defmethod component-children ((sb scroll-box))
(defmethod component-layout-node ((sb scroll-box)) (scroll-box-layout-node sb)) (scroll-box-children sb))
(defmethod component-layout-node ((sb scroll-box))
(scroll-box-layout-node sb))
(defun clamp-scroll (sb) (defun clamp-scroll (sb)
"Clamp scroll offsets to valid range."
(let* ((ln (scroll-box-layout-node sb)) (let* ((ln (scroll-box-layout-node sb))
(viewport-h (if ln (layout-node-height ln) 0)) (viewport-height (if ln (layout-node-height ln) 0))
(viewport-w (if ln (layout-node-width ln) 0)) (viewport-width (if ln (layout-node-width ln) 0))
(content-h (scroll-box-content-height sb)) (content-height (scroll-box-content-height sb))
(content-w (scroll-box-content-width sb))) (content-width (scroll-box-content-width sb)))
(setf (scroll-box-scroll-y sb) (max 0 (min (scroll-box-scroll-y sb) (- content-h viewport-h)))) (setf (scroll-box-scroll-y sb)
(setf (scroll-box-scroll-x sb) (max 0 (min (scroll-box-scroll-x sb) (- content-w viewport-w)))))) (max 0 (min (scroll-box-scroll-y sb)
(- content-height viewport-height))))
(setf (scroll-box-scroll-x sb)
(max 0 (min (scroll-box-scroll-x sb)
(- content-width viewport-width))))))
(defun scroll-by (sb dy dx) (defun scroll-by (sb dy dx)
(incf (scroll-box-scroll-y sb) dy) (incf (scroll-box-scroll-x sb) dx) "Scroll by DY rows and DX columns. Clamps to valid range."
(clamp-scroll sb) (mark-dirty sb)) (incf (scroll-box-scroll-y sb) dy)
(incf (scroll-box-scroll-x sb) dx)
(clamp-scroll sb)
(mark-dirty sb))
(defun scroll-box-content-height (sb) (defun scroll-box-content-height (sb)
"Total height of all children."
(reduce #'+ (scroll-box-children sb) (reduce #'+ (scroll-box-children sb)
:key (lambda (c) (let ((ln (component-layout-node c))) (if ln (max 1 (layout-node-height ln)) 1))) :key (lambda (c)
(let ((ln (component-layout-node c)))
(if ln (max 1 (layout-node-height ln)) 1)))
:initial-value 0)) :initial-value 0))
(defun scroll-box-content-width (sb) (defun scroll-box-content-width (sb)
"Maximum width among children."
(reduce #'max (scroll-box-children sb) (reduce #'max (scroll-box-children sb)
:key (lambda (c) (let ((ln (component-layout-node c))) (if ln (max 1 (layout-node-width ln)) 1))) :key (lambda (c)
(let ((ln (component-layout-node c)))
(if ln (max 1 (layout-node-width ln)) 1)))
:initial-value 0)) :initial-value 0))
(defmethod render ((sb scroll-box) backend) (defmethod render ((sb scroll-box) backend)
"Render visible children with scroll offset applied.
Delegates to each child's `render` method, temporarily offsetting
its layout-node position for the scroll offset. Children outside
the viewport are clipped out."
(let* ((ln (scroll-box-layout-node sb)) (let* ((ln (scroll-box-layout-node sb))
(vx 0) (vy 0) (vx 0) (vy 0)
(vw (if ln (layout-node-width ln) 80)) (vw (if ln (layout-node-width ln) 80))
@@ -46,34 +74,60 @@
(sy (scroll-box-scroll-y sb)) (sy (scroll-box-scroll-y sb))
(sx (scroll-box-scroll-x sb))) (sx (scroll-box-scroll-x sb)))
(dolist (child (scroll-box-children sb)) (dolist (child (scroll-box-children sb))
(let* ((cln (component-layout-node child)) (ch (if cln (layout-node-height cln) 1)) (cy vy)) (let* ((cln (component-layout-node child))
(when (and (< (- cy sy) vh) (> (+ (- cy sy) ch) 0)) (ch (if cln (layout-node-height cln) 1))
(let ((orig-x (if cln (layout-node-x cln) 0)) (orig-y (if cln (layout-node-y cln) 0))) (cy vy))
(when cln (setf (layout-node-x cln) (- vx sx) (layout-node-y cln) (- vy sy))) ;; Only render children that are visible in the viewport
(unwind-protect (render child backend) (when (and (< (- cy sy) vh)
(when cln (setf (layout-node-x cln) orig-x (layout-node-y cln) orig-y))))) (> (+ (- cy sy) ch) 0))
;; Temporarily offset child's layout-node position for rendering
(let ((orig-x (if cln (layout-node-x cln) 0))
(orig-y (if cln (layout-node-y cln) 0)))
(when cln
(setf (layout-node-x cln) (- vx sx)
(layout-node-y cln) (- vy sy)))
(unwind-protect
(render child backend)
(when cln
(setf (layout-node-x cln) orig-x
(layout-node-y cln) orig-y)))))
(incf vy ch))) (incf vy ch)))
(draw-scrollbars sb backend vw vh))) (draw-scrollbars sb backend vw vh)))
(defun scrollbar-thumb (scroll-pos viewport-size content-size)
(if (> content-size viewport-size) (/ (float scroll-pos) (- content-size viewport-size)) 0.0))
(defun draw-scrollbars (sb backend viewport-w viewport-h)
(let* ((content-h (scroll-box-content-height sb)) (content-w (scroll-box-content-width sb))
(sy (scroll-box-scroll-y sb)) (sx (scroll-box-scroll-x sb))
(ln (scroll-box-layout-node sb)) (ox (if ln (layout-node-x ln) 0)) (oy (if ln (layout-node-y ln) 0)))
(when (> content-h viewport-h)
(let* ((thumb (scrollbar-thumb sy viewport-h content-h)) (thumb-pos (round (* thumb viewport-h))))
(draw-rect backend (+ ox (1- viewport-w)) oy 1 viewport-h :bg :bright-black)
(draw-text backend (+ ox (1- viewport-w)) (+ oy thumb-pos) "█" nil nil)))
(when (> content-w viewport-w)
(let* ((thumb (scrollbar-thumb sx viewport-w content-w)) (thumb-pos (round (* thumb viewport-w))))
(draw-rect backend ox (+ oy (1- viewport-h)) viewport-w 1 :bg :bright-black)
(draw-text backend (+ ox thumb-pos) (+ oy (1- viewport-h)) "█" nil nil)))))
(defun update-sticky-scroll (sb) (defun update-sticky-scroll (sb)
"If sticky-scroll-p is active and at bottom, keep at bottom."
(when (sticky-scroll-p sb) (when (sticky-scroll-p sb)
(let* ((content-h (scroll-box-content-height sb)) (let* ((content-h (scroll-box-content-height sb))
(ln (scroll-box-layout-node sb)) (viewport-h (if ln (layout-node-height ln) 24))) (ln (scroll-box-layout-node sb))
(viewport-h (if ln (layout-node-height ln) 24)))
(when (>= (scroll-box-scroll-y sb) (- content-h viewport-h 1)) (when (>= (scroll-box-scroll-y sb) (- content-h viewport-h 1))
(setf (scroll-box-scroll-y sb) (max 0 (- content-h viewport-h))))))) (setf (scroll-box-scroll-y sb)
(max 0 (- content-h viewport-h)))))))
(defun scrollbar-thumb (scroll-pos viewport-size content-size)
"Return the thumb position for a scrollbar (0.0 to 1.0)."
(if (> content-size viewport-size)
(/ (float scroll-pos) (- content-size viewport-size))
0.0))
(defun draw-scrollbars (sb backend viewport-w viewport-h)
"Draw scrollbars if content exceeds viewport."
(let* ((content-h (scroll-box-content-height sb))
(content-w (scroll-box-content-width sb))
(sy (scroll-box-scroll-y sb))
(sx (scroll-box-scroll-x sb))
(ln (scroll-box-layout-node sb))
(ox (if ln (layout-node-x ln) 0))
(oy (if ln (layout-node-y ln) 0)))
;; Vertical scrollbar
(when (> content-h viewport-h)
(let* ((thumb (scrollbar-thumb sy viewport-h content-h))
(thumb-pos (round (* thumb viewport-h))))
(draw-rect backend (+ ox (1- viewport-w)) oy 1 viewport-h :bg :scrollbar-bg)
(draw-text backend (+ ox (1- viewport-w)) (+ oy thumb-pos) "█" nil nil)))
;; Horizontal scrollbar
(when (> content-w viewport-w)
(let* ((thumb (scrollbar-thumb sx viewport-w content-w))
(thumb-pos (round (* thumb viewport-w))))
(draw-rect backend ox (+ oy (1- viewport-h)) viewport-w 1 :bg :scrollbar-bg)
(draw-text backend (+ ox thumb-pos) (+ oy (1- viewport-h)) "█" nil nil)))))

81
src/components/tabbar.lisp
View File

@@ -1,8 +1,10 @@
(in-package #:cl-tty.container) (in-package #:cl-tty.container)
(defclass tab-bar (dirty-mixin) (defclass tab-bar (dirty-mixin)
((tabs :initform nil :initarg :tabs :accessor tab-bar-tabs :type list) ((tabs :initform nil :initarg :tabs
(active :initform nil :initarg :active :accessor tab-bar-active) :accessor tab-bar-tabs :type list)
(active :initform nil :initarg :active
:accessor tab-bar-active)
(layout-node :initform (make-layout-node) :accessor tab-bar-layout-node) (layout-node :initform (make-layout-node) :accessor tab-bar-layout-node)
(focusable :initform t :accessor tab-bar-focusable))) (focusable :initform t :accessor tab-bar-focusable)))
@@ -10,38 +12,71 @@
(make-instance 'tab-bar :tabs (or tabs nil) :active active)) (make-instance 'tab-bar :tabs (or tabs nil) :active active))
(defun tab-bar-add (tb id title) (defun tab-bar-add (tb id title)
(setf (tab-bar-tabs tb) (nconc (tab-bar-tabs tb) (list (list :id id :title title)))) "Add a tab with ID and TITLE. Sets as active if first tab."
(unless (tab-bar-active tb) (setf (tab-bar-active tb) id)) id) (setf (tab-bar-tabs tb)
(nconc (tab-bar-tabs tb) (list (list :id id :title title))))
(unless (tab-bar-active tb)
(setf (tab-bar-active tb) id))
id)
(defmethod component-layout-node ((tb tab-bar)) (tab-bar-layout-node tb)) (defmethod component-layout-node ((tb tab-bar))
(tab-bar-layout-node tb))
(defun tab-bar-next (tb) (defun tab-bar-next (tb)
(let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb)) "Move to next tab."
(ids (mapcar (lambda (tab) (getf tab :id)) tabs)) (pos (position current ids))) (let* ((tabs (tab-bar-tabs tb))
(when pos (let ((next (nth (mod (1+ pos) (length ids)) ids))) (current (tab-bar-active tb))
(setf (tab-bar-active tb) next) (mark-dirty tb))))) (ids (mapcar (lambda (tab) (getf tab :id)) tabs))
(pos (position current ids)))
(when pos
(let ((next (nth (mod (1+ pos) (length ids)) ids)))
(setf (tab-bar-active tb) next)
(mark-dirty tb)))))
(defun tab-bar-prev (tb) (defun tab-bar-prev (tb)
(let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb)) "Move to previous tab."
(ids (mapcar (lambda (tab) (getf tab :id)) tabs)) (pos (position current ids))) (let* ((tabs (tab-bar-tabs tb))
(when pos (let ((prev (nth (mod (1- pos) (length ids)) ids))) (current (tab-bar-active tb))
(setf (tab-bar-active tb) prev) (mark-dirty tb))))) (ids (mapcar (lambda (tab) (getf tab :id)) tabs))
(pos (position current ids)))
(when pos
(let ((prev (nth (mod (1- pos) (length ids)) ids)))
(setf (tab-bar-active tb) prev)
(mark-dirty tb)))))
(defun tab-bar-select (tb id) (setf (tab-bar-active tb) id) (mark-dirty tb)) (defun tab-bar-select (tb id)
"Select a tab by ID."
(setf (tab-bar-active tb) id)
(mark-dirty tb))
(defun tab-bar-handle-key (tb event) (defun tab-bar-handle-key (tb event)
(case (key-event-key event) (:left (tab-bar-prev tb) t) (:right (tab-bar-next tb) t) (t nil))) "Handle a key-event on a TabBar. Returns T if handled."
(case (key-event-key event)
(:left (tab-bar-prev tb) t)
(:right (tab-bar-next tb) t)
(t nil)))
(defmethod render ((tb tab-bar) backend) (defmethod render ((tb tab-bar) backend)
(let* ((ln (tab-bar-layout-node tb)) (x (if ln (layout-node-x ln) 0)) (let* ((ln (tab-bar-layout-node tb))
(y (if ln (layout-node-y ln) 0)) (w (if ln (layout-node-width ln) 80)) (x (if ln (layout-node-x ln) 0))
(active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos x)) (y (if ln (layout-node-y ln) 0))
(w (if ln (layout-node-width ln) 80))
(active-id (tab-bar-active tb))
(tabs (tab-bar-tabs tb))
(x-pos x))
(dolist (tab tabs) (dolist (tab tabs)
(let* ((id (getf tab :id)) (title (getf tab :title)) (let* ((id (getf tab :id))
(label (format nil " ~A " title)) (label-len (length label)) (title (getf tab :title))
(label (format nil " ~A " title))
(label-len (length label))
(is-active (eql id active-id)) (is-active (eql id active-id))
(fg (if is-active :accent :text-muted)) (fg (if is-active :accent :text-muted))
(bg (if is-active :background-element nil))) (bg (if is-active :background-element nil)))
(when (>= (+ x-pos label-len 2) w) (draw-text backend x-pos y "..." :text-muted nil) (return)) ;; Check if tab fits
(draw-text backend x-pos y label fg bg) (incf x-pos (+ label-len 2))))) (when (>= (+ x-pos label-len 2) (+ x w))
(values)) (draw-text backend x-pos y "..." :text-muted nil)
(return))
;; Draw tab
(draw-text backend x-pos y label fg bg)
(incf x-pos (+ label-len 2))))
(values)))