cl-tty/org/scrollbox.org

ScrollBox

• Overview
  • Contract
• Implementation
  • ScrollBox class
  • make-scroll-box constructor
  • component-children method
  • component-layout-node method
  • clamp-scroll helper
  • scroll-by method
  • scroll-box-content-height
  • scroll-box-content-width
  • Render method with viewport culling
  • update-sticky-scroll
  • scrollbar-thumb helper
  • draw-scrollbars
  • Bug Fixes (v1.0.0): scroll offset and scrollbar position
• Tests
  • Package and test infrastructure
  • ScrollBox constructor test
  • ScrollBox with children test
  • ScrollBox scroll-by test
  • ScrollBox component-children test
  • ScrollBox render no-op test
  • TabBar constructor test
  • TabBar add-tab test
  • TabBar active tab test
  • TabBar render no-op test
  • TabBar next/prev navigation test
  • TabBar select test
  • TabBar key handling test
  • ScrollBox clamp boundary test

Overview

ScrollBox is a container component that handles content larger than the viewport. It provides scroll offsets, viewport culling (only renders 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

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.

Defining this as a class (rather than a struct) lets us integrate with the CLOS-based component protocol — render dispatches on the class, and dirty-mixin provides the marking machinery used by the refresh loop.

(in-package :cl-tty.box)

(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)))

make-scroll-box constructor

A dedicated constructor function provides keyword argument defaults and ensures sticky-scroll-p defaults to T even when the caller omits it (the :initform on the slot handles default-initialization, but a nil value explicitly passed as :sticky-scroll-p nil needs to be preserved). Using a function instead of making the user call make-instance directly keeps the API ergonomic and hides CLOS plumbing.

(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)))

component-children method

component-children is part of the component protocol. The rendering pipeline calls this to discover the tree of children to render. By delegating to the scroll-box-children accessor, we keep the protocol implementation thin — just an indirection that makes scroll-box participate polymorphically alongside other container types.

(defmethod component-children ((sb scroll-box))
  (scroll-box-children sb))

component-layout-node method

component-layout-node returns the layout node that the layout engine uses to position the ScrollBox itself within its parent. Each ScrollBox creates its own layout node at construction time via make-layout-node, so this method simply returns that stored node.

(defmethod component-layout-node ((sb scroll-box))
  (scroll-box-layout-node sb))

clamp-scroll helper

clamp-scroll recalculates valid scroll bounds after content or viewport changes — called automatically when children change or the layout node resizes. It reads the viewport dimensions from the layout node and the content dimensions from the content-size helpers, then clamps both scroll offsets with max~/~min to ensure they never go below 0 or beyond the scrollable range.

(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))))))

scroll-by method

scroll-by adjusts the scroll offset by delta rows and columns. It increments the current offset, clamps via clamp-scroll, then marks the component dirty so the render loop picks up the change. This is the primary API entry point for programmatic scrolling (from keyboard input or mouse wheel events).

(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))

scroll-box-content-height

scroll-box-content-height calculates the total content height by summing all child heights. Each child reports its height through its layout node, with a minimum of 1 row (even zero-height children get a floor so they don't collapse the layout). This is used by clamp-scroll, scrollbar rendering, and sticky-scroll logic.

(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))

scroll-box-content-width

scroll-box-content-width calculates the maximum width among children, since horizontal scrolling follows the widest child rather than summing widths. Like the height counterpart, it floors child widths at 1 so empty children don't zero out the measurement.

(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))

Render method 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.

The method temporarily offsets each child's layout node by the scroll amount during rendering, then restores the original position via unwind-protect. This avoids mutating the permanent layout state while still making each child's render method draw at the correct scrolled position.

After child rendering, it delegates to draw-scrollbars for the scrollbar overlay.

(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)
                   (> (+ (- 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)))

update-sticky-scroll

update-sticky-scroll checks whether the view is at the bottom and, if the sticky-scroll-p flag is set, auto-scrolls to keep the bottommost content visible. The comparison uses a 1-row tolerance ((- content-h viewport-h 1)) so minor content changes don't cause jitter. The sticky flag is reset to nil when the user manually scrolls up (handled by callers of scroll-by).

(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)))))))

scrollbar-thumb helper

scrollbar-thumb converts a raw scroll position (in lines) into a normalized 0.0-to-1.0 ratio representing where the thumb should appear on the scrollbar track. When content fits entirely within the viewport, it returns 0.0 (no scrolling possible). This normalized value is used by draw-scrollbars to compute the pixel/character position of the thumb.

(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))

draw-scrollbars

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.

The vertical scrollbar uses a filled block (█) for the thumb and a background fill for the track. The horizontal scrollbar is drawn along the bottom edge. Both account for the scrollbox's own position within the layout tree (ox, oy) so nested scrollboxes render scrollbars at the correct screen coordinates.

(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)))))

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.

Package and test infrastructure

The tests use FiveAM, the Common Lisp testing framework. The package setup pulls in all the systems under test (cl-tty.backend, cl-tty.box, cl-tty.layout, cl-tty.input, cl-tty.container) along with the base :cl language and :fiveam itself.

run-tests is exported so the test runner script can call it unconditionally; it runs the scrollbox-suite and prints results via fiveam:explain! before exiting.

(defpackage :cl-tty-scrollbox-test
  (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
  (: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 constructor test

Confirms a bare make-scroll-box returns a scroll-box instance with default scroll offsets of 0 and no children. This establishes that the class definition and constructor are wired up correctly.

(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))))

ScrollBox with children test

Verifies that the :children initarg is accepted and that scroll-box-children returns the list. A ScrollBox with one child should report length 1.

(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))))

ScrollBox scroll-by test

Exercises scroll-by with a positive DY offset and asserts the scroll-y is non-negative after the operation. Combined with scrollbox-scroll-clamp below, this covers both the normal and boundary behavior of the scroll mechanic.

(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))))

ScrollBox component-children test

Confirms the component protocol method component-children returns the same child list that scroll-box-children does. This ensures the protocol indirection works and that the rendering pipeline will see the correct children.

(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))))

ScrollBox render no-op test

Renders a ScrollBox with no children to a string-output-stream backend. The test passes if no errors are signaled — this guards against nil layout nodes or unbound slots causing problems during the render pipeline's initial traversal.

(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 constructor test

Confirms a bare make-tab-bar returns a tab-bar instance with no active tab and no tabs. This validates the TabBar class definition and constructor.

(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))))

TabBar add-tab test

Tests that tab-bar-add returns the supplied ID, adds a tab to the internal list, and stores the title correctly. Each tab is stored as a plist, so the test checks both list length and the :title property.

(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")))))

TabBar active tab test

Verifies that (setf tab-bar-active) correctly selects a tab by ID and that tab-bar-active returns that ID afterward.

(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))))

TabBar render no-op test

Renders a fully configured TabBar (with tabs and an active selection) to a string-output-stream backend to confirm the render method doesn't error. A TabBar must draw its tab strip without crashing even when disconnected from a real terminal.

(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)))

TabBar next/prev navigation test

Exercises the full navigation cycle: tab-bar-next advances through three tabs, wrapping around past the last; tab-bar-prev goes backward, wrapping around past the first. This is the core keyboard interaction for tabbed UIs and must handle edge cases (empty bar, single tab, etc.) gracefully.

(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")))

TabBar select test

tab-bar-select activates a named tab directly (as opposed to relative next/prev navigation). This test verifies that selecting :tab2 from a three-tab bar correctly sets the active tab.

(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))))

TabBar key handling test

tab-bar-handle-key maps keyboard events to navigation actions. A :right key event should advance; a :left key event should retreat. This tests the bridge between the input event system and the TabBar navigation API.

(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))))

ScrollBox clamp boundary test

Directly tests clamp-scroll by setting scroll offsets to invalid values (negative and extremely large) and confirming they get clamped back to 0. With no children, content size is 0 so the max scroll is also 0 — this exercises the degenerate case.

(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)")))