Add non-escape-tag group
This commit is contained in:
parent
fb7a549e83
commit
543e14b774
3 changed files with 37 additions and 25 deletions
|
@ -9,6 +9,8 @@
|
||||||
#:make-keyword
|
#:make-keyword
|
||||||
#:plist-alist
|
#:plist-alist
|
||||||
#:symbolicate)
|
#:symbolicate)
|
||||||
|
(:import-from #:piccolo/groups
|
||||||
|
#:non-escape-tag-p)
|
||||||
(:import-from #:piccolo/escape
|
(:import-from #:piccolo/escape
|
||||||
#:escape-attrs-alist
|
#:escape-attrs-alist
|
||||||
#:escape-children
|
#:escape-children
|
||||||
|
@ -68,7 +70,9 @@
|
||||||
(make-instance 'builtin-element
|
(make-instance 'builtin-element
|
||||||
:tag tag
|
:tag tag
|
||||||
:attrs attrs
|
:attrs attrs
|
||||||
:children (escape-children children)))
|
:children (if (non-escape-tag-p tag)
|
||||||
|
children
|
||||||
|
(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
|
||||||
|
|
|
@ -1,9 +1,7 @@
|
||||||
(uiop:define-package #:piccolo/generator
|
(uiop:define-package #:piccolo/generator
|
||||||
(:use #:cl)
|
(:use #:cl)
|
||||||
(:import-from #:alexandria
|
(:import-from #:piccolo/groups
|
||||||
#:with-gensyms
|
#:self-closing-tag-p)
|
||||||
#:make-keyword
|
|
||||||
#:symbolicate)
|
|
||||||
(:import-from #:piccolo/elements
|
(:import-from #:piccolo/elements
|
||||||
#:attrs
|
#:attrs
|
||||||
#:attrs-alist
|
#:attrs-alist
|
||||||
|
@ -21,26 +19,6 @@
|
||||||
#:elem-str))
|
#:elem-str))
|
||||||
(in-package #:piccolo/generator)
|
(in-package #:piccolo/generator)
|
||||||
|
|
||||||
;;; groups of specific tags and attributes
|
|
||||||
|
|
||||||
(defun symbols-hash-table (symbols)
|
|
||||||
(let ((ht (make-hash-table)))
|
|
||||||
(mapcar (lambda (sym)
|
|
||||||
(setf (gethash (make-keyword sym) ht) t))
|
|
||||||
symbols)
|
|
||||||
ht))
|
|
||||||
|
|
||||||
(defmacro define-group (name &body symbols)
|
|
||||||
(with-gensyms (ht)
|
|
||||||
`(progn
|
|
||||||
(let ((,ht (symbols-hash-table ',symbols)))
|
|
||||||
(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
|
|
||||||
link meta param source track wbr)
|
|
||||||
|
|
||||||
;;; print-object
|
;;; print-object
|
||||||
|
|
||||||
(defparameter *expand-user-element* t)
|
(defparameter *expand-user-element* t)
|
||||||
|
|
30
src/groups.lisp
Normal file
30
src/groups.lisp
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
(defpackage #:piccolo/groups
|
||||||
|
(:use #:cl)
|
||||||
|
(:import-from #:alexandria
|
||||||
|
#:with-gensyms
|
||||||
|
#:symbolicate
|
||||||
|
#:make-keyword)
|
||||||
|
(:export #:self-closing-tag-p
|
||||||
|
#:non-escape-tag-p))
|
||||||
|
(in-package #:piccolo/groups)
|
||||||
|
|
||||||
|
(defun symbols-hash-table (symbols)
|
||||||
|
(let ((ht (make-hash-table)))
|
||||||
|
(mapcar (lambda (sym)
|
||||||
|
(setf (gethash (make-keyword sym) ht) t))
|
||||||
|
symbols)
|
||||||
|
ht))
|
||||||
|
|
||||||
|
(defmacro define-group (name &body symbols)
|
||||||
|
(with-gensyms (ht)
|
||||||
|
`(progn
|
||||||
|
(let ((,ht (symbols-hash-table ',symbols)))
|
||||||
|
(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
|
||||||
|
link meta param source track wbr)
|
||||||
|
|
||||||
|
(define-group non-escape-tag
|
||||||
|
style script textarea pre)
|
Loading…
Add table
Add a link
Reference in a new issue