+ (let ((curpos 0)
+ (maxpos (length string))
+ (strs nil))
+ (flet ((next-ansii-substring ()
+ (let ((pos (or (position #\% string :start curpos)
+ maxpos)))
+ (when (and (= curpos 0)
+ (= pos maxpos))
+ (return-from decode-escaped-encoding string))
+ (when (< curpos pos)
+ (push (subseq string
+ curpos
+ pos)
+ strs)
+ (setf curpos pos))))
+ (next-encoded-substring ()
+ (let ((pos (or (loop for i from curpos below maxpos by 3
+ unless (char= (aref string i)
+ #\%)
+ return i)
+ maxpos)))
+ (when (< curpos pos)
+ (let ((octets (handler-case (make-array (/ (- pos curpos)
+ 3)
+ :element-type '(unsigned-byte 8)
+ :fill-pointer 0)
+ (error ()
+ (.parse-error "Unsyntactic escaped encoding in ~s." string)))))
+ (loop for i from curpos below pos by 3
+ do (vector-push (handler-case
+ (parse-integer string
+ :start (1+ i)
+ :end (+ i 3)
+ :radix 16)
+ (error ()
+ (.parse-error "Non-hexidecimal digits after %: ~c~c."
+ (aref string (1+ i))
+ (aref string (+ 2 i)))))
+ octets))
+
+ (let* ((decoded-string (babel:octets-to-string octets
+ :encoding :utf-8))
+ (rpos (if reserved-chars
+ (position-if #'(lambda (ch)
+ (not (or (> (char-code ch) 127)
+ (= (sbit reserved-chars (char-code ch)) 0))))
+ decoded-string))))
+ (push (if rpos
+ (with-output-to-string (out)
+ (loop for ch across decoded-string
+ 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))))
+ (loop
+ while (< curpos maxpos)
+ do (next-ansii-substring)
+ while (< curpos maxpos)
+ do (next-encoded-substring)))
+ (if (cdr strs)
+ (apply #'concatenate
+ 'string
+ (nreverse strs))
+ (or (car strs)
+ ""))))
+
+