Organize packages
This commit is contained in:
parent
bef49c1ab3
commit
7e252406ec
4 changed files with 87 additions and 119 deletions
|
@ -1,45 +1,31 @@
|
||||||
(uiop:define-package #:piccolo/elements
|
(uiop:define-package #:piccolo/elements
|
||||||
(:use #:cl)
|
(:use #:cl)
|
||||||
(:local-nicknames (#:util #:piccolo/util))
|
(:local-nicknames (#:asu #:assoc-utils))
|
||||||
(:local-nicknames (#:asc #:assoc-utils))
|
|
||||||
(:local-nicknames (#:lol #:let-over-lambda))
|
(:local-nicknames (#:lol #:let-over-lambda))
|
||||||
(:local-nicknames (#:alx #:alexandria))
|
(:local-nicknames (#:alx #:alexandria))
|
||||||
(:export
|
(:local-nicknames (#:esc #:piccolo/escape))
|
||||||
;;; builtin HTML elements
|
(:export #:html
|
||||||
;;; 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|
|
|
||||||
#:html
|
|
||||||
|
|
||||||
;;; fragment lets you group elements without a wrapper element.
|
|
||||||
#:<>
|
#:<>
|
||||||
|
|
||||||
;;; user defined elements
|
|
||||||
#:define-element
|
#:define-element
|
||||||
;; for reference tag name, attributes and children elements in user
|
|
||||||
;; element definition
|
|
||||||
#:tag
|
#:tag
|
||||||
#:children
|
#:children
|
||||||
#:attrs
|
#:attrs
|
||||||
|
|
||||||
;;; attribute accessing utilility
|
|
||||||
#:attrs-alist
|
#:attrs-alist
|
||||||
#:make-attrs
|
#:make-attrs
|
||||||
#:copy-attrs
|
#:copy-attrs
|
||||||
#:attr
|
#:attr
|
||||||
#:delete-attr
|
#:delete-attr
|
||||||
|
|
||||||
;;; element
|
|
||||||
#:element
|
#:element
|
||||||
#:*builtin-elements*
|
#:builtin-element
|
||||||
#:builtin-element-with-prefix
|
#:builtin-element-with-prefix
|
||||||
#:user-element
|
#:user-element
|
||||||
#:fragment
|
#:fragment
|
||||||
#:element-tag
|
#:element-tag
|
||||||
#:element-attrs
|
#:element-attrs
|
||||||
#:element-children
|
|
||||||
#:element-prefix
|
#:element-prefix
|
||||||
#:user-element-expand-to))
|
#:element-children
|
||||||
|
#:user-element-expand-to
|
||||||
|
#:h))
|
||||||
(in-package #:piccolo/elements)
|
(in-package #:piccolo/elements)
|
||||||
|
|
||||||
;;; classes
|
;;; classes
|
||||||
|
@ -70,21 +56,21 @@
|
||||||
(make-instance 'builtin-element
|
(make-instance 'builtin-element
|
||||||
:tag tag
|
:tag tag
|
||||||
:attrs attrs
|
:attrs attrs
|
||||||
:children (util:escape-children children)))
|
:children (esc:escape-children children)))
|
||||||
|
|
||||||
(defun make-builtin-element-with-prefix (&key tag attrs children prefix)
|
(defun make-builtin-element-with-prefix (&key tag attrs children prefix)
|
||||||
(make-instance 'builtin-element-with-prefix
|
(make-instance 'builtin-element-with-prefix
|
||||||
:tag tag
|
:tag tag
|
||||||
:attrs attrs
|
:attrs attrs
|
||||||
:prefix prefix
|
:prefix prefix
|
||||||
:children (util:escape-children children)))
|
:children (esc:escape-children children)))
|
||||||
|
|
||||||
(defun make-user-element (&key tag attrs children expander)
|
(defun make-user-element (&key tag attrs children expander)
|
||||||
(make-instance 'user-element
|
(make-instance 'user-element
|
||||||
:tag tag
|
:tag tag
|
||||||
:attrs attrs
|
:attrs attrs
|
||||||
:expander expander
|
:expander expander
|
||||||
:children (util:escape-children children)))
|
:children (esc:escape-children children)))
|
||||||
|
|
||||||
(defmethod user-element-expand-to ((element user-element))
|
(defmethod user-element-expand-to ((element user-element))
|
||||||
(funcall (user-element-expander element)
|
(funcall (user-element-expander element)
|
||||||
|
@ -96,7 +82,7 @@
|
||||||
(make-instance 'fragment
|
(make-instance 'fragment
|
||||||
:tag 'fragment
|
:tag 'fragment
|
||||||
:attrs (make-attrs :alist nil)
|
:attrs (make-attrs :alist nil)
|
||||||
:children (util:escape-children children)))
|
:children (esc:escape-children children)))
|
||||||
|
|
||||||
;;; attributes
|
;;; attributes
|
||||||
|
|
||||||
|
@ -104,18 +90,18 @@
|
||||||
alist)
|
alist)
|
||||||
|
|
||||||
(defun make-attrs (&key alist)
|
(defun make-attrs (&key alist)
|
||||||
(if util:*escape-html*
|
(if esc:*escape-html*
|
||||||
(%make-attrs :alist (util:escape-attrs-alist alist))
|
(%make-attrs :alist (esc:escape-attrs-alist alist))
|
||||||
(%make-attrs :alist alist)))
|
(%make-attrs :alist alist)))
|
||||||
|
|
||||||
(defmethod (setf attr) (value (attrs attrs) key)
|
(defmethod (setf attr) (value (attrs attrs) key)
|
||||||
(setf (asc:aget (attrs-alist attrs) key) value))
|
(setf (asu:aget (attrs-alist attrs) key) value))
|
||||||
|
|
||||||
(defmethod delete-attr ((attrs attrs) key)
|
(defmethod delete-attr ((attrs attrs) key)
|
||||||
(asc:delete-from-alistf (attrs-alist attrs) key))
|
(asu:delete-from-alistf (attrs-alist attrs) key))
|
||||||
|
|
||||||
(defmethod attr ((attrs attrs) key)
|
(defmethod attr ((attrs attrs) key)
|
||||||
(asc:aget (attrs-alist attrs) key))
|
(asu:aget (attrs-alist attrs) key))
|
||||||
|
|
||||||
(defmethod (setf attr) (value (element element) key)
|
(defmethod (setf attr) (value (element element) key)
|
||||||
(setf (attr (element-attrs element) key) value))
|
(setf (attr (element-attrs element) key) value))
|
||||||
|
@ -132,14 +118,14 @@
|
||||||
(cond
|
(cond
|
||||||
((attrs-p (first attrs-and-children))
|
((attrs-p (first attrs-and-children))
|
||||||
(values (first attrs-and-children) (lol:flatten (rest attrs-and-children))))
|
(values (first attrs-and-children) (lol:flatten (rest attrs-and-children))))
|
||||||
((asc:alistp (first attrs-and-children))
|
((asu:alistp (first attrs-and-children))
|
||||||
(values (make-attrs :alist (first attrs-and-children))
|
(values (make-attrs :alist (first attrs-and-children))
|
||||||
(lol:flatten (rest attrs-and-children))))
|
(lol:flatten (rest attrs-and-children))))
|
||||||
((listp (first attrs-and-children)) ;plist
|
((listp (first attrs-and-children)) ;plist
|
||||||
(values (make-attrs :alist (util:plist-alist (first attrs-and-children)))
|
(values (make-attrs :alist (alx:plist-alist (first attrs-and-children)))
|
||||||
(lol:flatten (rest attrs-and-children))))
|
(lol:flatten (rest attrs-and-children))))
|
||||||
((hash-table-p (first attrs-and-children))
|
((hash-table-p (first attrs-and-children))
|
||||||
(values (make-attrs :alist (asc:hash-alist (first attrs-and-children)))
|
(values (make-attrs :alist (asu:hash-alist (first attrs-and-children)))
|
||||||
(lol:flatten (rest attrs-and-children))))
|
(lol:flatten (rest attrs-and-children))))
|
||||||
((keywordp (first attrs-and-children)) ;inline-plist
|
((keywordp (first attrs-and-children)) ;inline-plist
|
||||||
(loop for thing on attrs-and-children by #'cddr
|
(loop for thing on attrs-and-children by #'cddr
|
||||||
|
@ -227,3 +213,36 @@
|
||||||
|
|
||||||
(defmacro <> (&body children)
|
(defmacro <> (&body children)
|
||||||
`(%<> ,@children))
|
`(%<> ,@children))
|
||||||
|
|
||||||
|
;;; h macro
|
||||||
|
|
||||||
|
(defun html-element-p (node)
|
||||||
|
(and (symbolp node)
|
||||||
|
(not (keywordp node))
|
||||||
|
(gethash (alx:make-keyword node) *builtin-elements*)))
|
||||||
|
|
||||||
|
(defun modify-first-leaves (tree test result)
|
||||||
|
(if tree
|
||||||
|
(cons (let ((first-node (first tree)))
|
||||||
|
(cond
|
||||||
|
((listp first-node)
|
||||||
|
(modify-first-leaves first-node test result))
|
||||||
|
((funcall test first-node)
|
||||||
|
(funcall result first-node))
|
||||||
|
(t first-node)))
|
||||||
|
(mapcar (lambda (node)
|
||||||
|
(if (listp node)
|
||||||
|
(modify-first-leaves node test result)
|
||||||
|
node))
|
||||||
|
(rest tree)))))
|
||||||
|
|
||||||
|
(defmacro h (&body body)
|
||||||
|
`(progn
|
||||||
|
,@(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)))))
|
||||||
|
|
|
@ -1,25 +1,13 @@
|
||||||
(uiop:define-package #:piccolo/util
|
(uiop:define-package #:piccolo/escape
|
||||||
(:use #:cl)
|
(:use #:cl)
|
||||||
(:export
|
(:export #:*escape-html*
|
||||||
;;; list utility
|
|
||||||
#:plist-alist
|
|
||||||
|
|
||||||
;;; escape utility
|
|
||||||
#:*escape-html*
|
|
||||||
#:utf8-html-escape-char-p
|
#:utf8-html-escape-char-p
|
||||||
#:ascii-html-escape-char-p
|
#:ascii-html-escape-char-p
|
||||||
#:attr-value-escape-char-p
|
#:attr-value-escape-char-p
|
||||||
#:escape-string
|
#:escape-string
|
||||||
#:escape-attrs-alist
|
#:escape-attrs-alist
|
||||||
#:escape-children
|
#:escape-children))
|
||||||
|
(in-package #:piccolo/escape)
|
||||||
;;; syntax tree utility
|
|
||||||
#:modify-first-leaves))
|
|
||||||
(in-package #:piccolo/util)
|
|
||||||
|
|
||||||
(defun plist-alist (plist)
|
|
||||||
(loop for (k v) on plist by #'cddr
|
|
||||||
collect (cons k v)))
|
|
||||||
|
|
||||||
(defparameter *escape-html* :utf8
|
(defparameter *escape-html* :utf8
|
||||||
"Specify the escape option when generate html, can be :UTF8, :ASCII, :ATTR or NIL.
|
"Specify the escape option when generate html, can be :UTF8, :ASCII, :ATTR or NIL.
|
||||||
|
@ -74,18 +62,3 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
|
||||||
(otherwise child))
|
(otherwise child))
|
||||||
child))
|
child))
|
||||||
children))
|
children))
|
||||||
|
|
||||||
(defun modify-first-leaves (tree test result)
|
|
||||||
(if tree
|
|
||||||
(cons (let ((first-node (first tree)))
|
|
||||||
(cond
|
|
||||||
((listp first-node)
|
|
||||||
(modify-first-leaves first-node test result))
|
|
||||||
((funcall test first-node)
|
|
||||||
(funcall result first-node))
|
|
||||||
(t first-node)))
|
|
||||||
(mapcar (lambda (node)
|
|
||||||
(if (listp node)
|
|
||||||
(modify-first-leaves node test result)
|
|
||||||
node))
|
|
||||||
(rest tree)))))
|
|
|
@ -1,14 +1,8 @@
|
||||||
(uiop:define-package #:piccolo/generator
|
(uiop:define-package #:piccolo/generator
|
||||||
(:use #:cl)
|
(:use #:cl)
|
||||||
(:local-nicknames (#:alx #:alexandria))
|
(:local-nicknames (#:alx #:alexandria))
|
||||||
(:local-nicknames (#:util #:piccolo/util))
|
|
||||||
(:local-nicknames (#:elm #:piccolo/elements))
|
(:local-nicknames (#:elm #:piccolo/elements))
|
||||||
(:export
|
(:export #:*expand-user-element*
|
||||||
;;; the h macro for avoiding import all builtin html element functions
|
|
||||||
#:h
|
|
||||||
|
|
||||||
;;; helper for generate html string
|
|
||||||
#:*expand-user-element*
|
|
||||||
#:element-string
|
#:element-string
|
||||||
#:elem-str))
|
#:elem-str))
|
||||||
(in-package #:piccolo/generator)
|
(in-package #:piccolo/generator)
|
||||||
|
@ -72,24 +66,6 @@
|
||||||
"~<~a~:>")
|
"~<~a~:>")
|
||||||
(elm:element-children element))))
|
(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
|
;;; helper for generate html string
|
||||||
|
|
||||||
(defmethod element-string ((element elm:element))
|
(defmethod element-string ((element elm:element))
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
(uiop:define-package :piccolo
|
(uiop:define-package :piccolo
|
||||||
(:nicknames #:piccolo/main)
|
(:nicknames #:piccolo/main)
|
||||||
(:use #:cl)
|
(:use #:cl)
|
||||||
|
(:use-reexport #:piccolo/escape)
|
||||||
(:use-reexport #:piccolo/elements)
|
(:use-reexport #:piccolo/elements)
|
||||||
(:use-reexport #:piccolo/generator)
|
(:use-reexport #:piccolo/generator))
|
||||||
(:use-reexport #:piccolo/util))
|
|
||||||
(in-package :piccolo)
|
(in-package :piccolo)
|
||||||
|
|
Loading…
Reference in a new issue