- (let ((write-function
- (if (subtypep (stream-element-type stream) 'character)
- ;; FIXME (rudi 2004-08-09): since we know we're an
- ;; ansi stream here, we could replace these
- ;; functions with ansi-specific constructs
- #'write-char
- #'write-byte)))
- (do ((i start (1+ i)))
- ((>= i end) seq)
- (declare (type index i))
- (funcall write-function (aref seq i) stream)))))))
+ (with-array-data ((data seq) (offset-start start) (offset-end end))
+ (labels
+ ((output-seq-in-loop ()
+ (let ((write-function
+ (if (subtypep (stream-element-type stream) 'character)
+ (ansi-stream-out stream)
+ (ansi-stream-bout stream))))
+ (do ((i offset-start (1+ i)))
+ ((>= i offset-end))
+ (declare (type index i))
+ (funcall write-function stream (aref data i))))))
+ (typecase data
+ ((or (simple-array (unsigned-byte 8) (*))
+ (simple-array (signed-byte 8) (*)))
+ (if (fd-stream-p stream)
+ (output-raw-bytes stream data offset-start offset-end)
+ (output-seq-in-loop)))
+ (t
+ (output-seq-in-loop))))))))
+ seq)