Add define-group macro

This commit is contained in:
paku 2024-02-10 12:43:22 +09:00
parent 7e252406ec
commit 1daa23bc31

View file

@ -9,30 +9,39 @@
;;; print-object ;;; print-object
(defparameter *boolean-attrs* (defun symbols-hash-table (symbols)
'(allowfullscreen async autofocus autoplay checked controls default defer (let ((ht (make-hash-table)))
disabled formnovalidate inert ismap itemscope loop multiple muted nomodule (mapcar (lambda (sym)
novalidate open playsinline readonly required reversed selected)) (setf (gethash (alx:make-keyword sym) ht) t))
symbols)
ht))
(defparameter *self-closing-tags* (defmacro define-group (name &body symbols)
'(area base br col embed hr img input keygen (alx:with-gensyms (ht)
link meta param source track wbr)) `(progn
(let ((,ht (symbols-hash-table ',symbols)))
(defun ,(alx:symbolicate name '-p) (symbol)
(gethash (alx:make-keyword (string-upcase symbol)) ,ht))))))
(define-group boolean-attr-key
allowfullscreen async autofocus autoplay checked controls default defer
disabled formnovalidate inert ismap itemscope loop multiple muted nomodule
novalidate open playsinline readonly required reversed selected)
(define-group self-closing-tag
area base br col embed hr img input keygen
link meta param source track wbr)
(defparameter *expand-user-element* t) (defparameter *expand-user-element* t)
(defun self-closing-p (tag)
(member (make-symbol (string-upcase tag))
*self-closing-tags*
:test #'string=))
(defmethod print-object ((attrs elm:attrs) stream) (defmethod print-object ((attrs elm:attrs) stream)
(loop (loop
:for (k . v) :in (elm:attrs-alist attrs) :for (key . value) :in (elm:attrs-alist attrs)
:do (format stream (if (member k *boolean-attrs* :test #'string=) :do (format stream (if (boolean-attr-key-p key)
"~@[ ~a~]" "~@[ ~a~]"
" ~a=~s") " ~a=~s")
(string-downcase k) (string-downcase key)
v))) value)))
(defmethod print-object ((element elm:element) stream) (defmethod print-object ((element elm:element) stream)
(if (elm:element-children element) (if (elm:element-children element)
@ -43,7 +52,7 @@
(elm:element-attrs element) (elm:element-attrs element)
(elm:element-children element) (elm:element-children element)
(elm:element-tag element)) (elm:element-tag element))
(format stream (if (self-closing-p (elm:element-tag element)) (format stream (if (self-closing-tag-p (elm:element-tag element))
"<~a~a>" "<~a~a>"
"<~a~a></~a>") "<~a~a></~a>")
(elm:element-tag element) (elm:element-tag element)