Improve escape

src/escape.lisp

@@ -10,40 +10,41 @@
 
 (defparameter *escape-html* t)
 
-(defun html-escape-char-p (char)
-  (find char "<>&"))
+(defparameter *html-escape-map*
+  '((#\& . "&amp;")
+    (#\< . "&lt;")
+    (#\> . "&gt;")
+    (#\" . "&quot;")
+    (#\' . "&#x27;")
+    (#\/ . "&#x2F;")
+    (#\` . "&grave;")
+    (#\= . "&#x3D;")))
 
-(defun attr-value-escape-char-p (char)
-  (eql char #\"))
+(defparameter *attr-escape-map*
+  '((#\" . "&quot;")))
 
-(defun escape-char (char)
-  (case char
-    (#\< "&lt;")
-    (#\> "&gt;")
-    (#\& "&amp;")
-    (#\" "&quot;")
-    (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))

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'<>&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)) (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&#x27;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= "<div id=\"home\">
   <div id=\"cat\">
     <img src=\"cat.png\">
-    I'm a cat
+    I&#x27;m a cat
   </div>
   <div id=\"cat\">
     <img src=\"cat.png\">
-    I'm a cat
+    I&#x27;m a cat
   </div>
   <div id=\"doge\" class=\"small-dog\">
     <div id=\"cat\">
       <img src=\"cat.png\">
-      I'm a cat
+      I&#x27;m a cat
     </div>
     dog
   </div>