Improve rendering

This commit is contained in:
paku 2024-06-07 10:07:37 +09:00
parent 87bc1e12f2
commit 8f14d58aa7

View file

@ -71,31 +71,27 @@
(with-accessors ((type element-type) (with-accessors ((type element-type)
(props element-props) (props element-props)
(children element-children)) element (children element-children)) element
(let ((type-str (string-downcase type))) (let ((type-str (string-downcase type))
(props-str (render-props props)))
(if children (if children
(format stream (format stream
(if (and (null (rest children)) (if (or (rest children)
(typep (first children) 'string)) (typep (first children) 'element))
"~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>" "~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>") "~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>")
type-str type-str
(props->string props) props-str
(mapcar (lambda (child) (escape-children type children)
(if (and (not (non-escaping-tag-p type))
(stringp child))
(escape-html-text-content child)
child))
children)
type-str) type-str)
(format stream (format stream
(if (self-closing-tag-p type) (if (self-closing-tag-p type)
"<~a~a>" "<~a~a>"
"<~a~a></~a>") "<~a~a></~a>")
type-str type-str
(props->string props) props-str
type-str))))) type-str)))))
(defun props->string (props) (defun render-props (props)
(with-output-to-string (stream) (with-output-to-string (stream)
(loop (loop
:for (key value) :on props :by #'cddr :for (key value) :on props :by #'cddr
@ -109,6 +105,14 @@
key-str key-str
(escape-html-attribute value))))))) (escape-html-attribute value)))))))
(defun escape-children (type children)
(mapcar (lambda (child)
(if (and (not (non-escaping-tag-p type))
(stringp child))
(escape-html-text-content child)
child))
children))
(defmethod print-object ((element html-tag) stream) (defmethod print-object ((element html-tag) stream)
(format stream "<!DOCTYPE html>~%") (format stream "<!DOCTYPE html>~%")
(call-next-method)) (call-next-method))