Escape non-ASCII characters in URIs
authorDavid Lichteblau <david@lichteblau.com>
Sun, 23 Mar 2008 19:53:51 +0000 (23 20:53 +0100)
committerDavid Lichteblau <david@radon.(none)>
Sun, 23 Mar 2008 19:53:51 +0000 (23 20:53 +0100)
doc/index.xml
src/parse/unparse.lisp

index 1ed6410..96f13dc 100644 (file)
        <li>
          Don't escape &lt; in attributes.
        </li>
+       <li>
+         Don't escape &amp;{ in attributes.
+       </li>
+       <li>
+         Escape non-ASCII characters in URIs.
+       </li>
       </ul>
     </li>
     <li>
index 622eb43..4f93ad3 100644 (file)
          (%write-rune #/= sink)
          (%write-rune #/\" sink)
          (let ((value (hax:attribute-value a)))
-           (when (uri-attribute-p aname)
+           (when (uri-attribute-p name aname)
              (setf value (escape-uri-attribute value)))
            (unparse-attribute-string value sink))
          (%write-rune #/\" sink))))
     (%write-rune #/> sink)))
 
-;;; everything written as %URI in the DTD.  Complete list per element,
-;;; as found in the HTML 4.01 Strict DTD
-;;;
-;;; a          href
-;;; area       href
-;;; link       href
-;;; img        src longdesc usemap
-;;; object     classid codebase data usemap
-;;; q          cite
-;;; blockquote cite
-;;; inl        cite
-;;; del        cite
-;;; form       action
-;;; input      src usemap
-;;; head       profile
-;;; base       href
-;;; script     src for
-;;;
-;;; plus the reserved attribute datasrc.
-(defun uri-attribute-p (name)
-  (find (rod-downcase name)
-       '(#"action" #"cite" #"classid" #"codebase" #"data" #"for" #"href"
-         #"longdesc" #"profile" #"src" #"usemap")
-       :test 'rod=))
+;;; everything written as %URI in the DTD:
+(defun uri-attribute-p (ename aname)
+  (find (rod-downcase aname)
+       (cdr (find (rod-downcase ename)
+                  '((#"a"          #"href")
+                    (#"area"       #"href")
+                    (#"link"       #"href")
+                    (#"img"        #"src" #"longdesc" #"usemap")
+                    (#"object"     #"classid" #"codebase" #"data" #"usemap")
+                    (#"q"          #"cite")
+                    (#"blockquote" #"cite")
+                    (#"inl"        #"cite")
+                    (#"del"        #"cite")
+                    (#"form"       #"action")
+                    (#"input"      #"src" #"usemap")
+                    (#"head"       #"profile")
+                    (#"base"       #"href")
+                    (#"script"     #"src"  ;; #"for"
+                     ))
+                  :key #'car
+                  :test #'rod=))
+       :test #'rod=))
 
 (defun escape-uri-attribute (x)
-  ;; implementme
-  x)
+  (string-rod
+   (with-output-to-string (s)
+     (loop
+       for c across (rod-to-utf8-string x)
+       for code = (char-code c)
+       do
+         (if (< code 128)
+             (write-char c s)
+             (format s "%~2,'0X" code))))))
 
 (defmethod hax:end-element
     ((sink sink) name)