[flexi-streams-cvs] r17 - branches/hans

[hhubner at common-lisp.net]

Author: hhubner
Date: Wed May 14 06:59:57 2008
New Revision: 17

Modified:
   branches/hans/output.lisp
Log:
Fix bug in output cr-lf handling


Modified: branches/hans/output.lisp
==============================================================================
--- branches/hans/output.lisp	(original)
+++ branches/hans/output.lisp	Wed May 14 06:59:57 2008
@@ -80,7 +80,7 @@
 
 (defmacro define-char-writer (((stream stream-class) char sink) &body body)
   (let ((body body))
-    (with-unique-names (string start end dummy-sink byte i)
+    (with-unique-names (string start end dummy-sink input-char byte i eol-style)
       `(progn
          (defmethod char-to-octets ((,stream ,stream-class) ,char ,sink)
            (declare (optimize speed))
@@ -90,14 +90,23 @@
            (let ((,sink (make-array (truncate (*  (- ,end ,start)
                                                   (flexi-stream-output-size-factor ,stream)))
                                     :adjustable t :fill-pointer 0 :element-type '(unsigned-byte 8))))
-             (loop
+             (labels ((write-byte* (,byte ,dummy-sink)
+                              (declare (ignore ,dummy-sink))
+                              (vector-push-extend ,byte ,sink))
+                      (write-char (,char)
+                        , at body))
+               (loop
+                with ,eol-style = (external-format-eol-style (flexi-stream-external-format ,stream))
                 for ,i of-type fixnum from ,start below ,end
-                for ,char of-type character = (aref ,string ,i)
-                do (flet ((write-byte* (,byte ,dummy-sink)
-                            (declare (ignore ,dummy-sink))
-                            (vector-push-extend ,byte ,sink)))
-                     , at body))
-             ,sink))))))
+                for ,input-char of-type character = (aref ,string ,i)
+                do (if (eql ,input-char #\Newline)
+                       (case ,eol-style
+                         (:cr (write-char #\Return))
+                         (:crlf (write-char #\Return)
+                                (write-char #\Newline))
+                         (t (write-char #\Newline)))
+                       (write-char ,input-char)))
+               ,sink)))))))
 
 (define-char-writer ((stream flexi-latin-1-output-stream) char sink)
   (let ((octet (char-code char)))
@@ -191,18 +200,20 @@
         (write-byte* (ldb (byte 8 position) char-code) sink))
   char)
 
-(define-char-writer ((stream flexi-cr-mixin) char sink)
+(defmethod char-to-octets ((stream flexi-cr-mixin) char sink)
+  (declare (optimize speed))
   "The `base' method for all streams which need end-of-line
 conversion.  Uses CALL-NEXT-METHOD to do the actual work of sending
 one or more characters to SINK."
-  (with-accessors ((external-format flexi-stream-external-format))
+  (with-accessors
+        ((external-format flexi-stream-external-format))
       stream
     (case char
-      (#\Newline     
+      (#\Newline
        (case (external-format-eol-style external-format)
          (:cr (call-next-method stream #\Return sink))
          (:crlf (call-next-method stream #\Return sink)
-                (call-next-method stream #\Linefeed sink))))
+                (call-next-method stream #\Newline sink))))
       (otherwise (call-next-method)))
     char))