Jelajahi Sumber

stream-file-position

dlichteblau 19 tahun lalu
induk
melakukan
9f5241bf41
3 mengubah file dengan 39 tambahan dan 2 penghapusan
  1. 14 0
      README
  2. 24 2
      mixin.lisp
  3. 1 0
      package.lisp

+ 14 - 0
README

@@ -21,3 +21,17 @@ How to use it
 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.

+ 24 - 2
mixin.lisp

@@ -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

+ 1 - 0
package.lisp

@@ -39,5 +39,6 @@
 	    (:export #:trivial-gray-stream-mixin
 		     #:stream-read-sequence
 		     #:stream-write-sequence
+		     #:stream-file-position
 		     ,@common-symbols)))))
   (frob))