cl-tty/org/scrollbox-tabbar.org

#+TITLE: cl-tty v0.6.0 — ScrollBox + TabBar
#+STARTUP: content

* ScrollBox and TabBar

Container components. ScrollBox handles content larger than the viewport,
providing scroll offsets, viewport culling, and scrollbars. TabBar
handles horizontal tab navigation with keyboard support.

Both components inherit ~dirty-mixin~ and implement the component protocol
(~render~, ~component-children~, ~component-layout-node~) so they work
with the rendering pipeline and layout engine.

** Contract

ScrollBox:

~(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.

TabBar:

~(tab-bar &key tabs active-tab)~ → tab-bar
  TABS is a list of ~(id title)~ plists.

~(tab-bar-active sb)~ / ~(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.

** Tests

#+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

* Implementation

** Package

#+BEGIN_SRC lisp
(defpackage :cl-tty.container
  (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
  (:export
   ;; ScrollBox
   #:scroll-box #:make-scroll-box
   #:scroll-box-scroll-y #:scroll-box-scroll-x
   #:scroll-box-children
   #:scroll-by #:sticky-scroll-p
   ;; TabBar
   #:tab-bar #:make-tab-bar
   #:tab-bar-active #:tab-bar-tabs
   #:tab-bar-add
   ;; Rendering
   #:render))
#+END_SRC

** 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
(in-package #:cl-tty.container)

(defclass scroll-box (dirty-mixin)
  ((children :initform nil :initarg :children
             :accessor scroll-box-children :type list)
   (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)
  (make-instance 'scroll-box
    :children children
    :scroll-y scroll-y
    :scroll-x scroll-x
    :sticky-scroll-p (if (null sticky-scroll-p) t sticky-scroll-p)))
#+END_SRC

** ScrollBox: component protocol

~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
(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
(defun clamp-scroll (sb)
  "Clamp scroll offsets to valid range."
  (let* ((ln (scroll-box-layout-node sb))
         (viewport-height (if ln (layout-node-height ln) 0))
         (viewport-width  (if ln (layout-node-width ln) 0))
         (content-height (scroll-box-content-height sb))
         (content-width  (scroll-box-content-width sb)))
    (setf (scroll-box-scroll-y sb)
          (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)
  "Scroll by DY rows and DX columns. Clamps to valid range."
  (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
(defun scroll-box-content-height (sb)
  "Total height of all children."
  (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)
  "Maximum width among children."
  (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))
#+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
(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))
         (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 vy))
                   (> (+ cy (- sy) ch) vy))
          ;; 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) (- orig-x sx)
                    (layout-node-y cln) (- orig-y 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)))
#+END_SRC

** ScrollBox: sticky scroll

~sticky-scroll~ checks whether the view is at the bottom. If so,
auto-scrolls to keep the bottommost content visible. The user
calling ~scroll-by~ with a negative DY resets the sticky flag.

#+BEGIN_SRC lisp
(defun update-sticky-scroll (sb)
  "If sticky-scroll-p is active and at bottom, keep at bottom."
  (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

** 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
(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)))
    ;; 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 (1- viewport-w) 0 1 viewport-h :bg :scrollbar-bg)
        (draw-text backend (1- viewport-w) 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 0 (1- viewport-h) viewport-w 1 :bg :scrollbar-bg)
        (draw-text backend thumb-pos (1- viewport-h) "█" nil nil)))))
#+END_SRC

** 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
(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)
  "Add a tab with ID and TITLE. Sets as active if first tab."
  (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

** TabBar: component protocol

#+BEGIN_SRC 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
(defun tab-bar-next (tb)
  "Move to next tab."
  (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)
  "Move to previous tab."
  (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)
  "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
(defun tab-bar-handle-key (tb event)
  "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
(defmethod render ((tb tab-bar) backend)
  (let* ((ln (tab-bar-layout-node tb))
         (x 0) (y 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)))
        ;; Check if tab fits
        (when (>= (+ x-pos label-len 2) (+ x w))
          (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

** Combined tangle blocks

#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
(in-package #:cl-tty.container)

(defclass scroll-box (dirty-mixin)
  ((children :initform nil :initarg :children :accessor scroll-box-children :type list)
   (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)
  (make-instance 'scroll-box
    :children children :scroll-y scroll-y :scroll-x scroll-x
    :sticky-scroll-p (if (null sticky-scroll-p) t sticky-scroll-p)))

(defmethod component-children ((sb scroll-box)) (scroll-box-children sb))
(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 vy))
                   (> (+ cy (- sy) ch) vy))
          ;; 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) (- orig-x sx)
                    (layout-node-y cln) (- orig-y 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)))
    (when (> content-h viewport-h)
      (let* ((thumb (scrollbar-thumb sy viewport-h content-h))
             (thumb-pos (round (* thumb viewport-h))))
        (draw-rect backend (1- viewport-w) 0 1 viewport-h :bg :bright-black)
        (draw-text backend (1- viewport-w) 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 0 (1- viewport-h) viewport-w 1 :bg :bright-black)
        (draw-text backend thumb-pos (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 ../src/components/tabbar.lisp
(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)) (y 0)
         (w (if ln (layout-node-width ln) 80))
         (active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos 0))
    (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 ../src/components/container-package.lisp
(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