(&rest streams &aux (current streams)))
(:copier nil))
;; The car of this is the substream we are reading from now.
- current
- ;; This is a list of all the substreams there ever were. We need to
- ;; remember them so that we can close them.
- ;;
- ;; FIXME: ANSI says this is supposed to be the list of streams that
- ;; we still have to read from. So either this needs to become a
- ;; private member %STREAM (with CONCATENATED-STREAM-STREAMS a wrapper
- ;; around it which discards closed files from the head of the list)
- ;; or we need to update it as we run out of files.
- (streams nil :type list :read-only t))
+ (streams nil :type list))
(def!method print-object ((x concatenated-stream) stream)
(print-unreadable-object (x stream :type t :identity t)
(format stream
(macrolet ((in-fun (name fun)
`(defun ,name (stream eof-error-p eof-value)
- (do ((current (concatenated-stream-current stream)
- (cdr current)))
- ((null current)
+ (do ((streams (concatenated-stream-streams stream)
+ (cdr streams)))
+ ((null streams)
(eof-or-lose stream eof-error-p eof-value))
- (let* ((stream (car current))
+ (let* ((stream (car streams))
(result (,fun stream nil nil)))
(when result (return result)))
- (pop (concatenated-stream-current stream))))))
+ (pop (concatenated-stream-streams stream))))))
(in-fun concatenated-in read-char)
(in-fun concatenated-bin read-byte))
(defun concatenated-n-bin (stream buffer start numbytes eof-errorp)
- (do ((current (concatenated-stream-current stream) (cdr current))
+ (do ((streams (concatenated-stream-streams stream) (cdr streams))
(current-start start)
(remaining-bytes numbytes))
- ((null current)
+ ((null streams)
(if eof-errorp
(error 'end-of-file :stream stream)
(- numbytes remaining-bytes)))
- (let* ((stream (car current))
+ (let* ((stream (car streams))
(bytes-read (read-n-bytes stream buffer current-start
remaining-bytes nil)))
(incf current-start bytes-read)
(decf remaining-bytes bytes-read)
(when (zerop remaining-bytes) (return numbytes)))
- (setf (concatenated-stream-current stream) (cdr current))))
+ (setf (concatenated-stream-streams stream) (cdr streams))))
(defun concatenated-misc (stream operation &optional arg1 arg2)
- (let ((left (concatenated-stream-current stream)))
- (when left
- (let* ((current (car left)))
- (case operation
- (:listen
- (loop
- (let ((stuff (if (ansi-stream-p current)
- (funcall (ansi-stream-misc current) current
- :listen)
- (stream-misc-dispatch current :listen))))
- (cond ((eq stuff :eof)
- ;; Advance CURRENT, and try again.
- (pop (concatenated-stream-current stream))
- (setf current
- (car (concatenated-stream-current stream)))
- (unless current
- ;; No further streams. EOF.
- (return :eof)))
- (stuff
- ;; Stuff's available.
- (return t))
- (t
- ;; Nothing is available yet.
- (return nil))))))
- (:clear-input (clear-input current))
- (:unread (unread-char arg1 current))
- (:close
- (set-closed-flame stream))
- (t
- (if (ansi-stream-p current)
- (funcall (ansi-stream-misc current) current operation arg1 arg2)
- (stream-misc-dispatch current operation arg1 arg2))))))))
+ (let* ((left (concatenated-stream-streams stream))
+ (current (car left)))
+ (case operation
+ (:listen
+ (unless left
+ (return-from concatenated-misc :eof))
+ (loop
+ (let ((stuff (if (ansi-stream-p current)
+ (funcall (ansi-stream-misc current) current
+ :listen)
+ (stream-misc-dispatch current :listen))))
+ (cond ((eq stuff :eof)
+ ;; Advance STREAMS, and try again.
+ (pop (concatenated-stream-streams stream))
+ (setf current
+ (car (concatenated-stream-streams stream)))
+ (unless current
+ ;; No further streams. EOF.
+ (return :eof)))
+ (stuff
+ ;; Stuff's available.
+ (return t))
+ (t
+ ;; Nothing is available yet.
+ (return nil))))))
+ (:clear-input (when left (clear-input current)))
+ (:unread (when left (unread-char arg1 current)))
+ (:close
+ (set-closed-flame stream))
+ (t
+ (when left
+ (if (ansi-stream-p current)
+ (funcall (ansi-stream-misc current) current operation arg1 arg2)
+ (stream-misc-dispatch current operation arg1 arg2)))))))
\f
;;;; echo streams
(or (pop (echo-stream-unread-stuff stream))
(let* ((in (echo-stream-input-stream stream))
(out (echo-stream-output-stream stream))
- (result (,in-fun in ,@args)))
- (,out-fun result out)
- result)))))
+ (result (if eof-error-p
+ (,in-fun in ,@args)
+ (,in-fun in nil in))))
+ (cond
+ ((eql result in) eof-value)
+ (t (,out-fun result out) result)))))))
(in-fun echo-in read-char write-char eof-error-p eof-value)
(in-fun echo-bin read-byte write-byte eof-error-p eof-value))
\f
;; This is checked by FILE-LENGTH, so no need to do it here either.
;; (:file-length (length (string-input-stream-string stream)))
(:unread (decf (string-input-stream-current stream)))
+ (:close (set-closed-flame stream))
(:listen (or (/= (the index (string-input-stream-current stream))
(the index (string-input-stream-end stream)))
:eof))
(subseq buffer 0 end))))
arg1))))
(string-output-stream-index stream)))
+ (:close (set-closed-flame stream))
(:charpos
(do ((index (1- (the fixnum (string-output-stream-index stream)))
(1- index))