remove: old scrollbox-tabbar.org (all prose distributed to per-module orgs)
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:
@@ -207,7 +207,7 @@ line joining on backspace. See ~org/text-input.org~.
|
|||||||
|
|
||||||
Scrollable viewport with a list of children. Only renders children
|
Scrollable viewport with a list of children. Only renders children
|
||||||
intersecting the visible area (viewport culling). Scrollbars drawn
|
intersecting the visible area (viewport culling). Scrollbars drawn
|
||||||
at the right/bottom edges. See ~org/scrollbox-tabbar.org~.
|
at the right/bottom edges. See ~org/scrollbox.org~.
|
||||||
|
|
||||||
#+BEGIN_SRC lisp
|
#+BEGIN_SRC lisp
|
||||||
(make-scroll-box &key children scroll-y scroll-x sticky-scroll-p)
|
(make-scroll-box &key children scroll-y scroll-x sticky-scroll-p)
|
||||||
@@ -217,7 +217,7 @@ at the right/bottom edges. See ~org/scrollbox-tabbar.org~.
|
|||||||
*** TabBar
|
*** TabBar
|
||||||
|
|
||||||
Horizontal tab navigation. Renders tab labels, highlights active tab.
|
Horizontal tab navigation. Renders tab labels, highlights active tab.
|
||||||
Left/right arrows cycle through tabs. See ~org/scrollbox-tabbar.org~.
|
Left/right arrows cycle through tabs. See ~org/tabbar.org~.
|
||||||
|
|
||||||
#+BEGIN_SRC lisp
|
#+BEGIN_SRC lisp
|
||||||
(make-tab-bar &key tabs active)
|
(make-tab-bar &key tabs active)
|
||||||
@@ -356,7 +356,9 @@ cl-tty/
|
|||||||
├── tests/ # Test files
|
├── tests/ # Test files
|
||||||
├── org/ # Literate source files
|
├── org/ # Literate source files
|
||||||
│ ├── text-input.org
|
│ ├── text-input.org
|
||||||
│ ├── scrollbox-tabbar.org
|
│ ├── scrollbox.org
|
||||||
|
│ ├── tabbar.org
|
||||||
|
│ ├── container-package.org
|
||||||
│ ├── dialog.org
|
│ ├── dialog.org
|
||||||
│ ├── mouse.org
|
│ ├── mouse.org
|
||||||
│ ├── select.org
|
│ ├── select.org
|
||||||
|
|||||||
@@ -285,7 +285,9 @@ reads terminal background color at startup.
|
|||||||
│ ├── markdown-renderer.org
|
│ ├── markdown-renderer.org
|
||||||
│ ├── modern-backend.org
|
│ ├── modern-backend.org
|
||||||
│ ├── mouse.org
|
│ ├── mouse.org
|
||||||
│ ├── scrollbox-tabbar.org
|
│ ├── scrollbox.org
|
||||||
|
│ ├── tabbar.org
|
||||||
|
│ ├── container-package.org
|
||||||
│ ├── select.org
|
│ ├── select.org
|
||||||
│ ├── slot.org
|
│ ├── slot.org
|
||||||
│ └── text-input.org
|
│ └── text-input.org
|
||||||
|
|||||||
@@ -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
|
|
||||||
Reference in New Issue
Block a user