parent
a096d0be7b
commit
88d87a5920
3 changed files with 47 additions and 18 deletions
|
@ -21,6 +21,9 @@
|
|||
;;; exported as |time|, |map|
|
||||
:html
|
||||
|
||||
;;; fragment
|
||||
:<>
|
||||
|
||||
;;; user defined elements
|
||||
:define-element
|
||||
:*expand-user-element*
|
||||
|
|
|
@ -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)
|
||||
(let ((,g!element
|
||||
(make-user-element :tag (string-downcase ',name)
|
||||
(split-attrs-and-children attrs-and-children)
|
||||
(make-user-element
|
||||
:tag (string-downcase ',name)
|
||||
:attrs ,g!attrs
|
||||
:children ,g!children)))
|
||||
(setf (user-element-expander ,g!element)
|
||||
(lambda (tag attrs children)
|
||||
(declare (ignorable tag attrs children))
|
||||
: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 (make-keyword ',arg))))
|
||||
args)
|
||||
(progn ,@body))))
|
||||
,g!element)))
|
||||
(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))
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in a new issue