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%.
163 lines
6.2 KiB
Common Lisp
163 lines
6.2 KiB
Common Lisp
(defpackage :cl-tty-box-test
|
|
(:use :cl :fiveam :cl-tty.backend :cl-tty.layout :cl-tty.box)
|
|
(:export #:run-tests))
|
|
(in-package :cl-tty-box-test)
|
|
|
|
(def-suite box-suite :description "Box renderable tests")
|
|
(in-suite box-suite)
|
|
|
|
(defun run-tests ()
|
|
(let ((result (run 'box-suite)))
|
|
(fiveam:explain! result)
|
|
(uiop:quit 0)))
|
|
|
|
(defun make-capturing-backend ()
|
|
(let* ((s (make-string-output-stream))
|
|
(b (make-modern-backend :output-stream s)))
|
|
(values b s)))
|
|
|
|
(test box-creates-with-defaults
|
|
"A box created with no arguments has reasonable defaults"
|
|
(let ((b (make-box)))
|
|
(is (typep b 'box))
|
|
(is (typep (box-layout-node b) 'layout-node))))
|
|
|
|
(test box-renders-border
|
|
"A box with border draws border characters"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :border-style :single :width 10 :height 5)))
|
|
(compute-layout (box-layout-node bx) 10 5)
|
|
(render-box bx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "┌" out) "top-left corner")
|
|
(is (search "┐" out) "top-right corner")
|
|
(is (search "└" out) "bottom-left corner")
|
|
(is (search "┘" out) "bottom-right corner")))))
|
|
|
|
(test box-renders-background
|
|
"A box with background color fills interior"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :bg :red :width 5 :height 3)))
|
|
(compute-layout (box-layout-node bx) 5 3)
|
|
(render-box bx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "┌" out) "border with background")
|
|
(is (search "41m" out) "SGR background for red")))))
|
|
|
|
(test box-renders-title
|
|
"A box with title renders the title text"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :title "Hello" :width 12 :height 3)))
|
|
(compute-layout (box-layout-node bx) 12 3)
|
|
(render-box bx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "Hello" out) "title text should appear")))))
|
|
|
|
(test box-without-border
|
|
"A box with border-style nil draws no border"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :border-style nil :bg :red :width 5 :height 3)))
|
|
(compute-layout (box-layout-node bx) 5 3)
|
|
(render-box bx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "41m" out) "background still renders")
|
|
(is-false (search "┌" out) "no top-left corner")))))
|
|
|
|
(test box-zero-size
|
|
"A box with any zero dimension renders nothing"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :border-style :single :width 0 :height 0)))
|
|
(compute-layout (box-layout-node bx) 0 0)
|
|
(render-box bx b)
|
|
(is (string= (get-output-stream-string s) "")
|
|
"zero-size box produces no output"))))
|
|
|
|
(test box-single-column
|
|
"A box with width 1 renders nothing (needs min 2 for border)"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :border-style :single :width 1 :height 5)))
|
|
(compute-layout (box-layout-node bx) 1 5)
|
|
(render-box bx b)
|
|
(is (string= (get-output-stream-string s) "")
|
|
"width=1 box renders nothing"))))
|
|
|
|
(test box-minimum-size
|
|
"A box with minimum non-zero size still renders"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :border-style :single :width 2 :height 2)))
|
|
(compute-layout (box-layout-node bx) 2 2)
|
|
(render-box bx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "┌" out) "2x2 box still has borders")))))
|
|
|
|
(test text-creates-with-defaults
|
|
"A text created with no arguments has reasonable defaults"
|
|
(let ((txt (make-text "")))
|
|
(is (typep txt 'text))
|
|
(is (typep (text-layout-node txt) 'layout-node))))
|
|
|
|
(test text-renders-content
|
|
"A text renders its content at position"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((tx (make-text "Hello" :width 10 :height 1)))
|
|
(compute-layout (text-layout-node tx) 10 1)
|
|
(render-text tx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "Hello" out) "content should appear")))))
|
|
|
|
(test text-empty-string
|
|
"Empty text produces no output"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((tx (make-text "" :width 10 :height 1)))
|
|
(compute-layout (text-layout-node tx) 10 1)
|
|
(render-text tx b)
|
|
(is (string= (get-output-stream-string s) "")
|
|
"empty string produces no output"))))
|
|
|
|
(test text-truncates-when-no-wrap
|
|
"Text with wrap-mode :none truncates at width"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((tx (make-text "Hello World" :width 5 :height 1
|
|
:wrap-mode :none)))
|
|
(compute-layout (text-layout-node tx) 5 1)
|
|
(render-text tx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "Hello" out) "truncated to first 5 chars")))))
|
|
|
|
(test text-word-wraps
|
|
"Text with wrap-mode :word wraps at word boundaries"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((tx (make-text "Hello brave new world" :width 6 :height 3)))
|
|
(compute-layout (text-layout-node tx) 6 3)
|
|
(render-text tx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "Hello" out) "first line")
|
|
(is (search "brave" out) "second line")
|
|
(is (search "new" out) "third line")))))
|
|
|
|
(test text-word-wrap-single-word
|
|
"A word longer than width is hard-broken at max-width"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((tx (make-text "Hello" :width 3 :height 3)))
|
|
(compute-layout (text-layout-node tx) 3 3)
|
|
(render-text tx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "Hel" out) "first chunk is Hel")
|
|
(is (search "lo" out) "second chunk is lo")))))
|
|
|
|
(test span-creates-with-attributes
|
|
"A span has text and optional style attributes"
|
|
(let ((s (span "bold text" :bold t)))
|
|
(is (string= (span-text s) "bold text"))
|
|
(is-true (span-bold s))
|
|
(is-false (span-italic s))))
|
|
|
|
(test make-text-with-spans
|
|
"Text with spans stores span objects"
|
|
(let* ((sp (list (span "Hello" :bold t)
|
|
(span "World" :italic t)))
|
|
(tx (make-text "" :spans sp)))
|
|
(is (= (length (text-spans tx)) 2))
|
|
(is (string= (span-text (elt (text-spans tx) 0)) "Hello"))
|
|
(is-true (span-bold (elt (text-spans tx) 0)))))
|