Add fragment (#2)

* Add fragment

* Fix test

src/package.lisp

@@ -21,6 +21,9 @@
    ;;; exported as |time|, |map|
    :html
 
+   ;;; fragment
+   :<>
+
    ;;; user defined elements
    :define-element
    :*expand-user-element*

src/piccolo.lisp

@@ -18,6 +18,9 @@
   ((expand-to :initarg :expander
               :accessor user-element-expander)))
 
+(defclass fragment (element)
+  ())
+
 (defun make-builtin-element (&key tag attrs children)
   (make-instance 'builtin-element
                  :tag tag
@@ -44,6 +47,12 @@
            (element-attrs element)
            (element-children element)))
 
+(defun make-fragment (&key children)
+  (make-instance 'fragment
+                 :tag 'fragment
+                 :attrs (make-attrs :alist nil)
+                 :children (escape-children children)))
+
 (defstruct (attrs (:constructor %make-attrs))
   alist)
 
@@ -164,21 +173,22 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
 (defmacro! define-element (name (&rest args) &body body)
   (let ((%name (alexandria:symbolicate '% name)))
     `(progn
-       (defun ,%name (&rest ,g!attrs-and-children)
+       (defun ,%name (&rest attrs-and-children)
          (multiple-value-bind (,g!attrs ,g!children)
-             (split-attrs-and-children ,g!attrs-and-children)
+             (split-attrs-and-children attrs-and-children)
-           (let ((,g!element
+           (make-user-element 
-                   (make-user-element :tag (string-downcase ',name)
+            :tag (string-downcase ',name)
-                                      :attrs ,g!attrs
+            :attrs ,g!attrs
-                                      :children ,g!children)))
+            :children ,g!children
-             (setf (user-element-expander ,g!element)
+            :expander (lambda (tag attrs ,g!exp-children)
-                   (lambda (tag attrs children)
+                        (declare (ignorable tag attrs ,g!exp-children))
-                     (declare (ignorable tag attrs children))
+                        (let ((children (and ,g!exp-children
-                     (let ,(mapcar (lambda (arg)
+                                             (make-fragment :children ,g!exp-children))))
-                                     (list arg `(attr attrs (make-keyword ',arg))))
+                          (declare (ignorable children))
-                                   args)
+                          (let ,(mapcar (lambda (arg)
-                       (progn ,@body))))
+                                          (list arg `(attr attrs (make-keyword ',arg))))
-             ,g!element)))
+                                        args)
+                            (progn ,@body)))))))
        (defmacro ,name (&body attrs-and-children)
          `(,',%name ,@attrs-and-children)))))
 
@@ -189,6 +199,19 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
       (print-object (user-element-expand-to element) stream)
       (call-next-method)))
 
+(defun %<> (&rest children)
+  (make-fragment :children children))
+
+(defmacro <> (&body children)
+  `(%<> ,@children))
+
+(defmethod print-object ((element fragment) stream)
+  (if (element-children element)
+      (format stream (if (rest (element-children element))
+                         "~<~@{~a~^~:@_~}~:>"
+                         "~<~a~:>")
+              (element-children element))))
+
 (defun html-element-p (x)
   (and (symbolp x) (not (keywordp x)) (gethash (make-keyword x) *builtin-elements*)))
 
@@ -196,7 +219,7 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
   `(progn
      ,@(modify-first-leaves
         body
-        (html-element-p x)
+        (or (html-element-p x) (string= x '<>))
         (find-symbol (string-upcase x) :piccolo))))
 
 (defmethod element-string ((element element))

t/piccolo.lisp

@@ -261,19 +261,22 @@
 
     (is (eql nil (attrs-alist (element-attrs dog3))))
     (is (string= "dog" (second (element-children (user-element-expand-to dog3)))))
-    (is (string= "dog.png" (attr (first (element-children (user-element-expand-to dog3))) :src)))
+    (is (string= "dog.png" (attr (first (element-children
+                                         (first (element-children (user-element-expand-to dog3))))) :src)))
     (is (string= "dog.png" (attr (first (element-children dog3)) :src)))
 
     (is (equal '((:id . "dog") (:size . 10)) (attrs-alist (element-attrs dog4))))
     (is (= 10 (attr dog4 :size)))
     (is (string= "img" (element-tag (first (element-children dog4)))))
-    (is (string= "dog4.png" (attr (first (element-children (user-element-expand-to dog4))) :src)))
+    (is (string= "dog4.png" (attr (first (element-children
+                                          (first (element-children (user-element-expand-to dog4))))) :src)))
     (is (string= "woo" (second (element-children dog4))))
 
     (setf (attr dog4 :size) 16)
     (is (string= "big-dog" (attr (user-element-expand-to dog4) :class)))
     (setf (element-children dog4) (list dog1 dog2 dog3))
-    (is (equal (list dog1 dog2 dog3 "dog") (element-children (user-element-expand-to dog4))))))
+    (is (equal (list dog1 dog2 dog3) (element-children
+                                      (first (element-children (user-element-expand-to dog4))))))))
 
 (test user-element-html-generation
   (LET* ((dog1 (dog))