make seeking support the full lseek options, add seeking on output ports, remove seeking from decoders..

db4
Doug Coleman 2009-02-07 10:30:51 -06:00
parent 044fd02b5c
commit bc0521f88a
4 changed files with 18 additions and 12 deletions

View File

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

View File

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

View File

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

View File

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