diff --git a/src/code/exports.lisp b/src/code/exports.lisp index 5c8168da656eed3b1635e800f808cda7d500c1c9..0f224f6c23e2cce48b27c9d13bec23fe77d9c0fb 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -1444,7 +1444,9 @@ "FUNDAMENTAL-INPUT-STREAM" "FUNDAMENTAL-OUTPUT-STREAM" "FUNDAMENTAL-STREAM" "STREAM-ADVANCE-TO-COLUMN" "STREAM-CLEAR-INPUT" - "STREAM-CLEAR-OUTPUT" "STREAM-FINISH-OUTPUT" "STREAM-FORCE-OUTPUT" + "STREAM-CLEAR-OUTPUT" + "STREAM-FILE-POSITION" + "STREAM-FINISH-OUTPUT" "STREAM-FORCE-OUTPUT" "STREAM-FRESH-LINE" "STREAM-LINE-COLUMN" "STREAM-LINE-LENGTH" "STREAM-LISTEN" "STREAM-PEEK-CHAR" "STREAM-READ-BYTE" "STREAM-READ-CHAR" "STREAM-READ-CHAR-NO-HANG" "STREAM-READ-LINE" diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 6cb5256eddd8a831bdaf40996f2e385db91e4a20..f59f9cb7dce8d7b18fed36ff1904bdb39e40836a 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -370,7 +370,13 @@ (when res (- res (- in-buffer-length (lisp-stream-in-index stream)))) #+unicode - res))))) + res))) + ;; fundamental stream + (cond + (position + (setf (stream-file-position stream) position)) + (t + (stream-file-position stream))))) ;;; File-Length -- Public diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp index 32a800a284831f6c61787aca4c10c03faab5ad56..8d01c5c8790200a82dfcd106a7f908b8898ea39f 100644 --- a/src/pcl/gray-streams.lisp +++ b/src/pcl/gray-streams.lisp @@ -347,6 +347,32 @@ (:documentation _N"Implements WRITE-SEQUENCE for the stream.")) +(defgeneric stream-file-position (stream) + (:documentation + _N"Implements FILE-POSITION for the stream.")) + +(defmethod stream-file-position ((stream fundamental-stream)) + nil) + +(defmethod stream-file-position ((stream character-input-stream)) + (file-position (character-input-stream-lisp-stream stream))) + +(defmethod stream-file-position ((stream character-output-stream)) + (file-position (character-output-stream-lisp-stream stream))) + +(defgeneric (setf stream-file-position) (position stream) + (:documentation + _N"Implements FILE-POSITION for the stream for setting the position.")) + +(defmethod (setf stream-file-position) (position (stream fundamental-stream)) + nil) + +(defmethod (setf stream-file-position) (position (stream character-input-stream)) + (file-position (character-input-stream-lisp-stream stream) position)) + +(defmethod (setf stream-file-position) (position (stream character-output-stream)) + (file-position (character-output-stream-lisp-stream stream) position)) + ;;; Binary streams. ;;;