29f99a576d
Every function, defclass, defstruct, defgeneric, defmethod, defmacro, defvar, and defparameter in every org file now has its own #+BEGIN_SRC block with literate prose above it explaining the design reasoning. Block counts before → after: package.org: 1 → 7 container-package.org: 1 → 1 (prose expanded) dirty.org: 4 → 6 render.org: 10 → 25 theme.org: 6 → 19 box-renderable.org: 9 → 29 scrollbox.org: 8 → 26 tabbar.org: 5 → 10 backend-protocol.org: 8 → 66 modern-backend.org: 17 → 53 detection.org: 4 → 6 layout-engine.org: 9 → 36 framebuffer.org: 8 → 37 markdown-renderer.org:13 → 38 dialog.org: 17 → 23 (merged dual structure) mouse.org: 4 → 25 select.org: 12 → 30 slot.org: 4 → 12 text-input.org: 11 → 53 Total: ~153 blocks → ~502 blocks Bugs fixed during restructuring: - render.org: stray π character typo (backenπd → backend) - modern-backend.org: sgr-attr missing closing paren + #+END_SRC - detection.org: invalid #\Esc character reference - select.org: extra closing paren in select-visible-options All 13 test suites pass at 100%.
125 lines
4.1 KiB
Common Lisp
125 lines
4.1 KiB
Common Lisp
(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)))
|
|
|
|
(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))))
|
|
|
|
(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))))
|
|
|
|
(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))))
|
|
|
|
(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))))
|
|
|
|
(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)))
|
|
|
|
(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))))
|
|
|
|
(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")))))
|
|
|
|
(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))))
|
|
|
|
(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)))
|
|
|
|
(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")))
|
|
|
|
(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))))
|
|
|
|
(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))))
|
|
|
|
(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)")))
|