split: scrollbox-tabbar.org into scrollbox.org, tabbar.org, container-package.org

- Create org/scrollbox.org (tangles scrollbox.lisp)
- Create org/tabbar.org (tangles tabbar.lisp)
- Create org/container-package.org (tangles container-package.lisp)
- Disable :tangle in old scrollbox-tabbar.org (kept for prose docs)
- Fix missing paren in render method (was depth=1 at EOF)
- All 483 tests pass, 14 suites, 100%
This commit is contained in:
Hermes Agent
2026-05-12 18:00:06 +00:00
parent d5caaf296d
commit a061d60898
6 changed files with 199 additions and 44 deletions

26
org/container-package.org Normal file
View File

@@ -0,0 +1,26 @@
#+TITLE: Container Package
#+STARTUP: content
#+FILETAGS: :cl-tty:container:
* Overview
The ~cl-tty.container~ package defines the container component types:
ScrollBox and TabBar. It uses ~cl-tty.backend~, ~cl-tty.box~,
~cl-tty.layout~, and ~cl-tty.input~.
* Implementation
#+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

View File

@@ -46,7 +46,7 @@ TabBar:
** Tests ** Tests
#+BEGIN_SRC lisp :tangle ../tests/scrollbox-tabbar-tests.lisp #+BEGIN_SRC lisp :tangle no
(defpackage :cl-tty-scrollbox-test (defpackage :cl-tty-scrollbox-test
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.container) (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.container)
(:export #:run-tests)) (:export #:run-tests))
@@ -550,7 +550,7 @@ Two bugs were fixed in the ScrollBox render pipeline:
** Combined tangle blocks ** Combined tangle blocks
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.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)
@@ -650,7 +650,7 @@ Children outside the viewport are skipped."
(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 #+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/tabbar.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)
@@ -706,7 +706,7 @@ Children outside the viewport are skipped."
(values)) (values))
#+END_SRC #+END_SRC
#+BEGIN_SRC lisp :tangle ../src/components/container-package.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

93
org/scrollbox.org Normal file
View File

@@ -0,0 +1,93 @@
#+TITLE: ScrollBox
#+STARTUP: content
#+FILETAGS: :cl-tty:container:
* Overview
ScrollBox is a container component that handles content larger than the
viewport. It provides scroll offsets, viewport culling (only renders
visible children), and scrollbar rendering.
* Implementation
#+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)
(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))
(when (and (< (- cy sy) vh) (> (+ (- cy sy) ch) 0))
(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

60
org/tabbar.org Normal file
View File

@@ -0,0 +1,60 @@
#+TITLE: TabBar
#+STARTUP: content
#+FILETAGS: :cl-tty:container:
* Overview
TabBar handles horizontal tab navigation with keyboard support.
Tabs are rendered as labeled items; the active tab is highlighted.
* Implementation
#+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)) (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

View File

@@ -39,8 +39,6 @@
:initial-value 0)) :initial-value 0))
(defmethod render ((sb scroll-box) backend) (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)) (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))
@@ -48,23 +46,12 @@ Children outside the viewport are skipped."
(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)) (let* ((cln (component-layout-node child)) (ch (if cln (layout-node-height cln) 1)) (cy vy))
(ch (if cln (layout-node-height cln) 1)) (when (and (< (- cy sy) vh) (> (+ (- cy sy) ch) 0))
(cy vy)) (let ((orig-x (if cln (layout-node-x cln) 0)) (orig-y (if cln (layout-node-y cln) 0)))
;; Only render children that are visible in the viewport (when cln (setf (layout-node-x cln) (- vx sx) (layout-node-y cln) (- vy sy)))
(when (and (< (- cy sy) vh) (unwind-protect (render child backend)
(> (+ (- cy sy) ch) 0)) (when cln (setf (layout-node-x cln) orig-x (layout-node-y cln) orig-y)))))
;; 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)))
@@ -74,24 +61,19 @@ Children outside the viewport are skipped."
(defun draw-scrollbars (sb backend viewport-w viewport-h) (defun draw-scrollbars (sb backend viewport-w viewport-h)
(let* ((content-h (scroll-box-content-height sb)) (content-w (scroll-box-content-width sb)) (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)) (sy (scroll-box-scroll-y sb)) (sx (scroll-box-scroll-x sb))
(ln (scroll-box-layout-node sb)) (ln (scroll-box-layout-node sb)) (ox (if ln (layout-node-x ln) 0)) (oy (if ln (layout-node-y ln) 0)))
(ox (if ln (layout-node-x ln) 0))
(oy (if ln (layout-node-y ln) 0)))
(when (> content-h viewport-h) (when (> content-h viewport-h)
(let* ((thumb (scrollbar-thumb sy viewport-h content-h)) (let* ((thumb (scrollbar-thumb sy viewport-h content-h)) (thumb-pos (round (* thumb viewport-h))))
(thumb-pos (round (* thumb viewport-h))))
(draw-rect backend (+ ox (1- viewport-w)) oy 1 viewport-h :bg :bright-black) (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))) (draw-text backend (+ ox (1- viewport-w)) (+ oy thumb-pos) "█" nil nil)))
(when (> content-w viewport-w) (when (> content-w viewport-w)
(let* ((thumb (scrollbar-thumb sx viewport-w content-w)) (let* ((thumb (scrollbar-thumb sx viewport-w content-w)) (thumb-pos (round (* thumb viewport-w))))
(thumb-pos (round (* thumb viewport-w))))
(draw-rect backend ox (+ oy (1- viewport-h)) viewport-w 1 :bg :bright-black) (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))))) (draw-text backend (+ ox thumb-pos) (+ oy (1- viewport-h)) "█" nil nil)))))
(defun update-sticky-scroll (sb) (defun update-sticky-scroll (sb)
(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)) (ln (scroll-box-layout-node sb)) (viewport-h (if ln (layout-node-height ln) 24)))
(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)))))))

View File

@@ -17,15 +17,13 @@
(defun tab-bar-next (tb) (defun tab-bar-next (tb)
(let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb)) (let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb))
(ids (mapcar (lambda (tab) (getf tab :id)) tabs)) (ids (mapcar (lambda (tab) (getf tab :id)) tabs)) (pos (position current ids)))
(pos (position current ids)))
(when pos (let ((next (nth (mod (1+ pos) (length ids)) ids))) (when pos (let ((next (nth (mod (1+ pos) (length ids)) ids)))
(setf (tab-bar-active tb) next) (mark-dirty tb))))) (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)) (let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb))
(ids (mapcar (lambda (tab) (getf tab :id)) tabs)) (ids (mapcar (lambda (tab) (getf tab :id)) tabs)) (pos (position current ids)))
(pos (position current ids)))
(when pos (let ((prev (nth (mod (1- pos) (length ids)) ids))) (when pos (let ((prev (nth (mod (1- pos) (length ids)) ids)))
(setf (tab-bar-active tb) prev) (mark-dirty tb))))) (setf (tab-bar-active tb) prev) (mark-dirty tb)))))
@@ -35,10 +33,8 @@
(case (key-event-key event) (:left (tab-bar-prev tb) t) (:right (tab-bar-next tb) t) (t nil))) (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)) (let* ((ln (tab-bar-layout-node tb)) (x (if ln (layout-node-x ln) 0))
(x (if ln (layout-node-x ln) 0)) (y (if ln (layout-node-y ln) 0)) (w (if ln (layout-node-width ln) 80))
(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)) (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)) (title (getf tab :title))
@@ -46,8 +42,6 @@
(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) (when (>= (+ x-pos label-len 2) w) (draw-text backend x-pos y "..." :text-muted nil) (return))
(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)))))
(draw-text backend x-pos y label fg bg)
(incf x-pos (+ label-len 2)))))
(values)) (values))