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

remove: old scrollbox-tabbar.org (all prose distributed to per-module orgs)

Browse Source 
The combined org file had no unique content — all prose and code were
already in scrollbox.org, tabbar.org, and container-package.org. The
old file's code blocks had the pre-bugfix render/draw-scrollbars
versions and all had :tangle no.

Also update README.org and ARCHITECTURE.org references from
scrollbox-tabbar.org to the individual org files.
This commit is contained in:
Hermes Agent
2026-05-12 18:08:02 +00:00
parent 668966380e
commit 927f786716
3 changed files with 8 additions and 459 deletions
Download Patch File Download Diff File Expand all files Collapse all files

455
org/scrollbox-tabbar.org
View File

@@ -1,455 +0,0 @@
#+TITLE: ScrollBox + TabBar — Archived Combined Module
#+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
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
#+BEGIN_SRC lisp :tangle no
(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))
#+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 :tangle no
(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 :tangle no
(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 no
(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 :tangle no
(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 :tangle no
(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 :tangle no
(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 :tangle no
(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 :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)
"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 :tangle no
(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 no
(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 :tangle no
(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 :tangle no
(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)))
#+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
#+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 omitted here — see org/scrollbox.org
#+END_SRC