/[cmucl]/src/code/stream.lisp
ViewVC logotype

Diff of /src/code/stream.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by ram, Sat Jan 12 15:50:40 1991 UTC revision 1.8 by wlott, Sun Jan 13 01:34:20 1991 UTC
# Line 686  Line 686 
686                        (misc #'echo-misc)                        (misc #'echo-misc)
687                        (n-bin #'ill-bin))                        (n-bin #'ill-bin))
688              (:print-function %print-echo-stream)              (:print-function %print-echo-stream)
689              (:constructor make-echo-stream (input-stream output-stream))))              (:constructor make-echo-stream (input-stream output-stream)))
690      unread-stuff)
691    
692    
693  (macrolet ((in-fun (name fun out-slot &rest args)  (macrolet ((in-fun (name fun out-slot &rest args)
694               `(defun ,name (stream ,@args)               `(defun ,name (stream ,@args)
695                  (let* ((in (two-way-stream-input-stream stream))                  (or (pop (echo-stream-unread-stuff stream))
696                         (out (two-way-stream-output-stream stream))                      (let* ((in (echo-stream-input-stream stream))
697                         (result (,fun in ,@args)))                             (out (echo-stream-output-stream stream))
698                    (funcall (,out-slot out) out result)                             (result (,fun in ,@args)))
699                    result))))                        (funcall (,out-slot out) out result)
700                          result)))))
701    (in-fun echo-in read-char stream-out eof-errorp eof-value)    (in-fun echo-in read-char stream-out eof-errorp eof-value)
702    (in-fun echo-bin read-byte stream-bout eof-errorp eof-value))    (in-fun echo-bin read-byte stream-bout eof-errorp eof-value))
703    
# Line 705  Line 707 
707           (out (two-way-stream-output-stream stream))           (out (two-way-stream-output-stream stream))
708           (out-method (stream-misc out)))           (out-method (stream-misc out)))
709      (case operation      (case operation
710        (:listen (or (/= (the fixnum (stream-in-index in)) in-buffer-length)        (:listen (or (not (null (echo-stream-unread-stuff stream)))
711                       (/= (the fixnum (stream-in-index in)) in-buffer-length)
712                     (funcall in-method in :listen)))                     (funcall in-method in :listen)))
713          (:unread (push arg1 (echo-stream-unread-stuff stream)))
714        (:read-line        (:read-line
715         (multiple-value-bind (result eofp)         (let* ((stuff (echo-stream-unread-stuff stream))
716                              (read-line in arg1 arg2)                (newline-pos (position #\newline stuff)))
717           (if eofp           (if newline-pos
718               (write-string result out)               (progn
719               (write-line result out))                 (setf (echo-stream-unread-stuff stream)
720           (values result eofp)))                       (subseq stuff (1+ newline-pos)))
721                   (values (coerce (subseq stuff 0 newline-pos) 'simple-string)
722                           nil))
723                 (multiple-value-bind (result eofp)
724                                      (read-line in arg1 arg2)
725                   (if eofp
726                       (write-string result out)
727                       (write-line result out))
728                   (setf (echo-stream-unread-stuff stream) nil)
729                   (values (if stuff
730                               (concatenate 'simple-string stuff result)
731                               result)
732                           eofp)))))
733        (:element-type        (:element-type
734         (let ((in-type (funcall in-method in :element-type))         (let ((in-type (funcall in-method in :element-type))
735               (out-type (funcall out-method out :element-type)))               (out-type (funcall out-method out :element-type)))

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

  ViewVC Help
Powered by ViewVC 1.1.5