[Ecls-list] Sequence streams

Matthew Mondor mm_lists at pulsar-zone.net
Tue Aug 30 00:03:15 UTC 2011


On Mon, 29 Aug 2011 21:15:05 +0200
Juan Jose Garcia-Ripoll <juanjose.garciaripoll at googlemail.com> wrote:

> Thanks for finding the error. I just uploaded a fix.

I confirm that the sequence streams now work and that I can do what I
need with them, thank you very much for the quick implementation, btw :)


(defun utf-8-string-encode (string)
  (let ((v (make-array (+ 5 (length string)) ; Best case but we might grow
                       :element-type '(unsigned-byte 8)
                       :adjustable t
                       :fill-pointer 0)))
    (with-open-stream (s (ext:make-sequence-output-stream
                          v :external-format :utf-8))
      (loop
         for c across string
         do
           (write-char c s)
           (let ((d (array-dimension v 0)))
             (when (< (- d (fill-pointer v)) 5)
               (adjust-array v (* 2 d))))))
    v))

(defun utf-8-string-decode (bytes)
  (macrolet ((add-char (c)
               `(vector-push-extend ,c string 1024)))
    (with-open-stream (s (ext:make-sequence-input-stream
                          bytes :external-format :utf-8))
      (loop
         with string = (make-array 1024
                                   :element-type 'character
                                   :adjustable t
                                   :fill-pointer 0)
         for c of-type character =
           (handler-bind
               ((ext:stream-decoding-error
                 #'(lambda (e)
                     (mapc #'(lambda (o)
                               ;; Assume LATIN-1 and import
                               (add-char (code-char o)))
                           (ext:character-decoding-error-octets e))
                     (invoke-restart 'continue)))
                (end-of-file
                 #'(lambda (e)
                     (declare (ignore e))
                     (loop-finish))))
             (read-char s))
         do (add-char c)
         finally (return string)))))
-- 
Matt




More information about the ecl-devel mailing list