define-element
This commit is contained in:
parent
d0eefc4f2f
commit
374a1e8d31
2 changed files with 32 additions and 15 deletions
|
@ -8,7 +8,10 @@
|
||||||
:alist-plist)
|
:alist-plist)
|
||||||
(:import-from :let-over-lambda
|
(:import-from :let-over-lambda
|
||||||
:defmacro!
|
:defmacro!
|
||||||
:mkstr)
|
:mkstr
|
||||||
|
:flatten)
|
||||||
|
(:import-from :alexandria
|
||||||
|
:make-keyword)
|
||||||
(:export
|
(:export
|
||||||
;; all html5 elements, e.g. div, nav, media, export in code
|
;; all html5 elements, e.g. div, nav, media, export in code
|
||||||
;; except <time> and <map> conflicts with cl symbol, are defined and exported as |time|, |map|
|
;; except <time> and <map> conflicts with cl symbol, are defined and exported as |time|, |map|
|
||||||
|
@ -20,29 +23,29 @@
|
||||||
|
|
||||||
(defstruct attrs alist)
|
(defstruct attrs alist)
|
||||||
|
|
||||||
(defun split-attrs-and-chilren (attrs-and-children)
|
(defun split-attrs-and-children (attrs-and-children)
|
||||||
(cond
|
(cond
|
||||||
((attrs-p (first attrs-and-children))
|
((attrs-p (first attrs-and-children))
|
||||||
(values (first attrs-and-children) (rest attrs-and-children)))
|
(values (first attrs-and-children) (flatten (rest attrs-and-children))))
|
||||||
((alistp (first attrs-and-children))
|
((alistp (first attrs-and-children))
|
||||||
(values (make-attrs :alist (first attrs-and-children))
|
(values (make-attrs :alist (first attrs-and-children))
|
||||||
(rest attrs-and-children)))
|
(flatten (rest attrs-and-children))))
|
||||||
((listp (first attrs-and-children))
|
((listp (first attrs-and-children))
|
||||||
(values (make-attrs :alist (plist-alist (first attrs-and-children)))
|
(values (make-attrs :alist (plist-alist (first attrs-and-children)))
|
||||||
(rest attrs-and-children)))
|
(flatten (rest attrs-and-children))))
|
||||||
((hash-table-p (first attrs-and-children))
|
((hash-table-p (first attrs-and-children))
|
||||||
(values (make-attrs :alist (hash-alist (first attrs-and-children)))
|
(values (make-attrs :alist (hash-alist (first attrs-and-children)))
|
||||||
(rest attrs-and-children)))
|
(flatten (rest attrs-and-children))))
|
||||||
((keywordp (first attrs-and-children))
|
((keywordp (first attrs-and-children))
|
||||||
(loop for thing on attrs-and-children by #'cddr
|
(loop for thing on attrs-and-children by #'cddr
|
||||||
for (k v) = thing
|
for (k v) = thing
|
||||||
when (keywordp k)
|
when (and (keywordp k) v)
|
||||||
collect (cons k v) into attrs
|
collect (cons k v) into attrs
|
||||||
when (not (keywordp k))
|
when (not (keywordp k))
|
||||||
return (values (make-attrs :alist attrs) thing)
|
return (values (make-attrs :alist attrs) (flatten thing))
|
||||||
finally (return (values (make-attrs :alist attrs) nil))))
|
finally (return (values (make-attrs :alist attrs) nil))))
|
||||||
(t
|
(t
|
||||||
(values (make-attrs :alist nil) attrs-and-children))))
|
(values (make-attrs :alist nil) (flatten attrs-and-children)))))
|
||||||
|
|
||||||
(defun plist-alist (plist)
|
(defun plist-alist (plist)
|
||||||
(loop for (k v) on plist by #'cddr
|
(loop for (k v) on plist by #'cddr
|
||||||
|
@ -56,8 +59,10 @@
|
||||||
|
|
||||||
(defmacro define-builtin-element (element-name)
|
(defmacro define-builtin-element (element-name)
|
||||||
`(defun ,element-name (&rest attrs-and-children)
|
`(defun ,element-name (&rest attrs-and-children)
|
||||||
(multiple-value-bind (attrs children) (split-attrs-and-chilren attrs-and-children)
|
(multiple-value-bind (attrs children)
|
||||||
(make-element :tag (string-downcase (mkstr ',element-name)) :attrs attrs :children children))))
|
(split-attrs-and-children attrs-and-children)
|
||||||
|
(make-element :tag (string-downcase (mkstr ',element-name))
|
||||||
|
:attrs attrs :children children))))
|
||||||
|
|
||||||
(defmacro define-and-export-builtin-elements (&rest element-names)
|
(defmacro define-and-export-builtin-elements (&rest element-names)
|
||||||
`(progn
|
`(progn
|
||||||
|
@ -66,7 +71,7 @@
|
||||||
`(export ',e)))
|
`(export ',e)))
|
||||||
element-names)))
|
element-names)))
|
||||||
|
|
||||||
(define-builtin-elements
|
(define-and-export-builtin-elements
|
||||||
a abbr address area article aside audio b base bdi bdo blockquote
|
a abbr address area article aside audio b base bdi bdo blockquote
|
||||||
body br button canvas caption cite code col colgroup data datalist
|
body br button canvas caption cite code col colgroup data datalist
|
||||||
dd del details dfn dialog div dl dt em embed fieldset figcaption
|
dd del details dfn dialog div dl dt em embed fieldset figcaption
|
||||||
|
@ -99,5 +104,11 @@
|
||||||
(element-tag element))
|
(element-tag element))
|
||||||
(format stream "<~a~a>" (element-tag element) (element-attrs element))))
|
(format stream "<~a~a>" (element-tag element) (element-attrs element))))
|
||||||
|
|
||||||
;; (defmacro! define-element (name (&rest args) &body body)
|
(defmacro! define-element (name (&rest args) &body body)
|
||||||
;; `(defun ,name (&rest g!attrs-and-children)))
|
`(defun ,name (&rest ,g!attrs-and-children)
|
||||||
|
(multiple-value-bind (,g!attrs children)
|
||||||
|
(split-attrs-and-children ,g!attrs-and-children)
|
||||||
|
(let ,(mapcar (lambda (arg)
|
||||||
|
(list arg `(cdr (assoc (make-keyword ',arg) (attrs-alist ,g!attrs)))))
|
||||||
|
args)
|
||||||
|
,@body))))
|
||||||
|
|
|
@ -1,4 +1,10 @@
|
||||||
(in-package :cl-user)
|
(in-package :cl-user)
|
||||||
(defpackage flute.test
|
(defpackage flute.test
|
||||||
(:use :cl))
|
(:use :cl :flute))
|
||||||
(in-package :flute.test)
|
(in-package :flute.test)
|
||||||
|
|
||||||
|
(define-element clock (id size)
|
||||||
|
(div :id id
|
||||||
|
(h1 "clock")
|
||||||
|
(img "blabal" :size size)
|
||||||
|
children))
|
||||||
|
|
Loading…
Reference in a new issue