[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2014-08-3-g9e687a2

[Raymond Toy]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, master has been updated
       via  9e687a21f823e0c9fd5af32ab112dbe66476a9c6 (commit)
      from  58924e7138257f318397b397bb563967fb00c540 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 9e687a21f823e0c9fd5af32ab112dbe66476a9c6
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat Aug 9 08:05:41 2014 -0700

    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.

diff --git a/src/code/exports.lisp b/src/code/exports.lisp
index 5c8168d..0f224f6 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 6cb5256..f59f9cb 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 32a800a..8d01c5c 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.
 ;;;

-----------------------------------------------------------------------

Summary of changes:
 src/code/exports.lisp     |    4 +++-
 src/code/stream.lisp      |    8 +++++++-
 src/pcl/gray-streams.lisp |   26 ++++++++++++++++++++++++++
 3 files changed, 36 insertions(+), 2 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp