121 lines
3.2 KiB
Factor
121 lines
3.2 KiB
Factor
! Copyright (C) 2003, 2005 Slava Pestov.
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
IN: files
|
|
USING: kernel strings ;
|
|
|
|
! We need this early during bootstrap.
|
|
: path+ ( path path -- path )
|
|
#! Combine two paths. This will be implemented later.
|
|
"/" swap cat3 ;
|
|
|
|
IN: stdio
|
|
DEFER: stdio
|
|
|
|
IN: streams
|
|
USING: errors generic lists math namespaces sequences ;
|
|
|
|
! Stream protocol.
|
|
GENERIC: stream-flush ( stream -- )
|
|
GENERIC: stream-auto-flush ( stream -- )
|
|
GENERIC: stream-readln ( stream -- string )
|
|
GENERIC: stream-read ( count stream -- string )
|
|
GENERIC: stream-write-attr ( string style stream -- )
|
|
GENERIC: stream-close ( stream -- )
|
|
|
|
: stream-read1 ( stream -- char/f )
|
|
1 swap stream-read
|
|
dup empty? [ drop f ] [ 0 swap string-nth ] ifte ;
|
|
|
|
: stream-write ( string stream -- )
|
|
f swap stream-write-attr ;
|
|
|
|
: stream-print ( string stream -- )
|
|
[ stream-write ] keep
|
|
[ "\n" swap stream-write ] keep
|
|
stream-auto-flush ;
|
|
|
|
! Think '/dev/null'.
|
|
TUPLE: null-stream ;
|
|
M: null-stream stream-flush drop ;
|
|
M: null-stream stream-auto-flush drop ;
|
|
M: null-stream stream-readln drop f ;
|
|
M: null-stream stream-read 2drop f ;
|
|
M: null-stream stream-write-attr 3drop ;
|
|
M: null-stream stream-close drop ;
|
|
|
|
! String buffers support the stream output protocol.
|
|
M: sbuf stream-write-attr nip sbuf-append ;
|
|
M: sbuf stream-close drop ;
|
|
M: sbuf stream-flush drop ;
|
|
M: sbuf stream-auto-flush drop ;
|
|
|
|
! Sometimes, we want to have a delegating stream that uses stdio
|
|
! words.
|
|
TUPLE: wrapper-stream scope ;
|
|
|
|
C: wrapper-stream ( stream -- stream )
|
|
2dup set-delegate
|
|
[
|
|
>r <namespace> [ stdio set ] extend r>
|
|
set-wrapper-stream-scope
|
|
] keep ;
|
|
|
|
! Combine an input and output stream into one, and flush the
|
|
! stream more often.
|
|
TUPLE: duplex-stream in out flush? ;
|
|
|
|
M: duplex-stream stream-flush
|
|
duplex-stream-out stream-flush ;
|
|
|
|
M: duplex-stream stream-auto-flush
|
|
dup duplex-stream-flush? [
|
|
duplex-stream-out stream-flush
|
|
] [
|
|
drop
|
|
] ifte ;
|
|
|
|
M: duplex-stream stream-readln
|
|
duplex-stream-in stream-readln ;
|
|
|
|
M: duplex-stream stream-read
|
|
duplex-stream-in stream-read ;
|
|
|
|
M: duplex-stream stream-write-attr
|
|
duplex-stream-out stream-write-attr ;
|
|
|
|
M: duplex-stream stream-close
|
|
duplex-stream-out stream-close ;
|
|
|
|
! Reading lines and counting line numbers.
|
|
SYMBOL: line-number
|
|
SYMBOL: parser-stream
|
|
|
|
: next-line ( -- str )
|
|
parser-stream get stream-readln
|
|
line-number [ 1 + ] change ;
|
|
|
|
: read-lines ( stream quot -- )
|
|
#! Apply a quotation to each line as its read. Close the
|
|
#! stream.
|
|
swap [
|
|
parser-stream set 0 line-number set [ next-line ] while
|
|
] [
|
|
parser-stream get stream-close rethrow
|
|
] catch ;
|
|
|
|
! Standard actions protocol for presentations output to
|
|
! attributed streams.
|
|
: <actions> ( path alist -- alist )
|
|
#! For each element of the alist, change the value to
|
|
#! path " " value
|
|
[ uncons >r swap " " r> seq-append3 cons ] map-with ;
|
|
|
|
DEFER: <file-reader>
|
|
|
|
: resource-path ( -- path )
|
|
"resource-path" get [ "." ] unless* ;
|
|
|
|
: <resource-stream> ( path -- stream )
|
|
#! Open a file path relative to the Factor source code root.
|
|
resource-path swap path+ <file-reader> ;
|