From bc0521f88a52b7cef23ed77b75d165107ee36449 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 10:30:51 -0600
Subject: [PATCH] make seeking support the full lseek options, add seeking on
 output ports, remove seeking from decoders..

---
 basis/io/backend/unix/unix.factor  |  9 +++++++--
 basis/io/ports/ports.factor        | 13 +++++++------
 core/io/encodings/encodings.factor |  2 --
 core/io/io.factor                  |  6 ++++--
 4 files changed, 18 insertions(+), 12 deletions(-)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index 7340260b2e..e39ae3e7f8 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -46,8 +46,13 @@ M: fd cancel-operation ( fd -- )
         2bi
     ] if ;
 
-M: unix (stream-seek)
-    handle>> fd>> swap SEEK_SET lseek io-error ;
+M: unix (stream-seek) ( n seek-type stream -- )
+    swap {
+        { io:seek-absolute [ SEEK_SET ] }
+        { io:seek-relative [ SEEK_CUR ] }
+        { io:seek-end [ SEEK_END ] }
+    } case
+    [ handle>> fd>> swap ] dip lseek io-error ;
 
 SYMBOL: +retry+ ! just try the operation again without blocking
 SYMBOL: +input+
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 0f2dcc6e21..4b0336ed26 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -93,12 +93,6 @@ 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 )
@@ -126,6 +120,13 @@ M: output-port stream-write
 
 HOOK: (wait-to-write) io-backend ( port -- )
 
+HOOK: (stream-seek) os ( n seek-type stream -- )
+
+M: port stream-seek ( n seek-type stream -- )
+    dup check-disposed
+    [ nip buffer>> buffer-seek ] [ (stream-seek) ] 3bi ;
+
+
 GENERIC: shutdown ( handle -- )
 
 M: object shutdown drop ;
diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 4693c672a4..94d2115478 100644
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -50,8 +50,6 @@ 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 9b606194e0..1cfdaf526e 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -15,7 +15,8 @@ GENERIC: stream-write ( seq stream -- )
 GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
-GENERIC: stream-seek ( n stream -- )
+SINGLETONS: seek-absolute seek-relative seek-end ;
+GENERIC: stream-seek ( n seek-type stream -- )
 
 : stream-print ( str stream -- ) [ stream-write ] keep stream-nl ;
 
@@ -29,7 +30,8 @@ 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 ;
+: seek-input ( n seek-type -- ) input-stream get stream-seek ;
+: seek-output ( n seek-type -- ) output-stream get stream-seek ;
 
 : write1 ( elt -- ) output-stream get stream-write1 ;
 : write ( seq -- ) output-stream get stream-write ;