Refactor and format

src/elements.lisp

@@ -38,30 +38,35 @@
 
    ;;; the h macro for avoiding import all builtin html element functions
    #:h
+
+   ;;; helper for generate html string
    #:element-string
    #:elem-str))
 (in-package #:piccolo/elements)
 
+;;; classes
+
 (defclass element ()
-  ((tag :initarg :tag
+  ((tag      :initarg  :tag
-        :accessor element-tag)
+             :accessor element-tag)
-   (attrs :initarg :attrs
+   (attrs    :initarg  :attrs
-          :accessor element-attrs)
+             :accessor element-attrs)
-   (children :initarg :children
+   (children :initarg  :children
              :accessor element-children)))
 
 (defclass builtin-element (element) ())
 
 (defclass builtin-element-with-prefix (builtin-element)
-  ((prefix :initarg :prefix
+  ((prefix :initarg  :prefix
            :accessor element-prefix)))
 
 (defclass user-element (element)
   ((expand-to :initarg :expander
               :accessor user-element-expander)))
 
-(defclass fragment (element)
+(defclass fragment (element) ())
-  ())
+
+;;; constructors
 
 (defun make-builtin-element (&key tag attrs children)
   (make-instance 'builtin-element
@@ -95,6 +100,8 @@
                  :attrs (make-attrs :alist nil)
                  :children (util:escape-children children)))
 
+;;; attributes
+
 (defstruct (attrs (:constructor %make-attrs))
   alist)
 
@@ -121,7 +128,7 @@
 (defmethod attr ((element element) key)
   (attr (element-attrs element) key))
 
-(defvar *builtin-elements* (make-hash-table))
+;;; elements
 
 (defun split-attrs-and-children (attrs-and-children)
   (cond
@@ -147,6 +154,9 @@
     (t
      (values (make-attrs :alist nil) (lol:flatten attrs-and-children)))))
 
+(defparameter *builtin-elements* (make-hash-table))
+(setf (gethash :html *builtin-elements*) t)
+
 (defun %html (&rest attrs-and-children)
   (multiple-value-bind (attrs children)
       (split-attrs-and-children attrs-and-children)
@@ -158,8 +168,6 @@
 (defmacro html (&body attrs-and-children)
   `(%html ,@attrs-and-children))
 
-(setf (gethash :html *builtin-elements*) t)
-
 (defmacro define-builtin-element (element-name)
   (let ((%element-name (alx:symbolicate '% element-name)))
     `(progn
@@ -191,32 +199,61 @@
   style sub summary sup svg table tbody td template textarea tfoot th
   thead |time| title tr track u ul var video wbr)
 
+(lol:defmacro! define-element (name (&rest args) &body body)
+  (let ((%name (alx:symbolicate '% name)))
+    `(progn
+       (defun ,%name (&rest attrs-and-children)
+         (multiple-value-bind (,g!attrs ,g!children)
+             (split-attrs-and-children attrs-and-children)
+           (make-user-element 
+            :tag (string-downcase ',name)
+            :attrs ,g!attrs
+            :children ,g!children
+            :expander (lambda (tag attrs ,g!exp-children)
+                        (declare (ignorable tag attrs))
+                        (let ((children (and ,g!exp-children
+                                             (make-fragment :children ,g!exp-children))))
+                          (declare (ignorable children))
+                          (let ,(mapcar (lambda (arg)
+                                          (list arg `(attr attrs (alx:make-keyword ',arg))))
+                                        args)
+                            (progn ,@body)))))))
+       (defmacro ,name (&body attrs-and-children)
+         `(,',%name ,@attrs-and-children)))))
+
+(defun %<> (&rest children)
+  (make-fragment :children children))
+
+(defmacro <> (&body children)
+  `(%<> ,@children))
+
+;;; print-object
+
 (defparameter *boolean-attrs*
   '(allowfullscreen async autofocus autoplay checked controls default defer
     disabled formnovalidate inert ismap itemscope loop multiple muted nomodule
     novalidate open playsinline readonly required reversed selected))
 
-(defmethod print-object ((attrs attrs) stream)
-  (if (attrs-alist attrs)
-      (let ((alist (attrs-alist attrs)))
-        (dolist (pair alist)
-          (let ((key (car pair))
-                (value (cdr pair)))
-            (if (member key *boolean-attrs* :test #'string=)
-                (when value
-                  (format stream " ~a" (string-downcase key)))
-                (format stream " ~a=~s" (string-downcase key) value)))))
-      (format stream "")))
-
 (defparameter *self-closing-tags*
   '(area base br col embed hr img input keygen
     link meta param source track wbr))
 
+(defparameter *expand-user-element* t)
+
 (defun self-closing-p (tag)
   (member (make-symbol (string-upcase tag))
           *self-closing-tags*
           :test #'string=))
 
+(defmethod print-object ((attrs attrs) stream)
+  (loop 
+    :for (k . v) :in (attrs-alist attrs)
+    :do (format stream (if (member k *boolean-attrs* :test #'string=)
+                           "~@[ ~a~]"
+                           " ~a=~s")
+                (string-downcase k)
+                v)))
+
 (defmethod print-object ((element element) stream)
   (if (element-children element)
       (format stream (if (rest (element-children element))
@@ -237,41 +274,11 @@
   (format stream "~a~%" (element-prefix element))
   (call-next-method))
 
-(lol:defmacro! define-element (name (&rest args) &body body)
-  (let ((%name (alx:symbolicate '% name)))
-    `(progn
-       (defun ,%name (&rest attrs-and-children)
-         (multiple-value-bind (,g!attrs ,g!children)
-             (split-attrs-and-children attrs-and-children)
-           (make-user-element 
-            :tag (string-downcase ',name)
-            :attrs ,g!attrs
-            :children ,g!children
-            :expander (lambda (tag attrs ,g!exp-children)
-                        (declare (ignorable tag attrs ,g!exp-children))
-                        (let ((children (and ,g!exp-children
-                                             (make-fragment :children ,g!exp-children))))
-                          (declare (ignorable children))
-                          (let ,(mapcar (lambda (arg)
-                                          (list arg `(attr attrs (alx:make-keyword ',arg))))
-                                        args)
-                            (progn ,@body)))))))
-       (defmacro ,name (&body attrs-and-children)
-         `(,',%name ,@attrs-and-children)))))
-
-(defvar *expand-user-element* t)
-
 (defmethod print-object ((element user-element) stream)
   (if *expand-user-element*
       (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))
@@ -279,6 +286,8 @@
                          "~<~a~:>")
               (element-children element))))
 
+;;; h macro
+
 (defun html-element-p (node)
   (and (symbolp node)
        (not (keywordp node))
@@ -295,6 +304,8 @@
           (declare (ignorable node))
           (find-symbol (string-upcase node) :piccolo)))))
 
+;;; helper for generate html string
+
 (defmethod element-string ((element element))
   (with-output-to-string (s)
     (write element :stream s)))

src/util.lisp

@@ -3,7 +3,6 @@
   (:export
    ;;; list utility
    #:plist-alist
-   #:alist-plist
 
    ;;; escape utility
    #:*escape-html*
@@ -22,13 +21,7 @@
   (loop for (k v) on plist by #'cddr
         collect (cons k v)))
 
-(defun alist-plist (alist)
+(defparameter *escape-html* :utf8
-  (mapcan (lambda (kv)
-            (list (string-downcase (car kv))
-                  (cdr kv)))
-          alist))
-
-(defvar *escape-html* :utf8
   "Specify the escape option when generate html, can be :UTF8, :ASCII, :ATTR or NIL.
 If :UTF8, escape only #\<, #\> and #\& in body, and \" in attribute keys. #\' will
 in attribute keys will not be escaped since piccolo will always use double quote for