From 9e687a21f823e0c9fd5af32ab112dbe66476a9c6 Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Sat, 9 Aug 2014 08:05:41 -0700 Subject: [PATCH] Fix ticket #100 by implementing STREAM-FILE-POSITION Implements STREAM-FILE-POSiTION and (SETF STREAM-FILE-POSITION). * code/stream.lisp: * Add support for Gray streams in FILE-POSITION. * pcl/gray-streams.lisp: * Define STREAM-FILE-POSITION and (SETF STREAM-FILE-POSITION). * Add methods on FUNDAMENTAL-STREAM, CHARACTER-INPUT-STREAM, and CHARACTER-OUTPUT-STREAM. * code/exports.lisp: * Export STREAM-FILE-POSITION. --- src/code/exports.lisp | 4 +++- src/code/stream.lisp | 8 +++++++- src/pcl/gray-streams.lisp | 26 ++++++++++++++++++++++++++ 3 files changed, 36 insertions(+), 2 deletions(-) diff --git a/src/code/exports.lisp b/src/code/exports.lisp index 5c8168da6..0f224f6c2 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 6cb5256ed..f59f9cb7d 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 32a800a28..8d01c5c87 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. ;;; -- GitLab