Organize packages

This commit is contained in:
paku 2024-02-10 11:48:06 +09:00
parent bef49c1ab3
commit 7e252406ec
4 changed files with 87 additions and 119 deletions

View file

@ -1,45 +1,31 @@
(uiop:define-package #:piccolo/elements
(:use #:cl)
(:local-nicknames (#:util #:piccolo/util))
(:local-nicknames (#:asc #:assoc-utils))
(:local-nicknames (#:lol #:let-over-lambda))
(:local-nicknames (#:alx #:alexandria))
(:export
;;; builtin HTML elements
;;; 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
;; for reference tag name, attributes and children elements in user
;; element definition
#:tag
#:children
#:attrs
;;; attribute accessing utilility
#:attrs-alist
#:make-attrs
#:copy-attrs
#:attr
#:delete-attr
;;; element
#:element
#:*builtin-elements*
#:builtin-element-with-prefix
#:user-element
#:fragment
#:element-tag
#:element-attrs
#:element-children
#:element-prefix
#:user-element-expand-to))
(:local-nicknames (#:asu #:assoc-utils))
(:local-nicknames (#:lol #:let-over-lambda))
(:local-nicknames (#:alx #:alexandria))
(:local-nicknames (#:esc #:piccolo/escape))
(:export #:html
#:<>
#:define-element
#:tag
#:children
#:attrs
#:attrs-alist
#:make-attrs
#:copy-attrs
#:attr
#:delete-attr
#:element
#:builtin-element
#:builtin-element-with-prefix
#:user-element
#:fragment
#:element-tag
#:element-attrs
#:element-prefix
#:element-children
#:user-element-expand-to
#:h))
(in-package #:piccolo/elements)
;;; classes
@ -70,21 +56,21 @@
(make-instance 'builtin-element
:tag tag
:attrs attrs
:children (util:escape-children children)))
:children (esc:escape-children children)))
(defun make-builtin-element-with-prefix (&key tag attrs children prefix)
(make-instance 'builtin-element-with-prefix
:tag tag
:attrs attrs
:prefix prefix
:children (util:escape-children children)))
:children (esc:escape-children children)))
(defun make-user-element (&key tag attrs children expander)
(make-instance 'user-element
:tag tag
:attrs attrs
:expander expander
:children (util:escape-children children)))
:children (esc:escape-children children)))
(defmethod user-element-expand-to ((element user-element))
(funcall (user-element-expander element)
@ -96,7 +82,7 @@
(make-instance 'fragment
:tag 'fragment
:attrs (make-attrs :alist nil)
:children (util:escape-children children)))
:children (esc:escape-children children)))
;;; attributes
@ -104,18 +90,18 @@
alist)
(defun make-attrs (&key alist)
(if util:*escape-html*
(%make-attrs :alist (util:escape-attrs-alist alist))
(if esc:*escape-html*
(%make-attrs :alist (esc:escape-attrs-alist alist))
(%make-attrs :alist alist)))
(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)
(asc:delete-from-alistf (attrs-alist attrs) key))
(asu:delete-from-alistf (attrs-alist 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)
(setf (attr (element-attrs element) key) value))
@ -132,14 +118,14 @@
(cond
((attrs-p (first 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))
(lol:flatten (rest attrs-and-children))))
((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))))
((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))))
((keywordp (first attrs-and-children)) ;inline-plist
(loop for thing on attrs-and-children by #'cddr
@ -227,3 +213,36 @@
(defmacro <> (&body 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)))))

View file

@ -1,25 +1,13 @@
(uiop:define-package #:piccolo/util
(uiop:define-package #:piccolo/escape
(:use #:cl)
(:export
;;; list utility
#:plist-alist
;;; escape utility
#:*escape-html*
#:utf8-html-escape-char-p
#:ascii-html-escape-char-p
#:attr-value-escape-char-p
#:escape-string
#:escape-attrs-alist
#:escape-children
;;; 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)))
(:export #:*escape-html*
#:utf8-html-escape-char-p
#:ascii-html-escape-char-p
#:attr-value-escape-char-p
#:escape-string
#:escape-attrs-alist
#:escape-children))
(in-package #:piccolo/escape)
(defparameter *escape-html* :utf8
"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))
child))
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)))))

View file

@ -1,16 +1,10 @@
(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))
(:local-nicknames (#:alx #:alexandria))
(:local-nicknames (#:elm #:piccolo/elements))
(:export #:*expand-user-element*
#:element-string
#:elem-str))
(in-package #:piccolo/generator)
;;; print-object
@ -72,24 +66,6 @@
"~<~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))

View file

@ -1,7 +1,7 @@
(uiop:define-package :piccolo
(:nicknames #:piccolo/main)
(:use #:cl)
(:use-reexport #:piccolo/escape)
(:use-reexport #:piccolo/elements)
(:use-reexport #:piccolo/generator)
(:use-reexport #:piccolo/util))
(:use-reexport #:piccolo/generator))
(in-package :piccolo)