paku/hsx
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

Improve define-element

Browse source
This commit is contained in:
paku 2024-02-14 00:11:48 +09:00
parent 40df277aac
commit 1b617f7539
1 changed files with 23 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
src/elements.lisp
View file

@ -192,27 +192,29 @@
thead |time| title tr track u ul var video wbr) thead |time| title tr track u ul var video wbr)
(defmacro define-element (name (&rest args) &body body) (defmacro define-element (name (&rest args) &body body)
(alx:with-gensyms (attrs children exp-children) (let ((%name (alx:symbolicate '% name))
(let ((%name (alx:symbolicate '% name))) (attrs (gensym "attrs"))
`(progn (children (gensym "children"))
(defun ,%name (&rest attrs-and-children) (exp-children (gensym "exp-children")))
(multiple-value-bind (,attrs ,children) `(eval-when (:compile-toplevel :load-toplevel :execute)
(split-attrs-and-children attrs-and-children) (defun ,%name (&rest attrs-and-children)
(make-user-element (multiple-value-bind (,attrs ,children)
:tag (string-downcase ',name) (split-attrs-and-children attrs-and-children)
:attrs ,attrs (make-user-element
:children ,children :tag (string-downcase ',name)
:expander (lambda (tag attrs ,exp-children) :attrs ,attrs
(declare (ignorable tag attrs)) :children ,children
(let ((children (and ,exp-children :expander (lambda (tag attrs ,exp-children)
(make-fragment :children ,exp-children)))) (declare (ignorable tag attrs))
(declare (ignorable children)) (let ((children (and ,exp-children
(let ,(mapcar (lambda (arg) (make-fragment :children ,exp-children))))
(list arg `(attr attrs (alx:make-keyword ',arg)))) (declare (ignorable children))
args) (let ,(mapcar (lambda (arg)
(progn ,@body))))))) (list arg `(attr attrs (alx:make-keyword ',arg))))
(defmacro ,name (&body attrs-and-children) args)
`(,',%name ,@attrs-and-children)))))) (progn ,@body)))))))
(defmacro ,name (&body attrs-and-children)
`(,',%name ,@attrs-and-children)))))
(defun %<> (&rest attrs-and-children) (defun %<> (&rest attrs-and-children)
(multiple-value-bind (attrs children) (multiple-value-bind (attrs children)