X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fgray-streams.lisp;h=38eb79ea664821b26d8da5bd6c6d3f7669f80833;hb=9c3a9502bc872f024c365412d991ef43fd866e4c;hp=2b0cc85d3e4aa9bff25871903757ca5cc239721b;hpb=61dc1d5c0b4988f7e957be876a9abf9f31d51e0a;p=sbcl.git diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp index 2b0cc85..38eb79e 100644 --- a/src/pcl/gray-streams.lisp +++ b/src/pcl/gray-streams.lisp @@ -88,7 +88,13 @@ (setf (stream-open-p stream) nil) t) -(setf (fdefinition 'close) #'pcl-close) +(progn + ;; KLUDGE: Get in a call to PCL-CLOSE with a string-output-stream before + ;; setting it as CLOSE. Otherwise using NAMED-LAMBDAs as DFUNs causes a + ;; vicious metacircle from FORMAT NIL somewhere in the compiler. This is + ;; enough to get the dispatch settled down before we need it. + (pcl-close (make-string-output-stream)) + (setf (fdefinition 'close) #'pcl-close)) (let () (fmakunbound 'input-stream-p) @@ -96,7 +102,7 @@ (defgeneric input-stream-p (stream) #+sb-doc (:documentation "Can STREAM perform input operations?")) - + (defmethod input-stream-p ((stream ansi-stream)) (ansi-stream-input-stream-p stream)) @@ -108,11 +114,30 @@ (defmethod input-stream-p ((stream stream)) (bug-or-error stream 'input-stream-p)) - + (defmethod input-stream-p ((non-stream t)) (error 'type-error :datum non-stream :expected-type 'stream))) (let () + (fmakunbound 'interactive-stream-p) + + (defgeneric interactive-stream-p (stream) + #+sb-doc + (:documentation "Is STREAM an interactive stream?")) + + (defmethod interactive-stream-p ((stream ansi-stream)) + (funcall (ansi-stream-misc stream) stream :interactive-p)) + + (defmethod interactive-stream-p ((stream fundamental-stream)) + nil) + + (defmethod interactive-stream-p ((stream stream)) + (bug-or-error stream 'interactive-stream-p)) + + (defmethod interactive-stream-p ((non-stream t)) + (error 'type-error :datum non-stream :expected-type 'stream))) + +(let () (fmakunbound 'output-stream-p) (defgeneric output-stream-p (stream) @@ -124,7 +149,7 @@ (defmethod output-stream-p ((stream fundamental-stream)) nil) - + (defmethod output-stream-p ((stream fundamental-output-stream)) t) @@ -205,22 +230,22 @@ (defmethod stream-read-line ((stream fundamental-character-input-stream)) (let ((res (make-string 80)) - (len 80) - (index 0)) + (len 80) + (index 0)) (loop (let ((ch (stream-read-char stream))) (cond ((eq ch :eof) - (return (values (shrink-vector res index) t))) - (t - (when (char= ch #\newline) - (return (values (shrink-vector res index) nil))) - (when (= index len) - (setq len (* len 2)) - (let ((new (make-string len))) - (replace new res) - (setq res new))) - (setf (schar res index) ch) - (incf index))))))) + (return (values (%shrink-vector res index) t))) + (t + (when (char= ch #\newline) + (return (values (%shrink-vector res index) nil))) + (when (= index len) + (setq len (* len 2)) + (let ((new (make-string len))) + (replace new res) + (setq res new))) + (setf (schar res index) ch) + (incf index))))))) (defgeneric stream-clear-input (stream) #+sb-doc @@ -236,6 +261,7 @@ (error 'type-error :datum non-stream :expected-type 'stream)) (defgeneric stream-read-sequence (stream seq &optional start end) + #+sb-doc (:documentation "This is like CL:READ-SEQUENCE, but for Gray streams.")) @@ -247,11 +273,11 @@ ;;; not updated, and the index of the next element is returned. (defun basic-io-type-stream-read-sequence (stream seq start end read-fun) (declare (type sequence seq) - (type stream stream) - (type index start) - (type sequence-end end) + (type stream stream) + (type index start) + (type sequence-end end) (type function read-fun) - (values index)) + (values index)) (let ((end (or end (length seq)))) (declare (type index end)) (etypecase seq @@ -353,13 +379,13 @@ STREAM-WRITE-CHAR.")) (defmethod stream-write-string ((stream fundamental-character-output-stream) - string &optional (start 0) end) + string &optional (start 0) end) (declare (string string) - (fixnum start)) + (fixnum start)) (let ((end (or end (length string)))) (declare (fixnum end)) (do ((pos start (1+ pos))) - ((>= pos end)) + ((>= pos end)) (declare (type index pos)) (stream-write-char stream (aref string pos)))) string) @@ -437,26 +463,27 @@ #\SPACE character; it returns NIL if STREAM-LINE-COLUMN returns NIL.")) (defmethod stream-advance-to-column ((stream fundamental-character-output-stream) - column) + column) (let ((current-column (stream-line-column stream))) (when current-column (let ((fill (- column current-column))) - (dotimes (i fill) - (stream-write-char stream #\Space))) + (dotimes (i fill) + (stream-write-char stream #\Space))) T))) (defgeneric stream-write-sequence (stream seq &optional start end) + #+sb-doc (:documentation "This is like CL:WRITE-SEQUENCE, but for Gray streams.")) ;;; Write the elements of SEQ bounded by START and END to STREAM. (defun basic-io-type-stream-write-sequence (stream seq start end write-fun) (declare (type sequence seq) - (type stream stream) - (type index start) - (type sequence-end end) + (type stream stream) + (type index start) + (type sequence-end end) (type function write-fun) - (values sequence)) + (values sequence)) (let ((end (or end (length seq)))) (declare (type index start end)) (etypecase seq @@ -523,6 +550,18 @@ (basic-io-type-stream-write-sequence stream seq start end #'stream-write-byte)) +(defgeneric stream-file-position (stream &optional position-spec) + #+sb-doc + (:documentation + "Used by FILE-POSITION. Returns or changes the current position within STREAM.")) + +(defmethod stream-file-position ((stream ansi-stream) &optional position-spec) + (ansi-stream-file-position stream position-spec)) + +(defmethod stream-file-position ((stream t) &optional position-spec) + (declare (ignore stream position-spec)) + nil) + ;;; This is not in the Gray stream proposal, so it is left here ;;; as example code.