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) + ,@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))) - ,@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))