cl-tty/org/scrollbox-tabbar.org

ScrollBox + TabBar — Archived Combined Module

• NOTE: This file is an archive
• ScrollBox and TabBar
  • Contract
• Implementation
  • Package
  • ScrollBox class
  • ScrollBox: component protocol
  • ScrollBox: scroll-by
  • ScrollBox: content size estimation
  • ScrollBox: rendering with viewport culling
  • ScrollBox: sticky scroll
  • ScrollBox: scrollbar rendering
  • TabBar class
  • TabBar: component protocol
  • TabBar: navigation
  • TabBar: keyboard handler
  • TabBar: rendering
  • Bug Fixes (v1.0.0): scroll offset and scrollbar position
• Tests

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

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.

Implementation

Package

(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
   #:clamp-scroll
   ;; TabBar
   #: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
   ;; Rendering
   #:render))

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.

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

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.

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

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

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.

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

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

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

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.

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

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.

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

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.

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

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.

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

TabBar: component protocol

(defmethod component-layout-node ((tb tab-bar))
  (tab-bar-layout-node tb))

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

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

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

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

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.

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

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

(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 omitted here — see org/scrollbox.org