129 lines
4.4 KiB
Common Lisp
129 lines
4.4 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)))
|
|
|
|
;; ── ScrollBox Tests ─────────────────────────────────────────────
|
|
|
|
(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)))
|
|
|
|
;; ── TabBar Tests ────────────────────────────────────────────────
|
|
|
|
(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)")))
|