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