make seeking support the full lseek options, add seeking on output ports, remove seeking from decoders..
parent
044fd02b5c
commit
bc0521f88a
|
@ -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+
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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-
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue