From f6f716c4e3a6e6457c9eecfb9e3ab418f5463af4 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 01:03:12 -0600
Subject: [PATCH] unix support for stream seeking

---
 basis/io/backend/unix/unix.factor  | 3 +++
 basis/io/buffers/buffers.factor    | 3 +++
 basis/io/ports/ports.factor        | 8 +++++++-
 core/io/encodings/encodings.factor | 2 ++
 core/io/io.factor                  | 5 ++++-
 5 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index d86a72c665..7340260b2e 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -46,6 +46,9 @@ M: fd cancel-operation ( fd -- )
         2bi
     ] if ;
 
+M: unix (stream-seek)
+    handle>> fd>> swap SEEK_SET lseek io-error ;
+
 SYMBOL: +retry+ ! just try the operation again without blocking
 SYMBOL: +input+
 SYMBOL: +output+
diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index 4df081b17d..11fbbf947c 100644
--- a/basis/io/buffers/buffers.factor
+++ b/basis/io/buffers/buffers.factor
@@ -27,6 +27,9 @@ M: buffer dispose* ptr>> free ;
 : buffer-empty? ( buffer -- ? )
     fill>> zero? ; inline
 
+: buffer-seek ( n buffer -- )
+    (>>pos) ; inline
+
 : buffer-consume ( n buffer -- )
     [ + ] change-pos
     dup [ pos>> ] [ fill>> ] bi <
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 1fe717d5ee..dd95e37d72 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -4,7 +4,7 @@ USING: math kernel io sequences io.buffers io.timeouts generic
 byte-vectors system io.encodings math.order io.backend
 continuations classes byte-arrays namespaces splitting
 grouping dlists assocs io.encodings.binary summary accessors
-destructors combinators ;
+destructors combinators unix ;
 IN: io.ports
 
 SYMBOL: default-buffer-size
@@ -93,6 +93,12 @@ M: input-port stream-read-until ( seps port -- str/f sep/f )
         ] [ [ 2drop ] 2dip ] if
     ] if ;
 
+HOOK: (stream-seek) os ( n stream -- )
+
+M: input-port stream-seek ( n stream -- )
+    dup check-disposed
+    2dup buffer>> buffer-seek (stream-seek) ;
+
 TUPLE: output-port < buffered-port ;
 
 : <output-port> ( handle -- output-port )
diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 94d2115478..4693c672a4 100644
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -50,6 +50,8 @@ M: object <decoder> f decoder boa ;
 M: decoder stream-read1
     dup >decoder< decode-char fix-read1 ;
 
+M: decoder stream-seek stream>> stream-seek ;
+
 : fix-read ( stream string -- string )
     over cr>> [
         over cr-
diff --git a/core/io/io.factor b/core/io/io.factor
index 55cc336ef8..9b606194e0 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -15,6 +15,8 @@ GENERIC: stream-write ( seq stream -- )
 GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
+GENERIC: stream-seek ( n stream -- )
+
 : stream-print ( str stream -- ) [ stream-write ] keep stream-nl ;
 
 ! Default streams
@@ -27,6 +29,7 @@ SYMBOL: error-stream
 : read ( n -- seq ) input-stream get stream-read ;
 : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
 : read-partial ( n -- seq ) input-stream get stream-read-partial ;
+: seek ( n -- ) input-stream get stream-seek ;
 
 : write1 ( elt -- ) output-stream get stream-write1 ;
 : write ( seq -- ) output-stream get stream-write ;
@@ -82,4 +85,4 @@ PRIVATE>
 
 : stream-copy ( in out -- )
     [ [ [ write ] each-block ] with-output-stream ]
-    curry with-input-stream ;
\ No newline at end of file
+    curry with-input-stream ;