Add generator package
This commit is contained in:
parent
1b699a09ee
commit
e9c3b03d2b
3 changed files with 113 additions and 100 deletions
|
@ -16,7 +16,6 @@
|
||||||
|
|
||||||
;;; user defined elements
|
;;; user defined elements
|
||||||
#:define-element
|
#:define-element
|
||||||
#:*expand-user-element*
|
|
||||||
;; for reference tag name, attributes and children elements in user
|
;; for reference tag name, attributes and children elements in user
|
||||||
;; element definition
|
;; element definition
|
||||||
#:tag
|
#:tag
|
||||||
|
@ -30,18 +29,17 @@
|
||||||
#:attr
|
#:attr
|
||||||
#:delete-attr
|
#:delete-attr
|
||||||
|
|
||||||
;;; element slots
|
;;; element
|
||||||
|
#:element
|
||||||
|
#:*builtin-elements*
|
||||||
|
#:builtin-element-with-prefix
|
||||||
|
#:user-element
|
||||||
|
#:fragment
|
||||||
#:element-tag
|
#:element-tag
|
||||||
#:element-attrs
|
#:element-attrs
|
||||||
#:element-children
|
#:element-children
|
||||||
#:user-element-expand-to
|
#:element-prefix
|
||||||
|
#:user-element-expand-to))
|
||||||
;;; 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)
|
(in-package #:piccolo/elements)
|
||||||
|
|
||||||
;;; classes
|
;;; classes
|
||||||
|
@ -229,90 +227,3 @@
|
||||||
|
|
||||||
(defmacro <> (&body children)
|
(defmacro <> (&body children)
|
||||||
`(%<> ,@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))
|
|
||||||
|
|
||||||
(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))
|
|
||||||
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
|
|
||||||
"~@<<~a~a>~2I~:_~<~a~:>~0I~:_</~a>~:>")
|
|
||||||
(element-tag element)
|
|
||||||
(element-attrs element)
|
|
||||||
(element-children element)
|
|
||||||
(element-tag element))
|
|
||||||
(format stream (if (self-closing-p (element-tag element))
|
|
||||||
"<~a~a>"
|
|
||||||
"<~a~a></~a>")
|
|
||||||
(element-tag element)
|
|
||||||
(element-attrs element)
|
|
||||||
(element-tag element))))
|
|
||||||
|
|
||||||
(defmethod print-object ((element builtin-element-with-prefix) stream)
|
|
||||||
(format stream "~a~%" (element-prefix element))
|
|
||||||
(call-next-method))
|
|
||||||
|
|
||||||
(defmethod print-object ((element user-element) stream)
|
|
||||||
(if *expand-user-element*
|
|
||||||
(print-object (user-element-expand-to element) stream)
|
|
||||||
(call-next-method)))
|
|
||||||
|
|
||||||
(defmethod print-object ((element fragment) stream)
|
|
||||||
(if (element-children element)
|
|
||||||
(format stream (if (rest (element-children element))
|
|
||||||
"~<~@{~a~^~:@_~}~:>"
|
|
||||||
"~<~a~:>")
|
|
||||||
(element-children element))))
|
|
||||||
|
|
||||||
;;; h macro
|
|
||||||
|
|
||||||
(defun html-element-p (node)
|
|
||||||
(and (symbolp node)
|
|
||||||
(not (keywordp node))
|
|
||||||
(gethash (alx:make-keyword node) *builtin-elements*)))
|
|
||||||
|
|
||||||
(defmacro h (&body body)
|
|
||||||
`(progn
|
|
||||||
,@(util:modify-first-leaves
|
|
||||||
body
|
|
||||||
(lambda (node)
|
|
||||||
(declare (ignorable node))
|
|
||||||
(or (html-element-p node) (string= node '<>)))
|
|
||||||
(lambda (node)
|
|
||||||
(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)))
|
|
||||||
|
|
||||||
(defmethod elem-str ((element element))
|
|
||||||
(with-output-to-string (s)
|
|
||||||
(write element :stream s :pretty nil)))
|
|
||||||
|
|
101
src/generator.lisp
Normal file
101
src/generator.lisp
Normal file
|
@ -0,0 +1,101 @@
|
||||||
|
(uiop:define-package #:piccolo/generator
|
||||||
|
(:use #:cl)
|
||||||
|
(:local-nicknames (#:alx #:alexandria))
|
||||||
|
(:local-nicknames (#:util #:piccolo/util))
|
||||||
|
(:local-nicknames (#:elm #:piccolo/elements))
|
||||||
|
(:export
|
||||||
|
;;; the h macro for avoiding import all builtin html element functions
|
||||||
|
#:h
|
||||||
|
|
||||||
|
;;; helper for generate html string
|
||||||
|
#:*expand-user-element*
|
||||||
|
#:element-string
|
||||||
|
#:elem-str))
|
||||||
|
(in-package #:piccolo/generator)
|
||||||
|
|
||||||
|
;;; 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))
|
||||||
|
|
||||||
|
(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 elm:attrs) stream)
|
||||||
|
(loop
|
||||||
|
:for (k . v) :in (elm:attrs-alist attrs)
|
||||||
|
:do (format stream (if (member k *boolean-attrs* :test #'string=)
|
||||||
|
"~@[ ~a~]"
|
||||||
|
" ~a=~s")
|
||||||
|
(string-downcase k)
|
||||||
|
v)))
|
||||||
|
|
||||||
|
(defmethod print-object ((element elm:element) stream)
|
||||||
|
(if (elm:element-children element)
|
||||||
|
(format stream (if (rest (elm:element-children element))
|
||||||
|
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>"
|
||||||
|
"~@<<~a~a>~2I~:_~<~a~:>~0I~:_</~a>~:>")
|
||||||
|
(elm:element-tag element)
|
||||||
|
(elm:element-attrs element)
|
||||||
|
(elm:element-children element)
|
||||||
|
(elm:element-tag element))
|
||||||
|
(format stream (if (self-closing-p (elm:element-tag element))
|
||||||
|
"<~a~a>"
|
||||||
|
"<~a~a></~a>")
|
||||||
|
(elm:element-tag element)
|
||||||
|
(elm:element-attrs element)
|
||||||
|
(elm:element-tag element))))
|
||||||
|
|
||||||
|
(defmethod print-object ((element elm:builtin-element-with-prefix) stream)
|
||||||
|
(format stream "~a~%" (elm:element-prefix element))
|
||||||
|
(call-next-method))
|
||||||
|
|
||||||
|
(defmethod print-object ((element elm:user-element) stream)
|
||||||
|
(if *expand-user-element*
|
||||||
|
(print-object (elm:user-element-expand-to element) stream)
|
||||||
|
(call-next-method)))
|
||||||
|
|
||||||
|
(defmethod print-object ((element elm:fragment) stream)
|
||||||
|
(if (elm:element-children element)
|
||||||
|
(format stream (if (rest (elm:element-children element))
|
||||||
|
"~<~@{~a~^~:@_~}~:>"
|
||||||
|
"~<~a~:>")
|
||||||
|
(elm:element-children element))))
|
||||||
|
|
||||||
|
;;; h macro
|
||||||
|
|
||||||
|
(defun html-element-p (node)
|
||||||
|
(and (symbolp node)
|
||||||
|
(not (keywordp node))
|
||||||
|
(gethash (alx:make-keyword node) elm:*builtin-elements*)))
|
||||||
|
|
||||||
|
(defmacro h (&body body)
|
||||||
|
`(progn
|
||||||
|
,@(util:modify-first-leaves
|
||||||
|
body
|
||||||
|
(lambda (node)
|
||||||
|
(declare (ignorable node))
|
||||||
|
(or (html-element-p node) (string= node '<>)))
|
||||||
|
(lambda (node)
|
||||||
|
(declare (ignorable node))
|
||||||
|
(find-symbol (string-upcase node) :piccolo)))))
|
||||||
|
|
||||||
|
;;; helper for generate html string
|
||||||
|
|
||||||
|
(defmethod element-string ((element elm:element))
|
||||||
|
(with-output-to-string (s)
|
||||||
|
(write element :stream s :pretty t)))
|
||||||
|
|
||||||
|
(defmethod elem-str ((element elm:element))
|
||||||
|
(with-output-to-string (s)
|
||||||
|
(write element :stream s :pretty nil)))
|
|
@ -2,5 +2,6 @@
|
||||||
(:nicknames #:piccolo/main)
|
(:nicknames #:piccolo/main)
|
||||||
(:use #:cl)
|
(:use #:cl)
|
||||||
(:use-reexport #:piccolo/elements)
|
(:use-reexport #:piccolo/elements)
|
||||||
|
(:use-reexport #:piccolo/generator)
|
||||||
(:use-reexport #:piccolo/util))
|
(:use-reexport #:piccolo/util))
|
||||||
(in-package :piccolo)
|
(in-package :piccolo)
|
||||||
|
|
Loading…
Reference in a new issue