Fix conflict

db4
Slava Pestov 2009-01-13 17:54:27 -06:00
commit 21433c47ef
25 changed files with 302 additions and 279 deletions

View File

@ -1,11 +1,11 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: vocabs vocabs.loader kernel ; USING: vocabs vocabs.loader kernel io.thread threads
compiler.utilities namespaces ;
IN: bootstrap.threads IN: bootstrap.threads
USE: io.thread
USE: threads
"debugger" vocab [ "debugger" vocab [
"debugger.threads" require "debugger.threads" require
] when ] when
[ yield ] yield-hook set-global

View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: namespaces make math math.order math.parser sequences accessors USING: namespaces make math math.order math.parser sequences accessors
kernel kernel.private layouts assocs words summary arrays kernel kernel.private layouts assocs words summary arrays
combinators classes.algebra alien alien.c-types alien.structs combinators classes.algebra alien alien.c-types alien.structs
alien.strings alien.arrays sets threads libc continuations.private alien.strings alien.arrays sets libc continuations.private
fry cpu.architecture fry cpu.architecture
compiler.errors compiler.errors
compiler.alien compiler.alien
@ -11,7 +11,8 @@ compiler.cfg
compiler.cfg.instructions compiler.cfg.instructions
compiler.cfg.registers compiler.cfg.registers
compiler.cfg.builder compiler.cfg.builder
compiler.codegen.fixup ; compiler.codegen.fixup
compiler.utilities ;
IN: compiler.codegen IN: compiler.codegen
GENERIC: generate-insn ( insn -- ) GENERIC: generate-insn ( insn -- )
@ -463,7 +464,7 @@ TUPLE: callback-context ;
dup current-callback eq? [ dup current-callback eq? [
drop drop
] [ ] [
yield wait-to-return yield-hook get call wait-to-return
] if ; ] if ;
: do-callback ( quot token -- ) : do-callback ( quot token -- )

View File

@ -1,14 +1,14 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces arrays sequences io USING: accessors kernel namespaces arrays sequences io
words fry continuations vocabs assocs dlists definitions math words fry continuations vocabs assocs dlists definitions math
threads graphs generic combinators deques search-deques io graphs generic combinators deques search-deques io
stack-checker stack-checker.state stack-checker.inlining stack-checker stack-checker.state stack-checker.inlining
compiler.errors compiler.units compiler.tree.builder compiler.errors compiler.units compiler.tree.builder
compiler.tree.optimizer compiler.cfg.builder compiler.tree.optimizer compiler.cfg.builder
compiler.cfg.optimizer compiler.cfg.linearization compiler.cfg.optimizer compiler.cfg.linearization
compiler.cfg.two-operand compiler.cfg.linear-scan compiler.cfg.two-operand compiler.cfg.linear-scan
compiler.cfg.stack-frame compiler.codegen ; compiler.cfg.stack-frame compiler.codegen compiler.utilities ;
IN: compiler IN: compiler
SYMBOL: compile-queue SYMBOL: compile-queue
@ -107,7 +107,7 @@ t compile-dependencies? set-global
] with-return ; ] with-return ;
: compile-loop ( deque -- ) : compile-loop ( deque -- )
[ (compile) yield ] slurp-deque ; [ (compile) yield-hook get call ] slurp-deque ;
: decompile ( word -- ) : decompile ( word -- )
f 2array 1array t modify-code-heap ; f 2array 1array t modify-code-heap ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences sequences.private arrays vectors fry USING: kernel sequences sequences.private arrays vectors fry
math.order ; math.order namespaces assocs ;
IN: compiler.utilities IN: compiler.utilities
: flattener ( seq quot -- seq vector quot' ) : flattener ( seq quot -- seq vector quot' )
@ -21,3 +21,7 @@ IN: compiler.utilities
: map-flat ( seq quot -- seq' ) [ each ] flattening ; inline : map-flat ( seq quot -- seq' ) [ each ] flattening ; inline
: 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline : 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline
SYMBOL: yield-hook
yield-hook global [ [ ] or ] change-at

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Daniel Ehrenberg ! Copyright (C) 2007 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: delegate sequences.private sequences assocs USING: delegate sequences.private sequences assocs
io definitions kernel continuations ; io io.styles definitions kernel continuations ;
IN: delegate.protocols IN: delegate.protocols
PROTOCOL: sequence-protocol PROTOCOL: sequence-protocol

View File

@ -183,7 +183,7 @@ ARTICLE: "io" "Input and output"
{ $subsection "io.streams.byte-array" } { $subsection "io.streams.byte-array" }
{ $heading "Utilities" } { $heading "Utilities" }
{ $subsection "stream-binary" } { $subsection "stream-binary" }
{ $subsection "styles" } { $subsection "io.styles" }
{ $subsection "checksums" } { $subsection "checksums" }
{ $heading "Implementation" } { $heading "Implementation" }
{ $subsection "io.streams.c" } { $subsection "io.streams.c" }

View File

@ -3,7 +3,7 @@
! Copyright (C) 2004 Chris Double. ! Copyright (C) 2004 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io kernel namespaces prettyprint quotations USING: io io.styles kernel namespaces prettyprint quotations
sequences strings words xml.entities compiler.units effects sequences strings words xml.entities compiler.units effects
urls math math.parser combinators present fry ; urls math math.parser combinators present fry ;

View File

@ -1,7 +1,116 @@
USING: help.markup help.syntax io.streams.plain io strings USING: help.markup help.syntax io.streams.plain io strings
hashtables ; hashtables kernel quotations ;
IN: io.styles IN: io.styles
HELP: stream-format
{ $values { "str" string } { "style" "a hashtable" } { "stream" "an output stream" } }
{ $contract "Writes formatted text to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output."
$nl
"The " { $snippet "style" } " hashtable holds character style information. See " { $link "character-styles" } "." }
{ $notes "Most code only works on one stream at a time and should instead use " { $link format } "; see " { $link "stdio" } "." }
$io-error ;
HELP: make-block-stream
{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } }
{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "."
$nl
"Unlike " { $link make-span-stream } ", this creates a new paragraph block in the output."
$nl
"The " { $snippet "style" } " hashtable holds paragraph style information. See " { $link "paragraph-styles" } "." }
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-nesting } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-write-table
{ $values { "table-cells" "a sequence of sequences of table cells" } { "style" "a hashtable" } { "stream" "an output stream" } }
{ $contract "Prints a table of cells produced by " { $link with-cell } "."
$nl
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
{ $notes "Most code only works on one stream at a time and should instead use " { $link tabular-output } "; see " { $link "stdio" } "." }
$io-error ;
HELP: make-cell-stream
{ $values { "style" hashtable } { "stream" "an output stream" } { "stream'" object } }
{ $contract "Creates an output stream which writes to a table cell object." }
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-cell } "; see " { $link "stdio" } "." }
$io-error ;
HELP: make-span-stream
{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } }
{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "."
$nl
"Unlike " { $link make-block-stream } ", the stream output is inline, and not nested in a paragraph block." }
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-style } "; see " { $link "stdio" } "." }
$io-error ;
HELP: format
{ $values { "str" string } { "style" "a hashtable" } }
{ $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" 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 " { $link output-stream } "."
$nl
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
{ $examples
{ $code
"{ { 1 2 } { 3 4 } }"
"H{ { table-gap { 10 10 } } } ["
" [ [ [ [ . ] with-cell ] each ] with-row ] each"
"] tabular-output"
}
}
$io-error ;
HELP: with-row
{ $values { "quot" quotation } }
{ $description "Calls a quotation which emits a series of table cells using " { $link with-cell } ". This word can only be called inside the quotation given to " { $link tabular-output } "." }
$io-error ;
HELP: with-cell
{ $values { "quot" quotation } }
{ $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
{ $values { "str" string } }
{ $description "Outputs a table cell containing a single string. This word can only be called inside the quotation given to " { $link with-row } "." }
$io-error ;
HELP: with-style
{ $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 ;
ARTICLE: "formatted-stream-protocol" "Formatted stream protocol"
"The " { $vocab-link "io.styles" } " vocabulary defines a protocol for output streams that support rich text."
{ $subsection stream-format }
{ $subsection make-span-stream }
{ $subsection make-block-stream }
{ $subsection make-cell-stream }
{ $subsection stream-write-table } ;
ARTICLE: "formatted-stdout" "Formatted output on the default stream"
"The below words perform formatted output on " { $link output-stream } "."
$nl
"Formatted output:"
{ $subsection format }
{ $subsection with-style }
{ $subsection with-nesting }
"Tabular output:"
{ $subsection tabular-output }
{ $subsection with-row }
{ $subsection with-cell }
{ $subsection write-cell } ;
ARTICLE: "character-styles" "Character styles" ARTICLE: "character-styles" "Character styles"
"Character styles for " { $link stream-format } " and " { $link with-style } ":" "Character styles for " { $link stream-format } " and " { $link with-style } ":"
{ $subsection foreground } { $subsection foreground }
@ -33,7 +142,7 @@ ARTICLE: "presentations" "Presentations"
"The " { $link presented } " style can be used to emit clickable objects. A utility word for outputting this style:" "The " { $link presented } " style can be used to emit clickable objects. A utility word for outputting this style:"
{ $subsection write-object } ; { $subsection write-object } ;
ARTICLE: "styles" "Formatted output" ARTICLE: "styles" "Styled text"
"The " { $link stream-format } ", " { $link with-style } ", " { $link with-nesting } " and " { $link tabular-output } " words take a hashtable of style attributes. Output stream implementations are free to ignore style information." "The " { $link stream-format } ", " { $link with-style } ", " { $link with-nesting } " and " { $link tabular-output } " words take a hashtable of style attributes. Output stream implementations are free to ignore style information."
$nl $nl
"Style hashtables are keyed by symbols from the " { $vocab-link "io.styles" } " vocabulary." "Style hashtables are keyed by symbols from the " { $vocab-link "io.styles" } " vocabulary."
@ -42,7 +151,13 @@ $nl
{ $subsection "table-styles" } { $subsection "table-styles" }
{ $subsection "presentations" } ; { $subsection "presentations" } ;
ABOUT: "styles" ARTICLE: "io.styles" "Formatted output"
"The " { $vocab-link "io.styles" } " vocabulary defines a protocol for formatted output. This is used by the prettyprinter, help system, and various developer tools. Implementations include " { $vocab-link "ui.gadgets.panes" } ", " { $vocab-link "html.streams" } ", and " { $vocab-link "io.streams.plain" } "."
{ $subsection "formatted-stream-protocol" }
{ $subsection "formatted-stdout" }
{ $subsection "styles" } ;
ABOUT: "io.styles"
HELP: plain HELP: plain
{ $description "A value for the " { $link font-style } " character style denoting plain text." } ; { $description "A value for the " { $link font-style } " character style denoting plain text." } ;
@ -151,3 +266,12 @@ HELP: <input>
HELP: standard-table-style HELP: standard-table-style
{ $values { "style" hashtable } } { $values { "style" hashtable } }
{ $description "Outputs a table style where cells are separated by 5-pixel gaps and framed by a light gray border. This style can be passed to " { $link tabular-output } "." } ; { $description "Outputs a table style where cells are separated by 5-pixel gaps and framed by a light gray border. This style can be passed to " { $link tabular-output } "." } ;
ARTICLE: "io.streams.plain" "Plain writer streams"
"Plain writer streams wrap an underlying stream and provide a default implementation of "
{ $link stream-nl } ", "
{ $link stream-format } ", "
{ $link make-span-stream } ", "
{ $link make-block-stream } " and "
{ $link make-cell-stream } "."
{ $subsection plain-writer } ;

View File

@ -1,9 +1,139 @@
! Copyright (C) 2005, 2009 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: hashtables io colors summary make accessors splitting USING: hashtables io io.streams.plain io.streams.string
kernel ; colors summary make accessors splitting math.order
kernel namespaces assocs destructors strings sequences ;
IN: io.styles IN: io.styles
GENERIC: stream-format ( str style stream -- )
GENERIC: make-span-stream ( style stream -- stream' )
GENERIC: make-block-stream ( style stream -- stream' )
GENERIC: make-cell-stream ( style stream -- stream' )
GENERIC: stream-write-table ( table-cells style stream -- )
: format ( str style -- ) output-stream get stream-format ;
: tabular-output ( style quot -- )
swap [ { } make ] dip output-stream get stream-write-table ; inline
: with-row ( quot -- )
{ } make , ; inline
: with-cell ( quot -- )
H{ } output-stream get make-cell-stream
[ swap with-output-stream ] keep , ; inline
: write-cell ( str -- )
[ write ] with-cell ; inline
: with-style ( style quot -- )
swap dup assoc-empty? [
drop call
] [
output-stream get make-span-stream swap with-output-stream
] if ; inline
: with-nesting ( style quot -- )
[ output-stream get make-block-stream ] dip
with-output-stream ; inline
TUPLE: filter-writer stream ;
M: filter-writer stream-format
stream>> stream-format ;
M: filter-writer stream-write
stream>> stream-write ;
M: filter-writer stream-write1
stream>> stream-write1 ;
M: filter-writer make-span-stream
stream>> make-span-stream ;
M: filter-writer make-block-stream
stream>> make-block-stream ;
M: filter-writer make-cell-stream
stream>> make-cell-stream ;
M: filter-writer stream-flush
stream>> stream-flush ;
M: filter-writer stream-nl
stream>> stream-nl ;
M: filter-writer stream-write-table
stream>> stream-write-table ;
M: filter-writer dispose
stream>> dispose ;
TUPLE: ignore-close-stream < filter-writer ;
M: ignore-close-stream dispose drop ;
C: <ignore-close-stream> ignore-close-stream
TUPLE: style-stream < filter-writer style ;
: do-nested-style ( style style-stream -- style stream )
[ style>> swap assoc-union ] [ stream>> ] bi ; inline
C: <style-stream> style-stream
M: style-stream stream-format
do-nested-style stream-format ;
M: style-stream stream-write
[ style>> ] [ stream>> ] bi stream-format ;
M: style-stream stream-write1
[ 1string ] dip stream-write ;
M: style-stream make-span-stream
do-nested-style make-span-stream ;
M: style-stream make-block-stream
[ do-nested-style make-block-stream ] [ style>> ] bi
<style-stream> ;
M: style-stream make-cell-stream
[ do-nested-style make-cell-stream ] [ style>> ] bi
<style-stream> ;
M: style-stream stream-write-table
[ [ [ stream>> ] map ] map ] [ ] [ stream>> ] tri*
stream-write-table ;
M: plain-writer stream-format
nip stream-write ;
M: plain-writer make-span-stream
swap <style-stream> <ignore-close-stream> ;
M: plain-writer make-block-stream
nip <ignore-close-stream> ;
: format-column ( seq ? -- seq )
[
[ 0 [ length max ] reduce ] keep
swap [ CHAR: \s pad-right ] curry map
] unless ;
: map-last ( seq quot -- seq )
[ dup length <reversed> ] dip [ 0 = ] prepose 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-output-stream* ;
M: plain-writer make-cell-stream 2drop <string-writer> ;
! Font styles
SYMBOL: plain SYMBOL: plain
SYMBOL: bold SYMBOL: bold
SYMBOL: italic SYMBOL: italic

View File

@ -3,7 +3,7 @@
USING: arrays generic hashtables io kernel math assocs USING: arrays generic hashtables io kernel math assocs
namespaces make sequences strings io.styles vectors words namespaces make sequences strings io.styles vectors words
prettyprint.config splitting classes continuations prettyprint.config splitting classes continuations
io.streams.nested accessors sets ; accessors sets ;
IN: prettyprint.sections IN: prettyprint.sections
! State ! State

View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math namespaces make sequences words io USING: arrays kernel math namespaces make sequences words io
io.streams.string math.vectors ui.gadgets columns accessors io.styles math.vectors ui.gadgets columns accessors
math.geometry.rect locals fry ; math.geometry.rect locals fry ;
IN: ui.gadgets.grids IN: ui.gadgets.grids

View File

@ -6,7 +6,7 @@ ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme
ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
hashtables io kernel namespaces sequences io.styles strings hashtables io kernel namespaces sequences io.styles strings
quotations math opengl combinators math.vectors sorting quotations math opengl combinators math.vectors sorting
splitting io.streams.nested assocs ui.gadgets.presentations splitting assocs ui.gadgets.presentations
ui.gadgets.grids ui.gadgets.grid-lines ui.gadgets.grids ui.gadgets.grid-lines
classes.tuple models continuations destructors accessors classes.tuple models continuations destructors accessors
math.geometry.rect fry ; math.geometry.rect fry ;

View File

@ -2,6 +2,10 @@ USING: help.markup help.syntax io.streams.string quotations
strings math regexp regexp.backend ; strings math regexp regexp.backend ;
IN: validators IN: validators
HELP: v-checkbox
{ $values { "str" string } }
{ $description "Converts the string value of a checkbox component (either \"on\" or \"off\") to a boolean value." } ;
HELP: v-captcha HELP: v-captcha
{ $values { "str" string } } { $values { "str" string } }
{ $description "Throws a validation error if the string is non-empty. This is used to create bait fields for spam-bots to fill in." } ; { $description "Throws a validation error if the string is non-empty. This is used to create bait fields for spam-bots to fill in." } ;
@ -99,6 +103,7 @@ $nl
{ $subsection v-one-line } { $subsection v-one-line }
{ $subsection v-one-word } { $subsection v-one-word }
{ $subsection v-captcha } { $subsection v-captcha }
{ $subsection v-checkbox }
"More complex validators:" "More complex validators:"
{ $subsection v-email } { $subsection v-email }
{ $subsection v-url } { $subsection v-url }

View File

@ -10,6 +10,9 @@ namespaces assocs ;
[ "hello" ] [ "hello" v-one-word ] unit-test [ "hello" ] [ "hello" v-one-word ] unit-test
[ "hello world" v-one-word ] must-fail [ "hello world" v-one-word ] must-fail
[ t ] [ "on" v-checkbox ] unit-test
[ f ] [ "off" v-checkbox ] unit-test
[ "foo" v-number ] must-fail [ "foo" v-number ] must-fail
[ 123 ] [ "123" v-number ] unit-test [ 123 ] [ "123" v-number ] unit-test
[ 123 ] [ "123" v-integer ] unit-test [ 123 ] [ "123" v-integer ] unit-test

View File

@ -5,6 +5,9 @@ math.parser math.ranges assocs regexp unicode.categories arrays
hashtables words classes quotations xmode.catalog ; hashtables words classes quotations xmode.catalog ;
IN: validators IN: validators
: v-checkbox ( str -- ? )
"on" = ;
: v-default ( str def -- str/def ) : v-default ( str def -- str/def )
over empty? spin ? ; over empty? spin ? ;

View File

@ -57,45 +57,6 @@ HELP: stream-nl
{ $notes "Most code only works on one stream at a time and should instead use " { $link nl } "; see " { $link "stdio" } "." } { $notes "Most code only works on one stream at a time and should instead use " { $link nl } "; see " { $link "stdio" } "." }
$io-error ; $io-error ;
HELP: stream-format
{ $values { "str" string } { "style" "a hashtable" } { "stream" "an output stream" } }
{ $contract "Writes formatted text to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output."
$nl
"The " { $snippet "style" } " hashtable holds character style information. See " { $link "character-styles" } "." }
{ $notes "Most code only works on one stream at a time and should instead use " { $link format } "; see " { $link "stdio" } "." }
$io-error ;
HELP: make-block-stream
{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } }
{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "."
$nl
"Unlike " { $link make-span-stream } ", this creates a new paragraph block in the output."
$nl
"The " { $snippet "style" } " hashtable holds paragraph style information. See " { $link "paragraph-styles" } "." }
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-nesting } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-write-table
{ $values { "table-cells" "a sequence of sequences of table cells" } { "style" "a hashtable" } { "stream" "an output stream" } }
{ $contract "Prints a table of cells produced by " { $link with-cell } "."
$nl
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
{ $notes "Most code only works on one stream at a time and should instead use " { $link tabular-output } "; see " { $link "stdio" } "." }
$io-error ;
HELP: make-cell-stream
{ $values { "style" hashtable } { "stream" "an output stream" } { "stream'" object } }
{ $contract "Creates an output stream which writes to a table cell object." }
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-cell } "; see " { $link "stdio" } "." }
$io-error ;
HELP: make-span-stream
{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } }
{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "."
$nl
"Unlike " { $link make-block-stream } ", the stream output is inline, and not nested in a paragraph block." }
{ $notes "Most code only works on one stream at a time and should instead use " { $link with-style } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-print HELP: stream-print
{ $values { "str" string } { "stream" "an output stream" } } { $values { "str" string } { "stream" "an output stream" } }
@ -161,54 +122,6 @@ HELP: nl
{ $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." } { $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 ; $io-error ;
HELP: format
{ $values { "str" string } { "style" "a hashtable" } }
{ $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" 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 " { $link output-stream } "."
$nl
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
{ $examples
{ $code
"{ { 1 2 } { 3 4 } }"
"H{ { table-gap { 10 10 } } } ["
" [ [ [ [ . ] with-cell ] each ] with-row ] each"
"] tabular-output"
}
}
$io-error ;
HELP: with-row
{ $values { "quot" quotation } }
{ $description "Calls a quotation which emits a series of table cells using " { $link with-cell } ". This word can only be called inside the quotation given to " { $link tabular-output } "." }
$io-error ;
HELP: with-cell
{ $values { "quot" quotation } }
{ $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
{ $values { "str" string } }
{ $description "Outputs a table cell containing a single string. This word can only be called inside the quotation given to " { $link with-row } "." }
$io-error ;
HELP: with-style
{ $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 HELP: print
{ $values { "string" string } } { $values { "string" string } }
{ $description "Writes a newline-terminated string to " { $link output-stream } "." } { $description "Writes a newline-terminated string to " { $link output-stream } "." }
@ -279,12 +192,7 @@ $nl
{ $subsection stream-flush } { $subsection stream-flush }
{ $subsection stream-write1 } { $subsection stream-write1 }
{ $subsection stream-write } { $subsection stream-write }
{ $subsection stream-format }
{ $subsection stream-nl } { $subsection stream-nl }
{ $subsection make-span-stream }
{ $subsection make-block-stream }
{ $subsection make-cell-stream }
{ $subsection stream-write-table }
{ $see-also "io.timeouts" } ; { $see-also "io.timeouts" } ;
ARTICLE: "stdio" "Default input and output streams" ARTICLE: "stdio" "Default input and output streams"
@ -347,15 +255,6 @@ $nl
{ $subsection print } { $subsection print }
{ $subsection nl } { $subsection nl }
{ $subsection bl } { $subsection bl }
"Formatted output:"
{ $subsection format }
{ $subsection with-style }
{ $subsection with-nesting }
"Tabular output:"
{ $subsection tabular-output }
{ $subsection with-row }
{ $subsection with-cell }
{ $subsection write-cell }
"A pair of combinators for rebinding the " { $link output-stream } " variable:" "A pair of combinators for rebinding the " { $link output-stream } " variable:"
{ $subsection with-output-stream } { $subsection with-output-stream }
{ $subsection with-output-stream* } { $subsection with-output-stream* }

View File

@ -1,4 +1,4 @@
! Copyright (C) 2003, 2007 Slava Pestov. ! Copyright (C) 2003, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: hashtables generic kernel math namespaces make sequences USING: hashtables generic kernel math namespaces make sequences
continuations destructors assocs ; continuations destructors assocs ;
@ -13,11 +13,6 @@ GENERIC: stream-write1 ( ch stream -- )
GENERIC: stream-write ( str stream -- ) GENERIC: stream-write ( str stream -- )
GENERIC: stream-flush ( stream -- ) GENERIC: stream-flush ( stream -- )
GENERIC: stream-nl ( stream -- ) GENERIC: stream-nl ( stream -- )
GENERIC: stream-format ( str style stream -- )
GENERIC: make-span-stream ( style stream -- stream' )
GENERIC: make-block-stream ( style stream -- stream' )
GENERIC: make-cell-stream ( style stream -- stream' )
GENERIC: stream-write-table ( table-cells style stream -- )
: stream-print ( str stream -- ) : stream-print ( str stream -- )
[ stream-write ] keep stream-nl ; [ stream-write ] keep stream-nl ;
@ -46,7 +41,6 @@ SYMBOL: error-stream
: flush ( -- ) output-stream get stream-flush ; : flush ( -- ) output-stream get stream-flush ;
: nl ( -- ) output-stream get stream-nl ; : nl ( -- ) output-stream get stream-nl ;
: format ( str style -- ) output-stream get stream-format ;
: with-input-stream* ( stream quot -- ) : with-input-stream* ( stream quot -- )
input-stream swap with-variable ; inline input-stream swap with-variable ; inline
@ -68,30 +62,6 @@ SYMBOL: error-stream
[ [ drop dispose dispose ] 3curry ] 3bi [ [ drop dispose dispose ] 3curry ] 3bi
[ ] cleanup ; inline [ ] cleanup ; inline
: tabular-output ( style quot -- )
swap [ { } make ] dip output-stream get stream-write-table ; inline
: with-row ( quot -- )
{ } make , ; inline
: with-cell ( quot -- )
H{ } output-stream get make-cell-stream
[ swap with-output-stream ] keep , ; inline
: write-cell ( str -- )
[ write ] with-cell ; inline
: with-style ( style quot -- )
swap dup assoc-empty? [
drop call
] [
output-stream get make-span-stream swap with-output-stream
] if ; inline
: with-nesting ( style quot -- )
[ output-stream get make-block-stream ] dip
with-output-stream ; inline
: print ( string -- ) output-stream get stream-print ; : print ( string -- ) output-stream get stream-print ;
: bl ( -- ) " " write ; : bl ( -- ) " " write ;

View File

@ -1 +0,0 @@
Slava Pestov

View File

@ -1,2 +0,0 @@
USING: io io.streams.nested help.markup help.syntax ;

View File

@ -1,74 +0,0 @@
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic assocs kernel namespaces strings
quotations io continuations destructors accessors sequences ;
IN: io.streams.nested
TUPLE: filter-writer stream ;
M: filter-writer stream-format
stream>> stream-format ;
M: filter-writer stream-write
stream>> stream-write ;
M: filter-writer stream-write1
stream>> stream-write1 ;
M: filter-writer make-span-stream
stream>> make-span-stream ;
M: filter-writer make-block-stream
stream>> make-block-stream ;
M: filter-writer make-cell-stream
stream>> make-cell-stream ;
M: filter-writer stream-flush
stream>> stream-flush ;
M: filter-writer stream-nl
stream>> stream-nl ;
M: filter-writer stream-write-table
stream>> stream-write-table ;
M: filter-writer dispose
stream>> dispose ;
TUPLE: ignore-close-stream < filter-writer ;
M: ignore-close-stream dispose drop ;
C: <ignore-close-stream> ignore-close-stream
TUPLE: style-stream < filter-writer style ;
: do-nested-style ( style style-stream -- style stream )
[ style>> swap assoc-union ] [ stream>> ] bi ; inline
C: <style-stream> style-stream
M: style-stream stream-format
do-nested-style stream-format ;
M: style-stream stream-write
[ style>> ] [ stream>> ] bi stream-format ;
M: style-stream stream-write1
[ 1string ] dip stream-write ;
M: style-stream make-span-stream
do-nested-style make-span-stream ;
M: style-stream make-block-stream
[ do-nested-style make-block-stream ] [ style>> ] bi
<style-stream> ;
M: style-stream make-cell-stream
[ do-nested-style make-cell-stream ] [ style>> ] bi
<style-stream> ;
M: style-stream stream-write-table
[ [ [ stream>> ] map ] map ] [ ] [ stream>> ] tri*
stream-write-table ;

View File

@ -1 +0,0 @@
Support for with-stream-style implementation

View File

@ -1,15 +1,6 @@
USING: help.markup help.syntax io ; USING: help.markup help.syntax io ;
IN: io.streams.plain IN: io.streams.plain
ARTICLE: "io.streams.plain" "Plain writer streams"
"Plain writer streams wrap an underlying stream and provide a default implementation of "
{ $link stream-nl } ", "
{ $link stream-format } ", "
{ $link make-span-stream } ", "
{ $link make-block-stream } " and "
{ $link make-cell-stream } "."
{ $subsection plain-writer } ;
ABOUT: "io.streams.plain" ABOUT: "io.streams.plain"
HELP: plain-writer HELP: plain-writer

View File

@ -1,18 +1,9 @@
! Copyright (C) 2005, 2007 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel io io.streams.nested ; USING: kernel io ;
IN: io.streams.plain IN: io.streams.plain
MIXIN: plain-writer MIXIN: plain-writer
M: plain-writer stream-nl M: plain-writer stream-nl
CHAR: \n swap stream-write1 ; CHAR: \n swap stream-write1 ;
M: plain-writer stream-format
nip stream-write ;
M: plain-writer make-span-stream
swap <style-stream> <ignore-close-stream> ;
M: plain-writer make-block-stream
nip <ignore-close-stream> ;

View File

@ -1,4 +1,4 @@
! Copyright (C) 2003, 2008 Slava Pestov. ! Copyright (C) 2003, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors io kernel math namespaces sequences sbufs USING: accessors io kernel math namespaces sequences sbufs
strings generic splitting continuations destructors strings generic splitting continuations destructors
@ -17,21 +17,8 @@ SINGLETON: null-encoding
M: null-encoding decode-char drop stream-read1 ; M: null-encoding decode-char drop stream-read1 ;
: format-column ( seq ? -- seq )
[
[ 0 [ length max ] reduce ] keep
swap [ CHAR: \s pad-right ] curry map
] unless ;
: map-last ( seq quot -- seq )
[ dup length <reversed> ] dip [ 0 = ] prepose 2map ; inline
PRIVATE> PRIVATE>
: format-table ( table -- seq )
flip [ format-column ] map-last
flip [ " " join ] map ;
M: growable dispose drop ; M: growable dispose drop ;
M: growable stream-write1 push ; M: growable stream-write1 push ;
@ -78,8 +65,3 @@ M: growable stream-read-partial
[ <string-reader> ] dip with-input-stream ; inline [ <string-reader> ] dip with-input-stream ; inline
INSTANCE: growable plain-writer INSTANCE: growable plain-writer
M: plain-writer stream-write-table
[ drop format-table [ print ] each ] with-output-stream* ;
M: plain-writer make-cell-stream 2drop <string-writer> ;

View File

@ -57,8 +57,6 @@ PRIVATE>
SYMBOL: load-help? SYMBOL: load-help?
ERROR: circular-dependency name ;
<PRIVATE <PRIVATE
: load-source ( vocab -- ) : load-source ( vocab -- )