parent
21ac396128
commit
471fe2c272
|
@ -66,7 +66,7 @@ ERROR: ftp-error got expected ;
|
||||||
: list ( url -- ftp-response )
|
: list ( url -- ftp-response )
|
||||||
utf8 open-passive-client
|
utf8 open-passive-client
|
||||||
ftp-list
|
ftp-list
|
||||||
lines
|
stream-lines
|
||||||
<ftp-response> swap >>strings
|
<ftp-response> swap >>strings
|
||||||
read-response 226 ftp-assert
|
read-response 226 ftp-assert
|
||||||
parse-list ;
|
parse-list ;
|
||||||
|
|
|
@ -4,7 +4,7 @@ USING: io io.streams.byte-array ;
|
||||||
IN: io.encodings.string
|
IN: io.encodings.string
|
||||||
|
|
||||||
: decode ( byte-array encoding -- string )
|
: decode ( byte-array encoding -- string )
|
||||||
<byte-reader> contents ;
|
<byte-reader> stream-contents ;
|
||||||
|
|
||||||
: encode ( string encoding -- byte-array )
|
: encode ( string encoding -- byte-array )
|
||||||
[ write ] with-byte-writer ;
|
[ write ] with-byte-writer ;
|
||||||
|
|
|
@ -24,7 +24,7 @@ IN: xmode.code2html
|
||||||
[XML <style><-></style> XML] ;
|
[XML <style><-></style> XML] ;
|
||||||
|
|
||||||
:: htmlize-stream ( path stream -- xml )
|
:: htmlize-stream ( path stream -- xml )
|
||||||
stream lines
|
stream stream-lines
|
||||||
[ "" ] [ path over first find-mode htmlize-lines ]
|
[ "" ] [ path over first find-mode htmlize-lines ]
|
||||||
if-empty :> input
|
if-empty :> input
|
||||||
default-stylesheet :> stylesheet
|
default-stylesheet :> stylesheet
|
||||||
|
|
|
@ -13,7 +13,7 @@ GENERIC: checksum-stream ( stream checksum -- value )
|
||||||
GENERIC: checksum-lines ( lines checksum -- value )
|
GENERIC: checksum-lines ( lines checksum -- value )
|
||||||
|
|
||||||
M: checksum checksum-stream
|
M: checksum checksum-stream
|
||||||
[ contents ] dip checksum-bytes ;
|
[ stream-contents ] dip checksum-bytes ;
|
||||||
|
|
||||||
M: checksum checksum-lines
|
M: checksum checksum-lines
|
||||||
[ B{ CHAR: \n } join ] dip checksum-bytes ;
|
[ B{ CHAR: \n } join ] dip checksum-bytes ;
|
||||||
|
|
|
@ -20,13 +20,13 @@ HOOK: (file-appender) io-backend ( path -- stream )
|
||||||
swap normalize-path (file-appender) swap <encoder> ;
|
swap normalize-path (file-appender) swap <encoder> ;
|
||||||
|
|
||||||
: file-lines ( path encoding -- seq )
|
: file-lines ( path encoding -- seq )
|
||||||
<file-reader> lines ;
|
<file-reader> stream-lines ;
|
||||||
|
|
||||||
: with-file-reader ( path encoding quot -- )
|
: with-file-reader ( path encoding quot -- )
|
||||||
[ <file-reader> ] dip with-input-stream ; inline
|
[ <file-reader> ] dip with-input-stream ; inline
|
||||||
|
|
||||||
: file-contents ( path encoding -- seq )
|
: file-contents ( path encoding -- seq )
|
||||||
<file-reader> contents ;
|
<file-reader> stream-contents ;
|
||||||
|
|
||||||
: with-file-writer ( path encoding quot -- )
|
: with-file-writer ( path encoding quot -- )
|
||||||
[ <file-writer> ] dip with-output-stream ; inline
|
[ <file-writer> ] dip with-output-stream ; inline
|
||||||
|
|
|
@ -221,10 +221,14 @@ HELP: bl
|
||||||
{ $description "Outputs a space character (" { $snippet "\" \"" } ") to " { $link output-stream } "." }
|
{ $description "Outputs a space character (" { $snippet "\" \"" } ") to " { $link output-stream } "." }
|
||||||
$io-error ;
|
$io-error ;
|
||||||
|
|
||||||
HELP: lines
|
HELP: stream-lines
|
||||||
{ $values { "stream" "an input stream" } { "seq" "a sequence of strings" } }
|
{ $values { "stream" "an input stream" } { "seq" "a sequence of strings" } }
|
||||||
{ $description "Reads lines of text until the stream is exhausted, collecting them in a sequence of strings." } ;
|
{ $description "Reads lines of text until the stream is exhausted, collecting them in a sequence of strings." } ;
|
||||||
|
|
||||||
|
HELP: lines
|
||||||
|
{ $values { "seq" "a sequence of strings" } }
|
||||||
|
{ $description "Reads lines of text until from the " { $link input-stream } " until it is exhausted, collecting them in a sequence of strings." } ;
|
||||||
|
|
||||||
HELP: each-line
|
HELP: each-line
|
||||||
{ $values { "quot" { $quotation "( str -- )" } } }
|
{ $values { "quot" { $quotation "( str -- )" } } }
|
||||||
{ $description "Calls the quotation with successive lines of text, until the current " { $link input-stream } " is exhausted." } ;
|
{ $description "Calls the quotation with successive lines of text, until the current " { $link input-stream } " is exhausted." } ;
|
||||||
|
@ -233,11 +237,16 @@ HELP: each-block
|
||||||
{ $values { "quot" { $quotation "( block -- )" } } }
|
{ $values { "quot" { $quotation "( block -- )" } } }
|
||||||
{ $description "Calls the quotation with successive blocks of data, until the current " { $link input-stream } " is exhausted." } ;
|
{ $description "Calls the quotation with successive blocks of data, until the current " { $link input-stream } " is exhausted." } ;
|
||||||
|
|
||||||
HELP: contents
|
HELP: stream-contents
|
||||||
{ $values { "stream" "an input stream" } { "seq" "a string, byte array or " { $link f } } }
|
{ $values { "stream" "an input stream" } { "seq" "a string, byte array or " { $link f } } }
|
||||||
{ $description "Reads the entire contents of a stream. If the stream is empty, outputs" { $link f } "." }
|
{ $description "Reads the entire contents of a stream. If the stream is empty, outputs" { $link f } "." }
|
||||||
$io-error ;
|
$io-error ;
|
||||||
|
|
||||||
|
HELP: contents
|
||||||
|
{ $values { "seq" "a string, byte array or " { $link f } } }
|
||||||
|
{ $description "Reads the entire contents of a the stream stored in " { $link input-stream } ". If the stream is empty, outputs" { $link f } "." }
|
||||||
|
$io-error ;
|
||||||
|
|
||||||
ARTICLE: "stream-protocol" "Stream protocol"
|
ARTICLE: "stream-protocol" "Stream protocol"
|
||||||
"The stream protocol consists of a large number of generic words, many of which are optional."
|
"The stream protocol consists of a large number of generic words, many of which are optional."
|
||||||
$nl
|
$nl
|
||||||
|
@ -347,9 +356,11 @@ $nl
|
||||||
"First, a simple composition of " { $link stream-write } " and " { $link stream-nl } ":"
|
"First, a simple composition of " { $link stream-write } " and " { $link stream-nl } ":"
|
||||||
{ $subsection stream-print }
|
{ $subsection stream-print }
|
||||||
"Processing lines one by one:"
|
"Processing lines one by one:"
|
||||||
|
{ $subsection stream-lines }
|
||||||
{ $subsection lines }
|
{ $subsection lines }
|
||||||
{ $subsection each-line }
|
{ $subsection each-line }
|
||||||
"Processing blocks of data:"
|
"Processing blocks of data:"
|
||||||
|
{ $subsection stream-contents }
|
||||||
{ $subsection contents }
|
{ $subsection contents }
|
||||||
{ $subsection each-block }
|
{ $subsection each-block }
|
||||||
"Copying the contents of one stream to another:"
|
"Copying the contents of one stream to another:"
|
||||||
|
|
|
@ -68,9 +68,12 @@ SYMBOL: error-stream
|
||||||
|
|
||||||
: bl ( -- ) " " write ;
|
: bl ( -- ) " " write ;
|
||||||
|
|
||||||
: lines ( stream -- seq )
|
: stream-lines ( stream -- seq )
|
||||||
[ [ readln dup ] [ ] produce nip ] with-input-stream ;
|
[ [ readln dup ] [ ] produce nip ] with-input-stream ;
|
||||||
|
|
||||||
|
: lines ( -- seq )
|
||||||
|
input-stream get stream-lines ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: each-morsel ( handler: ( data -- ) reader: ( -- data ) -- )
|
: each-morsel ( handler: ( data -- ) reader: ( -- data ) -- )
|
||||||
|
@ -81,11 +84,14 @@ PRIVATE>
|
||||||
: each-line ( quot -- )
|
: each-line ( quot -- )
|
||||||
[ readln ] each-morsel ; inline
|
[ readln ] each-morsel ; inline
|
||||||
|
|
||||||
: contents ( stream -- seq )
|
: stream-contents ( stream -- seq )
|
||||||
[
|
[
|
||||||
[ 65536 read-partial dup ] [ ] produce nip concat f like
|
[ 65536 read-partial dup ] [ ] produce nip concat f like
|
||||||
] with-input-stream ;
|
] with-input-stream ;
|
||||||
|
|
||||||
|
: contents ( -- seq )
|
||||||
|
input-stream get stream-contents ;
|
||||||
|
|
||||||
: each-block ( quot: ( block -- ) -- )
|
: each-block ( quot: ( block -- ) -- )
|
||||||
[ 8192 read-partial ] each-morsel ; inline
|
[ 8192 read-partial ] each-morsel ; inline
|
||||||
|
|
||||||
|
|
|
@ -272,7 +272,7 @@ print-use-hook [ [ ] ] initialize
|
||||||
: parse-stream ( stream name -- quot )
|
: parse-stream ( stream name -- quot )
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
lines dup parse-fresh
|
stream-lines dup parse-fresh
|
||||||
[ nip ] [ finish-parsing ] 2bi
|
[ nip ] [ finish-parsing ] 2bi
|
||||||
forget-smudged
|
forget-smudged
|
||||||
] with-source-file
|
] with-source-file
|
||||||
|
|
|
@ -7,7 +7,7 @@ IN: contributors
|
||||||
|
|
||||||
: changelog ( -- authors )
|
: changelog ( -- authors )
|
||||||
image parent-directory [
|
image parent-directory [
|
||||||
"git log --pretty=format:%an" ascii <process-reader> lines
|
"git log --pretty=format:%an" ascii <process-reader> stream-lines
|
||||||
] with-directory ;
|
] with-directory ;
|
||||||
|
|
||||||
: patch-counts ( authors -- assoc )
|
: patch-counts ( authors -- assoc )
|
||||||
|
|
|
@ -16,7 +16,7 @@ M: output-process-error error.
|
||||||
|
|
||||||
: try-output-process ( command -- )
|
: try-output-process ( command -- )
|
||||||
>process +stdout+ >>stderr utf8 <process-reader*>
|
>process +stdout+ >>stderr utf8 <process-reader*>
|
||||||
[ contents ] [ dup wait-for-process ] bi*
|
[ stream-contents ] [ dup wait-for-process ] bi*
|
||||||
0 = [ 2drop ] [ output-process-error ] if ;
|
0 = [ 2drop ] [ output-process-error ] if ;
|
||||||
|
|
||||||
HOOK: really-delete-tree os ( path -- )
|
HOOK: really-delete-tree os ( path -- )
|
||||||
|
|
Loading…
Reference in New Issue