Add group package
This commit is contained in:
parent
1a909aa994
commit
d4275d6967
5 changed files with 56 additions and 4 deletions
|
@ -7,10 +7,12 @@
|
||||||
"hsx-test/defhsx"
|
"hsx-test/defhsx"
|
||||||
"hsx-test/hsx"
|
"hsx-test/hsx"
|
||||||
"hsx-test/escaper"
|
"hsx-test/escaper"
|
||||||
"hsx-test/renderer")
|
"hsx-test/renderer"
|
||||||
|
"hsx-test/group")
|
||||||
:test-names ((#:element-test . #:hsx-test/element)
|
:test-names ((#:element-test . #:hsx-test/element)
|
||||||
(#:defhsx-test . #:hsx-test/defhsx)
|
(#:defhsx-test . #:hsx-test/defhsx)
|
||||||
(#:hsx-test . #:hsx-test/hsx)
|
(#:hsx-test . #:hsx-test/hsx)
|
||||||
(#:escaper-test . #:hsx-test/escaper)
|
(#:escaper-test . #:hsx-test/escaper)
|
||||||
(#:renderer-test . #:hsx-test/renderer))
|
(#:renderer-test . #:hsx-test/renderer)
|
||||||
:num-checks 37)
|
(#:group-test . #:hsx-test/group))
|
||||||
|
:num-checks 41)
|
||||||
|
|
|
@ -3,6 +3,8 @@
|
||||||
(:import-from #:hsx/escaper
|
(:import-from #:hsx/escaper
|
||||||
#:escape-html-attribute
|
#:escape-html-attribute
|
||||||
#:escape-html-text-content)
|
#:escape-html-text-content)
|
||||||
|
(:import-from #:hsx/group
|
||||||
|
#:self-closing-tag-p)
|
||||||
(:export #:element
|
(:export #:element
|
||||||
#:tag
|
#:tag
|
||||||
#:html-tag
|
#:html-tag
|
||||||
|
@ -84,7 +86,9 @@
|
||||||
children)
|
children)
|
||||||
type-str)
|
type-str)
|
||||||
(format stream
|
(format stream
|
||||||
"<~a~a></~a>"
|
(if (self-closing-tag-p type)
|
||||||
|
"<~a~a>"
|
||||||
|
"<~a~a></~a>")
|
||||||
type-str
|
type-str
|
||||||
(props->string props)
|
(props->string props)
|
||||||
type-str)))))
|
type-str)))))
|
||||||
|
|
26
src/group.lisp
Normal file
26
src/group.lisp
Normal file
|
@ -0,0 +1,26 @@
|
||||||
|
(defpackage #:hsx/group
|
||||||
|
(:use #:cl)
|
||||||
|
(:import-from #:alexandria
|
||||||
|
#:make-keyword
|
||||||
|
#:symbolicate)
|
||||||
|
(:export #:defgroup
|
||||||
|
#:self-closing-tag-p))
|
||||||
|
(in-package #:hsx/group)
|
||||||
|
|
||||||
|
(defun make-keyword-hash-table (symbols)
|
||||||
|
(let ((ht (make-hash-table)))
|
||||||
|
(mapcar (lambda (sym)
|
||||||
|
(setf (gethash (make-keyword sym) ht) t))
|
||||||
|
symbols)
|
||||||
|
ht))
|
||||||
|
|
||||||
|
(defmacro defgroup (name &body symbols)
|
||||||
|
(let ((p-name (symbolicate '* name '*)))
|
||||||
|
`(progn
|
||||||
|
(defparameter ,p-name (make-keyword-hash-table ',symbols))
|
||||||
|
(defun ,(symbolicate name '-p) (keyword)
|
||||||
|
(gethash keyword ,p-name)))))
|
||||||
|
|
||||||
|
(defgroup self-closing-tag
|
||||||
|
area base br col embed hr img input keygen
|
||||||
|
link meta param source track wbr)
|
16
tests/group.lisp
Normal file
16
tests/group.lisp
Normal file
|
@ -0,0 +1,16 @@
|
||||||
|
(defpackage #:hsx-test/group
|
||||||
|
(:use #:cl
|
||||||
|
#:fiveam
|
||||||
|
#:hsx/group))
|
||||||
|
(in-package #:hsx-test/group)
|
||||||
|
|
||||||
|
(def-suite group-test)
|
||||||
|
(in-suite group-test)
|
||||||
|
|
||||||
|
(defgroup fruit
|
||||||
|
apple banana orange)
|
||||||
|
|
||||||
|
(test defgroup
|
||||||
|
(is (hash-table-p *fruit*))
|
||||||
|
(is (fruit-p :apple))
|
||||||
|
(is (not (fruit-p :tomato))))
|
|
@ -48,6 +48,10 @@
|
||||||
"foo"
|
"foo"
|
||||||
(span "bar"))))))
|
(span "bar"))))))
|
||||||
|
|
||||||
|
(test self-closing-tag
|
||||||
|
(is (string= "<img src=\"/background.png\">"
|
||||||
|
(render (img :src "/background.png")))))
|
||||||
|
|
||||||
(test fragment
|
(test fragment
|
||||||
(let ((frg (<>
|
(let ((frg (<>
|
||||||
(li "bar")
|
(li "bar")
|
||||||
|
|
Loading…
Reference in a new issue