Add raw-fragment

This commit is contained in:
Akira Tempaku 2025-03-28 12:47:37 +09:00
commit aa1efe72cd
Signed by: paku
GPG key ID: 5B4E8402BCC50607
5 changed files with 31 additions and 66 deletions

View file

@ -20,4 +20,5 @@
noscript object ol optgroup option output p param picture pre progress
q rp rt ruby s samp script section select small source span strong
style sub summary sup svg table tbody td template textarea tfoot th
thead |time| title tr track u ul var video wbr <>)
thead |time| title tr track u ul var video wbr
<> raw!)

View file

@ -3,15 +3,14 @@
(:import-from #:str
#:collapse-whitespaces)
(:import-from #:hsx/utils
#:defgroup
#:escape-html-attribute
#:escape-html-text-content)
#:escape-html-text-content
#:escape-html-attribute)
(:export #:element
#:tag
#:html-tag
#:self-closing-tag
#:non-escaping-tag
#:fragment
#:raw-fragment
#:component
#:create-element
#:element-type
@ -23,12 +22,10 @@
;;; tag group definitions
(defgroup self-closing-tag
area base br col embed hr img input
link meta param source track wbr)
(defgroup non-escaping-tag
script style)
(deftype self-closing-tag-sym ()
'(member
:area :base :br :col :embed :hr :img :input
:link :meta :param :source :track :wbr))
;;;; class definitions
@ -49,10 +46,10 @@
(defclass self-closing-tag (tag) ())
(defclass non-escaping-tag (tag) ())
(defclass fragment (tag) ())
(defclass raw-fragment (fragment) ())
(defclass component (element) ())
;;;; factory
@ -61,9 +58,9 @@
(make-instance
(cond ((functionp type) 'component)
((eq type :<>) 'fragment)
((eq type :raw!) 'raw-fragment)
((eq type :html) 'html-tag)
((self-closing-tag-p type) 'self-closing-tag)
((non-escaping-tag-p type) 'non-escaping-tag)
((typep type 'self-closing-tag-sym) 'self-closing-tag)
((keywordp type) 'tag)
(t (error "element-type must be a keyword or a function.")))
:type type
@ -95,7 +92,7 @@
(if children
(format stream
(if (or (rest children)
(typep (first children) 'element))
(typep (first children) '(and element (not fragment))))
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
"~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>")
type
@ -148,7 +145,7 @@
child))
(element-children element)))
(defmethod render-children ((element non-escaping-tag))
(defmethod render-children ((element raw-fragment))
(element-children element))
(defmethod expand-component ((element component))

View file

@ -5,8 +5,7 @@
#:make-keyword
#:symbolicate)
(:export #:escape-html-attribute
#:escape-html-text-content
#:defgroup))
#:escape-html-text-content))
(in-package #:hsx/utils)
(defparameter *text-content-escape-map*
@ -41,18 +40,3 @@
(defun escape-html-attribute (str)
(escape-string str *attribute-escape-map*))
(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 ((param-name (symbolicate '* name '*))
(pred-name (symbolicate name '-p)))
`(progn
(defparameter ,param-name (make-keyword-hash-table ',symbols))
(defun ,pred-name (keyword)
(gethash keyword ,param-name)))))