You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
95 lines
4.6 KiB
Scheme
95 lines
4.6 KiB
Scheme
1 week ago
|
(cond-expand
|
||
|
|
(local
|
||
|
|
(load-relative "../html-widgets.scm")
|
||
|
|
(import html-widgets))
|
||
|
|
(chicken-5
|
||
|
|
(import html-widgets)))
|
||
|
|
|
||
|
|
(import test (chicken sort) srfi-13)
|
||
|
|
|
||
|
|
(test "Ensure (widgets) is initialized correctly" (widgets) '())
|
||
|
|
|
||
|
|
(test-assert "Define a simple widget"
|
||
|
|
(define-widget (Simple-Button ())
|
||
|
|
`(button "A button")))
|
||
|
|
|
||
|
|
(test "SXML for simple button" '(button "A button") (widget->sxml-and-css '(Simple-Button)))
|
||
|
|
(test "CSS for simple button" '() (receive (_ css) (widget->sxml-and-css '(Simple-Button)) css))
|
||
|
|
|
||
|
|
(test-assert "Define a more complex widget"
|
||
|
|
(define-widget (Fancy-Button ((color "blue")))
|
||
|
|
`(button (@ (style ((background-color ,color)))) "A Fancy button")))
|
||
|
|
|
||
|
|
(test "SXML for fancy button using default color arg" '(button (@ (class "x6a6e56dd4762d830ee54fc65cecabd58")) "A Fancy button") (widget->sxml-and-css '(Fancy-Button)))
|
||
|
|
(test "CSS for fancy button using default color arg" '(".x6a6e56dd4762d830ee54fc65cecabd58 { background-color: blue }") (receive (_ css) (widget->sxml-and-css '(Fancy-Button)) css))
|
||
|
|
(test "SXML for fancy button passing in color arg" '(button (@ (class "xa3ed2da9387d3e404378fa00f4560b41")) "A Fancy button") (widget->sxml-and-css '(Fancy-Button (@ (color "red")))))
|
||
|
|
(test "CSS for fancy button passing in color arg" '(".xa3ed2da9387d3e404378fa00f4560b41 { background-color: red }") (receive (_ css) (widget->sxml-and-css '(Fancy-Button (@ (color "red")))) css))
|
||
|
|
(test "In SXML: CSS class being re-used" '(div (button (@ (class "x6a6e56dd4762d830ee54fc65cecabd58")) "A Fancy button")
|
||
|
|
(button (@ (class "x6a6e56dd4762d830ee54fc65cecabd58")) "A Fancy button"))
|
||
|
|
(widget->sxml-and-css '(div (Fancy-Button) (Fancy-Button))))
|
||
|
|
(test "In CSS: CSS class being re-used" '(".x6a6e56dd4762d830ee54fc65cecabd58 { background-color: blue }") (receive (_ css) (widget->sxml-and-css '(div (Fancy-Button) (Fancy-Button))) css))
|
||
|
|
|
||
|
|
(test-assert "Define a widget that returns another widget"
|
||
|
|
(define-widget (Trans-Button)
|
||
|
|
`(Simple-Button)))
|
||
|
|
|
||
|
|
(test "SXML for widget that returns another widget" '(button "A button") (widget->sxml-and-css '(Trans-Button)))
|
||
|
|
(test "CSS for widget that returns another widget" '() (receive (_ css) (widget->sxml-and-css '(Trans-Button)) css))
|
||
|
|
|
||
|
|
(test-assert "Define a widget that specifies a content var"
|
||
|
|
(define-widget (Box () contents)
|
||
|
|
`(div ,@contents)))
|
||
|
|
|
||
|
|
(test "SXML for widget with contents" '(div (span "body")) (widget->sxml-and-css '(Box (span "body"))))
|
||
|
|
(test "CSS for widget with contents" '() (receive (_ css) (widget->sxml-and-css '(Box (span "body"))) css))
|
||
|
|
|
||
|
|
(test-assert "Define a widget that specifies args and content var"
|
||
|
|
(define-widget (Box2 ((use-article #f)) contents)
|
||
|
|
(if use-article
|
||
|
|
`(article ,@contents)
|
||
|
|
`(div ,@contents))))
|
||
|
|
|
||
|
|
(test "SXML for widget with args and contents (use default)" '(div (span "body")) (widget->sxml-and-css '(Box2 (span "body"))))
|
||
|
|
(test "SXML for widget with args and contents (pass arg)" '(article (span "body")) (widget->sxml-and-css '(Box2 (@ (use-article #t)) (span "body"))))
|
||
|
|
|
||
|
|
(test "SXML for complex widgets with re-used classes"
|
||
|
|
'(div (span "body")
|
||
|
|
(button (@ (class "x6a6e56dd4762d830ee54fc65cecabd58")) "A Fancy button")
|
||
|
|
(button (@ (class "x6a6e56dd4762d830ee54fc65cecabd58")) "A Fancy button")
|
||
|
|
(button (@ (class "xa3ed2da9387d3e404378fa00f4560b41")) "A Fancy button"))
|
||
|
|
(widget->sxml-and-css
|
||
|
|
'(Box
|
||
|
|
(span "body")
|
||
|
|
(Fancy-Button)
|
||
|
|
(Fancy-Button)
|
||
|
|
(Fancy-Button (@ (color "red"))))))
|
||
|
|
|
||
|
|
(test "CSS for complex widgets with re-used classes"
|
||
|
|
'(".x6a6e56dd4762d830ee54fc65cecabd58 { background-color: blue }"
|
||
|
|
".xa3ed2da9387d3e404378fa00f4560b41 { background-color: red }")
|
||
|
|
(receive (_ css)
|
||
|
|
(widget->sxml-and-css
|
||
|
|
'(Box
|
||
|
|
(span "body")
|
||
|
|
(Fancy-Button)
|
||
|
|
(Fancy-Button)
|
||
|
|
(Fancy-Button (@ (color "red")))))
|
||
|
|
(sort css string<))) ;; the classes can be returned in any order so sort them to make it easier to test
|
||
|
|
|
||
|
|
(test-assert "Define a widget with root and query styles"
|
||
|
|
(define-widget (Styles () contents)
|
||
|
|
`(div (@ (style ((color "red")
|
||
|
|
(@container "(max-width: 400px)"
|
||
|
|
(color "blue")))))
|
||
|
|
,@contents)))
|
||
|
|
|
||
|
|
(test "CSS for widget with root and query styles"
|
||
|
|
'(".x73706d193dfd4d1d9bba528027060dfc { color: red } @container (max-width: 400px) { .x73706d193dfd4d1d9bba528027060dfc { color: blue } }")
|
||
|
|
(receive (_ css)
|
||
|
|
(widget->sxml-and-css
|
||
|
|
'(Styles "contents"))
|
||
|
|
(sort css string<)))
|
||
|
|
|
||
|
|
|
||
|
|
(test-exit)
|