Add group package

This commit is contained in:
paku 2024-06-01 20:14:17 +09:00
parent 1a909aa994
commit d4275d6967
5 changed files with 56 additions and 4 deletions

View file

@ -7,10 +7,12 @@
"hsx-test/defhsx"
"hsx-test/hsx"
"hsx-test/escaper"
"hsx-test/renderer")
"hsx-test/renderer"
"hsx-test/group")
:test-names ((#:element-test . #:hsx-test/element)
(#:defhsx-test . #:hsx-test/defhsx)
(#:hsx-test . #:hsx-test/hsx)
(#:escaper-test . #:hsx-test/escaper)
(#:renderer-test . #:hsx-test/renderer))
:num-checks 37)
(#:renderer-test . #:hsx-test/renderer)
(#:group-test . #:hsx-test/group))
:num-checks 41)

View file

@ -3,6 +3,8 @@
(:import-from #:hsx/escaper
#:escape-html-attribute
#:escape-html-text-content)
(:import-from #:hsx/group
#:self-closing-tag-p)
(:export #:element
#:tag
#:html-tag
@ -84,7 +86,9 @@
children)
type-str)
(format stream
"<~a~a></~a>"
(if (self-closing-tag-p type)
"<~a~a>"
"<~a~a></~a>")
type-str
(props->string props)
type-str)))))

26
src/group.lisp Normal file
View 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
View 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))))

View file

@ -48,6 +48,10 @@
"foo"
(span "bar"))))))
(test self-closing-tag
(is (string= "<img src=\"/background.png\">"
(render (img :src "/background.png")))))
(test fragment
(let ((frg (<>
(li "bar")