diff --git a/src/elements.lisp b/src/elements.lisp index 1f8c6bf..faaac83 100644 --- a/src/elements.lisp +++ b/src/elements.lisp @@ -1,8 +1,18 @@ (uiop:define-package #:piccolo/elements (:use #:cl) - (:local-nicknames (#:asu #:assoc-utils)) - (:local-nicknames (#:alx #:alexandria)) - (:local-nicknames (#:esc #:piccolo/escape)) + (:import-from #:assoc-utils + #:aget + #:alistp + #:delete-from-alistf + #:hash-alist) + (:import-from #:alexandria + #:make-keyword + #:plist-alist + #:symbolicate) + (:import-from #:piccolo/escape + #:escape-attrs-alist + #:escape-children + #:*escape-html*) (:export #:html #:<> #:define-element @@ -56,21 +66,21 @@ (make-instance 'builtin-element :tag tag :attrs attrs - :children (esc:escape-children children))) + :children (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 (esc:escape-children children))) + :children (escape-children children))) (defun make-user-element (&key tag attrs children expander) (make-instance 'user-element :tag tag :attrs attrs :expander expander - :children (esc:escape-children children))) + :children (escape-children children))) (defmethod user-element-expand-to ((element user-element)) (funcall (user-element-expander element) @@ -82,7 +92,7 @@ (make-instance 'fragment :tag "fragment" :attrs (make-attrs :alist nil) - :children (esc:escape-children children))) + :children (escape-children children))) ;;; attributes @@ -90,18 +100,18 @@ alist) (defun make-attrs (&key alist) - (if esc:*escape-html* - (%make-attrs :alist (esc:escape-attrs-alist alist)) + (if *escape-html* + (%make-attrs :alist (escape-attrs-alist alist)) (%make-attrs :alist alist))) (defmethod (setf attr) (value (attrs attrs) key) - (setf (asu:aget (attrs-alist attrs) key) value)) + (setf (aget (attrs-alist attrs) key) value)) (defmethod delete-attr ((attrs attrs) key) - (asu:delete-from-alistf (attrs-alist attrs) key)) + (delete-from-alistf (attrs-alist attrs) key)) (defmethod attr ((attrs attrs) key) - (asu:aget (attrs-alist attrs) key)) + (aget (attrs-alist attrs) key)) (defmethod (setf attr) (value (element element) key) (setf (attr (element-attrs element) key) value)) @@ -127,15 +137,15 @@ (cond ((attrs-p (first attrs-and-children)) (values (first attrs-and-children) (flatten (rest attrs-and-children)))) - ((asu:alistp (first attrs-and-children)) + ((alistp (first attrs-and-children)) (values (make-attrs :alist (first attrs-and-children)) (flatten (rest attrs-and-children)))) ((and (listp (first attrs-and-children)) (keywordp (first (first attrs-and-children)))) ;plist - (values (make-attrs :alist (alx:plist-alist (first attrs-and-children))) + (values (make-attrs :alist (plist-alist (first attrs-and-children))) (flatten (rest attrs-and-children)))) ((hash-table-p (first attrs-and-children)) - (values (make-attrs :alist (asu:hash-alist (first attrs-and-children))) + (values (make-attrs :alist (hash-alist (first attrs-and-children))) (flatten (rest attrs-and-children)))) ((keywordp (first attrs-and-children)) ;inline-plist (loop :for thing :on attrs-and-children :by #'cddr @@ -163,7 +173,7 @@ `(%html ,@attrs-and-children)) (defmacro define-builtin-element (element-name) - (let ((%element-name (alx:symbolicate '% element-name))) + (let ((%element-name (symbolicate '% element-name))) `(progn (defun ,%element-name (&rest attrs-and-children) (multiple-value-bind (attrs children) @@ -178,7 +188,7 @@ `(progn ,@(mapcan (lambda (e) (list `(define-builtin-element ,e) - `(setf (gethash (alx:make-keyword ',e) *builtin-elements*) t) + `(setf (gethash (make-keyword ',e) *builtin-elements*) t) `(export ',e))) element-names))) @@ -194,7 +204,7 @@ thead |time| title tr track u ul var video wbr) (defmacro define-element (name (&rest props) &body body) - (let ((%name (alx:symbolicate '% name)) + (let ((%name (symbolicate '% name)) (attrs (gensym "attrs")) (children (gensym "children")) (raw-children (gensym "raw-children"))) @@ -211,12 +221,12 @@ (let ((children (and ,raw-children (apply #'%<> ,raw-children)))) (declare (ignorable children)) (let ,(mapcar (lambda (prop) - (list prop `(attr attrs (alx:make-keyword ',prop)))) + (list prop `(attr attrs (make-keyword ',prop)))) props) (let ((...props (loop :for (key . value) in (attrs-alist attrs) :unless (member key - ',(mapcar #'alx:make-keyword + ',(mapcar #'make-keyword props)) :append (list key value)))) (declare (ignorable ...props)) @@ -238,7 +248,7 @@ (defun html-element-p (node) (and (symbolp node) (not (keywordp node)) - (gethash (alx:make-keyword node) *builtin-elements*))) + (gethash (make-keyword node) *builtin-elements*))) (defun fragment-p (node) (string= node '<>)) diff --git a/src/generator.lisp b/src/generator.lisp index 2ea2a74..d556624 100644 --- a/src/generator.lisp +++ b/src/generator.lisp @@ -1,7 +1,21 @@ (uiop:define-package #:piccolo/generator (:use #:cl) - (:local-nicknames (#:alx #:alexandria)) - (:local-nicknames (#:elm #:piccolo/elements)) + (:import-from #:alexandria + #:with-gensyms + #:make-keyword + #:symbolicate) + (:import-from #:piccolo/elements + #:attrs + #:attrs-alist + #:element + #:element-tag + #:element-attrs + #:element-children + #:element-prefix + #:builtin-element-with-prefix + #:user-element + #:user-element-expand-to + #:fragment) (:export #:*expand-user-element* #:element-string #:elem-str)) @@ -12,16 +26,16 @@ (defun symbols-hash-table (symbols) (let ((ht (make-hash-table))) (mapcar (lambda (sym) - (setf (gethash (alx:make-keyword sym) ht) t)) + (setf (gethash (make-keyword sym) ht) t)) symbols) ht)) (defmacro define-group (name &body symbols) - (alx:with-gensyms (ht) + (with-gensyms (ht) `(progn (let ((,ht (symbols-hash-table ',symbols))) - (defun ,(alx:symbolicate name '-p) (symbol) - (gethash (alx:make-keyword (string-upcase symbol)) ,ht)))))) + (defun ,(symbolicate name '-p) (symbol) + (gethash (make-keyword (string-upcase symbol)) ,ht)))))) (define-group self-closing-tag area base br col embed hr img input keygen @@ -31,53 +45,53 @@ (defparameter *expand-user-element* t) -(defmethod print-object ((attrs elm:attrs) stream) +(defmethod print-object ((attrs attrs) stream) (loop - :for (key . value) :in (elm:attrs-alist attrs) + :for (key . value) :in (attrs-alist attrs) :do (format stream (if (typep value 'boolean) "~@[ ~a~]" " ~a=~s") (string-downcase key) value))) -(defmethod print-object ((element elm:element) stream) - (if (elm:element-children element) - (format stream (if (rest (elm:element-children element)) +(defmethod print-object ((element element) stream) + (if (element-children element) + (format stream (if (rest (element-children element)) "~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_~:>" "~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_~:>") - (elm:element-tag element) - (elm:element-attrs element) - (elm:element-children element) - (elm:element-tag element)) - (format stream (if (self-closing-tag-p (elm:element-tag element)) + (element-tag element) + (element-attrs element) + (element-children element) + (element-tag element)) + (format stream (if (self-closing-tag-p (element-tag element)) "<~a~a>" "<~a~a>") - (elm:element-tag element) - (elm:element-attrs element) - (elm:element-tag element)))) + (element-tag element) + (element-attrs element) + (element-tag element)))) -(defmethod print-object ((element elm:builtin-element-with-prefix) stream) - (format stream "~a~%" (elm:element-prefix element)) +(defmethod print-object ((element builtin-element-with-prefix) stream) + (format stream "~a~%" (element-prefix element)) (call-next-method)) -(defmethod print-object ((element elm:user-element) stream) +(defmethod print-object ((element user-element) stream) (if *expand-user-element* - (print-object (elm:user-element-expand-to element) stream) + (print-object (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)) +(defmethod print-object ((element fragment) stream) + (if (element-children element) + (format stream (if (rest (element-children element)) "~<~@{~a~^~:@_~}~:>" "~<~a~:>") - (elm:element-children element)))) + (element-children element)))) ;;; helper for generate html string -(defmethod element-string ((element elm:element)) +(defmethod element-string ((element element)) (with-output-to-string (s) (write element :stream s :pretty t))) -(defmethod elem-str ((element elm:element)) +(defmethod elem-str ((element element)) (with-output-to-string (s) (write element :stream s :pretty nil)))