[cl-plus-ssl-cvs] CVS trivial-gray-streams

[dlichteblau]

Update of /project/cl-plus-ssl/cvsroot/trivial-gray-streams
In directory clnet:/tmp/cvs-serv22759

Modified Files:
	README mixin.lisp package.lisp 
Log Message:
stream-file-position


--- /project/cl-plus-ssl/cvsroot/trivial-gray-streams/README	2005/11/25 20:08:44	1.2
+++ /project/cl-plus-ssl/cvsroot/trivial-gray-streams/README	2006/09/14 17:45:36	1.3
@@ -21,3 +21,17 @@
 3. In order for (2) to work on all Lisps, make sure to subclass all your
    stream classes from TRIVIAL-GRAY-STREAM-MIXIN if you intend to define
    methods on those two generic functions.
+
+
+Extensions
+==========
+
+Generic function STREAM-READ-SEQUENCE (stream sequence start end &key)
+Generic function STREAM-WRITE-SEQUENCE (stream sequence start end &key)
+
+	See above.
+
+Generic function STREAM-FILE-POSITION (stream) => file position
+Generic function (SETF STREAM-FILE-POSITION) (position-spec stream) => successp
+
+	Will only be called by LispWorks and CLISP.
--- /project/cl-plus-ssl/cvsroot/trivial-gray-streams/mixin.lisp	2005/12/04 23:40:31	1.4
+++ /project/cl-plus-ssl/cvsroot/trivial-gray-streams/mixin.lisp	2006/09/14 17:45:36	1.5
@@ -7,6 +7,9 @@
 (defgeneric stream-write-sequence
     (stream sequence start end &key &allow-other-keys))
 
+(defgeneric stream-file-position (stream))
+(defgeneric (setf stream-file-position) (newval stream))
+
 (defmethod stream-write-string
     ((stream trivial-gray-stream-mixin) seq &optional start end)
   (stream-write-sequence stream seq (or start 0) (or end (length seq))))
@@ -16,6 +19,14 @@
 (defmethod stream-terpri ((stream trivial-gray-stream-mixin))
   (write-char #\newline stream))
 
+(defmethod stream-file-position ((stream trivial-gray-stream-mixin))
+  nil)
+
+(defmethod (setf stream-file-position)
+    (newval (stream trivial-gray-stream-mixin))
+  (declare (ignore newval))
+  nil)
+
 #+allegro
 (progn
   (defmethod excl:stream-read-sequence
@@ -41,7 +52,13 @@
     (stream-read-sequence s seq start end))
   (defmethod stream:stream-write-sequence
       ((s trivial-gray-stream-mixin) seq start end)
-    (stream-write-sequence s seq start end)))
+    (stream-write-sequence s seq start end))
+
+  (defmethod stream:stream-file-position ((stream trivial-gray-stream-mixin))
+    (stream-file-position stream))
+  (defmethod (setf stream:stream-file-position)
+      (newval (stream trivial-gray-stream-mixin))
+    (setf (stream-file-position stream) newval)))
 
 #+openmcl
 (progn
@@ -80,7 +97,12 @@
 
   (defmethod gray:stream-write-char-sequence
       ((s trivial-gray-stream-mixin) seq &optional start end)
-    (stream-write-sequence s seq start end)))
+    (stream-write-sequence s seq start end))
+
+  (defmethod gray:stream-position ((stream trivial-gray-stream-mixin) position)
+    (if position
+	(setf (stream-file-position stream) position)
+        (stream-file-position stream))))
 
 #+sbcl
 (progn
--- /project/cl-plus-ssl/cvsroot/trivial-gray-streams/package.lisp	2005/11/26 12:01:03	1.3
+++ /project/cl-plus-ssl/cvsroot/trivial-gray-streams/package.lisp	2006/09/14 17:45:36	1.4
@@ -39,5 +39,6 @@
 	    (:export #:trivial-gray-stream-mixin
 		     #:stream-read-sequence
 		     #:stream-write-sequence
+		     #:stream-file-position
 		     , at common-symbols)))))
   (frob))