dlichteblau 19 жил өмнө
parent
commit
9f5241bf41
3 өөрчлөгдсөн 39 нэмэгдсэн , 2 устгасан
  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
 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
    stream classes from TRIVIAL-GRAY-STREAM-MIXIN if you intend to define
    methods on those two generic functions.
    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
 (defgeneric stream-write-sequence
     (stream sequence start end &key &allow-other-keys))
     (stream sequence start end &key &allow-other-keys))
 
 
+(defgeneric stream-file-position (stream))
+(defgeneric (setf stream-file-position) (newval stream))
+
 (defmethod stream-write-string
 (defmethod stream-write-string
     ((stream trivial-gray-stream-mixin) seq &optional start end)
     ((stream trivial-gray-stream-mixin) seq &optional start end)
   (stream-write-sequence stream seq (or start 0) (or end (length seq))))
   (stream-write-sequence stream seq (or start 0) (or end (length seq))))
@@ -16,6 +19,14 @@
 (defmethod stream-terpri ((stream trivial-gray-stream-mixin))
 (defmethod stream-terpri ((stream trivial-gray-stream-mixin))
   (write-char #\newline stream))
   (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
 #+allegro
 (progn
 (progn
   (defmethod excl:stream-read-sequence
   (defmethod excl:stream-read-sequence
@@ -41,7 +52,13 @@
     (stream-read-sequence s seq start end))
     (stream-read-sequence s seq start end))
   (defmethod stream:stream-write-sequence
   (defmethod stream:stream-write-sequence
       ((s trivial-gray-stream-mixin) seq start end)
       ((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
 #+openmcl
 (progn
 (progn
@@ -80,7 +97,12 @@
 
 
   (defmethod gray:stream-write-char-sequence
   (defmethod gray:stream-write-char-sequence
       ((s trivial-gray-stream-mixin) seq &optional start end)
       ((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
 #+sbcl
 (progn
 (progn

+ 1 - 0
package.lisp

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