/[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.89 by rtoy, Sat Jan 23 18:02:05 2010 UTC revision 1.89.4.1 by rtoy, Thu Feb 25 20:34:52 2010 UTC
# Line 18  Line 18 
18  ;;;  ;;;
19  (in-package "LISP")  (in-package "LISP")
20    
21    (intl:textdomain "cmucl")
22    
23  (export '(broadcast-stream make-broadcast-stream broadcast-stream-streams  (export '(broadcast-stream make-broadcast-stream broadcast-stream-streams
24            synonym-stream make-synonym-stream synonym-stream-symbol            synonym-stream make-synonym-stream synonym-stream-symbol
25            concatenated-stream make-concatenated-stream            concatenated-stream make-concatenated-stream
# Line 53  Line 55 
55  ;;; The initialization of these streams is performed by Stream-Init,  ;;; The initialization of these streams is performed by Stream-Init,
56  ;;; which lives in the file of machine-specific stream functions.  ;;; which lives in the file of machine-specific stream functions.
57  ;;;  ;;;
58  (defvar *terminal-io* () "Terminal I/O stream.")  (defvar *terminal-io* () _N"Terminal I/O stream.")
59  (defvar *standard-input* () "Default input stream.")  (defvar *standard-input* () _N"Default input stream.")
60  (defvar *standard-output* () "Default output stream.")  (defvar *standard-output* () _N"Default output stream.")
61  (defvar *error-output* () "Error output stream.")  (defvar *error-output* () _N"Error output stream.")
62  (defvar *query-io* () "Query I/O stream.")  (defvar *query-io* () _N"Query I/O stream.")
63  (defvar *trace-output* () "Trace output stream.")  (defvar *trace-output* () _N"Trace output stream.")
64  (defvar *debug-io* () "Interactive debugging stream.")  (defvar *debug-io* () _N"Interactive debugging stream.")
65    
66  (defun ill-in-any (stream &rest ignore)  (defun ill-in-any (stream &rest ignore)
67    (declare (ignore ignore))    (declare (ignore ignore))
68    (error 'simple-type-error    (error 'simple-type-error
69           :datum stream           :datum stream
70           :expected-type '(satisfies input-stream-p)           :expected-type '(satisfies input-stream-p)
71           :format-control "~S is not an input stream."           :format-control _"~S is not an input stream."
72           :format-arguments (list stream)))           :format-arguments (list stream)))
73  (defun ill-out-any (stream &rest ignore)  (defun ill-out-any (stream &rest ignore)
74    (declare (ignore ignore))    (declare (ignore ignore))
75    (error 'simple-type-error    (error 'simple-type-error
76           :datum stream           :datum stream
77           :expected-type '(satisfies output-stream-p)           :expected-type '(satisfies output-stream-p)
78           :format-control "~S is not an output stream."           :format-control _"~S is not an output stream."
79           :format-arguments (list stream)))           :format-arguments (list stream)))
80  (defun ill-in (stream &rest ignore)  (defun ill-in (stream &rest ignore)
81    (declare (ignore ignore))    (declare (ignore ignore))
82    (error 'simple-type-error    (error 'simple-type-error
83           :datum stream           :datum stream
84           :expected-type '(satisfies input-stream-p)           :expected-type '(satisfies input-stream-p)
85           :format-control "~S is not a character input stream."           :format-control _"~S is not a character input stream."
86           :format-arguments (list stream)))           :format-arguments (list stream)))
87  (defun ill-out (stream &rest ignore)  (defun ill-out (stream &rest ignore)
88    (declare (ignore ignore))    (declare (ignore ignore))
89    (error 'simple-type-error    (error 'simple-type-error
90           :datum stream           :datum stream
91           :expected-type '(satisfies output-stream-p)           :expected-type '(satisfies output-stream-p)
92           :format-control "~S is not a character output stream."           :format-control _"~S is not a character output stream."
93           :format-arguments (list stream)))           :format-arguments (list stream)))
94  (defun ill-bin (stream &rest ignore)  (defun ill-bin (stream &rest ignore)
95    (declare (ignore ignore))    (declare (ignore ignore))
96    (error 'simple-type-error    (error 'simple-type-error
97           :datum stream           :datum stream
98           :expected-type '(satisfies input-stream-p)           :expected-type '(satisfies input-stream-p)
99           :format-control "~S is not a binary input stream."           :format-control _"~S is not a binary input stream."
100           :format-arguments (list stream)))           :format-arguments (list stream)))
101  (defun ill-n-bin (stream &rest ignore)  (defun ill-n-bin (stream &rest ignore)
102    (declare (ignore ignore))    (declare (ignore ignore))
103    (error 'simple-type-error    (error 'simple-type-error
104           :datum stream           :datum stream
105           :expected-type '(satisfies input-stream-p)           :expected-type '(satisfies input-stream-p)
106           :format-control "~S is not a binary input stream ~           :format-control _"~S is not a binary input stream ~
107                            or does not support multi-byte read operations."                            or does not support multi-byte read operations."
108           :format-arguments (list stream)))           :format-arguments (list stream)))
109  (defun ill-bout (stream &rest ignore)  (defun ill-bout (stream &rest ignore)
# Line 109  Line 111 
111    (error 'simple-type-error    (error 'simple-type-error
112           :datum stream           :datum stream
113           :expected-type '(satisfies output-stream-p)           :expected-type '(satisfies output-stream-p)
114           :format-control "~S is not a binary output stream."           :format-control _"~S is not a binary output stream."
115           :format-arguments (list stream)))           :format-arguments (list stream)))
116  (defun closed-flame (stream &rest ignore)  (defun closed-flame (stream &rest ignore)
117    (declare (ignore ignore))    (declare (ignore ignore))
118    (error "~S is closed." stream))    (error _"~S is closed." stream))
119  (defun do-nothing (&rest ignore)  (defun do-nothing (&rest ignore)
120    (declare (ignore ignore)))    (declare (ignore ignore)))
121  (defun no-gray-streams (stream)  (defun no-gray-streams (stream)
122    (error 'simple-type-error    (error 'simple-type-error
123           :datum stream           :datum stream
124           :expected-type 'stream           :expected-type 'stream
125           :format-control "~S is an unsupported Gray stream."           :format-control _"~S is an unsupported Gray stream."
126           :format-arguments (list stream)))           :format-arguments (list stream)))
127    
128  (defun %print-stream (structure stream d)  (defun %print-stream (structure stream d)
# Line 205  Line 207 
207  ;;; Stream manipulation functions.  ;;; Stream manipulation functions.
208    
209  (defun input-stream-p (stream)  (defun input-stream-p (stream)
210    "Returns non-nil if the given Stream can perform input operations."    _N"Returns non-nil if the given Stream can perform input operations."
211    (declare (type stream stream))    (declare (type stream stream))
212    ;; Note: Gray streams redefines this function; any changes made here need    ;; Note: Gray streams redefines this function; any changes made here need
213    ;; to be duplicated in .../pcl/gray-streams.lisp    ;; to be duplicated in .../pcl/gray-streams.lisp
# Line 222  Line 224 
224                 (not (eq (lisp-stream-n-bin stream) #'ill-n-bin)))))))                 (not (eq (lisp-stream-n-bin stream) #'ill-n-bin)))))))
225    
226  (defun output-stream-p (stream)  (defun output-stream-p (stream)
227    "Returns non-nil if the given Stream can perform output operations."    _N"Returns non-nil if the given Stream can perform output operations."
228    (declare (type stream stream))    (declare (type stream stream))
229    ;; Note: Gray streams redefines this function; any changes made here need    ;; Note: Gray streams redefines this function; any changes made here need
230    ;; to be duplicated in .../pcl/gray-streams.lisp    ;; to be duplicated in .../pcl/gray-streams.lisp
# Line 238  Line 240 
240                 (not (eq (lisp-stream-bout stream) #'ill-bout)))))))                 (not (eq (lisp-stream-bout stream) #'ill-bout)))))))
241    
242  (defun open-stream-p (stream)  (defun open-stream-p (stream)
243    "Return true if Stream is not closed."    _N"Return true if Stream is not closed."
244    (declare (type stream stream))    (declare (type stream stream))
245    ;; Note: Gray streams redefines this function; any changes made here need    ;; Note: Gray streams redefines this function; any changes made here need
246    ;; to be duplicated in .../pcl/gray-streams.lisp    ;; to be duplicated in .../pcl/gray-streams.lisp
# Line 249  Line 251 
251      (not (eq (lisp-stream-in stream) #'closed-flame))))      (not (eq (lisp-stream-in stream) #'closed-flame))))
252    
253  (defun stream-element-type (stream)  (defun stream-element-type (stream)
254    "Returns a type specifier for the kind of object returned by the Stream."    _N"Returns a type specifier for the kind of object returned by the Stream."
255    (declare (type stream stream))    (declare (type stream stream))
256    ;; Note: Gray streams redefines this function; any changes made here need    ;; Note: Gray streams redefines this function; any changes made here need
257    ;; to be duplicated in .../pcl/gray-streams.lisp    ;; to be duplicated in .../pcl/gray-streams.lisp
# Line 260  Line 262 
262      (funcall (lisp-stream-misc stream) stream :element-type)))      (funcall (lisp-stream-misc stream) stream :element-type)))
263    
264  (defun interactive-stream-p (stream)  (defun interactive-stream-p (stream)
265    "Return true if Stream does I/O on a terminal or other interactive device."    _N"Return true if Stream does I/O on a terminal or other interactive device."
266    (declare (type stream stream))    (declare (type stream stream))
267    (stream-dispatch stream    (stream-dispatch stream
268      ;; simple-stream      ;; simple-stream
# Line 279  Line 281 
281      (error 'simple-type-error      (error 'simple-type-error
282             :datum stream             :datum stream
283             :expected-type 'stream:simple-stream             :expected-type 'stream:simple-stream
284             :format-control "Can't set interactive flag on ~S."             :format-control _"Can't set interactive flag on ~S."
285             :format-arguments (list stream))))             :format-arguments (list stream))))
286    
287  (defun stream-external-format (stream)  (defun stream-external-format (stream)
288    "Returns the external format used by the given Stream."    _N"Returns the external format used by the given Stream."
289    (declare (type stream stream))    (declare (type stream stream))
290    (stream-dispatch stream    (stream-dispatch stream
291      ;; simple-stream      ;; simple-stream
# Line 312  Line 314 
314    extfmt)    extfmt)
315    
316  (defun close (stream &key abort)  (defun close (stream &key abort)
317    "Closes the given Stream.  No more I/O may be performed, but inquiries    _N"Closes the given Stream.  No more I/O may be performed, but inquiries
318    may still be made.  If :Abort is non-nil, an attempt is made to clean    may still be made.  If :Abort is non-nil, an attempt is made to clean
319    up the side effects of having created the stream."    up the side effects of having created the stream."
320    (declare (type stream stream))    (declare (type stream stream))
# Line 345  Line 347 
347  ;;;    Call the misc method with the :file-position operation.  ;;;    Call the misc method with the :file-position operation.
348  ;;;  ;;;
349  (defun file-position (stream &optional position)  (defun file-position (stream &optional position)
350    "With one argument returns the current position within the file    _N"With one argument returns the current position within the file
351     File-Stream is open to.  If the second argument is supplied, then     File-Stream is open to.  If the second argument is supplied, then
352     this becomes the new file position.  The second argument may also     this becomes the new file position.  The second argument may also
353     be :start or :end for the start and end of the file, respectively."     be :start or :end for the start and end of the file, respectively."
# Line 371  Line 373 
373  ;;;    Like File-Position, only use :file-length.  ;;;    Like File-Position, only use :file-length.
374  ;;;  ;;;
375  (defun file-length (stream)  (defun file-length (stream)
376    "This function returns the length of the file that File-Stream is open to."    _N"This function returns the length of the file that File-Stream is open to."
377    (stream-dispatch stream    (stream-dispatch stream
378      ;; simple-stream      ;; simple-stream
379      (stream::%file-length stream)      (stream::%file-length stream)
# Line 383  Line 385 
385    
386  (defun read-line (&optional (stream *standard-input*) (eof-errorp t) eof-value  (defun read-line (&optional (stream *standard-input*) (eof-errorp t) eof-value
387                              recursive-p)                              recursive-p)
388    "Returns a line of text read from the Stream as a string, discarding the    _N"Returns a line of text read from the Stream as a string, discarding the
389    newline character."    newline character."
390    (let ((stream (in-synonym-of stream)))    (let ((stream (in-synonym-of stream)))
391      (stream-dispatch stream      (stream-dispatch stream
# Line 429  Line 431 
431  (declaim (inline read-char unread-char read-byte listen))  (declaim (inline read-char unread-char read-byte listen))
432  (defun read-char (&optional (stream *standard-input*) (eof-errorp t) eof-value  (defun read-char (&optional (stream *standard-input*) (eof-errorp t) eof-value
433                              recursive-p)                              recursive-p)
434    "Inputs a character from Stream and returns it."    _N"Inputs a character from Stream and returns it."
435    (let ((stream (in-synonym-of stream)))    (let ((stream (in-synonym-of stream)))
436      (stream-dispatch stream      (stream-dispatch stream
437        ;; simple-stream        ;; simple-stream
# Line 446  Line 448 
448              char)))))              char)))))
449    
450  (defun unread-char (character &optional (stream *standard-input*))  (defun unread-char (character &optional (stream *standard-input*))
451    "Puts the Character back on the front of the input Stream."    _N"Puts the Character back on the front of the input Stream."
452    (let ((stream (in-synonym-of stream)))    (let ((stream (in-synonym-of stream)))
453      (stream-dispatch stream      (stream-dispatch stream
454        ;; simple-stream        ;; simple-stream
# Line 456  Line 458 
458        (let ((index (1- (lisp-stream-in-index stream)))        (let ((index (1- (lisp-stream-in-index stream)))
459              (buffer (lisp-stream-in-buffer stream)))              (buffer (lisp-stream-in-buffer stream)))
460          (declare (fixnum index))          (declare (fixnum index))
461          (when (minusp index) (error "Nothing to unread."))          (when (minusp index) (error _"Nothing to unread."))
462          (cond (buffer          (cond (buffer
463                 (setf (aref buffer index) (char-code character))                 (setf (aref buffer index) (char-code character))
464                 (setf (lisp-stream-in-index stream) index))                 (setf (lisp-stream-in-index stream) index))
# Line 469  Line 471 
471          (cond (sbuf          (cond (sbuf
472                 (let ((index (1- (lisp-stream-string-index stream))))                 (let ((index (1- (lisp-stream-string-index stream))))
473                   (when (minusp index)                   (when (minusp index)
474                     (error "Nothing to unread."))                     (error _"Nothing to unread."))
475                   (setf (aref sbuf index) character)                   (setf (aref sbuf index) character)
476                   (setf (lisp-stream-string-index stream) index)))                   (setf (lisp-stream-string-index stream) index)))
477                (ibuf                (ibuf
478                 (let ((index (1- (lisp-stream-in-index stream))))                 (let ((index (1- (lisp-stream-in-index stream))))
479                   (when (minusp index)                   (when (minusp index)
480                     (error "Nothing to unread."))                     (error _"Nothing to unread."))
481                   ;; This only works for iso8859-1!                   ;; This only works for iso8859-1!
482                   (setf (aref ibuf index) (char-code character))                   (setf (aref ibuf index) (char-code character))
483                   (setf (lisp-stream-in-index stream) index)))                   (setf (lisp-stream-in-index stream) index)))
# Line 539  Line 541 
541                    eof-detected-form))                    eof-detected-form))
542             ,char-var)             ,char-var)
543            (t            (t
544             (error "Impossible case reached in PEEK-CHAR")))))             (error _"Impossible case reached in PEEK-CHAR")))))
545    
546  (defun peek-char (&optional (peek-type nil) (stream *standard-input*)  (defun peek-char (&optional (peek-type nil) (stream *standard-input*)
547                              (eof-errorp t) eof-value recursive-p)                              (eof-errorp t) eof-value recursive-p)
548    "Peeks at the next character in the input Stream.  See manual for details."    _N"Peeks at the next character in the input Stream.  See manual for details."
549    ;; FIXME: The type of PEEK-TYPE is also declared in a DEFKNOWN, but    ;; FIXME: The type of PEEK-TYPE is also declared in a DEFKNOWN, but
550    ;; the compiler doesn't seem to be smart enough to go from there to    ;; the compiler doesn't seem to be smart enough to go from there to
551    ;; imposing a type check. Figure out why (because PEEK-TYPE is an    ;; imposing a type check. Figure out why (because PEEK-TYPE is an
# Line 553  Line 555 
555      (error 'simple-type-error      (error 'simple-type-error
556             :datum peek-type             :datum peek-type
557             :expected-type '(or character boolean)             :expected-type '(or character boolean)
558             :format-control "~@<bad PEEK-TYPE=~S, ~_expected ~S~:>"             :format-control _"~@<bad PEEK-TYPE=~S, ~_expected ~S~:>"
559             :format-arguments (list peek-type '(or character boolean))))             :format-arguments (list peek-type '(or character boolean))))
560    (let ((stream (in-synonym-of stream)))    (let ((stream (in-synonym-of stream)))
561      (if (typep stream 'echo-stream)      (if (typep stream 'echo-stream)
# Line 584  Line 586 
586             :eof-detected-form (eof-or-lose stream eof-errorp eof-value))))))             :eof-detected-form (eof-or-lose stream eof-errorp eof-value))))))
587    
588  (defun listen (&optional (stream *standard-input*) (width 1))  (defun listen (&optional (stream *standard-input*) (width 1))
589    "Returns T if a character is available on the given Stream."    _N"Returns T if a character is available on the given Stream."
590    (declare (type streamlike stream))    (declare (type streamlike stream))
591    (let ((stream (in-synonym-of stream)))    (let ((stream (in-synonym-of stream)))
592      (stream-dispatch stream      (stream-dispatch stream
# Line 599  Line 601 
601    
602  (defun read-char-no-hang (&optional (stream *standard-input*)  (defun read-char-no-hang (&optional (stream *standard-input*)
603                                      (eof-errorp t) eof-value recursive-p)                                      (eof-errorp t) eof-value recursive-p)
604    "Returns the next character from the Stream if one is available, or nil."    _N"Returns the next character from the Stream if one is available, or nil."
605    (let ((stream (in-synonym-of stream)))    (let ((stream (in-synonym-of stream)))
606      (stream-dispatch stream      (stream-dispatch stream
607        ;; simple-stream        ;; simple-stream
# Line 617  Line 619 
619    
620    
621  (defun clear-input (&optional (stream *standard-input*) buffer-only)  (defun clear-input (&optional (stream *standard-input*) buffer-only)
622    "Clears any buffered input associated with the Stream."    _N"Clears any buffered input associated with the Stream."
623    (declare (type streamlike stream))    (declare (type streamlike stream))
624    (let ((stream (in-synonym-of stream)))    (let ((stream (in-synonym-of stream)))
625      (stream-dispatch stream      (stream-dispatch stream
# Line 632  Line 634 
634    nil)    nil)
635    
636  (defun read-byte (stream &optional (eof-errorp t) eof-value)  (defun read-byte (stream &optional (eof-errorp t) eof-value)
637    "Returns the next byte of the Stream."    _N"Returns the next byte of the Stream."
638    (declare (type stream stream))    (declare (type stream stream))
639    (let ((stream (in-synonym-of stream)))    (let ((stream (in-synonym-of stream)))
640      (stream-dispatch stream      (stream-dispatch stream
# Line 650  Line 652 
652              char)))))              char)))))
653    
654  (defun read-n-bytes (stream buffer start numbytes &optional (eof-errorp t))  (defun read-n-bytes (stream buffer start numbytes &optional (eof-errorp t))
655    "Reads Numbytes bytes into the Buffer starting at Start, returning the number    _N"Reads Numbytes bytes into the Buffer starting at Start, returning the number
656     of bytes read.     of bytes read.
657     -- If EOF-ERROR-P is true, an END-OF-FILE condition is signalled if     -- If EOF-ERROR-P is true, an END-OF-FILE condition is signalled if
658        end-of-file is encountered before Count bytes have been read.        end-of-file is encountered before Count bytes have been read.
# Line 815  Line 817 
817  ;;; Output functions:  ;;; Output functions:
818    
819  (defun write-char (character &optional (stream *standard-output*))  (defun write-char (character &optional (stream *standard-output*))
820    "Outputs the Character to the Stream."    _N"Outputs the Character to the Stream."
821    (declare (type streamlike stream))    (declare (type streamlike stream))
822    (let ((stream (out-synonym-of stream)))    (let ((stream (out-synonym-of stream)))
823      (stream-dispatch stream      (stream-dispatch stream
# Line 828  Line 830 
830    character)    character)
831    
832  (defun terpri (&optional (stream *standard-output*))  (defun terpri (&optional (stream *standard-output*))
833    "Outputs a new line to the Stream."    _N"Outputs a new line to the Stream."
834    (declare (type streamlike stream))    (declare (type streamlike stream))
835    (let ((stream (out-synonym-of stream)))    (let ((stream (out-synonym-of stream)))
836      (stream-dispatch stream      (stream-dispatch stream
# Line 841  Line 843 
843    nil)    nil)
844    
845  (defun fresh-line (&optional (stream *standard-output*))  (defun fresh-line (&optional (stream *standard-output*))
846    "Outputs a new line to the Stream if it is not positioned at the beginning of    _N"Outputs a new line to the Stream if it is not positioned at the beginning of
847     a line.  Returns T if it output a new line, nil otherwise."     a line.  Returns T if it output a new line, nil otherwise."
848    (declare (type streamlike stream))    (declare (type streamlike stream))
849    (let ((stream (out-synonym-of stream)))    (let ((stream (out-synonym-of stream)))
# Line 857  Line 859 
859    
860  (defun write-string (string &optional (stream *standard-output*)  (defun write-string (string &optional (stream *standard-output*)
861                              &key (start 0) end)                              &key (start 0) end)
862    "Outputs the String to the given Stream."    _N"Outputs the String to the given Stream."
863    (write-string* string stream start (or end (length (the vector string)))))    (write-string* string stream start (or end (length (the vector string)))))
864    
865  (defun write-string* (string &optional (stream *standard-output*)  (defun write-string* (string &optional (stream *standard-output*)
# Line 884  Line 886 
886    
887  (defun write-line (string &optional (stream *standard-output*)  (defun write-line (string &optional (stream *standard-output*)
888                            &key (start 0) (end (length string)))                            &key (start 0) (end (length string)))
889    "Outputs the String to the given Stream, followed by a newline character."    _N"Outputs the String to the given Stream, followed by a newline character."
890    (write-line* string stream start (or end (length string))))    (write-line* string stream start (or end (length string))))
891    
892  (defun write-line* (string &optional (stream *standard-output*)  (defun write-line* (string &optional (stream *standard-output*)
# Line 916  Line 918 
918      string))      string))
919    
920  (defun charpos (&optional (stream *standard-output*))  (defun charpos (&optional (stream *standard-output*))
921    "Returns the number of characters on the current line of output of the given    _N"Returns the number of characters on the current line of output of the given
922    Stream, or Nil if that information is not availible."    Stream, or Nil if that information is not availible."
923    (declare (type streamlike stream))    (declare (type streamlike stream))
924    (let ((stream (out-synonym-of stream)))    (let ((stream (out-synonym-of stream)))
# Line 929  Line 931 
931        (stream-line-column stream))))        (stream-line-column stream))))
932    
933  (defun line-length (&optional (stream *standard-output*))  (defun line-length (&optional (stream *standard-output*))
934    "Returns the number of characters that will fit on a line of output on the    _N"Returns the number of characters that will fit on a line of output on the
935    given Stream, or Nil if that information is not available."    given Stream, or Nil if that information is not available."
936    (declare (type streamlike stream))    (declare (type streamlike stream))
937    (let ((stream (out-synonym-of stream)))    (let ((stream (out-synonym-of stream)))
# Line 942  Line 944 
944        (stream-line-length stream))))        (stream-line-length stream))))
945    
946  (defun finish-output (&optional (stream *standard-output*))  (defun finish-output (&optional (stream *standard-output*))
947    "Attempts to ensure that all output sent to the Stream has reached its    _N"Attempts to ensure that all output sent to the Stream has reached its
948     destination, and only then returns."     destination, and only then returns."
949    (declare (type streamlike stream))    (declare (type streamlike stream))
950    (let ((stream (out-synonym-of stream)))    (let ((stream (out-synonym-of stream)))
# Line 956  Line 958 
958    nil)    nil)
959    
960  (defun force-output (&optional (stream *standard-output*))  (defun force-output (&optional (stream *standard-output*))
961    "Attempts to force any buffered output to be sent."    _N"Attempts to force any buffered output to be sent."
962    (declare (type streamlike stream))    (declare (type streamlike stream))
963    (let ((stream (out-synonym-of stream)))    (let ((stream (out-synonym-of stream)))
964      (stream-dispatch stream      (stream-dispatch stream
# Line 969  Line 971 
971    nil)    nil)
972    
973  (defun clear-output (&optional (stream *standard-output*))  (defun clear-output (&optional (stream *standard-output*))
974    "Clears the given output Stream."    _N"Clears the given output Stream."
975    (declare (type streamlike stream))    (declare (type streamlike stream))
976    (let ((stream (out-synonym-of stream)))    (let ((stream (out-synonym-of stream)))
977      (stream-dispatch stream      (stream-dispatch stream
# Line 982  Line 984 
984    nil)    nil)
985    
986  (defun write-byte (integer stream)  (defun write-byte (integer stream)
987    "Outputs the Integer to the binary Stream."    _N"Outputs the Integer to the binary Stream."
988    (declare (type stream stream))    (declare (type stream stream))
989    (let ((stream (out-synonym-of stream)))    (let ((stream (out-synonym-of stream)))
990      (stream-dispatch stream      (stream-dispatch stream
# Line 1048  Line 1050 
1050    (streams () :type list :read-only t))    (streams () :type list :read-only t))
1051    
1052  (defun make-broadcast-stream (&rest streams)  (defun make-broadcast-stream (&rest streams)
1053    "Returns an output stream which sends its output to all of the given    _N"Returns an output stream which sends its output to all of the given
1054  streams."  streams."
1055    (dolist (s streams)    (dolist (s streams)
1056      (unless (output-stream-p s)      (unless (output-stream-p s)
# Line 1140  streams." Line 1142  streams."
1142    (format stream "#<Synonym Stream to ~S>" (synonym-stream-symbol s)))    (format stream "#<Synonym Stream to ~S>" (synonym-stream-symbol s)))
1143    
1144  (setf (documentation 'make-synonym-stream 'function)  (setf (documentation 'make-synonym-stream 'function)
1145    "Returns a stream which performs its operations on the stream which is the    _N"Returns a stream which performs its operations on the stream which is the
1146     value of the dynamic variable named by Symbol.")     value of the dynamic variable named by Symbol.")
1147    
1148  ;;; The output simple output methods just call the corresponding method  ;;; The output simple output methods just call the corresponding method
# Line 1222  streams." Line 1224  streams."
1224            (two-way-stream-output-stream s)))            (two-way-stream-output-stream s)))
1225    
1226  (defun make-two-way-stream (input-stream output-stream)  (defun make-two-way-stream (input-stream output-stream)
1227    "Returns a bidirectional stream which gets its input from Input-Stream and    _N"Returns a bidirectional stream which gets its input from Input-Stream and
1228     sends its output to Output-Stream."     sends its output to Output-Stream."
1229    (unless (input-stream-p input-stream)    (unless (input-stream-p input-stream)
1230      (ill-in-any input-stream))      (ill-in-any input-stream))
# Line 1308  streams." Line 1310  streams."
1310            (concatenated-stream-streams s)))            (concatenated-stream-streams s)))
1311    
1312  (defun make-concatenated-stream (&rest streams)  (defun make-concatenated-stream (&rest streams)
1313    "Returns a stream which takes its input from each of the Streams in turn,    _N"Returns a stream which takes its input from each of the Streams in turn,
1314     going on to the next at EOF."     going on to the next at EOF."
1315    (dolist (s streams)    (dolist (s streams)
1316      (unless (input-stream-p s)      (unless (input-stream-p s)
# Line 1393  streams." Line 1395  streams."
1395    unread-stuff)    unread-stuff)
1396    
1397  (defun make-echo-stream (input-stream output-stream)  (defun make-echo-stream (input-stream output-stream)
1398    "Returns an echo stream that takes input from Input-stream and sends    _N"Returns an echo stream that takes input from Input-stream and sends
1399  output to Output-stream"  output to Output-stream"
1400    (unless (input-stream-p input-stream)    (unless (input-stream-p input-stream)
1401      (ill-in-any input-stream))      (ill-in-any input-stream))
# Line 1511  output to Output-stream" Line 1513  output to Output-stream"
1513            (two-way-stream-output-stream s)))            (two-way-stream-output-stream s)))
1514    
1515  (setf (documentation 'make-echo-stream 'function)  (setf (documentation 'make-echo-stream 'function)
1516    "Returns a bidirectional stream which gets its input from Input-Stream and    _N"Returns a bidirectional stream which gets its input from Input-Stream and
1517     sends its output to Output-Stream.  In addition, all input is echoed to     sends its output to Output-Stream.  In addition, all input is echoed to
1518     the output stream")     the output stream")
1519    
# Line 1610  output to Output-stream" Line 1612  output to Output-stream"
1612    
1613  (defun make-string-input-stream (string &optional  (defun make-string-input-stream (string &optional
1614                                          (start 0) (end (length string)))                                          (start 0) (end (length string)))
1615    "Returns an input stream which will supply the characters of String between    _N"Returns an input stream which will supply the characters of String between
1616    Start and End in order."    Start and End in order."
1617    (declare (type string string)    (declare (type string string)
1618             (type index start)             (type index start)
# Line 1637  output to Output-stream" Line 1639  output to Output-stream"
1639    (write-string "#<String-Output Stream>" stream))    (write-string "#<String-Output Stream>" stream))
1640    
1641  (defun make-string-output-stream (&key (element-type 'character))  (defun make-string-output-stream (&key (element-type 'character))
1642    "Returns an Output stream which will accumulate all output given to it for    _N"Returns an Output stream which will accumulate all output given to it for
1643     the benefit of the function Get-Output-Stream-String."     the benefit of the function Get-Output-Stream-String."
1644    (declare (ignore element-type))    (declare (ignore element-type))
1645    (%make-string-output-stream))    (%make-string-output-stream))
# Line 1697  output to Output-stream" Line 1699  output to Output-stream"
1699       (set-closed-flame stream))))       (set-closed-flame stream))))
1700    
1701  (defun get-output-stream-string (stream)  (defun get-output-stream-string (stream)
1702    "Returns a string of all the characters sent to a stream made by    _N"Returns a string of all the characters sent to a stream made by
1703     Make-String-Output-Stream since the last call to this function."     Make-String-Output-Stream since the last call to this function."
1704    (declare (type string-output-stream stream))    (declare (type string-output-stream stream))
1705    (let* ((length (string-output-stream-index stream))    (let* ((length (string-output-stream-index stream))
# Line 1707  output to Output-stream" Line 1709  output to Output-stream"
1709      result))      result))
1710    
1711  (defun dump-output-stream-string (in-stream out-stream)  (defun dump-output-stream-string (in-stream out-stream)
1712    "Dumps the characters buffer up in the In-Stream to the Out-Stream as    _N"Dumps the characters buffer up in the In-Stream to the Out-Stream as
1713    Get-Output-Stream-String would return them."    Get-Output-Stream-String would return them."
1714    (write-string* (string-output-stream-string in-stream) out-stream    (write-string* (string-output-stream-string in-stream) out-stream
1715                   0 (string-output-stream-index in-stream))                   0 (string-output-stream-index in-stream))
# Line 1815  output to Output-stream" Line 1817  output to Output-stream"
1817    (indentation 0))    (indentation 0))
1818    
1819  (setf (documentation 'make-indenting-stream 'function)  (setf (documentation 'make-indenting-stream 'function)
1820   "Returns an output stream which indents its output by some amount.")   _N"Returns an output stream which indents its output by some amount.")
1821    
1822  (defun %print-indenting-stream (s stream d)  (defun %print-indenting-stream (s stream d)
1823    (declare (ignore s d))    (declare (ignore s d))
# Line 1902  output to Output-stream" Line 1904  output to Output-stream"
1904    (target (required-argument) :type stream))    (target (required-argument) :type stream))
1905    
1906  (defun make-case-frob-stream (target kind)  (defun make-case-frob-stream (target kind)
1907    "Returns a stream that sends all output to the stream TARGET, but modifies    _N"Returns a stream that sends all output to the stream TARGET, but modifies
1908     the case of letters, depending on KIND, which should be one of:     the case of letters, depending on KIND, which should be one of:
1909       :upcase - convert to upper case.       :upcase - convert to upper case.
1910       :downcase - convert to lower case.       :downcase - convert to lower case.
# Line 2151  output to Output-stream" Line 2153  output to Output-stream"
2153  ;;; LISTEN fails, then we have some random stream we must wait on.  ;;; LISTEN fails, then we have some random stream we must wait on.
2154  ;;;  ;;;
2155  (defun get-stream-command (stream)  (defun get-stream-command (stream)
2156    "This takes a stream and waits for text or a command to appear on it.  If    _N"This takes a stream and waits for text or a command to appear on it.  If
2157     text appears before a command, this returns nil, and otherwise it returns     text appears before a command, this returns nil, and otherwise it returns
2158     a command."     a command."
2159    (let ((cmdp (funcall (lisp-stream-misc stream) stream :get-command)))    (let ((cmdp (funcall (lisp-stream-misc stream) stream :get-command)))
# Line 2166  output to Output-stream" Line 2168  output to Output-stream"
2168  ;;; READ-SEQUENCE --  ;;; READ-SEQUENCE --
2169    
2170  (defun read-sequence (seq stream &key (start 0) (end nil) partial-fill)  (defun read-sequence (seq stream &key (start 0) (end nil) partial-fill)
2171    "Destructively modify SEQ by reading elements from STREAM.    _N"Destructively modify SEQ by reading elements from STREAM.
2172    
2173    Seq is bounded by Start and End. Seq is destructively modified by    Seq is bounded by Start and End. Seq is destructively modified by
2174    copying successive elements into it from Stream. If the end of file    copying successive elements into it from Stream. If the end of file
# Line 2203  output to Output-stream" Line 2205  output to Output-stream"
2205        (cond ((not (open-stream-p stream))        (cond ((not (open-stream-p stream))
2206               (error 'simple-stream-error               (error 'simple-stream-error
2207                      :stream stream                      :stream stream
2208                      :format-control "The stream is not open."))                      :format-control _"The stream is not open."))
2209              ((not (input-stream-p stream))              ((not (input-stream-p stream))
2210               (error 'simple-stream-error               (error 'simple-stream-error
2211                      :stream stream                      :stream stream
2212                      :format-control "The stream is not open for input."))                      :format-control _"The stream is not open for input."))
2213              ((and seq (>= start end) 0))              ((and seq (>= start end) 0))
2214              (t              (t
2215               ;; So much for object-oriented programming!               ;; So much for object-oriented programming!
# Line 2291  output to Output-stream" Line 2293  output to Output-stream"
2293      (error 'type-error      (error 'type-error
2294             :datum (read-char stream nil #\Null)             :datum (read-char stream nil #\Null)
2295             :expected-type (stream-element-type stream)             :expected-type (stream-element-type stream)
2296             :format-control "Trying to read characters from a binary stream."))             :format-control _"Trying to read characters from a binary stream."))
2297    ;; Let's go as low level as it seems reasonable.    ;; Let's go as low level as it seems reasonable.
2298    (let* ((numbytes (- end start))    (let* ((numbytes (- end start))
2299           (total-bytes 0))           (total-bytes 0))
# Line 2319  output to Output-stream" Line 2321  output to Output-stream"
2321      (error 'type-error      (error 'type-error
2322             :datum (read-char stream nil #\Null)             :datum (read-char stream nil #\Null)
2323             :expected-type (stream-element-type stream)             :expected-type (stream-element-type stream)
2324             :format-control "Trying to read characters from a binary stream."))             :format-control _"Trying to read characters from a binary stream."))
2325    ;; Let's go as low level as it seems reasonable.    ;; Let's go as low level as it seems reasonable.
2326    (let* ((numbytes (- end start))    (let* ((numbytes (- end start))
2327           (total-bytes 0))           (total-bytes 0))
# Line 2343  output to Output-stream" Line 2345  output to Output-stream"
2345      (error 'type-error      (error 'type-error
2346             :datum (read-char stream nil #\Null)             :datum (read-char stream nil #\Null)
2347             :expected-type (stream-element-type stream)             :expected-type (stream-element-type stream)
2348             :format-control "Trying to read characters from a binary stream."))             :format-control _"Trying to read characters from a binary stream."))
2349    (do ((i start (1+ i))    (do ((i start (1+ i))
2350         (s-len (length s)))         (s-len (length s)))
2351        ((or (>= i s-len)        ((or (>= i s-len)
# Line 2416  output to Output-stream" Line 2418  output to Output-stream"
2418                    :datum (read-byte stream nil 0)                    :datum (read-byte stream nil 0)
2419                    :expected-type (stream-element-type stream) ; Bogus?!?                    :expected-type (stream-element-type stream) ; Bogus?!?
2420                    :format-control                    :format-control
2421                    "Trying to read binary data from a text stream."))                    _"Trying to read binary data from a text stream."))
2422    
2423            ;; Let's go as low level as it seems reasonable.            ;; Let's go as low level as it seems reasonable.
2424            ((not (member stream-et            ((not (member stream-et
# Line 2534  output to Output-stream" Line 2536  output to Output-stream"
2536  ;;; will always puzzle me.  ;;; will always puzzle me.
2537    
2538  (defun write-sequence (seq stream &key (start 0) (end nil))  (defun write-sequence (seq stream &key (start 0) (end nil))
2539    "Writes the elements of the Seq bounded by Start and End to Stream.    _N"Writes the elements of the Seq bounded by Start and End to Stream.
2540    
2541    Argument(s):    Argument(s):
2542    SEQ:     a proper SEQUENCE    SEQ:     a proper SEQUENCE
# Line 2563  output to Output-stream" Line 2565  output to Output-stream"
2565        (cond ((not (open-stream-p stream))        (cond ((not (open-stream-p stream))
2566               (error 'simple-stream-error               (error 'simple-stream-error
2567                      :stream stream                      :stream stream
2568                      :format-control "The stream is not open."))                      :format-control _"The stream is not open."))
2569              ((not (output-stream-p stream))              ((not (output-stream-p stream))
2570               (error 'simple-stream-error               (error 'simple-stream-error
2571                      :stream stream                      :stream stream
2572                      :format-control "The stream is not open for output."))                      :format-control _"The stream is not open for output."))
2573              ((and seq (>= start end)) seq)              ((and seq (>= start end)) seq)
2574              (t              (t
2575               ;; So much for object-oriented programming!               ;; So much for object-oriented programming!
# Line 2619  output to Output-stream" Line 2621  output to Output-stream"
2621                        :datum e                        :datum e
2622                        :expected-type type                        :expected-type type
2623                        :format-control                        :format-control
2624                        "Trying to output an element of unproper type to a stream.")))))                        _"Trying to output an element of unproper type to a stream.")))))
2625      (let ((stream-et (stream-element-type stream)))      (let ((stream-et (stream-element-type stream)))
2626    
2627        (check-list-element-types seq stream-et)        (check-list-element-types seq stream-et)
# Line 2661  output to Output-stream" Line 2663  output to Output-stream"
2663      (error 'type-error      (error 'type-error
2664             :datum seq             :datum seq
2665             :expected-type (stream-element-type stream)             :expected-type (stream-element-type stream)
2666             :format-control "Trying to output a string to a binary stream."))             :format-control _"Trying to output a string to a binary stream."))
2667    (write-string seq stream :start start :end end)    (write-string seq stream :start start :end end)
2668    seq)    seq)
2669    
# Line 2698  output to Output-stream" Line 2700  output to Output-stream"
2700      (error 'simple-type-error      (error 'simple-type-error
2701             :datum (elt seq 0)             :datum (elt seq 0)
2702             :expected-type (stream-element-type stream)             :expected-type (stream-element-type stream)
2703             :format-control "Trying to output binary data to a text stream."))             :format-control _"Trying to output binary data to a text stream."))
2704    (cond ((system:fd-stream-p stream)    (cond ((system:fd-stream-p stream)
2705           (flet ((write-n-x8-bytes (stream data start end byte-size)           (flet ((write-n-x8-bytes (stream data start end byte-size)
2706                    (let ((x8-mult (truncate byte-size 8)))                    (let ((x8-mult (truncate byte-size 8)))
# Line 2769  output to Output-stream" Line 2771  output to Output-stream"
2771  ;;; READ-SEQUENCE -- Public  ;;; READ-SEQUENCE -- Public
2772  ;;;  ;;;
2773  (defun read-sequence (seq stream &key (start 0) (end nil))  (defun read-sequence (seq stream &key (start 0) (end nil))
2774    "Destructively modify SEQ by reading elements from STREAM.    _N"Destructively modify SEQ by reading elements from STREAM.
2775    SEQ is bounded by START and END. SEQ is destructively modified by    SEQ is bounded by START and END. SEQ is destructively modified by
2776    copying successive elements into it from STREAM. If the end of file    copying successive elements into it from STREAM. If the end of file
2777    for STREAM is reached before copying all elements of the subsequence,    for STREAM is reached before copying all elements of the subsequence,
# Line 2832  output to Output-stream" Line 2834  output to Output-stream"
2834  ;;; WRITE-SEQUENCE -- Public  ;;; WRITE-SEQUENCE -- Public
2835  ;;;  ;;;
2836  (defun write-sequence (seq stream &key (start 0) (end nil))  (defun write-sequence (seq stream &key (start 0) (end nil))
2837    "Write the elements of SEQ bounded by START and END to STREAM."    _N"Write the elements of SEQ bounded by START and END to STREAM."
2838    (declare (type sequence seq)    (declare (type sequence seq)
2839             (type stream stream)             (type stream stream)
2840             (type index start)             (type index start)

Legend:
Removed from v.1.89  
changed lines
  Added in v.1.89.4.1

  ViewVC Help
Powered by ViewVC 1.1.5