-(macrolet ((in-fun (name fun out-slot stream-method &rest args)
- `(defun ,name (stream ,@args)
- (or (pop (echo-stream-unread-stuff stream))
- (let* ((in (echo-stream-input-stream stream))
- (out (echo-stream-output-stream stream))
- (result (,fun in ,@args)))
- (if (ansi-stream-p out)
- (funcall (,out-slot out) out result)
- (,stream-method out result))
- result)))))
- (in-fun echo-in read-char ansi-stream-out stream-write-char
- eof-error-p eof-value)
- (in-fun echo-bin read-byte ansi-stream-bout stream-write-byte
- eof-error-p eof-value))
-
-(defun echo-misc (stream operation &optional arg1 arg2)
- (let* ((in (two-way-stream-input-stream stream))
- (out (two-way-stream-output-stream stream)))
- (case operation
- (:listen
- (or (not (null (echo-stream-unread-stuff stream)))
- (if (ansi-stream-p in)
- (or (/= (the fixnum (ansi-stream-in-index in))
- +ansi-stream-in-buffer-length+)
- (funcall (ansi-stream-misc in) in :listen))
- (stream-misc-dispatch in :listen))))
- (:unread (push arg1 (echo-stream-unread-stuff stream)))
- (:element-type
- (let ((in-type (stream-element-type in))
- (out-type (stream-element-type out)))
- (if (equal in-type out-type)
- in-type `(and ,in-type ,out-type))))
- (:close
- (set-closed-flame stream))
- (:peek-char
- ;; For the special case of peeking into an echo-stream
- ;; arg1 is PEEK-TYPE, arg2 is (EOF-ERROR-P EOF-VALUE)
- ;; returns peeked-char, eof-value, or errors end-of-file
- ;;
- ;; Note: This code could be moved into PEEK-CHAR if desired.
- ;; I am unsure whether this belongs with echo-streams because it is
- ;; echo-stream specific, or PEEK-CHAR because it is peeking code.
- ;; -- mrd 2002-11-18
- ;;
- ;; UNREAD-CHAR-P indicates whether the current character was one
- ;; that was previously unread. In that case, we need to ensure that
- ;; the semantics for UNREAD-CHAR are held; the character should
- ;; not be echoed again.
- (let ((unread-char-p nil))
- (flet ((outfn (c)
- (unless unread-char-p
- (if (ansi-stream-p out)
- (funcall (ansi-stream-out out) out c)
- ;; gray-stream
- (stream-write-char out c))))
- (infn ()
- ;; Obtain input from unread buffer or input stream,
- ;; and set the flag appropriately.
- (cond ((not (null (echo-stream-unread-stuff stream)))
- (setf unread-char-p t)
- (pop (echo-stream-unread-stuff stream)))
- (t
- (setf unread-char-p nil)
- (read-char in (first arg2) (second arg2))))))
- (generalized-peeking-mechanism
- arg1 (second arg2) char
- (infn)
- (unread-char char in)
- (outfn char)))))
- (t
- (or (if (ansi-stream-p in)
- (funcall (ansi-stream-misc in) in operation arg1 arg2)
- (stream-misc-dispatch in operation arg1 arg2))
- (if (ansi-stream-p out)
- (funcall (ansi-stream-misc out) out operation arg1 arg2)
- (stream-misc-dispatch out operation arg1 arg2)))))))
-\f
-;;;; base STRING-STREAM stuff
-
-(defstruct (string-stream
- (:include ansi-stream)
- (:constructor nil)
- (:copier nil))
- ;; FIXME: This type declaration is true, and will probably continue
- ;; to be true. However, note well the comments in DEFTRANSFORM
- ;; REPLACE, implying that performance of REPLACE is somewhat
- ;; critical to performance of string streams. If (VECTOR CHARACTER)
- ;; ever becomes different from (VECTOR BASE-CHAR), the transform
- ;; probably needs to be extended.
- (string (missing-arg) :type (vector character)))
+(macrolet ((in-fun (name in-fun out-fun &rest args)
+ `(defun ,name (stream ,@args)
+ (or (pop (echo-stream-unread-stuff stream))
+ (let* ((in (echo-stream-input-stream stream))
+ (out (echo-stream-output-stream stream))
+ (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))
+
+(defun echo-n-bin (stream buffer start numbytes eof-error-p)
+ (let ((new-start start)
+ (read 0))
+ (loop
+ (let ((thing (pop (echo-stream-unread-stuff stream))))
+ (cond
+ (thing
+ (setf (aref buffer new-start) thing)
+ (incf new-start)
+ (incf read)
+ (when (= read numbytes)
+ (return-from echo-n-bin numbytes)))
+ (t (return nil)))))
+ (let ((bytes-read (read-n-bytes (echo-stream-input-stream stream) buffer
+ new-start (- numbytes read) nil)))
+ (cond
+ ((not eof-error-p)
+ (write-sequence buffer (echo-stream-output-stream stream)
+ :start new-start :end (+ new-start bytes-read))
+ (+ bytes-read read))
+ ((> numbytes (+ read bytes-read))
+ (write-sequence buffer (echo-stream-output-stream stream)
+ :start new-start :end (+ new-start bytes-read))
+ (error 'end-of-file :stream stream))
+ (t
+ (write-sequence buffer (echo-stream-output-stream stream)
+ :start new-start :end (+ new-start bytes-read))
+ (aver (= numbytes (+ new-start bytes-read)))
+ numbytes)))))