paku/hsx
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

Improve escape

Browse source
This commit is contained in:
paku 2024-02-12 01:49:28 +09:00
parent 050c14209c
commit 40df277aac
2 changed files with 23 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
src/escape.lisp
View file

@ -10,40 +10,41 @@
(defparameter *escape-html* t) (defparameter *escape-html* t)
(defun html-escape-char-p (char) (defparameter *html-escape-map*
(find char "<>&")) '((#\& . "&amp;")
(#\< . "&lt;")
(#\> . "&gt;")
(#\" . "&quot;")
(#\' . "&#x27;")
(#\/ . "&#x2F;")
(#\` . "&grave;")
(#\= . "&#x3D;")))
(defun attr-value-escape-char-p (char) (defparameter *attr-escape-map*
(eql char #\")) '((#\" . "&quot;")))
(defun escape-char (char) (defun escape-char (char escape-map)
(case char (or (cdr (assoc char escape-map))
(#\< "&lt;") char))
(#\> "&gt;")
(#\& "&amp;")
(#\" "&quot;")
(t (error "Escaped character is undefined: ~a" char))))
(defun escape-string (string test) (defun escape-string (string escape-map)
(if (stringp string) (if (stringp string)
(with-output-to-string (s) (with-output-to-string (s)
(loop (loop
for c across string for c across string
do (write (if (funcall test c) do (write (escape-char c escape-map)
(escape-char c)
c)
:stream s :escape nil))) :stream s :escape nil)))
string)) string))
(defun escape-attrs-alist (alist) (defun escape-attrs-alist (alist)
(mapcar (lambda (kv) (mapcar (lambda (kv)
(cons (car kv) (cons (car kv)
(escape-string (cdr kv) #'attr-value-escape-char-p))) (escape-string (cdr kv) *attr-escape-map*)))
alist)) alist))
(defun escape-children (children) (defun escape-children (children)
(mapcar (lambda (child) (mapcar (lambda (child)
(if (stringp child) (if (stringp child)
(escape-string child #'html-escape-char-p) (escape-string child *html-escape-map*)
child)) child))
children)) children))

10
t/piccolo.lisp
View file

@ -185,7 +185,7 @@
(is (string= "child text 1" (first (element-children a)))) (is (string= "child text 1" (first (element-children a))))
(is (string= "child text 2 &lt;br&gt; &amp;" (second (element-children a)))) (is (string= "child text 2 &lt;br&gt; &amp;" (second (element-children a))))
(is (string= "child'<>&quot;.html" (attr (element-attrs (third (element-children a))) :href))) (is (string= "child'<>&quot;.html" (attr (element-attrs (third (element-children a))) :href)))
(is (string= "child'&lt;&gt;\"" (first (element-children (third (element-children a)))))) (is (string= "child&#x27;&lt;&gt;&quot;" (first (element-children (third (element-children a))))))
(is (string= (string (code-char 128)) (second (element-children (third (element-children a)))))) (is (string= (string (code-char 128)) (second (element-children (third (element-children a))))))
(is (string= (string (code-char 128)) (fourth (element-children a)))))) (is (string= (string (code-char 128)) (fourth (element-children a))))))
@ -228,7 +228,7 @@
(let ((cat (cat))) (let ((cat (cat)))
(is (string= "cat" (attr (user-element-expand-to cat) :id))) (is (string= "cat" (attr (user-element-expand-to cat) :id)))
(is (string= "cat.png" (attr (first (element-children (user-element-expand-to cat))) :src))) (is (string= "cat.png" (attr (first (element-children (user-element-expand-to cat))) :src)))
(is (string= "I'm a cat" (car (last (element-children (user-element-expand-to cat)))))))) (is (string= "I&#x27;m a cat" (car (last (element-children (user-element-expand-to cat))))))))
(define-element dog (id size) (define-element dog (id size)
(if (and (realp size) (> size 10)) (if (and (realp size) (> size 10))
@ -298,16 +298,16 @@
(is (string= "<div id=\"home\"> (is (string= "<div id=\"home\">
<div id=\"cat\"> <div id=\"cat\">
<img src=\"cat.png\"> <img src=\"cat.png\">
I'm a cat I&#x27;m a cat
</div> </div>
<div id=\"cat\"> <div id=\"cat\">
<img src=\"cat.png\"> <img src=\"cat.png\">
I'm a cat I&#x27;m a cat
</div> </div>
<div id=\"doge\" class=\"small-dog\"> <div id=\"doge\" class=\"small-dog\">
<div id=\"cat\"> <div id=\"cat\">
<img src=\"cat.png\"> <img src=\"cat.png\">
I'm a cat I&#x27;m a cat
</div> </div>
dog dog
</div> </div>