From: Juho Snellman <jsnell@iki.fi>
Date: Thu, 11 Jan 2007 21:41:59 +0000 (+0000)
Subject: 1.0.1.23:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=520a9274ee6db138ecb8e056f3c524afac1d0c88;p=sbcl.git

1.0.1.23:
        Add generic function STREAM-FILE-POSITION, used to provide an
        implementation of FILE-POSITION for Gray streams (thanks to Eric
        Marsden).
---

diff --git a/NEWS b/NEWS
index bdde696..5fe4cfd 100644
--- a/NEWS
+++ b/NEWS
@@ -10,6 +10,9 @@ changes in sbcl-1.0.2 relative to sbcl-1.0.1:
   * improvement: support for executable cores on NetBSD (thanks to 
     Richard Kreuter)
   * new feature: added a RESTART-FRAME debugger command
+  * new feature: new generic function SB-GRAY:STREAM-FILE-POSITION can 
+    be used to provide an implementation for FILE-POSITION on Gray streams
+    (thanks to Eric Marsden)
   * optimization: the function call overhead in code compiled with 
     a high DEBUG optimization setting is significantly 
   * bug fix: an error is signaled for attempts to use READ-SEQUENCE
diff --git a/doc/manual/streams.texinfo b/doc/manual/streams.texinfo
index ddb0003..243ccf4 100644
--- a/doc/manual/streams.texinfo
+++ b/doc/manual/streams.texinfo
@@ -105,7 +105,7 @@ of fundamental-stream.
 
 @include fun-common-lisp-stream-element-type.texinfo
 @include fun-common-lisp-close.texinfo
-
+@include fun-sb-gray-stream-file-position.texinfo
 
 
 
diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 1fd8ae0..580b77f 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -763,7 +763,7 @@ Lisp extension proposal by David N. Gray"
                "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 609df65..61e786c 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -176,9 +176,10 @@
                      (- +ansi-stream-in-buffer-length+
                         (ansi-stream-in-index stream)))))))))))
 
-
 (defun file-position (stream &optional position)
-  (ansi-stream-file-position stream position))
+  (if (ansi-stream-p stream)
+      (ansi-stream-file-position stream position)
+      (stream-file-position stream position)))
 
 ;;; This is a literal translation of the ANSI glossary entry "stream
 ;;; associated with a file".
diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp
index 28ed0f1..7498eea 100644
--- a/src/pcl/gray-streams.lisp
+++ b/src/pcl/gray-streams.lisp
@@ -255,6 +255,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."))
 
@@ -465,6 +466,7 @@
       T)))
 
 (defgeneric stream-write-sequence (stream seq &optional start end)
+  #+sb-doc
   (:documentation
    "This is like CL:WRITE-SEQUENCE, but for Gray streams."))
 
@@ -542,6 +544,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.
diff --git a/tests/gray-streams.impure.lisp b/tests/gray-streams.impure.lisp
index f20c68b..181e0c1 100644
--- a/tests/gray-streams.impure.lisp
+++ b/tests/gray-streams.impure.lisp
@@ -60,7 +60,8 @@
 
 (defclass character-output-stream (fundamental-character-output-stream)
   ((lisp-stream :initarg :lisp-stream
-                :accessor character-output-stream-lisp-stream)))
+                :accessor character-output-stream-lisp-stream)
+   (position :initform 42 :accessor character-output-stream-position)))
 
 (defclass character-input-stream (fundamental-character-input-stream)
   ((lisp-stream :initarg :lisp-stream
@@ -100,6 +101,11 @@
 
 (defmethod stream-clear-output ((stream character-output-stream))
   (clear-output (character-output-stream-lisp-stream stream)))
+
+(defmethod stream-file-position ((stream character-output-stream) &optional new-value)
+  (if new-value
+      (setf (character-output-stream-position stream) new-value)
+      (character-output-stream-position stream)))
 
 ;;;; example character input stream encapsulating a lisp-stream
 
@@ -271,3 +277,11 @@
                      ((eq byte :eof))
                    (write-byte byte our-bin-to-char-output))))
              test-string))))
+
+
+
+;;; Minimal test of file-position
+(let ((stream (make-instance 'character-output-stream)))
+  (assert (= (file-position stream) 42))
+  (assert (file-position stream 50))
+  (assert (= (file-position stream) 50)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 82304ff..611eb22 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.1.22"
+"1.0.1.23"