From 80962ea9b48d5fa845d520cf88b3b13ef991cbbd Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@juanjo-imac.local>
Date: Wed, 10 Dec 2008 16:16:46 +0100
Subject: [PATCH] Added a new method, STREAM-FILE-POSITION, for compatibility
 with SBCL's Gray streams

---
 src/CHANGELOG         |  2 ++
 src/c/file.d          | 10 ++++++----
 src/c/symbols_list.h  |  1 +
 src/c/symbols_list2.h |  1 +
 src/clos/streams.lsp  | 12 ++++++++++++
 5 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index 34b80cdb0..1478aba70 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -75,6 +75,8 @@ ECL 8.9.0:
 
  - We now ship version 0.7.3 of the portable CLX library.
 
+ - A new method, STREAM-FILE-POSITION, has been added to the Gray streams package.
+
 * Embedding:
 
  - ECL now implements a more transparent interface for setting and querying
diff --git a/src/c/file.d b/src/c/file.d
index 8d6ed2f7d..28eab6207 100644
--- a/src/c/file.d
+++ b/src/c/file.d
@@ -2115,8 +2115,9 @@ ecl_file_position(cl_object strm)
 	cl_object output;
 BEGIN:
 #ifdef ECL_CLOS_STREAMS
-	if (ECL_INSTANCEP(strm))
-		FEerror("file-position not implemented for CLOS streams", 0);
+	if (ECL_INSTANCEP(strm)) {
+		return funcall(2, @'gray::stream-file-position', strm);
+	}
 #endif
 	if (type_of(strm) != t_stream)
 		FEtype_error_stream(strm);
@@ -2206,8 +2207,9 @@ ecl_file_position_set(cl_object strm, cl_object large_disp)
 	int extra = 0;
 BEGIN:
 #ifdef ECL_CLOS_STREAMS
-	if (ECL_INSTANCEP(strm))
-		FEerror("file-position not implemented for CLOS streams", 0);
+	if (ECL_INSTANCEP(strm)) {
+		return funcall(3, @'gray::stream-file-position', strm, large_disp);
+	}
 #endif
 	if (type_of(strm) != t_stream) 
 		FEtype_error_stream(strm);
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index ccd9abf3a..0a3e05c5d 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1655,6 +1655,7 @@ cl_symbols[] = {
 {GRAY_ "STREAM-CLEAR-INPUT", GRAY_ORDINARY, NULL, -1, OBJNULL},
 {GRAY_ "STREAM-CLEAR-OUTPUT", GRAY_ORDINARY, NULL, -1, OBJNULL},
 {GRAY_ "STREAM-ELEMENT-TYPE", GRAY_ORDINARY, NULL, 1, OBJNULL},
+{GRAY_ "STREAM-FILE-POSITION", GRAY_ORDINARY, NULL, -1, OBJNULL},
 {GRAY_ "STREAM-FINISH-OUTPUT", GRAY_ORDINARY, NULL, -1, OBJNULL},
 {GRAY_ "STREAM-FORCE-OUTPUT", GRAY_ORDINARY, NULL, -1, OBJNULL},
 {GRAY_ "STREAM-FRESH-LINE", GRAY_ORDINARY, NULL, -1, OBJNULL},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index e54d3c11d..381f43cba 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1655,6 +1655,7 @@ cl_symbols[] = {
 {GRAY_ "STREAM-CLEAR-INPUT",NULL},
 {GRAY_ "STREAM-CLEAR-OUTPUT",NULL},
 {GRAY_ "STREAM-ELEMENT-TYPE",NULL},
+{GRAY_ "STREAM-FILE-POSITION",NULL},
 {GRAY_ "STREAM-FINISH-OUTPUT",NULL},
 {GRAY_ "STREAM-FORCE-OUTPUT",NULL},
 {GRAY_ "STREAM-FRESH-LINE",NULL},
diff --git a/src/clos/streams.lsp b/src/clos/streams.lsp
index 0671cef63..b32ff8c74 100644
--- a/src/clos/streams.lsp
+++ b/src/clos/streams.lsp
@@ -196,6 +196,10 @@
   (:documentation
    "This is like CL:WRITE-SEQUENCE, but for Gray streams."))
 
+(defgeneric stream-file-position (stream &optional position)
+  (:documentation
+   "This is like CL:FILE-POSITION, but for Gray streams."))
+
 
 ;;;
 ;;; Our class hierarchy looks like the one from Gray streams
@@ -520,6 +524,14 @@
 (defmethod stream-start-line-p ((stream fundamental-character-output-stream))
   (eql (stream-line-column stream) 0))
 
+;; FILE-POSITION
+
+(defmethod stream-file-position ((stream ansi-stream) &optional position)
+  (file-position stream position))
+
+(defmethod stream-file-position ((stream t) &optional position)
+  (declare (ignore stream position))
+  nil)
 
 ;; STREAM-P