diff --git a/src/escape.lisp b/src/escape.lisp index a340c68..777f6a8 100644 --- a/src/escape.lisp +++ b/src/escape.lisp @@ -10,40 +10,41 @@ (defparameter *escape-html* t) -(defun html-escape-char-p (char) - (find char "<>&")) +(defparameter *html-escape-map* + '((#\& . "&") + (#\< . "<") + (#\> . ">") + (#\" . """) + (#\' . "'") + (#\/ . "/") + (#\` . "`") + (#\= . "="))) -(defun attr-value-escape-char-p (char) - (eql char #\")) +(defparameter *attr-escape-map* + '((#\" . """))) -(defun escape-char (char) - (case char - (#\< "<") - (#\> ">") - (#\& "&") - (#\" """) - (t (error "Escaped character is undefined: ~a" char)))) +(defun escape-char (char escape-map) + (or (cdr (assoc char escape-map)) + char)) -(defun escape-string (string test) +(defun escape-string (string escape-map) (if (stringp string) (with-output-to-string (s) (loop for c across string - do (write (if (funcall test c) - (escape-char c) - c) + do (write (escape-char c escape-map) :stream s :escape nil))) string)) (defun escape-attrs-alist (alist) (mapcar (lambda (kv) (cons (car kv) - (escape-string (cdr kv) #'attr-value-escape-char-p))) + (escape-string (cdr kv) *attr-escape-map*))) alist)) (defun escape-children (children) (mapcar (lambda (child) (if (stringp child) - (escape-string child #'html-escape-char-p) + (escape-string child *html-escape-map*) child)) children)) diff --git a/t/piccolo.lisp b/t/piccolo.lisp index 9c95633..ad9cc35 100644 --- a/t/piccolo.lisp +++ b/t/piccolo.lisp @@ -185,7 +185,7 @@ (is (string= "child text 1" (first (element-children a)))) (is (string= "child text 2 <br> &" (second (element-children a)))) (is (string= "child'<>".html" (attr (element-attrs (third (element-children a))) :href))) - (is (string= "child'<>\"" (first (element-children (third (element-children a)))))) + (is (string= "child'<>"" (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)) (fourth (element-children a)))))) @@ -228,7 +228,7 @@ (let ((cat (cat))) (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= "I'm a cat" (car (last (element-children (user-element-expand-to cat)))))))) + (is (string= "I'm a cat" (car (last (element-children (user-element-expand-to cat)))))))) (define-element dog (id size) (if (and (realp size) (> size 10)) @@ -298,16 +298,16 @@ (is (string= "