ARTICLE: "embedding-factor" "What embedding looks like from Factor"
"Factor code will run inside an embedded instance in the same way it would run in a stand-alone instance."
$nl
-"One exception is the global " { $link stdio } " stream, which is by default not bound to the terminal where the process is running, to avoid conflicting with any I/O the host process might perform. To initialize the terminal stream, " { $link init-stdio } " must be called explicitly."
+"One exception is that the global " { $link input-stream } " and " { $link output-stream } " streams are not bound by default, to avoid conflicting with any I/O the host process might perform. The " { $link init-stdio } " words must be called explicitly to initialize terminal streams."
$nl
"There is a word which can detect when Factor is embedded:"
{ $subsection embedded? }
"Writing image to " write
architecture get boot-image-name resource-path
[ write "..." print flush ]
- [ binary <file-writer> [ (write-image) ] with-stream ] bi ;
+ [ binary [ (write-image) ] with-file-writer ] bi ;
PRIVATE>
parse-command-line
run-user-init
"run" get run
- stdio get [ stream-flush ] when*
+ output-stream get [ stream-flush ] when*
] [ print-error 1 exit ] recover
] set-boot-quot
HELP: compiler-error.
{ $values { "error" "an error" } { "word" word } }
-{ $description "Prints a compiler error to the " { $link stdio } " stream." } ;
+{ $description "Prints a compiler error to " { $link output-stream } "." } ;
HELP: compiler-errors.
{ $values { "type" symbol } }
-{ $description "Prints compiler errors to the " { $link stdio } " stream. The type parameter is one of " { $link +error+ } ", " { $link +warning+ } ", or " { $link +linkage+ } "." } ;
+{ $description "Prints compiler errors to " { $link output-stream } ". The type parameter is one of " { $link +error+ } ", " { $link +warning+ } ", or " { $link +linkage+ } "." } ;
HELP: :errors
-{ $description "Prints all serious compiler errors from the most recent compile to the " { $link stdio } " stream." } ;
+{ $description "Prints all serious compiler errors from the most recent compile to " { $link output-stream } "." } ;
HELP: :warnings
-{ $description "Prints all ignorable compiler warnings from the most recent compile to the " { $link stdio } " stream." } ;
+{ $description "Prints all ignorable compiler warnings from the most recent compile to " { $link output-stream } "." } ;
HELP: :linkage
-{ $description "Prints all C library interface linkage errors from the most recent compile to the " { $link stdio } " stream." } ;
+{ $description "Prints all C library interface linkage errors from the most recent compile to " { $link output-stream } "." } ;
{ :errors :warnings } related-words
{ $code
"<external-resource> ... do stuff ... dispose"
}
-"The reason being that if " { $snippet "do stuff" } " throws an error, the resource will not be disposed of. The most important case where this can occur is with I/O streams, and the correct solution is to always use " { $link with-stream } "; see " { $link "stdio" } " for details." ;
+"The reason being that if " { $snippet "do stuff" } " throws an error, the resource will not be disposed of. The most important case where this can occur is with I/O streams, and the correct solution is to always use " { $link with-input-stream } " and " { $link with-output-stream } "; see " { $link "stdio" } " for details." ;
ARTICLE: "errors" "Error handling"
"Support for handling exceptional situations such as bad user input, implementation bugs, and input/output errors is provided by a set of words built using continuations."
HELP: error.
{ $values { "error" "an error" } }
-{ $contract "Print an error to the " { $link stdio } " stream. You can define methods on this generic word to print human-readable messages for custom errors." }
+{ $contract "Print an error to " { $link output-stream } ". You can define methods on this generic word to print human-readable messages for custom errors." }
{ $notes "Code should call " { $link print-error } " instead, which handles the case where the printing of the error itself throws an error." } ;
HELP: error-help
HELP: print-error
{ $values { "error" "an error" } }
-{ $description "Print an error to the " { $link stdio } " stream." }
+{ $description "Print an error to " { $link output-stream } "." }
{ $notes "This word is called by the listener and other tools which report caught errors to the user." } ;
HELP: restarts.
-{ $description "Print a list of restarts for the most recently thrown error to the " { $link stdio } " stream." } ;
+{ $description "Print a list of restarts for the most recently thrown error to " { $link output-stream } "." } ;
HELP: error-hook
{ $var-description "A quotation with stack effect " { $snippet "( error -- )" } " which is used by " { $link try } " to report the error to the user." }
math namespaces prettyprint prettyprint.config sequences assocs
sequences.private strings io.styles vectors words system
splitting math.parser classes.tuple continuations
-continuations.private combinators generic.math io.streams.duplex
+continuations.private combinators generic.math
classes.builtin classes compiler.units generic.standard vocabs
threads threads.private init kernel.private libc io.encodings
mirrors accessors math.order ;
M: inconsistent-next-method summary
drop "Executing call-next-method with inconsistent parameters" ;
-M: stream-closed-twice summary
- drop "Attempt to perform I/O on closed stream" ;
-
M: check-method summary
drop "Invalid parameters for create-method" ;
HELP: infer.
{ $values { "quot" "a quotation" } }
-{ $description "Attempts to infer the quotation's stack effect, and prints this data to the " { $link stdio } " stream." }
+{ $description "Attempts to infer the quotation's stack effect, and prints this data to " { $link output-stream } "." }
{ $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ;
{ infer infer. } related-words
HELP: inspector-hook
{ $var-description "A quotation with stack effect " { $snippet "( obj -- )" } ", called by the inspector to display an overview of an object."
$nl
-"The default implementation calls " { $link describe } " which outputs on the " { $link stdio } " stream, but the graphical listener sets this variable so that calling " { $link inspect } " in the UI opens the graphical inspector." } ;
+"The default implementation calls " { $link describe } " which outputs on " { $link output-stream } ", but the graphical listener sets this variable so that calling " { $link inspect } " in the UI opens the graphical inspector." } ;
{ $contract "Initializes the I/O system. Called on startup." } ;
HELP: init-stdio
-{ $contract "Initializes the global " { $link stdio } " stream. Called on startup." } ;
+{ $contract "Initializes the global " { $link input-stream } " and " { $link output-stream } ". Called on startup." } ;
HOOK: (init-stdio) io-backend ( -- stdin stdout stderr )
: init-stdio ( -- )
- (init-stdio) utf8 <encoder> stderr set-global
- utf8 <encoder-duplex> stdio set-global ;
+ (init-stdio)
+ [ utf8 <decoder> input-stream set-global ]
+ [ utf8 <encoder> output-stream set-global ]
+ [ utf8 <encoder> error-stream set-global ] tri* ;
HOOK: io-multiplex io-backend ( ms -- )
ARTICLE: "encodings-constructors" "Manually constructing an encoded stream"
"The following words can be used to construct encoded streams. Note that they are usually not used directly, but rather by the stream constructors themselves. Most stream constructors take an encoding descriptor as a parameter and internally call these constructors."
{ $subsection <encoder> }
-{ $subsection <decoder> }
-{ $subsection <encoder-duplex> } ;
+{ $subsection <decoder> } ;
HELP: <encoder>
{ $values { "stream" "an output stream" }
{ $description "Wraps the given stream in a new stream using the given encoding for all input. The encoding descriptor can either be a class or an instance of something conforming to the " { $link "encodings-protocol" } "." }
$low-level-note ;
-HELP: <encoder-duplex>
-{ $values { "stream-in" "an input stream" }
- { "stream-out" "an output stream" }
- { "encoding" "an encoding descriptor" }
- { "duplex" "an encoded duplex stream" } }
-{ $description "Wraps the given streams in an encoder or decoder stream, and puts them together in a duplex stream for input and output. If either input stream is already encoded, that encoding is stripped off before it is reencoded. The encoding descriptor must conform to the " { $link "encodings-protocol" } "." }
-$low-level-note ;
-
-{ <encoder> <decoder> <encoder-duplex> } related-words
-
ARTICLE: "encodings-descriptors" "Encoding descriptors"
"An encoding descriptor is something which can be used for input or output streams to encode or decode files. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
{ $subsection "io.encodings.binary" }
unit-test
: lines-test ( stream -- line1 line2 )
- [ readln readln ] with-stream ;
+ [ readln readln ] with-input-stream ;
[
"This is a line."
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel sequences sbufs vectors namespaces growable
strings io classes continuations combinators io.styles
-io.streams.plain splitting io.streams.duplex byte-arrays
-sequences.private accessors ;
+io.streams.plain splitting byte-arrays sequences.private
+accessors ;
IN: io.encodings
! The encoding descriptor protocol
over decoder? [ >r decoder-stream r> ] when <decoder> ;
PRIVATE>
-
-: <encoder-duplex> ( stream-in stream-out encoding -- duplex )
- tuck reencode >r redecode r> <duplex-stream> ;
HELP: with-file-reader
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } }
-{ $description "Opens a file for reading and calls the quotation using " { $link with-stream } "." }
+{ $description "Opens a file for reading and calls the quotation using " { $link with-input-stream } "." }
{ $errors "Throws an error if the file is unreadable." } ;
HELP: with-file-writer
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } }
-{ $description "Opens a file for writing using the given encoding and calls the quotation using " { $link with-stream } "." }
+{ $description "Opens a file for writing using the given encoding and calls the quotation using " { $link with-output-stream } "." }
{ $errors "Throws an error if the file cannot be opened for writing." } ;
HELP: with-file-appender
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } }
-{ $description "Opens a file for appending using the given encoding and calls the quotation using " { $link with-stream } "." }
+{ $description "Opens a file for appending using the given encoding and calls the quotation using " { $link with-output-stream } "." }
{ $errors "Throws an error if the file cannot be opened for writing." } ;
HELP: set-file-lines
<file-reader> lines ;
: with-file-reader ( path encoding quot -- )
- >r <file-reader> r> with-stream ; inline
+ >r <file-reader> r> with-input-stream ; inline
: file-contents ( path encoding -- str )
<file-reader> contents ;
: with-file-writer ( path encoding quot -- )
- >r <file-writer> r> with-stream ; inline
+ >r <file-writer> r> with-output-stream ; inline
: set-file-lines ( seq path encoding -- )
[ [ print ] each ] with-file-writer ;
[ write ] with-file-writer ;
: with-file-appender ( path encoding quot -- )
- >r <file-appender> r> with-stream ; inline
+ >r <file-appender> r> with-output-stream ; inline
! Pathnames
: path-separator? ( ch -- ? ) os windows? "/\\" "/" ? member? ;
ARTICLE: "stream-protocol" "Stream protocol"
"The stream protocol consists of a large number of generic words, many of which are optional."
$nl
-"Stream protocol words are rarely called directly, since code which only works with one stream at a time should be written use " { $link "stdio" } " instead, wrapping I/O operations such as " { $link read } " and " { $link write } " in a " { $link with-stream } ". This leads more simpler, more reusable and more robust code."
+"Stream protocol words are rarely called directly, since code which only works with one stream at a time should be written use " { $link "stdio" } " instead, wrapping I/O operations such as " { $link read } " and " { $link write } " in " { $link with-input-stream } " and " { $link with-output-stream } "."
$nl
"All streams must implement the " { $link dispose } " word in addition to the stream protocol."
$nl
{ $subsection stream-write-table }
{ $see-also "io.timeouts" } ;
-ARTICLE: "stdio" "The default stream"
-"Most I/O code only operates on one stream at a time. The " { $emphasis "default stream" } " is an implicit parameter used by many I/O words designed for this particular use-case. Using this idiom improves code in three ways:"
+ARTICLE: "stdio" "Default input and output streams"
+"Most I/O code only operates on one stream at a time. The " { $link input-stream } " and " { $link output-stream } " variables are implicit parameters used by many I/O words. Using this idiom improves code in three ways:"
{ $list
{ "Code becomes simpler because there is no need to keep a stream around on the stack." }
- { "Code becomes more robust because " { $link with-stream } " automatically closes the stream if there is an error." }
- { "Code becomes more reusable because it can be written to not worry about which stream is being used, and instead the caller can use " { $link with-stream } " to specify the source or destination for I/O operations." }
+ { "Code becomes more robust because " { $link with-input-stream } " and " { $link with-output-stream } " automatically close the streams if there is an error." }
+ { "Code becomes more reusable because it can be written to not worry about which stream is being used, and instead the caller can use " { $link with-input-stream } " or " { $link with-output-stream } " to specify the source or destination for I/O operations." }
}
"For example, here is a program which reads the first line of a file, converts it to an integer, then reads that many characters, and splits them into groups of 16:"
{ $code
"USING: continuations kernel io io.files math.parser splitting ;"
- "\"data.txt\" <file-reader>"
+ "\"data.txt\" utf8 <file-reader>"
"dup stream-readln number>string over stream-read 16 group"
"swap dispose"
}
"This code has two problems: it has some unnecessary stack shuffling, and if either " { $link stream-readln } " or " { $link stream-read } " throws an I/O error, the stream is not closed because " { $link dispose } " is never reached. So we can add a call to " { $link with-disposal } " to ensure the stream is always closed:"
{ $code
"USING: continuations kernel io io.files math.parser splitting ;"
- "\"data.txt\" <file-reader> ["
+ "\"data.txt\" utf8 <file-reader> ["
" dup stream-readln number>string over stream-read"
" 16 group"
"] with-disposal"
"This code is robust however it is more complex than it needs to be since. This is where the default stream words come in; using them, the above can be rewritten as follows:"
{ $code
"USING: continuations kernel io io.files math.parser splitting ;"
- "\"data.txt\" <file-reader> ["
+ "\"data.txt\" utf8 <file-reader> ["
" readln number>string read 16 group"
- "] with-stream"
+ "] with-input-stream"
}
-"The default stream is stored in a dynamically-scoped variable:"
-{ $subsection stdio }
-"Unless rebound in a child namespace, this variable will be set to a console stream for interacting with the user."
+"An even better implementation that takes advantage of a utility word:"
+{ $code
+ "USING: continuations kernel io io.files math.parser splitting ;"
+ "\"data.txt\" utf8 ["
+ " readln number>string read 16 group"
+ "] with-file-reader"
+}
+"The default input stream is stored in a dynamically-scoped variable:"
+{ $subsection input-stream }
+"Unless rebound in a child namespace, this variable will be set to a console stream for reading input from the user."
+$nl
+"Words reading from the default input stream:"
{ $subsection read1 }
{ $subsection read }
{ $subsection read-until }
{ $subsection readln }
+"A pair of combinators for rebinding the " { $link input-stream } " variable:"
+{ $subsection with-input-stream }
+{ $subsection with-input-stream* }
+"The default output stream is stored in a dynamically-scoped variable:"
+{ $subsection output-stream }
+"Unless rebound in a child namespace, this variable will be set to a console stream for showing output to the user."
+$nl
+"Words writing to the default input stream:"
{ $subsection flush }
{ $subsection write1 }
{ $subsection write }
{ $subsection with-row }
{ $subsection with-cell }
{ $subsection write-cell }
-"A pair of combinators support rebinding the " { $link stdio } " variable:"
-{ $subsection with-stream }
-{ $subsection with-stream* } ;
+"A pair of combinators for rebinding the " { $link output-stream } " variable:"
+{ $subsection with-output-stream }
+{ $subsection with-output-stream* }
+"A pair of combinators for rebinding both default streams at once:"
+{ $subsection with-streams }
+{ $subsection with-streams* } ;
ARTICLE: "stream-utils" "Stream utilities"
"There are a few useful stream-related words which are not generic, but merely built up from the stream protocol."
{ $description "Copies the contents of one stream into another, closing both streams when done." }
$io-error ;
-HELP: stdio
-{ $var-description "Holds a stream, used for various implicit stream operations. Rebound using " { $link with-stream } " and " { $link with-stream* } "." } ;
+HELP: input-stream
+{ $var-description "Holds an input stream for various implicit stream operations. Rebound using " { $link with-input-stream } " and " { $link with-input-stream* } "." } ;
+
+HELP: output-stream
+{ $var-description "Holds an output stream for various implicit stream operations. Rebound using " { $link with-output-stream } " and " { $link with-output-stream* } "." } ;
HELP: readln
{ $values { "str/f" "a string or " { $link f } } }
-{ $description "Reads a line of input from the " { $link stdio } " stream. Outputs " { $link f } " on stream exhaustion." }
+{ $description "Reads a line of input from " { $link input-stream } ". Outputs " { $link f } " on stream exhaustion." }
$io-error ;
HELP: read1
{ $values { "ch/f" "a character or " { $link f } } }
-{ $description "Reads a character of input from the " { $link stdio } " stream. Outputs " { $link f } " on stream exhaustion." }
+{ $description "Reads a character of input from " { $link input-stream } ". Outputs " { $link f } " on stream exhaustion." }
$io-error ;
HELP: read
{ $values { "n" "a non-negative integer" } { "str/f" "a string or " { $link f } } }
-{ $description "Reads " { $snippet "n" } " characters of input from the " { $link stdio } " stream. Outputs a truncated string or " { $link f } " on stream exhaustion." }
+{ $description "Reads " { $snippet "n" } " characters of input from " { $link input-stream } ". Outputs a truncated string or " { $link f } " on stream exhaustion." }
$io-error ;
HELP: read-until
{ $values { "seps" string } { "str/f" "a string or " { $link f } } { "sep/f" "a character or " { $link f } } }
-{ $contract "Reads characters from the " { $link stdio } " stream. until the first occurrence of a separator character, or stream exhaustion. In the former case, the separator character is pushed on the stack, and is not part of the output string. In the latter case, the entire stream contents are output, along with " { $link f } "." }
+{ $contract "Reads characters from " { $link input-stream } ". until the first occurrence of a separator character, or stream exhaustion. In the former case, the separator character is pushed on the stack, and is not part of the output string. In the latter case, the entire stream contents are output, along with " { $link f } "." }
$io-error ;
HELP: write1
{ $values { "ch" "a character" } }
-{ $contract "Writes a character of output to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $contract "Writes a character of output to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
$io-error ;
HELP: write
{ $values { "str" string } }
-{ $description "Writes a string of output to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $description "Writes a string of output to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
$io-error ;
HELP: flush
-{ $description "Waits for any pending output to the " { $link stdio } " stream to complete." }
+{ $description "Waits for any pending output on " { $link output-stream } " to complete." }
$io-error ;
HELP: nl
-{ $description "Writes a line terminator to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $description "Writes a line terminator to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
$io-error ;
HELP: format
{ $values { "str" string } { "style" "a hashtable" } }
-{ $description "Writes formatted text to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $description "Writes formatted text to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
{ $notes "Details are in the documentation for " { $link stream-format } "." }
$io-error ;
HELP: with-nesting
-{ $values { "style" "a hashtable" } { "quot" "a quotation" } }
-{ $description "Calls the quotation in a new dynamic scope with the " { $link stdio } " stream rebound to a nested paragraph stream, with formatting information applied." }
+{ $values { "style" "a hashtable" } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to a nested paragraph stream, with formatting information applied." }
{ $notes "Details are in the documentation for " { $link make-block-stream } "." }
$io-error ;
HELP: tabular-output
{ $values { "style" "a hashtable" } { "quot" quotation } }
-{ $description "Calls a quotation which emits a series of equal-length table rows using " { $link with-row } ". The results are laid out in a tabular fashion on the " { $link stdio } " stream."
+{ $description "Calls a quotation which emits a series of equal-length table rows using " { $link with-row } ". The results are laid out in a tabular fashion on " { $link output-stream } "."
$nl
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
{ $examples
HELP: with-cell
{ $values { "quot" quotation } }
-{ $description "Calls a quotation in a new scope with the " { $link stdio } " stream rebound. Output performed by the quotation is displayed in a table cell. This word can only be called inside the quotation given to " { $link with-row } "." }
+{ $description "Calls a quotation in a new scope with " { $link output-stream } " rebound. Output performed by the quotation is displayed in a table cell. This word can only be called inside the quotation given to " { $link with-row } "." }
$io-error ;
HELP: write-cell
$io-error ;
HELP: with-style
-{ $values { "style" "a hashtable" } { "quot" "a quotation" } }
+{ $values { "style" "a hashtable" } { "quot" quotation } }
{ $description "Calls the quotation in a new dynamic scope where calls to " { $link write } ", " { $link format } " and other stream output words automatically inherit style settings from " { $snippet "style" } "." }
{ $notes "Details are in the documentation for " { $link make-span-stream } "." }
$io-error ;
HELP: print
{ $values { "string" string } }
-{ $description "Writes a newline-terminated string to the " { $link stdio } " stream." }
+{ $description "Writes a newline-terminated string to " { $link output-stream } "." }
$io-error ;
-HELP: with-stream
-{ $values { "stream" "an input or output stream" } { "quot" "a quotation" } }
-{ $description "Calls the quotation in a new dynamic scope, with the " { $link stdio } " variable rebound to " { $snippet "stream" } ". The stream is closed if the quotation returns or throws an error." } ;
+HELP: with-input-stream
+{ $values { "stream" "an input stream" } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with " { $link input-stream } " rebound to " { $snippet "stream" } ". The stream is closed if the quotation returns or throws an error." } ;
+
+HELP: with-output-stream
+{ $values { "stream" "an output stream" } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with " { $link output-stream } " rebound to " { $snippet "stream" } ". The stream is closed if the quotation returns or throws an error." } ;
+
+HELP: with-streams
+{ $values { "input" "an input stream" } { "output" "an output stream" } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with " { $link input-stream } " rebound to " { $snippet "input" } " and " { $link output-stream } " rebound to " { $snippet "output" } ". The stream is closed if the quotation returns or throws an error." } ;
+
+HELP: with-streams*
+{ $values { "input" "an input stream" } { "output" "an output stream" } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with " { $link input-stream } " rebound to " { $snippet "input" } " and " { $link output-stream } " rebound to " { $snippet "output" } "." }
+{ $notes "This word does not close the stream. Compare with " { $link with-streams } "." } ;
+
+{ with-input-stream with-input-stream* } related-words
+
+{ with-output-stream with-output-stream* } related-words
-{ with-stream with-stream* } related-words
+HELP: with-input-stream*
+{ $values { "stream" "an input stream" } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with " { $link input-stream } " rebound to " { $snippet "stream" } "." }
+{ $notes "This word does not close the stream. Compare with " { $link with-input-stream } "." } ;
-HELP: with-stream*
-{ $values { "stream" "an input or output stream" } { "quot" "a quotation" } }
-{ $description "Calls the quotation in a new dynamic scope, with the " { $link stdio } " variable rebound to " { $snippet "stream" } "." }
-{ $notes "This word does not close the stream. Compare with " { $link with-stream } "." } ;
+HELP: with-output-stream*
+{ $values { "stream" "an output stream" } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with " { $link output-stream } " rebound to " { $snippet "stream" } "." }
+{ $notes "This word does not close the stream. Compare with " { $link with-output-stream } "." } ;
HELP: bl
-{ $description "Outputs a space character (" { $snippet "\" \"" } ")." }
+{ $description "Outputs a space character (" { $snippet "\" \"" } ") to " { $link output-stream } "." }
$io-error ;
HELP: write-object
{ $values { "str" string } { "obj" "an object" } }
-{ $description "Writes a string to the " { $link stdio } " stream, associating it with the object. If formatted output is supported, the string will become a clickable presentation of the object, otherwise this word behaves like a call to " { $link write } "." }
+{ $description "Writes a string to " { $link output-stream } ", associating it with the object. If formatted output is supported, the string will become a clickable presentation of the object, otherwise this word behaves like a call to " { $link write } "." }
$io-error ;
HELP: lines
"This is a line.\rThis is another line.\r"
] [
"core/io/test/mac-os-eol.txt" <resource-reader>
- [ 500 read ] with-stream
+ [ 500 read ] with-input-stream
] unit-test
[
255
] [
"core/io/test/binary.txt" <resource-reader>
- [ read1 ] with-stream >fixnum
+ [ read1 ] with-input-stream >fixnum
] unit-test
! Make sure we use correct to_c_string form when writing
"J" read-until 2array ,
"i" read-until 2array ,
"X" read-until 2array ,
- ] with-stream
+ ] with-input-stream
] { } make
] unit-test
10 [ 65536 read drop ] times
] with-file-reader
] unit-test
-
-! [ "" ] [ 0 read ] unit-test
-
-! [ ] [ "123" write 9000 CHAR: x <string> write flush ] unit-test
-
-! [
-! "/core/io/test/binary.txt" <resource-reader>
-! [ 0.2 read ] with-stream
-! ] must-fail
[ 2dup (stream-copy) ] [ dispose dispose ] [ ]
cleanup ;
-! Default stream
-SYMBOL: stdio
+! Default streams
+SYMBOL: input-stream
+SYMBOL: output-stream
+SYMBOL: error-stream
-! Default error stream
-SYMBOL: stderr
+: readln ( -- str/f ) input-stream get stream-readln ;
+: read1 ( -- ch/f ) input-stream get stream-read1 ;
+: read ( n -- str/f ) input-stream get stream-read ;
+: read-until ( seps -- str/f sep/f ) input-stream get stream-read-until ;
-: readln ( -- str/f ) stdio get stream-readln ;
-: read1 ( -- ch/f ) stdio get stream-read1 ;
-: read ( n -- str/f ) stdio get stream-read ;
-: read-until ( seps -- str/f sep/f ) stdio get stream-read-until ;
+: write1 ( ch -- ) output-stream get stream-write1 ;
+: write ( str -- ) output-stream get stream-write ;
+: flush ( -- ) output-stream get stream-flush ;
-: write1 ( ch -- ) stdio get stream-write1 ;
-: write ( str -- ) stdio get stream-write ;
-: flush ( -- ) stdio get stream-flush ;
+: nl ( -- ) output-stream get stream-nl ;
+: format ( str style -- ) output-stream get stream-format ;
-: nl ( -- ) stdio get stream-nl ;
-: format ( str style -- ) stdio get stream-format ;
+: with-input-stream* ( stream quot -- )
+ input-stream swap with-variable ; inline
-: with-stream* ( stream quot -- )
- stdio swap with-variable ; inline
+: with-input-stream ( stream quot -- )
+ [ with-input-stream* ] curry with-disposal ; inline
-: with-stream ( stream quot -- )
- [ with-stream* ] curry with-disposal ; inline
+: with-output-stream* ( stream quot -- )
+ output-stream swap with-variable ; inline
+
+: with-output-stream ( stream quot -- )
+ [ with-output-stream* ] curry with-disposal ; inline
+
+: with-streams* ( input output quot -- )
+ [ with-input-stream* ] curry with-output-stream* ; inline
+
+: with-streams ( input output quot -- )
+ [ with-input-stream ] curry with-output-stream ; inline
: tabular-output ( style quot -- )
- swap >r { } make r> stdio get stream-write-table ; inline
+ swap >r { } make r> output-stream get stream-write-table ; inline
: with-row ( quot -- )
{ } make , ; inline
: with-cell ( quot -- )
- H{ } stdio get make-cell-stream
- [ swap with-stream ] keep , ; inline
+ H{ } output-stream get make-cell-stream
+ [ swap with-output-stream ] keep , ; inline
: write-cell ( str -- )
[ write ] with-cell ; inline
swap dup assoc-empty? [
drop call
] [
- stdio get make-span-stream swap with-stream
+ output-stream get make-span-stream swap with-output-stream
] if ; inline
: with-nesting ( style quot -- )
- >r stdio get make-block-stream r> with-stream ; inline
+ >r output-stream get make-block-stream
+ r> with-output-stream ; inline
-: print ( string -- ) stdio get stream-print ;
+: print ( string -- ) output-stream get stream-print ;
: bl ( -- ) " " write ;
presented associate format ;
: lines ( stream -- seq )
- [ [ readln dup ] [ ] [ drop ] unfold ] with-stream ;
+ [ [ readln dup ] [ ] [ drop ] unfold ] with-input-stream ;
: contents ( stream -- str )
[
[ 65536 read dup ] [ ] [ drop ] unfold concat f like
- ] with-stream ;
+ ] with-input-stream ;
HELP: with-byte-reader
{ $values { "encoding" "an encoding descriptor" }
{ "quot" quotation } { "byte-array" byte-array } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream for reading from a byte array using an encoding." } ;
+{ $description "Calls the quotation in a new dynamic scope with " { $link input-stream } " rebound to an input stream for reading from a byte array using an encoding." } ;
HELP: with-byte-writer
{ $values { "encoding" "an encoding descriptor" }
{ "quot" quotation }
{ "byte-array" byte-array } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an output stream writing data to a byte array using an encoding." } ;
+{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an output stream writing data to a byte array using an encoding." } ;
USING: byte-arrays byte-vectors kernel io.encodings io.streams.string
-sequences io namespaces io.encodings.private ;
+sequences io namespaces io.encodings.private accessors ;
IN: io.streams.byte-array
: <byte-writer> ( encoding -- stream )
512 <byte-vector> swap <encoder> ;
: with-byte-writer ( encoding quot -- byte-array )
- >r <byte-writer> r> [ stdio get ] compose with-stream*
- dup encoder? [ encoder-stream ] when >byte-array ; inline
+ >r <byte-writer> r> [ output-stream get ] compose with-output-stream*
+ dup encoder? [ stream>> ] when >byte-array ; inline
: <byte-reader> ( byte-array encoding -- stream )
>r >byte-vector dup reverse-here r> <decoder> ;
: with-byte-reader ( byte-array encoding quot -- )
- >r <byte-reader> r> with-stream ; inline
+ >r <byte-reader> r> with-input-stream* ; inline
! See http://factorcode.org/license.txt for BSD license.
USING: kernel kernel.private namespaces io io.encodings
sequences math generic threads.private classes io.backend
-io.streams.duplex io.files continuations byte-arrays ;
+io.files continuations byte-arrays ;
IN: io.streams.c
TUPLE: c-writer handle ;
+++ /dev/null
-Slava Pestov
+++ /dev/null
-USING: help.markup help.syntax io continuations ;
-IN: io.streams.duplex
-
-ARTICLE: "io.streams.duplex" "Duplex streams"
-"Duplex streams combine an input stream and an output stream into a bidirectional stream."
-{ $subsection duplex-stream }
-{ $subsection <duplex-stream> } ;
-
-ABOUT: "io.streams.duplex"
-
-HELP: duplex-stream
-{ $class-description "A bidirectional stream wrapping an input and output stream." } ;
-
-HELP: <duplex-stream>
-{ $values { "in" "an input stream" } { "out" "an output stream" } { "stream" " a duplex stream" } }
-{ $description "Creates a duplex stream. Writing to a duplex stream will write to " { $snippet "out" } ", and reading from a duplex stream will read from " { $snippet "in" } ". Closing a duplex stream closes both the input and output streams." } ;
-
-HELP: stream-closed-twice
-{ $error-description "This error is thrown when performing an I/O operation on a " { $link duplex-stream } " which has been closed with " { $link dispose } "." } ;
+++ /dev/null
-USING: io.streams.duplex io kernel continuations tools.test ;
-IN: io.streams.duplex.tests
-
-! Test duplex stream close behavior
-TUPLE: closing-stream closed? ;
-
-: <closing-stream> closing-stream new ;
-
-M: closing-stream dispose
- dup closing-stream-closed? [
- "Closing twice!" throw
- ] [
- t swap set-closing-stream-closed?
- ] if ;
-
-TUPLE: unclosable-stream ;
-
-: <unclosable-stream> unclosable-stream new ;
-
-M: unclosable-stream dispose
- "Can't close me!" throw ;
-
-[ ] [
- <closing-stream> <closing-stream> <duplex-stream>
- dup dispose dispose
-] unit-test
-
-[ t ] [
- <unclosable-stream> <closing-stream> [
- <duplex-stream>
- [ dup dispose ] [ 2drop ] recover
- ] keep closing-stream-closed?
-] unit-test
-
-[ t ] [
- <closing-stream> [ <unclosable-stream>
- <duplex-stream>
- [ dup dispose ] [ 2drop ] recover
- ] keep closing-stream-closed?
-] unit-test
+++ /dev/null
-! Copyright (C) 2005, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel continuations io accessors ;
-IN: io.streams.duplex
-
-! We ensure that the stream can only be closed once, to preserve
-! integrity of duplex I/O ports.
-
-TUPLE: duplex-stream in out closed ;
-
-: <duplex-stream> ( in out -- stream )
- f duplex-stream boa ;
-
-ERROR: stream-closed-twice ;
-
-<PRIVATE
-
-: check-closed ( stream -- stream )
- dup closed>> [ stream-closed-twice ] when ; inline
-
-: in ( duplex -- stream ) check-closed in>> ;
-
-: out ( duplex -- stream ) check-closed out>> ;
-
-PRIVATE>
-
-M: duplex-stream stream-flush
- out stream-flush ;
-
-M: duplex-stream stream-readln
- in stream-readln ;
-
-M: duplex-stream stream-read1
- in stream-read1 ;
-
-M: duplex-stream stream-read-until
- in stream-read-until ;
-
-M: duplex-stream stream-read-partial
- in stream-read-partial ;
-
-M: duplex-stream stream-read
- in stream-read ;
-
-M: duplex-stream stream-write1
- out stream-write1 ;
-
-M: duplex-stream stream-write
- out stream-write ;
-
-M: duplex-stream stream-nl
- out stream-nl ;
-
-M: duplex-stream stream-format
- out stream-format ;
-
-M: duplex-stream make-span-stream
- out make-span-stream ;
-
-M: duplex-stream make-block-stream
- out make-block-stream ;
-
-M: duplex-stream make-cell-stream
- out make-cell-stream ;
-
-M: duplex-stream stream-write-table
- out stream-write-table ;
-
-M: duplex-stream dispose
- #! The output stream is closed first, in case both streams
- #! are attached to the same file descriptor, the output
- #! buffer needs to be flushed before we close the fd.
- dup closed>> [
- t >>closed
- [ dup out>> dispose ]
- [ dup in>> dispose ] [ ] cleanup
- ] unless drop ;
+++ /dev/null
-Combine an input and an output stream into a single duplex stream
HELP: with-string-writer
{ $values { "quot" quotation } { "str" string } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to a new string writer. The accumulated string is output when the quotation returns." } ;
+{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to a new string writer. The accumulated string is output when the quotation returns." } ;
HELP: <string-reader>
{ $values { "str" string } { "stream" "an input stream" } }
HELP: with-string-reader
{ $values { "str" string } { "quot" quotation } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream reading " { $snippet "str" } " from beginning to end." } ;
+{ $description "Calls the quotation in a new dynamic scope with " { $link input-stream } " rebound to an input stream reading " { $snippet "str" } " from beginning to end." } ;
"J" read-until 2array ,
"i" read-until 2array ,
"X" read-until 2array ,
- ] with-stream
+ ] with-input-stream
] { } make
] unit-test
512 <sbuf> ;
: with-string-writer ( quot -- str )
- <string-writer> swap [ stdio get ] compose with-stream*
+ <string-writer> swap [ output-stream get ] compose with-output-stream*
>string ; inline
M: growable stream-read1 dup empty? [ drop f ] [ pop ] if ;
>sbuf dup reverse-here null <decoder> ;
: with-string-reader ( str quot -- )
- >r <string-reader> r> with-stream ; inline
+ >r <string-reader> r> with-input-stream ; inline
INSTANCE: growable plain-writer
] unless ;
: map-last ( seq quot -- seq )
- swap dup length <reversed>
- [ zero? rot [ call ] keep swap ] 2map nip ; inline
+ >r dup length <reversed> [ zero? ] r> compose 2map ; inline
: format-table ( table -- seq )
flip [ format-column ] map-last
flip [ " " join ] map ;
M: plain-writer stream-write-table
- [ drop format-table [ print ] each ] with-stream* ;
+ [ drop format-table [ print ] each ] with-output-stream* ;
M: plain-writer make-cell-stream 2drop <string-writer> ;
HELP: read-quot
{ $values { "quot/f" "a parsed quotation, or " { $link f } " indicating end of file" } }
-{ $description "Reads a Factor expression which possibly spans more than one line from " { $link stdio } " stream. Additional lines of input are read while the parser stack height is greater than one. Since structural parsing words push partial quotations on the stack, this will keep on reading input until all delimited parsing words are terminated." } ;
+{ $description "Reads a Factor expression which possibly spans more than one line from " { $link input-stream } ". Additional lines of input are read while the parser stack height is greater than one. Since structural parsing words push partial quotations on the stack, this will keep on reading input until all delimited parsing words are terminated." } ;
HELP: listen
-{ $description "Prompts for an expression on the " { $link stdio } " stream and evaluates it. On end of file, " { $link quit-flag } " is set to terminate the listener loop." }
-{ $errors "If the expression input by the user throws an error, the error is printed to the " { $link stdio } " stream and the word returns normally." } ;
+{ $description "Prompts for an expression on " { $link input-stream } " and evaluates it. On end of file, " { $link quit-flag } " is set to terminate the listener loop." }
+{ $errors "If the expression input by the user throws an error, the error is printed to " { $link output-stream } " and the word returns normally." } ;
HELP: listener
-{ $description "Prompts for expressions on the " { $link stdio } " stream and evaluates them until end of file is reached." } ;
+{ $description "Prompts for expressions on " { $link input-stream } " and evaluates them until end of file is reached." } ;
HELP: bye
{ $description "Exits the current listener." }
! See http://factorcode.org/license.txt for BSD license.
USING: arrays hashtables io kernel math math.parser memory
namespaces parser sequences strings io.styles
-io.streams.duplex vectors words generic system combinators
-continuations debugger definitions compiler.units accessors ;
+vectors words generic system combinators continuations debugger
+definitions compiler.units accessors ;
IN: listener
SYMBOL: quit-flag
M: object stream-read-quot
V{ } clone read-quot-loop ;
-M: duplex-stream stream-read-quot
- duplex-stream-in stream-read-quot ;
-
-: read-quot ( -- quot/f ) stdio get stream-read-quot ;
+: read-quot ( -- quot/f ) input-stream get stream-read-quot ;
: bye ( -- ) quit-flag on ;
[ 1 1 >base ] must-fail
[ 1 0 >base ] must-fail
[ 1 -1 >base ] must-fail
+
+[ "0.0/0.0" ] [ 0.0 0.0 / number>string ] unit-test
IN: parser
ARTICLE: "vocabulary-search-shadow" "Shadowing word names"
-"If adding a vocabulary to the search path results in a word in another vocabulary becoming inaccessible due to the new vocabulary defining a word with the same name, a message is printed to the " { $link stdio } " stream. Except when debugging suspected name clashes, these messages can be ignored."
+"If adding a vocabulary to the search path results in a word in another vocabulary becoming inaccessible due to the new vocabulary defining a word with the same name, we say that the old word has been " { $emphasis "shadowed" } "."
$nl
"Here is an example where shadowing occurs:"
{ $code
"USING: sequences io ;"
""
": append"
- " \"foe::append calls sequences::append\" print append ;"
+ " \"foe::append calls sequences:append\" print append ;"
""
"IN: fee"
""
": append"
- " \"fee::append calls fee::append\" print append ;"
+ " \"fee::append calls fee:append\" print append ;"
""
"IN: fox"
"USE: foe"
""
": append"
- " \"fox::append calls foe::append\" print append ;"
+ " \"fox::append calls foe:append\" print append ;"
""
"\"1234\" \"5678\" append print"
""
}
"When placed in a source file and run, the above code produces the following output:"
{ $code
- "foe::append calls sequences::append"
+ "foe:append calls sequences:append"
"12345678"
- "fee::append calls foe::append"
- "foe::append calls sequences::append"
+ "fee:append calls foe:append"
+ "foe:append calls sequences:append"
"12345678"
-} ;
+}
+"The " { $vocab-link "qualified" } " vocabulary contains some tools for helping with shadowing." ;
ARTICLE: "vocabulary-search-errors" "Word lookup errors"
"If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies. Then, one of three things happen:"
{ $description "Saves the location of a definition and associates this definition with the current source file." } ;
HELP: parser-notes
-{ $var-description "A boolean controlling whether the parser will print various notes and warnings. Switched on by default. If a source file is being run for its effect on the " { $link stdio } " stream, this variable should be switched off, to prevent parser notes from polluting the output." } ;
+{ $var-description "A boolean controlling whether the parser will print various notes and warnings. Switched on by default. If a source file is being run for its effect on " { $link output-stream } ", this variable should be switched off, to prevent parser notes from polluting the output." } ;
HELP: parser-notes?
{ $values { "?" "a boolean" } }
HELP: eval>string
{ $values { "str" string } { "output" string } }
-{ $description "Evaluates the Factor code in " { $snippet "str" } " with the " { $link stdio } " stream rebound to a string output stream, then outputs the resulting string." } ;
+{ $description "Evaluates the Factor code in " { $snippet "str" } " with " { $link output-stream } " rebound to a string output stream, then outputs the resulting string." } ;
HELP: staging-violation
{ $values { "word" word } }
$nl
"Prettyprinter words are found in the " { $vocab-link "prettyprint" } " vocabulary."
$nl
-"The key words to print an object to the " { $link stdio } " stream; the first two emit a trailing newline, the second two do not:"
+"The key words to print an object to " { $link output-stream } "; the first two emit a trailing newline, the second two do not:"
{ $subsection . }
{ $subsection short. }
{ $subsection pprint }
HELP: with-pprint
{ $values { "obj" object } { "quot" quotation } }
-{ $description "Sets up the prettyprinter and calls the quotation in a new scope. The quotation should add sections to the top-level block. When the quotation returns, the top-level block is printed to the " { $link stdio } " stream." } ;
+{ $description "Sets up the prettyprinter and calls the quotation in a new scope. The quotation should add sections to the top-level block. When the quotation returns, the top-level block is printed to " { $link output-stream } "." } ;
HELP: pprint
{ $values { "obj" object } }
-{ $description "Prettyprints an object to the " { $link stdio } " stream. Output is influenced by many variables; see " { $link "prettyprint-variables" } "." } ;
+{ $description "Prettyprints an object to " { $link output-stream } ". Output is influenced by many variables; see " { $link "prettyprint-variables" } "." } ;
{ pprint pprint* with-pprint } related-words
HELP: .
{ $values { "obj" object } }
-{ $description "Prettyprints an object to the " { $link stdio } " stream with a trailing line break. Output is influenced by many variables; see " { $link "prettyprint-variables" } "." } ;
+{ $description "Prettyprints an object to " { $link output-stream } " with a trailing line break. Output is influenced by many variables; see " { $link "prettyprint-variables" } "." } ;
HELP: unparse
{ $values { "obj" object } { "str" "Factor source string" } }
HELP: pprint-short
{ $values { "obj" object } }
-{ $description "Prettyprints an object to the " { $link stdio } " stream. This word rebinds printer control variables to enforce ``shorter'' output. See " { $link "prettyprint-variables" } "." } ;
+{ $description "Prettyprints an object to " { $link output-stream } ". This word rebinds printer control variables to enforce ``shorter'' output. See " { $link "prettyprint-variables" } "." } ;
HELP: short.
{ $values { "obj" object } }
-{ $description "Prettyprints an object to the " { $link stdio } " stream with a trailing line break. This word rebinds printer control variables to enforce ``shorter'' output." } ;
+{ $description "Prettyprints an object to " { $link output-stream } " with a trailing line break. This word rebinds printer control variables to enforce ``shorter'' output." } ;
HELP: .b
{ $values { "n" "an integer" } }
HELP: do-indent
-{ $description "Outputs the current indent nesting to the " { $link stdio } " stream." } ;
+{ $description "Outputs the current indent nesting to " { $link output-stream } "." } ;
HELP: fresh-line
{ $values { "n" "the current column position" } }
USING: asn1 asn1.ldap io io.streams.string tools.test ;
[ 6 ] [
- "\u000002\u000001\u000006" <string-reader> [ asn-syntax read-ber ] with-stream
+ "\u000002\u000001\u000006" <string-reader> [ asn-syntax read-ber ] with-input-stream
] unit-test
[ "testing" ] [
- "\u000004\u000007testing" <string-reader> [ asn-syntax read-ber ] with-stream
+ "\u000004\u000007testing" <string-reader> [ asn-syntax read-ber ] with-input-stream
] unit-test
[ { 1 { 3 "Administrator" "ad_is_bogus" } } ] [
"0$\u000002\u000001\u000001`\u00001f\u000002\u000001\u000003\u000004\rAdministrator\u000080\u00000bad_is_bogus"
- <string-reader> [ asn-syntax read-ber ] with-stream
+ <string-reader> [ asn-syntax read-ber ] with-input-stream
] unit-test
[
readln [ do-line (reverse-complement) ] [ show-seq ] if* ;
: reverse-complement ( infile outfile -- )
- ascii <file-writer> [
- swap ascii <file-reader> [
- swap <duplex-stream> [
- 500000 <vector> (reverse-complement)
- ] with-stream
- ] with-disposal
- ] with-disposal ;
+ ascii [
+ ascii [
+ 500000 <vector> (reverse-complement)
+ ] with-file-reader
+ ] with-file-writer ;
: reverse-complement-in
"reverse-complement-in.txt" temp-file ;
] ignore-errors ;
: simple-client ( -- )
- server-addr ascii <client> [
+ server-addr ascii [
CHAR: b write1 flush
number-of-requests
[ CHAR: a dup write1 flush read1 assert= ] times
counter get count-down
- ] with-stream ;
+ ] with-client ;
: stop-server ( -- )
- server-addr ascii <client> [
+ server-addr ascii [
CHAR: x write1
- ] with-stream ;
+ ] with-client ;
: clients ( n -- )
dup pprint " clients: " write [
INSTANCE: md5 checksum
M: md5 checksum-stream ( stream -- byte-array )
- drop [ initialize-md5 stream>md5 get-md5 ] with-stream ;
+ drop [ initialize-md5 stream>md5 get-md5 ] with-input-stream ;
INSTANCE: sha1 checksum
M: sha1 checksum-stream ( stream -- sha1 )
- drop [ initialize-sha1 stream>sha1 get-sha1 ] with-stream ;
+ drop [ initialize-sha1 stream>sha1 get-sha1 ] with-input-stream ;
: sha1-interleave ( string -- seq )
[ zero? ] left-trim
USING: serialize sequences concurrency.messaging threads io
io.server qualified arrays namespaces kernel io.encodings.binary
accessors ;
-QUALIFIED: io.sockets
+FROM: io.sockets => host-name <inet> with-client ;
IN: concurrency.distributed
SYMBOL: local-node
: start-node ( port -- )
[ internet-server ]
- [ io.sockets:host-name swap io.sockets:<inet> ] bi
+ [ host-name swap <inet> ] bi
(start-node) ;
TUPLE: remote-process id node ;
C: <remote-process> remote-process
: send-remote-message ( message node -- )
- binary io.sockets:<client>
- [ serialize ] with-stream ;
+ binary [ serialize ] with-client ;
M: remote-process send ( message thread -- )
[ id>> 2array ] [ node>> ] bi
: changelog ( -- authors )
image parent-directory [
- "git-log --pretty=format:%an" <process-stream> lines
+ "git-log --pretty=format:%an" <process-reader> lines
] with-directory ;
: patch-counts ( authors -- assoc )
USING: kernel cpu.8080 cpu.8080.emulator math math io\r
-tools.time combinators sequences io.files ;\r
+tools.time combinators sequences io.files io.encodings.ascii ;\r
IN: cpu.8080.test\r
\r
: step ( cpu -- )\r
\r
: >ppm ( cpu filename -- cpu )\r
#! Dump the current screen image to a ppm image file with the given name.\r
- <file-writer> [\r
+ ascii [\r
"P3" print\r
"256 224" print\r
"1" print\r
] each-8bit drop\r
] each drop nl\r
] each\r
- ] with-stream ;\r
+ ] with-file-writer ;\r
\r
: time-test ( -- )\r
test-cpu [ 1000000 run-n drop ] time ;\r
ipad seq-bitxor ;
: stream>sha1-hmac ( K stream -- hmac )
- [ init-hmac sha1-hmac ] with-stream ;
+ [ init-hmac sha1-hmac ] with-input-stream ;
: file>sha1-hmac ( K path -- hmac )
binary <file-reader> stream>sha1-hmac ;
binary <byte-reader> stream>sha1-hmac ;
: stream>md5-hmac ( K stream -- hmac )
- [ init-hmac md5-hmac ] with-stream ;
+ [ init-hmac md5-hmac ] with-input-stream ;
: file>md5-hmac ( K path -- hmac )
binary <file-reader> stream>md5-hmac ;
: csv-row ( stream -- row )
init-vars
- [ row nip ] with-stream ;
+ [ row nip ] with-input-stream ;
: csv ( stream -- rows )
init-vars
- [ [ (csv) ] { } make ] with-stream ;
+ [ [ (csv) ] { } make ] with-input-stream ;
: with-delimiter ( char quot -- )
delimiter swap with-variable ; inline
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: continuations io.backend libc kernel namespaces
-sequences system vectors ;
+USING: continuations io.backend io.nonblocking libc kernel
+namespaces sequences system vectors ;
IN: destructors
SYMBOL: error-destructors
C: <handle-destructor> handle-destructor
-HOOK: destruct-handle io-backend ( obj -- )
-
M: handle-destructor dispose ( obj -- )
- handle-destructor-alien destruct-handle ;
+ handle-destructor-alien close-handle ;
: close-always ( handle -- )
<handle-destructor> add-always-destructor ;
] with-byte-writer ;
: send-jedit-request ( request -- )
- jedit-server-info "localhost" rot <inet> binary <client> [
+ jedit-server-info "localhost" rot <inet> binary [
4 >be write
dup length 2 >be write
write
- ] with-stream ;
+ ] with-client ;
: jedit-location ( file line -- )
number>string "+line:" prepend 2array
M: gesture-logger handle-gesture*
drop
dup T{ button-down } = [ over request-focus ] when
- swap gesture-logger-stream [ . ] with-stream*
+ swap gesture-logger-stream [ . ] with-output-stream*
t ;
M: gesture-logger user-input*
gesture-logger-stream [
"User input: " write print
- ] with-stream* t ;
+ ] with-output-stream* t ;
: gesture-logger ( -- )
[
}
"Send some bytes to a remote host:"
{ $code
- "\"myhost\" 1033 <inet> <client>"
- "[ { 12 17 102 } >string write ] with-stream"
+ "\"myhost\" 1033 <inet>"
+ "[ { 12 17 102 } >string write ] with-client"
}
{ $references
{ }
{ { $snippet "set-" { $emphasis "foo" } } { "sets " { $snippet "foo" } " to a new value" } { $links set-length } }
{ { $snippet { $emphasis "foo" } "-" { $emphasis "bar" } } { "(tuple accessors) outputs the value of the " { $snippet "bar" } " slot of the " { $snippet "foo" } " at the top of the stack" } { } }
{ { $snippet "set-" { $emphasis "foo" } "-" { $emphasis "bar" } } { "(tuple mutators) sets the value of the " { $snippet "bar" } " slot of the " { $snippet "foo" } " at the top of the stack" } { } }
- { { $snippet "with-" { $emphasis "foo" } } { "performs some kind of initialization and cleanup related to " { $snippet "foo" } ", usually in a new dynamic scope" } { $links with-scope with-stream } }
+ { { $snippet "with-" { $emphasis "foo" } } { "performs some kind of initialization and cleanup related to " { $snippet "foo" } ", usually in a new dynamic scope" } { $links with-scope with-input-stream with-output-stream } }
{ { $snippet "$" { $emphasis "foo" } } { "help markup" } { $links $heading $emphasis } }
}
{ $heading "Stack effect conventions" }
HELP: help
{ $values { "topic" "an article name or a word" } }
{ $description
- "Displays a help article or documentation associated to a word on the " { $link stdio } " stream."
+ "Displays a help article or documentation associated to a word on " { $link output-stream } "."
} ;
HELP: about
HELP: ($index)
{ $values { "articles" "a sequence of help articles" } }
-{ $description "Writes a list of " { $link $subsection } " elements to the " { $link stdio } " stream." } ;
+{ $description "Writes a list of " { $link $subsection } " elements to " { $link output-stream } "." } ;
HELP: xref-help
{ $description "Update help cross-referencing. Usually this is done automatically." } ;
HELP: print-element
{ $values { "element" "a markup element" } }
-{ $description "Prints a markup element to the " { $link stdio } " stream." } ;
+{ $description "Prints a markup element to " { $link output-stream } "." } ;
HELP: print-content
{ $values { "element" "a markup element" } }
-{ $description "Prints a top-level markup element to the " { $link stdio } " stream." } ;
+{ $description "Prints a top-level markup element to " { $link output-stream } "." } ;
HELP: simple-element
{ $class-description "Class of simple elements, which are just arrays of elements." } ;
] unit-test
[ "<" ] [
- [ "<" H{ } stdio get format-html-span ] make-html-string
+ [ "<" H{ } output-stream get format-html-span ] make-html-string
] unit-test
TUPLE: funky town ;
rot html-sub-stream-stream ;
: delegate-write ( string -- )
- stdio get delegate stream-write ;
+ output-stream get delegate stream-write ;
: object-link-tag ( style quot -- )
presented pick at [
: format-html-span ( string style stream -- )
[
[ [ drop delegate-write ] span-tag ] object-link-tag
- ] with-stream* ;
+ ] with-output-stream* ;
TUPLE: html-span-stream ;
: format-html-div ( string style stream -- )
[
[ [ delegate-write ] div-tag ] object-link-tag
- ] with-stream* ;
+ ] with-output-stream* ;
TUPLE: html-block-stream ;
</td>
] with each </tr>
] with each </table>
- ] with-stream* ;
+ ] with-output-stream* ;
M: html-stream make-cell-stream ( style stream -- stream' )
(html-sub-stream) ;
M: html-stream stream-nl ( stream -- )
- dup test-last-div? [ drop ] [ [ <br/> ] with-stream* ] if ;
+ dup test-last-div? [ drop ] [ [ <br/> ] with-output-stream* ] if ;
! Utilities
: with-html-stream ( quot -- )
- stdio get <html-stream> swap with-stream* ; inline
+ output-stream get <html-stream> swap with-output-stream* ; inline
: xhtml-preamble
"<?xml version=\"1.0\"?>" write-html
: do-redirect ( response -- response stream )
dup response-code 300 399 between? [
- stdio get dispose
+ output-stream get dispose
redirects inc
redirects get max-redirects < [
header>> "location" swap at
too-many-redirects
] if
] [
- stdio get
+ output-stream get
] if ;
: close-on-error ( stream quot -- )
: http-request ( request -- response stream )
dup request [
dup request-addr latin1 <client>
- 1 minutes over set-timeout
[
- write-request flush
+ 1 minutes timeouts
+ write-request
+ input-stream get dispose
read-response
do-redirect
] close-on-error
: do-chunked-encoding ( response stream -- response stream/string )
over "transfer-encoding" header "chunked" = [
- [ [ read-chunks ] "" make ] with-stream
+ [ [ read-chunks ] "" make ] with-input-stream
] when ;
: <get-request> ( url -- request )
[ H{ { "a" { "b" "c" } } } ] [ "a=b&a=c" query>assoc ] unit-test
[ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test
+
: lf>crlf "\n" split "\r\n" join ;
STRING: read-request-test-1
! Try with a slightly malformed request
[ t ] [
- "localhost" 1237 <inet> ascii <client> [
+ "localhost" 1237 <inet> ascii [
"GET nested HTTP/1.0\r\n" write flush
"\r\n" write flush
read-crlf drop
read-header
- ] with-stream "location" swap at "/" head?
+ ] with-client "location" swap at "/" head?
] unit-test
[ "http://localhost:1237/redirect-loop" http-get ]
M: callable write-response-body* call ;
-M: object write-response-body* stdio get stream-copy ;
+M: object write-response-body* output-stream get stream-copy ;
: write-response-body ( response -- response )
dup body>> write-response-body* ;
200 >>code\r
"CGI output follows" >>message\r
swap '[\r
- ,
stdio get swap <cgi-process> <process-stream> [
\r+ ,
output-stream get swap <cgi-process> <process-stream> [
\r post? [ request get post-data>> write flush ] when\r
- stdio get swap (stream-copy)\r
+ input-stream get swap (stream-copy)\r
] with-stream\r
] >>body ;\r
\r
bi
] recover ;
-: default-timeout 1 minutes stdio get set-timeout ;
-
: ?refresh-all ( -- )
development-mode get-global
[ global [ refresh-all ] bind ] when ;
: handle-client ( -- )
[
- default-timeout
+ 1 minutes timeouts
?refresh-all
read-request
do-request
[ size>> "content-length" set-header ]\r
[ modified>> "last-modified" set-header ] bi\r
]\r
- [ '[ , binary <file-reader> stdio get stream-copy ] >>body ] bi\r
+ [ '[ , binary <file-reader> output-stream get stream-copy ] >>body ] bi\r
] <file-responder> ;\r
\r
: serve-static ( filename mime-type -- response )\r
{ "stream" "a bidirectional stream" } }
{ $description "Launches a process and redirects its input and output via a pair of pipes which may be read and written as a stream of the given encoding." } ;
-HELP: with-process-stream
-{ $values
- { "desc" "a launch descriptor" }
- { "quot" quotation }
- { "status" "an exit code" } }
-{ $description "Calls " { $snippet "quot" } " in a dynamic scope where " { $link stdio } " is rebound to a process stream. After the quotation returns, waits for the process to end and outputs the exit code." } ;
-
HELP: wait-for-process
{ $values { "process" process } { "status" integer } }
{ $description "If the process is still running, waits for it to exit, otherwise outputs the exit code immediately. Can be called multiple times on the same process." } ;
{ $subsection try-process }
{ $subsection run-detached }
"Redirecting standard input and output to a pipe:"
-{ $subsection <process-stream> }
-{ $subsection with-process-stream } ;
+{ $subsection <process-reader> }
+{ $subsection <process-writer> }
+{ $subsection <process-stream> } ;
ARTICLE: "io.launcher.examples" "Launcher examples"
"Starting a command and waiting for it to finish:"
" <process>"
" swap >>stderr"
" \"report\" >>command"
- " ascii <process-stream> lines sort reverse [ print ] each"
+ " ascii <process-reader> lines sort reverse [ print ] each"
"] with-disposal"
} ;
USING: tools.test io.launcher ;
\ <process-stream> must-infer
+\ <process-reader> must-infer
+\ <process-writer> must-infer
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: io io.backend io.timeouts system kernel namespaces
-strings hashtables sequences assocs combinators vocabs.loader
-init threads continuations math io.encodings io.streams.duplex
-io.nonblocking accessors concurrency.flags ;
+USING: io io.backend io.timeouts io.pipes system kernel
+namespaces strings hashtables sequences assocs combinators
+vocabs.loader init threads continuations math io.encodings
+io.streams.duplex io.nonblocking io.streams.duplex accessors
+concurrency.flags locals destructors ;
IN: io.launcher
TUPLE: process < identity-tuple
M: process timed-out kill-process ;
-HOOK: (process-stream) io-backend ( process -- handle in out )
-
-: <process-stream*> ( desc encoding -- stream process )
- >r >process dup dup (process-stream) <reader&writer>
- r> <encoder-duplex> -roll
- process-started ;
+:: <process-reader*> ( process encoding -- process stream )
+ [
+ (pipe) {
+ [ add-error-destructor ]
+ [
+ process >process
+ [ swap out>> or ] change-stdout
+ run-detached
+ ]
+ [ out>> close-handle ]
+ [ in>> <reader> encoding <decoder> ]
+ } cleave
+ ] with-destructors ;
+
+: <process-reader> ( desc encoding -- stream )
+ <process-reader*> nip ; inline
+
+:: <process-writer*> ( process encoding -- process stream )
+ [
+ (pipe) {
+ [ add-error-destructor ]
+ [
+ process >process
+ [ swap in>> or ] change-stdout
+ run-detached
+ ]
+ [ in>> close-handle ]
+ [ out>> <writer> encoding <encoder> ]
+ } cleave
+ ] with-destructors ;
+
+: <process-writer> ( desc encoding -- stream )
+ <process-writer*> nip ; inline
+
+:: <process-stream*> ( process encoding -- process stream )
+ [
+ (pipe) (pipe) {
+ [ [ add-error-destructor ] bi@ ]
+ [
+ process >process
+ [ swap out>> or ] change-stdout
+ [ swap in>> or ] change-stdin
+ run-detached
+ ]
+ [ [ in>> close-handle ] [ out>> close-handle ] bi* ]
+ [
+ [ in>> <reader> ] [ out>> <writer> ] bi*
+ encoding <encoder-duplex>
+ ]
+ } 2cleave
+ ] with-destructors ;
: <process-stream> ( desc encoding -- stream )
- <process-stream*> drop ; inline
-
-: with-process-stream ( desc quot -- status )
- swap <process-stream*> >r
- [ swap with-stream ] keep
- r> wait-for-process ; inline
+ <process-stream*> nip ; inline
: notify-exit ( process status -- )
>>status
GENERIC: underlying-handle ( stream -- handle )
-M: port underlying-handle port-handle ;
+M: port underlying-handle handle>> ;
M: duplex-stream underlying-handle
- dup duplex-stream-in underlying-handle
- swap duplex-stream-out underlying-handle tuck =
- [ "Invalid duplex stream" throw ] when ;
+ [ in>> underlying-handle ]
+ [ out>> underlying-handle ] bi
+ [ = [ "Invalid duplex stream" throw ] when ] keep ;
! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel io sequences io.buffers io.timeouts generic
-byte-vectors system io.streams.duplex io.encodings math.order
-io.backend continuations debugger classes byte-arrays namespaces
-splitting dlists assocs io.encodings.binary inspector accessors ;
+byte-vectors system io.encodings math.order io.backend
+continuations debugger classes byte-arrays namespaces splitting
+dlists assocs io.encodings.binary inspector accessors ;
IN: io.nonblocking
SYMBOL: default-buffer-size
--- /dev/null
+USING: io io.pipes io.streams.string io.encodings.utf8
+continuations tools.test kernel ;
+IN: io.pipes.tests
+
+[ "Hello" ] [
+ utf8 <pipe> "Hello" over stream-write dispose
+ dup stream-readln swap dispose
+] unit-test
+
+[ { } ] [ { } utf8 with-pipes ] unit-test
+[ { f } ] [ { [ f ] } utf8 with-pipes ] unit-test
+[ { "Hello" } ] [ "Hello" [ { [ readln ] } utf8 with-pipes ] with-string-reader ] unit-test
+
+[ { f "Hello" } ] [
+ {
+ [ "Hello" print flush f ]
+ [ readln ]
+ } utf8 with-pipes
+] unit-test
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings io.backend io.nonblocking io.streams.duplex
+io splitting sequences sequences.lib namespaces kernel
+destructors math concurrency.combinators locals accessors
+arrays continuations ;
+IN: io.pipes
+
+TUPLE: pipe in out ;
+
+: close-pipe ( pipe -- )
+ [ in>> ] [ out>> ] bi 2array dispose-each ;
+
+HOOK: (pipe) io-backend ( -- pipe )
+
+:: <pipe> ( encoding -- input-stream output-stream )
+ [
+ (pipe)
+ [ [ close-later ] each ]
+ [
+ [ in>> <reader> encoding <decoder> ]
+ [ out>> <writer> encoding <encoder> ] bi
+ ] bi
+ ] with-destructors ;
+
+:: with-fds ( input-fd output-fd quot encoding -- )
+ input-fd [ <reader> encoding <decoder> dup add-always-destructor ] [ input-stream get ] if* [
+ output-fd [ <writer> encoding <encoder> dup add-always-destructor ] [ output-stream get ] if*
+ quot with-output-stream
+ ] with-input-stream ; inline
+
+: <pipes> ( n -- pipes )
+ [ (pipe) dup [ close-later ] each ] replicate
+ { f f } [ prefix ] [ suffix ] bi
+ 2 <sliding-groups> ;
+
+: with-pipe-fds ( seq -- results )
+ [
+ [ length dup zero? [ drop { } ] [ 1- <pipes> ] if ] keep
+ [ >r [ first in>> ] [ second out>> ] bi r> 2curry ] 2map
+ [ call ] parallel-map
+ ] with-destructors ;
+
+: with-pipes ( seq encoding -- results )
+ [ [ with-fds ] 2curry ] curry map with-pipe-fds ;
HELP: with-server
{ $values { "seq" "a sequence of address specifiers" } { "service" "a string or " { $link f } } { "encoding" "an encoding to use for client connections" } { "quot" "a quotation" } }
-{ $description "Starts a TCP/IP server. The quotation is called in a new thread for each client connection, with the client connection being the " { $link stdio } " stream. Client connections are logged to the " { $link stdio } " stream at the time the server was started." } ;
+{ $description "Starts a TCP/IP server. The quotation is called in a new thread for each client connection, with the client connection being both the " { $link input-stream } " and " { $link output-stream } "." } ;
HELP: with-datagrams
{ $values { "seq" "a sequence of address specifiers" } { "service" "a string or " { $link f } } { "quot" "a quotation" } }
-{ $description "Starts a UDP/IP server. The quotation is called for each datagram packet received. Datagram packets are logged to the " { $link stdio } " stream at the time the server was started." } ;
+{ $description "Starts a UDP/IP server. The quotation is called for each datagram packet received." } ;
ARTICLE: "network-connection" "Connection-oriented networking"
"Network connections can be established with this word:"
{ $subsection <client> }
+{ $subsection with-client }
"Connection-oriented network servers are implemented by first opening a server socket, then waiting for connections:"
{ $subsection <server> }
{ $subsection accept }
! Copyright (C) 2007, 2008 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: generic kernel io.backend namespaces continuations
-sequences arrays io.encodings io.nonblocking accessors ;
+sequences arrays io.encodings io.nonblocking io.streams.duplex
+accessors ;
IN: io.sockets
TUPLE: local path ;
: <client> ( addrspec encoding -- stream )
>r (client) r> <encoder-duplex> ;
+: with-client ( addrspec encoding quot -- )
+ >r <client> r> with-stream ; inline
+
HOOK: (server) io-backend ( addrspec -- handle )
: <server> ( addrspec encoding -- server )
--- /dev/null
+Slava Pestov
--- /dev/null
+USING: help.markup help.syntax io continuations quotations ;
+IN: io.streams.duplex
+
+ARTICLE: "io.streams.duplex" "Duplex streams"
+"Duplex streams combine an input stream and an output stream into a bidirectional stream."
+{ $subsection duplex-stream }
+{ $subsection <duplex-stream> }
+"A pair of combinators for rebinding both default streams at once:"
+{ $subsection with-stream }
+{ $subsection with-stream* } ;
+
+ABOUT: "io.streams.duplex"
+
+HELP: duplex-stream
+{ $class-description "A bidirectional stream wrapping an input and output stream." } ;
+
+HELP: <duplex-stream>
+{ $values { "in" "an input stream" } { "out" "an output stream" } { "stream" " a duplex stream" } }
+{ $description "Creates a duplex stream. Writing to a duplex stream will write to " { $snippet "out" } ", and reading from a duplex stream will read from " { $snippet "in" } ". Closing a duplex stream closes both the input and output streams." } ;
+
+HELP: stream-closed-twice
+{ $error-description "This error is thrown when performing an I/O operation on a " { $link duplex-stream } " which has been closed with " { $link dispose } "." } ;
+
+HELP: with-stream
+{ $values { "stream" duplex-stream } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } ". The stream is closed if the quotation returns or throws an error." } ;
+
+HELP: with-stream*
+{ $values { "stream" duplex-stream } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } "." }
+{ $notes "This word does not close the stream. Compare with " { $link with-stream } "." } ;
+
+HELP: <encoder-duplex>
+{ $values { "stream-in" "an input stream" }
+ { "stream-out" "an output stream" }
+ { "encoding" "an encoding descriptor" }
+ { "duplex" "an encoded duplex stream" } }
+{ $description "Wraps the given streams in an encoder or decoder stream, and puts them together in a duplex stream for input and output. If either input stream is already encoded, that encoding is stripped off before it is reencoded. The encoding descriptor must conform to the " { $link "encodings-protocol" } "." }
+$low-level-note ;
--- /dev/null
+USING: io.streams.duplex io kernel continuations tools.test ;
+IN: io.streams.duplex.tests
+
+! Test duplex stream close behavior
+TUPLE: closing-stream closed? ;
+
+: <closing-stream> closing-stream new ;
+
+M: closing-stream dispose
+ dup closing-stream-closed? [
+ "Closing twice!" throw
+ ] [
+ t swap set-closing-stream-closed?
+ ] if ;
+
+TUPLE: unclosable-stream ;
+
+: <unclosable-stream> unclosable-stream new ;
+
+M: unclosable-stream dispose
+ "Can't close me!" throw ;
+
+[ ] [
+ <closing-stream> <closing-stream> <duplex-stream>
+ dup dispose dispose
+] unit-test
+
+[ t ] [
+ <unclosable-stream> <closing-stream> [
+ <duplex-stream>
+ [ dup dispose ] [ 2drop ] recover
+ ] keep closing-stream-closed?
+] unit-test
+
+[ t ] [
+ <closing-stream> [ <unclosable-stream>
+ <duplex-stream>
+ [ dup dispose ] [ 2drop ] recover
+ ] keep closing-stream-closed?
+] unit-test
--- /dev/null
+! Copyright (C) 2005, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel continuations io io.encodings io.encodings.private
+io.timeouts debugger inspector listener accessors ;
+IN: io.streams.duplex
+
+! We ensure that the stream can only be closed once, to preserve
+! integrity of duplex I/O ports.
+
+TUPLE: duplex-stream in out closed ;
+
+: <duplex-stream> ( in out -- stream )
+ f duplex-stream boa ;
+
+ERROR: stream-closed-twice ;
+
+M: stream-closed-twice summary
+ drop "Attempt to perform I/O on closed stream" ;
+
+<PRIVATE
+
+: check-closed ( stream -- stream )
+ dup closed>> [ stream-closed-twice ] when ; inline
+
+: in ( duplex -- stream ) check-closed in>> ;
+
+: out ( duplex -- stream ) check-closed out>> ;
+
+PRIVATE>
+
+M: duplex-stream stream-flush
+ out stream-flush ;
+
+M: duplex-stream stream-readln
+ in stream-readln ;
+
+M: duplex-stream stream-read1
+ in stream-read1 ;
+
+M: duplex-stream stream-read-until
+ in stream-read-until ;
+
+M: duplex-stream stream-read-partial
+ in stream-read-partial ;
+
+M: duplex-stream stream-read
+ in stream-read ;
+
+M: duplex-stream stream-write1
+ out stream-write1 ;
+
+M: duplex-stream stream-write
+ out stream-write ;
+
+M: duplex-stream stream-nl
+ out stream-nl ;
+
+M: duplex-stream stream-format
+ out stream-format ;
+
+M: duplex-stream make-span-stream
+ out make-span-stream ;
+
+M: duplex-stream make-block-stream
+ out make-block-stream ;
+
+M: duplex-stream make-cell-stream
+ out make-cell-stream ;
+
+M: duplex-stream stream-write-table
+ out stream-write-table ;
+
+M: duplex-stream stream-read-quot
+ in stream-read-quot ;
+
+M: duplex-stream set-timeout
+ [ in set-timeout ] [ out set-timeout ] 2bi ;
+
+M: duplex-stream dispose
+ #! The output stream is closed first, in case both streams
+ #! are attached to the same file descriptor, the output
+ #! buffer needs to be flushed before we close the fd.
+ dup closed>> [
+ t >>closed
+ [ dup out>> dispose ]
+ [ dup in>> dispose ] [ ] cleanup
+ ] unless drop ;
+
+: <encoder-duplex> ( stream-in stream-out encoding -- duplex )
+ tuck reencode >r redecode r> <duplex-stream> ;
+
+: with-stream* ( stream quot -- )
+ >r [ in>> ] [ out>> ] bi r> with-streams* ; inline
+
+: with-stream ( stream quot -- )
+ >r [ in>> ] [ out>> ] bi r> with-streams ; inline
--- /dev/null
+Combine an input and an output stream into a single duplex stream
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: io.streams.null
-USING: kernel io io.timeouts continuations ;
+USING: kernel io io.timeouts io.streams.duplex continuations ;
TUPLE: null-stream ;
M: null-stream dispose drop ;
M: null-stream set-timeout 2drop ;
-M: null-stream stream-readln drop f ;
-M: null-stream stream-read1 drop f ;
-M: null-stream stream-read-until 2drop f f ;
-M: null-stream stream-read 2drop f ;
-M: null-stream stream-write1 2drop ;
-M: null-stream stream-write 2drop ;
-M: null-stream stream-nl drop ;
-M: null-stream stream-flush drop ;
-M: null-stream stream-format 3drop ;
-M: null-stream make-span-stream nip ;
-M: null-stream make-block-stream nip ;
-M: null-stream make-cell-stream nip ;
-M: null-stream stream-write-table 3drop ;
+
+TUPLE: null-reader < null-stream ;
+
+M: null-reader stream-readln drop f ;
+M: null-reader stream-read1 drop f ;
+M: null-reader stream-read-until 2drop f f ;
+M: null-reader stream-read 2drop f ;
+
+TUPLE: null-writer < null-stream ;
+
+M: null-writer stream-write1 2drop ;
+M: null-writer stream-write 2drop ;
+M: null-writer stream-nl drop ;
+M: null-writer stream-flush drop ;
+M: null-writer stream-format 3drop ;
+M: null-writer make-span-stream nip ;
+M: null-writer make-block-stream nip ;
+M: null-writer make-cell-stream nip ;
+M: null-writer stream-write-table 3drop ;
+
+: with-null-reader ( quot -- )
+ T{ null-reader } swap with-input-stream* ; inline
+
+: with-null-writer ( quot -- )
+ T{ null-writer } swap with-output-stream* ; inline
: with-null-stream ( quot -- )
- T{ null-stream } swap with-stream* ; inline
+ T{ duplex-stream f T{ null-reader } T{ null-writer } }
+ swap with-stream* ; inline
! Copyright (C) 2008 Slava Pestov, Doug Coleman\r
! See http://factorcode.org/license.txt for BSD license.\r
-USING: kernel calendar alarms io.streams.duplex io.encodings ;\r
+USING: kernel calendar alarms io io.encodings accessors\r
+namespaces ;\r
IN: io.timeouts\r
\r
! Won't need this with new slot accessors\r
GENERIC: timeout ( obj -- dt/f )\r
GENERIC: set-timeout ( dt/f obj -- )\r
\r
-M: duplex-stream set-timeout\r
- 2dup\r
- duplex-stream-in set-timeout\r
- duplex-stream-out set-timeout ;\r
+M: decoder set-timeout stream>> set-timeout ;\r
\r
-M: decoder set-timeout decoder-stream set-timeout ;\r
-\r
-M: encoder set-timeout encoder-stream set-timeout ;\r
+M: encoder set-timeout stream>> set-timeout ;\r
\r
GENERIC: timed-out ( obj -- )\r
\r
] [\r
2drop call\r
] if ; inline\r
+\r
+: timeouts ( dt -- )\r
+ [ input-stream get set-timeout ]\r
+ [ output-stream get set-timeout ] bi ;\r
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien generic assocs kernel kernel.private math
-io.nonblocking sequences strings structs sbufs
-threads unix vectors io.buffers io.backend io.encodings
-io.streams.duplex math.parser continuations system libc
-qualified namespaces io.timeouts io.encodings.utf8 accessors ;
+io.nonblocking sequences strings structs sbufs threads unix
+vectors io.buffers io.backend io.encodings math.parser
+continuations system libc qualified namespaces io.timeouts
+io.encodings.utf8 accessors ;
QUALIFIED: io
IN: io.unix.backend
"cat"
"launcher-test-1" temp-file
2array
- ascii <process-stream> contents
+ ascii <process-reader> contents
] unit-test
[ f ] [
"launcher-test-1" temp-file
2array >>command
+inherit+ >>stdout
- ascii <process-stream> contents
+ ascii <process-reader> contents
] unit-test
[ ] [
"cat"
"launcher-test-1" temp-file
2array
- ascii <process-stream> contents
+ ascii <process-reader> contents
] unit-test
[ ] [
"cat"
"launcher-test-1" temp-file
2array
- ascii <process-stream> contents
+ ascii <process-reader> contents
] unit-test
[ t ] [
<process>
"env" >>command
{ { "A" "B" } } >>environment
- ascii <process-stream> lines
+ ascii <process-reader> lines
"A=B" swap member?
] unit-test
"env" >>command
{ { "A" "B" } } >>environment
+replace-environment+ >>environment-mode
- ascii <process-stream> lines
+ ascii <process-reader> lines
] unit-test
[ "hi\n" ] [
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: io io.backend io.launcher io.nonblocking io.unix.backend
-io.unix.files io.nonblocking sequences kernel namespaces math
-system alien.c-types debugger continuations arrays assocs
-combinators unix.process strings threads unix
-io.unix.launcher.parser accessors io.files io.files.private ;
+USING: kernel namespaces math system sequences debugger
+continuations arrays assocs combinators alien.c-types strings
+threads accessors
+io io.backend io.launcher io.nonblocking io.files
+io.files.private io.unix.files io.unix.backend
+io.unix.launcher.parser
+unix unix.process ;
IN: io.unix.launcher
! Search unix first
: redirect-closed ( obj mode fd -- )
>r >r drop "/dev/null" r> r> redirect-file ;
-: redirect-stream ( obj mode fd -- )
- >r drop underlying-handle dup reset-fd r> redirect-fd ;
-
: redirect ( obj mode fd -- )
{
{ [ pick not ] [ redirect-inherit ] }
{ [ pick string? ] [ redirect-file ] }
{ [ pick +closed+ eq? ] [ redirect-closed ] }
{ [ pick +inherit+ eq? ] [ redirect-closed ] }
- [ redirect-stream ]
+ { [ pick integer? ] [ >r drop dup reset-fd r> redirect-fd ] }
+ [ >r >r underlying-handle r> r> redirect ]
} cond ;
: ?closed dup +closed+ eq? [ drop "/dev/null" ] when ;
M: unix kill-process* ( pid -- )
SIGTERM kill io-error ;
-: open-pipe ( -- pair )
- 2 "int" <c-array> dup pipe zero?
- [ 2 c-int-array> ] [ drop f ] if ;
-
-: setup-stdio-pipe ( stdin stdout -- )
- 2dup first close second close
- >r first 0 dup2 drop r> second 1 dup2 drop ;
-
-M: unix (process-stream)
- >r open-pipe open-pipe r>
- [ >r setup-stdio-pipe r> spawn-process ] curry
- [ -rot 2dup second close first close ]
- with-fork
- first swap second ;
-
: find-process ( handle -- process )
processes get swap [ nip swap handle>> = ] curry
assoc-find 2drop ;
-! Inefficient process wait polling, used on Linux and Solaris.
-! On BSD and Mac OS X, we use kqueue() which scales better.
M: unix wait-for-processes ( -- ? )
-1 0 <int> tuck WNOHANG waitpid
dup 0 <= [
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: system alien.c-types kernel unix math sequences
+qualified io.unix.backend ;
+IN: io.unix.pipes
+QUALIFIED: io.pipes
+
+M: unix io.pipes:(pipe) ( -- pair )
+ 2 "int" <c-array>
+ dup pipe io-error
+ 2 c-int-array> first2 io.pipes:pipe boa ;
[ { "Hello world" "FOO" } ] [
[
- socket-server <local> ascii <client>
- [
+ socket-server <local> ascii [
readln ,
"XYZ" print flush
readln ,
- ] with-stream
+ ] with-client
] { } make
] unit-test
! Invalid parameter tests
[
- image binary [ stdio get accept ] with-file-reader
+ image binary [ input-stream get accept ] with-file-reader
] must-fail
[
- image binary [ stdio get receive ] with-file-reader
+ image binary [ input-stream get receive ] with-file-reader
] must-fail
[
image binary [
B{ 1 2 } datagram-server <local>
- stdio get send
+ input-stream get send
] with-file-reader
] must-fail
-USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts
-io.unix.launcher io.unix.mmap io.backend combinators namespaces
-system vocabs.loader sequences words init ;
+USING: io.unix.backend io.unix.files io.unix.sockets
+io.unix.launcher io.unix.mmap io.unix.pipes io.timeouts
+io.backend combinators namespaces system vocabs.loader
+sequences words init ;
"io.unix." os word-name append require
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays continuations io
io.windows io.windows.nt.pipes libc io.nonblocking
-io.streams.duplex windows.types math windows.kernel32
+windows.types math windows.kernel32
namespaces io.launcher kernel sequences windows.errors
splitting system threads init strings combinators
io.backend accessors concurrency.flags io.files assocs
<process>\r
vm "-script" "stderr.factor" 3array >>command\r
"err2.txt" temp-file >>stderr\r
- ascii <process-stream> lines first\r
+ ascii <process-reader> lines first\r
] with-directory\r
] unit-test\r
\r
"extra/io/windows/nt/launcher/test" resource-path [\r
<process>\r
vm "-script" "env.factor" 3array >>command\r
- ascii <process-stream> contents\r
+ ascii <process-reader> contents\r
] with-directory eval\r
\r
os-envs =\r
vm "-script" "env.factor" 3array >>command\r
+replace-environment+ >>environment-mode\r
os-envs >>environment\r
- ascii <process-stream> contents\r
+ ascii <process-reader> contents\r
] with-directory eval\r
\r
os-envs =\r
<process>\r
vm "-script" "env.factor" 3array >>command\r
{ { "A" "B" } } >>environment\r
- ascii <process-stream> contents\r
+ ascii <process-reader> contents\r
] with-directory eval\r
\r
"A" swap at\r
vm "-script" "env.factor" 3array >>command\r
{ { "HOME" "XXX" } } >>environment\r
+prepend-environment+ >>environment-mode\r
- ascii <process-stream> contents\r
+ ascii <process-reader> contents\r
] with-directory eval\r
\r
"HOME" swap at "XXX" =\r
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays continuations destructors io
-io.windows libc io.nonblocking io.streams.duplex windows.types
+io.windows libc io.nonblocking windows.types
math windows.kernel32 windows namespaces io.launcher kernel
sequences windows.errors assocs splitting system strings
io.windows.launcher io.windows.nt.pipes io.backend io.files
USING: alien alien.c-types arrays destructors io io.windows libc
windows.types math windows.kernel32 windows namespaces kernel
sequences windows.errors assocs math.parser system random
-combinators accessors ;
+combinators accessors io.pipes ;
IN: io.windows.nt.pipes
! This code is based on
! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py
-: create-named-pipe ( name mode -- handle )
+: create-named-pipe ( name in-mode -- handle )
FILE_FLAG_OVERLAPPED bitor
PIPE_TYPE_BYTE
1
dup win32-error=0/f
dup add-completion ;
-: open-other-end ( name mode -- handle )
+: open-other-end ( name out-mode -- handle )
FILE_SHARE_READ FILE_SHARE_WRITE bitor
security-attributes-inherit
OPEN_EXISTING
dup win32-error=0/f
dup add-completion ;
-TUPLE: pipe in out ;
-
: <pipe> ( name in-mode out-mode -- pipe )
[
>r over >r create-named-pipe dup close-later
pipe boa
] with-destructors ;
-: close-pipe ( pipe -- )
- dup
- in>> CloseHandle drop
- out>> CloseHandle drop ;
-
: <incoming-pipe> ( name -- pipe )
PIPE_ACCESS_INBOUND GENERIC_WRITE <pipe> ;
: <outgoing-pipe> ( name -- pipe )
- PIPE_ACCESS_
DUPLEX GENERIC_READ <pipe> ;
+ PIPE_ACCESS_
OUTBOUND GENERIC_READ <pipe> ;
: unique-pipe-name ( -- string )
[
! /dev/null simulation
: null-input ( -- pipe )
<unique-outgoing-pipe>
- dup out>> CloseHandle drop
- in>> ;
+ [ in>> ] [ out>> CloseHandle drop ] bi ;
: null-output ( -- pipe )
<unique-incoming-pipe>
- dup in>> CloseHandle drop
- out>> ;
+ [ in>> CloseHandle drop ] [ out>> ] bi ;
: null-pipe ( mode -- pipe )
{
- { [ dup GENERIC_READ = ] [ drop null-input ] }
- { [ dup GENERIC_WRITE = ] [ drop null-output ] }
- } cond ;
+ { GENERIC_READ [ null-input ] }
+ { GENERIC_WRITE [ null-output ] }
+ } case ;
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays destructors io io.backend
io.buffers io.files io.nonblocking io.sockets io.binary
-io.sockets.impl windows.errors strings io.streams.duplex
+io.sockets.impl windows.errors strings
kernel math namespaces sequences windows windows.kernel32
windows.shell32 windows.types windows.winsock splitting
continuations math.bitfields system accessors ;
IN: io.windows
-M: windows destruct-handle CloseHandle drop ;
-
M: windows destruct-socket closesocket drop ;
TUPLE: win32-file handle ptr ;
drop ;
M: win32-file close-handle ( handle -- )
- win32-file-handle CloseHandle drop ;
+ win32-file-handle close-handle ;
+
+M: alien close-handle ( handle -- )
+ CloseHandle drop ;
! Clean up resources (open handle) if add-completion fails
: open-file ( path access-mode create-mode flags -- handle )
\r
: (log-message) ( msg -- )\r
#! msg: { msg word-name level service }\r
- first4 log-stream [ write-message flush ] with-stream* ;\r
+ first4 log-stream [ write-message flush ] with-output-stream* ;\r
\r
: try-dispose ( stream -- )\r
[ dispose ] curry [ error. ] recover ;\r
{ $description "Wrapper for " { $link glColor4d } " taking a color specifier." } ;
HELP: gl-error
-{ $description "If the most recent OpenGL call resulted in an error, print the error to the " { $link stdio } " stream." } ;
+{ $description "If the most recent OpenGL call resulted in an error, print the error to " { $link output-stream } "." } ;
HELP: do-state
{
[ 2 ] [
[ 2 "int" b, ] B{ } make
- <string-reader> [ "int" read-native ] with-stream
+ <string-reader> [ "int" read-native ] with-input-stream
] unit-test
[ "FRAM" ] [ "FRAM\0" [ read-c-string ] with-string-reader ] unit-test
MACRO: (unpack) ( str -- quot )
[
- \ <string-reader> ,
[
[ unpack-table at , \ , , ] each
] [ ] make
1quotation [ { } make ] append
1quotation %
- \ with-stream ,
+ \ with-string-input ,
] [ ] make ;
: unpack-native ( seq str -- seq )
: file-read-unbuffered ( n path -- bytes )
over default-buffer-size [
- binary <file-reader> [ read ] with-stream
+ binary [ read ] with-file-reader
] with-variable ;
M: unix-random random-bytes* ( n tuple -- byte-array )
{ "gcc" c-file "-o" exe } to-strings
[ "Error compiling generated C program" print ] run-or-bail
- exe ascii <process-stream> contents string>number ;
\ No newline at end of file
+ exe ascii <process-reader> contents string>number ;
\ No newline at end of file
"Starting SMTP server on port " write dup . flush
"127.0.0.1" swap <inet4> ascii <server> [
accept drop [
- 1 minutes stdio get set-timeout
+ default-timeout
"220 hello\r\n" write flush
process
global [ flush ] bind
: with-smtp-connection ( quot -- )
smtp-server get
dup log-smtp-connection
- ascii <client> [
+ ascii [
smtp-domain [ host-name or ] change
- read-timeout get stdio get set-timeout
+ read-timeout get timeouts
call
- ] with-stream ; inline
+ ] with-client ; inline
: crlf "\r\n" write ;
read1 set-next next ;\r
\r
: state-parse ( stream quot -- )\r
- ! with-stream implicitly creates a new scope which we use\r
- swap [ init-parser call ] with-stream ; inline\r
+ ! with-input-stream implicitly creates a new scope which we use\r
+ swap [ init-parser call ] with-input-stream ; inline\r
\r
: string-parse ( input quot -- )\r
>r <string-reader> r> state-parse ; inline\r
-USING: combinators io io.files io.streams.duplex
-io.streams.string kernel math math.parser continuations
-namespaces pack prettyprint sequences strings system
-hexdump io.encodings.binary inspector accessors ;
+USING: combinators io io.files io.streams.string kernel math
+math.parser continuations namespaces pack prettyprint sequences
+strings system hexdump io.encodings.binary inspector accessors ;
IN: tar
: zero-checksum 256 ;
] if* ;
: read-data-blocks ( tar-header out -- )
- >r stdio get r> <duplex-stream> [
- (read-data-blocks)
- ] with-stream* ;
+ [ (read-data-blocks) ] with-output-stream* ;
: parse-tar-header ( seq -- obj )
[ header-checksum ] keep over zero-checksum = [
assocs kernel vocabs words sequences memory io system arrays
continuations math definitions mirrors splitting parser classes
inspector layouts vocabs.loader prettyprint.config prettyprint
-debugger io.streams.c io.streams.duplex io.files io.backend
+debugger io.streams.c io.files io.backend
quotations io.launcher words.private tools.deploy.config
bootstrap.image io.encodings.utf8 accessors ;
IN: tools.deploy.backend
+stdout+ >>stderr
+closed+ >>stdin
+low-priority+ >>priority
- utf8 <process-stream*>
- >r copy-lines r> wait-for-process zero? [
- "Deployment failed" throw
- ] unless ;
+ utf8 <process-reader*>
+ copy-lines
+ wait-for-process zero? [ "Deployment failed" throw ] unless ;
: make-boot-image ( -- )
#! If stage1 image doesn't exist, create one.
io.thread:io-thread
libc.private:mallocs
source-files:source-files
- stderr
- stdio
+ input-stream
+ output-stream
+ error-stream
} %
deploy-threads? [
HELP: counters.
{ $values { "assoc" "an association list mapping words to integers" } }
-{ $description "Prints an association list of call counts to the " { $link stdio } " stream." } ;
+{ $description "Prints an association list of call counts to " { $link output-stream } "." } ;
HELP: profile
{ $values { "quot" quotation } }
HELP: test-failures.
{ $values { "assoc" "an association list of unit test failures" } }
-{ $description "Prints unit test failures output by " { $link run-tests } " or " { $link run-all-tests } " to the " { $link stdio } " stream." } ;
+{ $description "Prints unit test failures output by " { $link run-tests } " or " { $link run-all-tests } " to " { $link output-stream } "." } ;
io ;
IN: tools.test.ui
-! We can't print to stdio here because that might be a pane
+! We can't print to output-stream here because that might be a pane
! stream, and our graft-queue rebinding here would be captured
! by code adding children to the pane...
: with-grafted-gadget ( gadget quot -- )
dup mock-gadget-ungraft-called 1+
swap set-mock-gadget-ungraft-called ;
-! We can't print to stdio here because that might be a pane
+! We can't print to output-stream here because that might be a pane
! stream, and our graft-queue rebinding here would be captured
! by code adding children to the pane...
[
HELP: gadget.
{ $values { "gadget" gadget } }
-{ $description "Writes a gadget followed by a newline to the " { $link stdio } " stream." }
+{ $description "Writes a gadget followed by a newline to " { $link output-stream } "." }
{ $notes "Not all streams support this operation." } ;
HELP: ?nl
HELP: with-pane
{ $values { "pane" pane } { "quot" quotation } }
-{ $description "Clears the pane and calls the quotation in a new scope where " { $link stdio } " is rebound to a " { $link pane-stream } " writing to the pane." } ;
+{ $description "Clears the pane and calls the quotation in a new scope where " { $link output-stream } " is rebound to a " { $link pane-stream } " writing to the pane." } ;
HELP: make-pane
{ $values { "quot" quotation } { "gadget" "a new " { $link gadget } } }
-{ $description "Calls the quotation in a new scope where " { $link stdio } " is rebound to a " { $link pane-stream } " writing to a new pane. The output area of the new pane is output on the stack after the quotation returns. The pane itself is not output." } ;
+{ $description "Calls the quotation in a new scope where " { $link output-stream } " is rebound to a " { $link pane-stream } " writing to a new pane. The output area of the new pane is output on the stack after the quotation returns. The pane itself is not output." } ;
HELP: <scrolling-pane>
{ $values { "pane" "a new " { $link pane } } }
[ ] [ #children "num-children" set ] unit-test
[ ] [
- "pane" get <pane-stream> [ 10000 [ . ] each ] with-stream*
+ "pane" get <pane-stream> [ 10000 [ . ] each ] with-output-stream*
] unit-test
[ t ] [ #children "num-children" get = ] unit-test
ui.gadgets.theme ui.clipboards ui.gestures ui.traverse ui.render
hashtables io kernel namespaces sequences io.styles strings
quotations math opengl combinators math.vectors
-io.streams.duplex sorting splitting io.streams.nested assocs
+sorting splitting io.streams.nested assocs
ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids
ui.gadgets.grid-lines classes.tuple models continuations ;
IN: ui.gadgets.panes
M: pane-stream write-gadget
pane-stream-pane pane-current add-gadget ;
-M: duplex-stream write-gadget
- duplex-stream-out write-gadget ;
-
: print-gadget ( gadget stream -- )
tuck write-gadget stream-nl ;
: gadget. ( gadget -- )
- stdio get print-gadget ;
+ output-stream get print-gadget ;
: ?nl ( stream -- )
dup pane-stream-pane pane-current gadget-children empty?
: with-pane ( pane quot -- )
over scroll>top
over pane-clear >r <pane-stream> r>
- over >r with-stream* r> ?nl ; inline
+ over >r with-output-stream* r> ?nl ; inline
: make-pane ( quot -- gadget )
<pane> [ swap with-pane ] keep smash-pane ; inline
: interactor-input. ( string interactor -- )
interactor-output [
dup string? [ dup write-input nl ] [ short. ] if
- ] with-stream* ;
+ ] with-output-stream* ;
: add-interactor-history ( str interactor -- )
over empty? [ 2drop ] [ interactor-history push-new ] if ;
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: inspector ui.tools.interactor ui.tools.inspector
-ui.tools.workspace help.markup io io.streams.duplex io.styles
+ui.tools.workspace help.markup io io.styles
kernel models namespaces parser quotations sequences ui.commands
ui.gadgets ui.gadgets.editors ui.gadgets.labelled
ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
<scrolling-pane> g-> set-listener-gadget-output
<scroller> "Output" <labelled-gadget> 1 track, ;
-: listener-stream ( listener -- stream )
- dup listener-gadget-input
- swap listener-gadget-output <pane-stream>
- <duplex-stream> ;
+: listener-streams ( listener -- input output )
+ [ input>> ] [ output>> <pane-stream> ] bi ;
: <listener-input> ( listener -- gadget )
listener-gadget-output <pane-stream> <interactor> ;
swap show-tool inspect-object ;
: listener-thread ( listener -- )
- dup listener-stream [
- dup [ ui-listener-hook ] curry listener-hook set
- dup [ ui-error-hook ] curry error-hook set
- [ ui-inspector-hook ] curry inspector-hook set
- welcome.
- listener
- ] with-stream* ;
+ dup listener-streams [
+ [
+ [ [ ui-listener-hook ] curry listener-hook set ]
+ [ [ ui-error-hook ] curry error-hook set ]
+ [ [ ui-inspector-hook ] curry inspector-hook set ] tri
+ welcome.
+ listener
+ ] with-input-stream*
+ ] with-output-stream* ;
: start-listener-thread ( listener -- )
[ listener-thread ] curry "Listener" spawn drop ;
\r
HELP: write-xml\r
{ $values { "xml" "an XML document" } }\r
-{ $description "prints the contents of an XML document (" { $link xml } ") to stdio" }\r
+{ $description "prints the contents of an XML document (" { $link xml } ") to " { $link output-stream } "." }\r
{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ;\r
\r
HELP: print-xml\r
{ $values { "xml" "an XML document" } }\r
-{ $description "prints the contents of an XML document (" { $link xml } ") to stdio, followed by a newline" }\r
+{ $description "prints the contents of an XML document (" { $link xml } ") to " { $link output-stream } ", followed by a newline" }\r
{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ;\r
\r
HELP: pprint-xml\r
{ $values { "xml" "an XML document" } }\r
-{ $description "prints the contents of an XML document (" { $link xml } ") to stdio in a prettyprinted form." }\r
+{ $description "prints the contents of an XML document (" { $link xml } ") to " { $link output-stream } " in a prettyprinted form." }\r
{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ;\r
\r
HELP: pprint-xml-but\r
\r
HELP: <pull-xml>\r
{ $values { "pull-xml" "a pull-xml tuple" } }\r
-{ $description "creates an XML pull-based parser which reads from the " { $link stdio } " stream, executing all initial XML commands to set up the parser." }\r
+{ $description "creates an XML pull-based parser which reads from " { $link input-stream } ", executing all initial XML commands to set up the parser." }\r
{ $see-also pull-xml pull-elem pull-event } ;\r
\r
HELP: pull-elem\r
\r
HELP: write-item\r
{ $values { "object" "an XML element" } }\r
-{ $description "writes an XML element to the " { $link stdio } " stream." }\r
+{ $description "writes an XML element to " { $link output-stream } "." }\r
{ $see-also write-chunk write-xml } ;\r
\r
HELP: write-chunk\r
{ $values { "seq" "an XML document fragment" } }\r
-{ $description "writes an XML document fragment, ie a sequence of XML elements, to the " { $link stdio } " stream." }\r
+{ $description "writes an XML document fragment, ie a sequence of XML elements, to " { $link output-stream } "." }\r
{ $see-also write-item write-xml } ;\r
\r
HELP: deep-tag-named\r
TUPLE: pull-xml scope ;
: <pull-xml> ( -- pull-xml )
[
- stdio [ ] change ! bring stdio var in this scope
+ input-stream [ ] change ! bring var in this scope
init-parser reset-prolog init-ns-stack
text-now? on
] H{ } make-assoc
: htmlize-file ( path -- )
dup utf8 [
- stdio get
- over ".html" append utf8 [
- htmlize-stream
+ dup ".html" append utf8 [
+ input-stream get htmlize-stream
] with-file-writer
] with-file-reader ;
projects / factor.git / commitdiff