fix format

[puri-unicode.git] / src.lisp

diff --git a/src.lisp b/src.lisp
index 697e40f..c94c2b2 100644 (file)
--- a/src.lisp
+++ b/src.lisp
@@ -837,13 +837,24 @@ URI ~s contains illegal character ~s at position ~d."
                      (push (if rpos
                                (with-output-to-string (out)
                                  (loop for ch across decoded-string
-                                      for i from curpos by 3
-                                    do (let ((octet (char-code ch)))
-                                         (if (or (null reserved-chars)
-                                                 (> octet 127)
-                                                 (= (sbit reserved-chars octet) 0))
-                                             (write-char ch out)
-                                             (write-string (subseq string i (+ i 3)) out)))))
+                                    with i = curpos
+                                    do (let ((code (char-code ch)))
+                                         (cond
+                                           ((or (null reserved-chars)
+                                                (> code 127)
+                                                (= (sbit reserved-chars code) 0))
+                                            (write-char ch out)
+                                            (incf i
+                                                  (* (cond
+                                                       ((< code #x80) 1)
+                                                       ((< code #x800) 2)
+                                                       ((< code #x10000) 3)
+                                                       ((< code #x200000) 4)
+                                                       ((< code #x4000000) 5)
+                                                       (t 6))
+                                                     3)))
+                                           (t (write-string (subseq string i (+ i 3)) out)
+                                              (incf i 3))))))
                                decoded-string)
                            strs))))
                    (setf curpos pos))))
@@ -939,34 +950,17 @@ URI ~s contains illegal character ~s at position ~d."
      then (format stream "~a" (uri-string urn))
      else (uri-string urn)))
 
-(defparameter *escaped-encoding*
-    (vector #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e #\f))
-
 (defun encode-escaped-encoding (string reserved-chars escape)
   (when (null escape) (return-from encode-escaped-encoding string))
-  ;; Make a string as big as it possibly needs to be (3 times the original
-  ;; size), and truncate it at the end.
-  (do* ((max (length string))
-        (new-max (* 3 max)) ;; worst case new size
-        (new-string (make-string new-max))
-        (i 0 (1+ i))
-        (new-i -1)
-        c ci)
-      ((= i max)
-       (shrink-vector new-string (incf new-i)))
-    (setq ci (char-int (setq c (char string i))))
-    (if* (or (null reserved-chars)
-             (> ci 127)
-             (= 0 (sbit reserved-chars ci)))
-       then ;; ok as is
-            (incf new-i)
-            (setf (char new-string new-i) c)
-       else ;; need to escape it
-            (multiple-value-bind (q r) (truncate ci 16)
-              (setf (char new-string (incf new-i)) #\%)
-              (setf (char new-string (incf new-i)) (elt *escaped-encoding* q))
-              (setf (char new-string (incf new-i))
-                (elt *escaped-encoding* r))))))
+  (with-output-to-string (out)
+    (loop for ch across string
+       do (let ((code (char-code ch)))  
+            (if (and (< code 128)
+                     (or (null reserved-chars)
+                         (= 0 (sbit reserved-chars code))))
+                (write-char ch out)
+                (loop for octet across (babel:string-to-octets (string ch) :encoding :utf-8)
+                   do (format out "%~(~2,'0x~)" octet)))))))
 
 (defmethod print-object ((uri uri) stream)
   (if* *print-escape*