Merge branch 'master' of git://factorcode.org/git/factor

basis/bootstrap/threads/threads.factor

@@ -1,11 +1,11 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! 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
 
-USE: io.thread
-USE: threads
-
 "debugger" vocab [
     "debugger.threads" require
 ] when
+
+[ yield ] yield-hook set-global

basis/compiler/codegen/codegen.factor

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

basis/compiler/compiler.factor

@@ -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.
 USING: accessors kernel namespaces arrays sequences io
 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
 compiler.errors compiler.units compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.builder
 compiler.cfg.optimizer compiler.cfg.linearization
 compiler.cfg.two-operand compiler.cfg.linear-scan
-compiler.cfg.stack-frame compiler.codegen ;
+compiler.cfg.stack-frame compiler.codegen compiler.utilities ;
 IN: compiler
 
 SYMBOL: compile-queue
@@ -107,7 +107,7 @@ t compile-dependencies? set-global
     ] with-return ;
 
 : compile-loop ( deque -- )
-    [ (compile) yield ] slurp-deque ;
+    [ (compile) yield-hook get call ] slurp-deque ;
 
 : decompile ( word -- )
     f 2array 1array t modify-code-heap ;

basis/compiler/utilities/utilities.factor

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

basis/delegate/protocols/protocols.factor

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

basis/help/handbook/handbook.factor

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

basis/html/elements/elements.factor

@@ -3,7 +3,7 @@
 ! Copyright (C) 2004 Chris Double.
 ! 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
 urls math math.parser combinators present fry ;
 

basis/io/directories/directories-docs.factor

@@ -50,6 +50,10 @@ HELP: with-directory-files
 { $values { "path" "a pathname string" } { "quot" quotation } }
 { $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ".  Restores the current directory after the quotation is called." } ;
 
+HELP: with-directory-entries
+{ $values { "path" "a pathname string" } { "quot" quotation } }
+{ $description "Calls the quotation with the directory entries on the stack and with the directory set as the " { $link current-directory } ".  Restores the current directory after the quotation is called." } ;
+
 HELP: delete-file
 { $values { "path" "a pathname string" } }
 { $description "Deletes a file." }
@@ -122,6 +126,7 @@ ARTICLE: "io.directories.listing" "Directory listing"
 "Directory listing:"
 { $subsection directory-entries }
 { $subsection directory-files }
+{ $subsection with-directory-entries }
 { $subsection with-directory-files } ;
 
 ARTICLE: "io.directories.create" "Creating directories"

basis/io/directories/directories.factor

@@ -41,6 +41,9 @@ HOOK: (directory-entries) os ( path -- seq )
 : directory-files ( path -- seq )
     directory-entries [ name>> ] map ;
 
+: with-directory-entries ( path quot -- )
+    '[ "" directory-entries @ ] with-directory ; inline
+
 : with-directory-files ( path quot -- )
     '[ "" directory-files @ ] with-directory ; inline
 

basis/io/directories/search/search.factor

@@ -14,7 +14,7 @@ TUPLE: directory-iterator path bfs queue ;
 
 : push-directory ( path iter -- )
     [ qualified-directory ] dip [
-        dup queue>> swap bfs>>
+        [ queue>> ] [ bfs>> ] bi
         [ push-front ] [ push-back ] if
     ] curry each ;
 

basis/io/files/info/unix/unix.factor

@@ -114,30 +114,6 @@ M: file-info file-mode? [ permissions>> ] dip mask? ;
 
 PRIVATE>
 
-: ch>file-type ( ch -- type )
-    {
-        { CHAR: b [ +block-device+ ] }
-        { CHAR: c [ +character-device+ ] }
-        { CHAR: d [ +directory+ ] }
-        { CHAR: l [ +symbolic-link+ ] }
-        { CHAR: s [ +socket+ ] }
-        { CHAR: p [ +fifo+ ] }
-        { CHAR: - [ +regular-file+ ] }
-        [ drop +unknown+ ]
-    } case ;
-
-: file-type>ch ( type -- string )
-    {
-        { +block-device+ [ CHAR: b ] }
-        { +character-device+ [ CHAR: c ] }
-        { +directory+ [ CHAR: d ] }
-        { +symbolic-link+ [ CHAR: l ] }
-        { +socket+ [ CHAR: s ] }
-        { +fifo+ [ CHAR: p ] }
-        { +regular-file+ [ CHAR: - ] }
-        [ drop CHAR: - ]
-    } case ;
-
 : UID           OCT: 0004000 ; inline
 : GID           OCT: 0002000 ; inline
 : STICKY        OCT: 0001000 ; inline
@@ -251,3 +227,47 @@ M: string set-file-group ( path string -- )
 
 : file-group-name ( path -- string )
     file-group-id group-name ;
+
+: ch>file-type ( ch -- type )
+    {
+        { CHAR: b [ +block-device+ ] }
+        { CHAR: c [ +character-device+ ] }
+        { CHAR: d [ +directory+ ] }
+        { CHAR: l [ +symbolic-link+ ] }
+        { CHAR: s [ +socket+ ] }
+        { CHAR: p [ +fifo+ ] }
+        { CHAR: - [ +regular-file+ ] }
+        [ drop +unknown+ ]
+    } case ;
+
+: file-type>ch ( type -- ch )
+    {
+        { +block-device+ [ CHAR: b ] }
+        { +character-device+ [ CHAR: c ] }
+        { +directory+ [ CHAR: d ] }
+        { +symbolic-link+ [ CHAR: l ] }
+        { +socket+ [ CHAR: s ] }
+        { +fifo+ [ CHAR: p ] }
+        { +regular-file+ [ CHAR: - ] }
+        [ drop CHAR: - ]
+    } case ;
+
+<PRIVATE
+
+: file-type>executable ( directory-entry -- string )
+    name>> any-execute? "*" "" ? ;
+
+PRIVATE>
+
+: file-type>trailing ( directory-entry -- string )
+    dup type>>
+    {
+        { +directory+ [ drop "/" ] }
+        { +symbolic-link+ [ drop "@" ] }
+        { +fifo+ [ drop "|" ] }
+        { +socket+ [ drop "=" ] }
+        { +whiteout+ [ drop "%" ] }
+        { +unknown+ [ file-type>executable ] }
+        { +regular-file+ [ file-type>executable ] }
+        [ drop file-type>executable ]
+    } case ;

basis/io/styles/styles-docs.factor

@@ -1,7 +1,116 @@
 USING: help.markup help.syntax io.streams.plain io strings
-hashtables ;
+hashtables kernel quotations ;
 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"
 "Character styles for " { $link stream-format } " and " { $link with-style } ":"
 { $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:"
 { $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."
 $nl
 "Style hashtables are keyed by symbols from the " { $vocab-link "io.styles" } " vocabulary."
@@ -42,7 +151,13 @@ $nl
 { $subsection "table-styles" }
 { $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
 { $description "A value for the " { $link font-style } " character style denoting plain text." } ;
@@ -157,3 +272,12 @@ HELP: <input>
 HELP: standard-table-style
 { $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 } "." } ;
+
+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 } ;

basis/io/styles/styles.factor

@@ -1,9 +1,139 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! 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
 
+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: bold
 SYMBOL: italic

basis/prettyprint/sections/sections.factor

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

basis/sorting/slots/slots-docs.factor

@@ -6,17 +6,17 @@ IN: sorting.slots
 
 HELP: compare-slots
 { $values
-     { "sort-specs" "a sequence of accessor/comparator pairs" }
+     { "sort-specs" "a sequence of accessors ending with a comparator" }
      { "<=>" { $link +lt+ } " " { $link +eq+ } " or " { $link +gt+ } }
 }
 { $description "Compares two objects using a chain of intrinsic linear orders such that if two objects are " { $link +eq+ } ", then the next comparator is tried. The comparators are slot-name/comparator pairs." } ;
 
 HELP: sort-by-slots
 { $values
-     { "seq" sequence } { "sort-specs" "a sequence of accessor/comparator pairs" }
+     { "seq" sequence } { "sort-specs" "a sequence of accessors ending with a comparator" }
      { "seq'" sequence }
 }
-{ $description "Sorts a sequence of tuples by the sort-specs in " { $snippet "sort-spec" } ". A sort-spec is a slot accessor and a comparator." }
+{ $description "Sorts a sequence of tuples by the sort-specs in " { $snippet "sort-spec" } ". A sort-spec is a sequence of slot accessors ending in a comparator." }
 { $examples
     "Sort by slot c, then b descending:"
     { $example
@@ -32,6 +32,13 @@ HELP: sort-by-slots
     }
 } ;
 
+HELP: split-by-slots
+{ $values
+     { "accessor-seqs" "a sequence of sequences of tuple accessors" }
+     { "quot" quotation }
+}
+{ $description "Splits a sequence of tuples into a sequence of slices of tuples that have the same values in all slots in the accessor sequence. This word is only useful for splitting a sorted sequence, but is more efficient than partitioning in such a case." } ;
+
 ARTICLE: "sorting.slots" "Sorting by slots"
 "The " { $vocab-link "sorting.slots" } " vocabulary can sort tuples by slot in ascending or descending order, using subsequent slots as tie-breakers." $nl
 "Comparing two objects by a sequence of slots:"

basis/sorting/slots/slots-tests.factor

@@ -1,10 +1,12 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors math.order sorting.slots tools.test
-sorting.human ;
+sorting.human arrays sequences kernel assocs multiline ;
 IN: sorting.literals.tests
 
-TUPLE: sort-test a b c ;
+TUPLE: sort-test a b c tuple2 ;
+
+TUPLE: tuple2 d ;
 
 [
     {
@@ -43,8 +45,101 @@ TUPLE: sort-test a b c ;
 ] unit-test
 
 [
-    { }
+    {
+        {
+            T{ sort-test { a 1 } { b 1 } { c 10 } }
+            T{ sort-test { a 1 } { b 1 } { c 11 } }
+        }
+        { T{ sort-test { a 1 } { b 3 } { c 9 } } }
+        {
+            T{ sort-test { a 2 } { b 5 } { c 3 } }
+            T{ sort-test { a 2 } { b 5 } { c 2 } }
+        }
+    }
 ] [
-    { }
+    {
-    { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots
+        T{ sort-test f 1 3 9 }
+        T{ sort-test f 1 1 10 }
+        T{ sort-test f 1 1 11 }
+        T{ sort-test f 2 5 3 }
+        T{ sort-test f 2 5 2 }
+    }
+    { { a>> human-<=> } { b>> <=> } } [ sort-by-slots ] keep
+    [ but-last-slice ] map split-by-slots [ >array ] map
+] unit-test
+
+: split-test ( seq -- seq' )
+    { { a>> } { b>> } } split-by-slots ;
+
+[ split-test ] must-infer
+
+[ { } ]
+[ { } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots ] unit-test
+
+[
+    {
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 2 } } } }
+        T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 4 } } } }
+    }
+] [
+    {
+        T{ sort-test f 6 f f T{ tuple2 f 1 } }
+        T{ sort-test f 5 f f T{ tuple2 f 4 } }
+        T{ sort-test f 6 f f T{ tuple2 f 3 } }
+        T{ sort-test f 6 f f T{ tuple2 f 3 } }
+        T{ sort-test f 5 f f T{ tuple2 f 3 } }
+        T{ sort-test f 6 f f T{ tuple2 f 2 } }
+    } { { tuple2>> d>> <=> } { a>> <=> } } sort-by-slots
+] unit-test
+
+[
+    {
+        {
+            T{ sort-test
+                { a 6 }
+                { tuple2 T{ tuple2 { d 1 } } }
+            }
+        }
+        {
+            T{ sort-test
+                { a 6 }
+                { tuple2 T{ tuple2 { d 2 } } }
+            }
+        }
+        {
+            T{ sort-test
+                { a 5 }
+                { tuple2 T{ tuple2 { d 3 } } }
+            }
+        }
+        {
+            T{ sort-test
+                { a 6 }
+                { tuple2 T{ tuple2 { d 3 } } }
+            }
+            T{ sort-test
+                { a 6 }
+                { tuple2 T{ tuple2 { d 3 } } }
+            }
+        }
+        {
+            T{ sort-test
+                { a 5 }
+                { tuple2 T{ tuple2 { d 4 } } }
+            }
+        }
+    }
+] [
+    {
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 2 } } } }
+        T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 4 } } } }
+    } { { tuple2>> d>> } { a>> } } split-by-slots [ >array ] map
 ] unit-test

basis/sorting/slots/slots.factor

@@ -1,19 +1,30 @@
 ! Copyright (C) 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators.short-circuit fry kernel macros math.order
-sequences words sorting ;
+sequences words sorting sequences.deep assocs splitting.monotonic
+math ;
 IN: sorting.slots
 
 <PRIVATE
 
-: slot-comparator ( accessor comparator -- quot )
+: slot-comparator ( seq -- quot )
-    '[ [ _ execute ] bi@ _ execute dup +eq+ eq? [ drop f ] when ] ;
+    [
+        but-last-slice
+        [ '[ [ _ execute ] bi@ ] ] map concat
+    ] [
+        peek
+        '[ @ _ execute dup +eq+ eq? [ drop f ] when ]
+    ] bi ;
 
 PRIVATE>
 
 MACRO: compare-slots ( sort-specs -- <=> )
-    #! sort-spec: { accessor comparator }
+    #! sort-spec: { accessors comparator }
-    [ first2 slot-comparator ] map '[ _ 2|| +eq+ or ] ;
+    [ slot-comparator ] map '[ _ 2|| +eq+ or ] ;
 
 : sort-by-slots ( seq sort-specs -- seq' )
     '[ _ compare-slots ] sort ;
+
+MACRO: split-by-slots ( accessor-seqs -- quot )
+    [ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map
+    '[ [ _ 2&& ] slice monotonic-slice ] ;

basis/tools/files/files-tests.factor

@@ -1,10 +1,8 @@
-! Copyright (C) 2008 Your name.
+! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test tools.files strings kernel ;
 IN: tools.files.tests
 
-\ directory. must-infer
-
 [ ] [ "" directory. ] unit-test
 
 [ ] [ file-systems. ] unit-test

basis/tools/files/files.factor

@@ -1,24 +1,29 @@
-! Copyright (C) 2008 Doug Coleman.
+! Copyright (C) 2008, 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators io io.files io.files.info
+USING: accessors arrays calendar combinators fry io io.directories
-io.directories kernel math.parser sequences system vocabs.loader
+io.files.info kernel math math.parser prettyprint sequences system
-calendar math fry prettyprint ;
+vocabs.loader sorting.slots calendar.format ;
 IN: tools.files
 
-SYMBOLS: permissions file-name nlinks file-size date ;
-
 <PRIVATE
 
-: ls-time ( timestamp -- string )
+: dir-or-size ( file-info -- str )
+    dup directory? [
+        drop "<DIR>" 20 CHAR: \s pad-right
+    ] [
+        size>> number>string 20 CHAR: \s pad-left
+    ] if ;
+
+: listing-time ( timestamp -- string )
     [ hour>> ] [ minute>> ] bi
     [ number>string 2 CHAR: 0 pad-left ] bi@ ":" glue ;
 
-: ls-timestamp ( timestamp -- string )
+: listing-date ( timestamp -- string )
     [ month>> month-abbreviation ]
     [ day>> number>string 2 CHAR: \s pad-left ]
     [
         dup year>> dup now year>> =
-        [ drop ls-time ] [ nip number>string ] if
+        [ drop listing-time ] [ nip number>string ] if
         5 CHAR: \s pad-left
     ] tri 3array " " join ;
 
@@ -28,12 +33,57 @@ SYMBOLS: permissions file-name nlinks file-size date ;
 
 : execute>string ( ? -- string ) "x" "-" ? ; inline
 
-HOOK: (directory.) os ( path -- lines )
-
 PRIVATE>
 
-: directory. ( path -- )
+SYMBOLS: file-name file-name/type permissions file-type nlinks file-size
-    [ (directory.) ] with-directory-files [ print ] each ;
+file-date file-time file-datetime uid gid user group link-target unix-datetime
+directory-or-size ;
+
+TUPLE: listing-tool path specs sort ;
+
+TUPLE: file-listing directory-entry file-info ;
+
+C: <file-listing> file-listing
+
+: <listing-tool> ( path -- listing-tool )
+    listing-tool new
+        swap >>path
+        { file-name } >>specs ;
+
+: list-slow? ( listing-tool -- ? )
+    specs>> { file-name } sequence= not ;
+
+ERROR: unknown-file-spec symbol ;
+
+HOOK: file-spec>string os ( file-listing spec -- string )
+
+M: object file-spec>string ( file-listing spec -- string )
+    {
+        { file-name [ directory-entry>> name>> ] }
+        { directory-or-size [ file-info>> dir-or-size ] }
+        { file-size [ file-info>> size>> number>string ] }
+        { file-date [ file-info>> modified>> listing-date ] }
+        { file-time [ file-info>> modified>> listing-time ] }
+        { file-datetime [ file-info>> modified>> timestamp>ymdhms ] }
+        [ unknown-file-spec ]
+    } case ;
+
+: list-files-fast ( listing-tool -- array )
+    path>> [ [ name>> 1array ] map ] with-directory-entries ; inline
+
+: list-files-slow ( listing-tool -- array )
+    [ path>> ] [ sort>> ] [ specs>> ] tri '[
+            [ dup name>> file-info file-listing boa ] map
+            _ [ sort-by-slots ] when*
+            [ _ [ file-spec>string ] with map ] map
+    ] with-directory-entries ; inline
+
+: list-files ( listing-tool -- array ) 
+    dup list-slow? [ list-files-slow ] [ list-files-fast ] if ; inline
+
+HOOK: (directory.) os ( path -- lines )
+
+: directory. ( path -- ) (directory.) simple-table. ;
 
 SYMBOLS: device-name mount-point type
 available-space free-space used-space total-space
@@ -43,16 +93,16 @@ percent-used percent-free ;
 
 : file-system-spec ( file-system-info obj -- str )
     {
-        { device-name [ device-name>> [ "" ] unless* ] }
+        { device-name [ device-name>> "" or ] }
-        { mount-point [ mount-point>> [ "" ] unless* ] }
+        { mount-point [ mount-point>> "" or ] }
-        { type [ type>> [ "" ] unless* ] }
+        { type [ type>> "" or ] }
-        { available-space [ available-space>> [ 0 ] unless* ] }
+        { available-space [ available-space>> 0 or ] }
-        { free-space [ free-space>> [ 0 ] unless* ] }
+        { free-space [ free-space>> 0 or ] }
-        { used-space [ used-space>> [ 0 ] unless* ] }
+        { used-space [ used-space>> 0 or ] }
-        { total-space [ total-space>> [ 0 ] unless* ] }
+        { total-space [ total-space>> 0 or ] }
         { percent-used [
             [ used-space>> ] [ total-space>> ] bi
-            [ [ 0 ] unless* ] bi@ dup 0 =
+            [ 0 or ] bi@ dup 0 =
             [ 2drop 0 ] [ / percent ] if
         ] }
     } case ;
@@ -65,8 +115,10 @@ percent-used percent-free ;
     [ [ unparse ] map ] bi prefix simple-table. ;
 
 : file-systems. ( -- )
-    { device-name available-space free-space used-space total-space percent-used mount-point }
+    {
-    print-file-systems ;
+        device-name available-space free-space used-space
+        total-space percent-used mount-point
+    } print-file-systems ;
 
 {
     { [ os unix? ] [ "tools.files.unix" ] }

basis/tools/files/unix/unix.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators kernel system unicode.case io.files
-io.files.info io.files.info.unix tools.files generalizations
+io.files.info io.files.info.unix generalizations
 strings arrays sequences math.parser unix.groups unix.users
-tools.files.private unix.stat math fry macros combinators.smart ;
+tools.files.private unix.stat math fry macros combinators.smart
+io.files.info.unix io tools.files math.order prettyprint ;
 IN: tools.files.unix
 
 <PRIVATE
@@ -45,19 +46,23 @@ IN: tools.files.unix
     } cond ;
 
 M: unix (directory.) ( path -- lines )
-    [ [
+    <listing-tool>
-        [
+        { permissions nlinks user group file-size file-date file-name } >>specs
-            dup file-info [
+        { { directory-entry>> name>> <=> } } >>sort
+    [ [ list-files ] with-group-cache ] with-user-cache ;
+
+M: unix file-spec>string ( file-listing spec -- string )
     {
-                    [ permissions-string ]
+        { file-name/type [
-                    [ nlink>> number>string 3 CHAR: \s pad-left ]
+            directory-entry>> [ name>> ] [ file-type>trailing ] bi append
-                    [ uid>> user-name ]
+        ] }
-                    [ gid>> group-name ]
+        { permissions [ file-info>> permissions-string ] }
-                    [ size>> number>string 15 CHAR: \s pad-left ]
+        { nlinks [ file-info>> nlink>> number>string ] }
-                    [ modified>> ls-timestamp ]
+        { user [ file-info>> uid>> user-name ] }
-                } cleave
+        { group [ file-info>> gid>> group-name ] }
-            ] output>array swap suffix " " join
+        { uid [ file-info>> uid>> number>string ] }
-        ] map
+        { gid [ file-info>> gid>> number>string ] }
-    ] with-group-cache ] with-user-cache ;
+        [ call-next-method ]
+    } case ;
 
 PRIVATE>

basis/tools/files/windows/windows.factor

@@ -2,24 +2,15 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors calendar.format combinators io.files
 kernel math.parser sequences splitting system tools.files
-generalizations tools.files.private io.files.info ;
+generalizations tools.files.private io.files.info math.order ;
 IN: tools.files.windows
 
 <PRIVATE
 
-: directory-or-size ( file-info -- str )
-    dup directory? [
-        drop "<DIR>" 20 CHAR: \s pad-right
-    ] [
-        size>> number>string 20 CHAR: \s pad-left
-    ] if ;
-
 M: windows (directory.) ( entries -- lines )
-    [
+    <listing-tool>
-        dup file-info {
+        { file-datetime directory-or-size file-name } >>specs
-            [ modified>> timestamp>ymdhms ]
+        { { directory-entry>> name>> <=> } } >>sort
-            [ directory-or-size ]
+    list-files ;
-        } cleave 2 narray swap suffix " " join
-    ] map ;
 
 PRIVATE>

basis/ui/gadgets/grids/grids.factor

@@ -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.
 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 ;
 IN: ui.gadgets.grids
 

basis/ui/gadgets/panes/panes.factor

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

basis/validators/validators-docs.factor

@@ -2,6 +2,10 @@ USING: help.markup help.syntax io.streams.string quotations
 strings math regexp regexp.backend ;
 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
 { $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." } ;
@@ -99,6 +103,7 @@ $nl
 { $subsection v-one-line    }
 { $subsection v-one-word    }
 { $subsection v-captcha     }
+{ $subsection v-checkbox    }
 "More complex validators:"
 { $subsection v-email       }
 { $subsection v-url         }

basis/validators/validators-tests.factor

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

basis/validators/validators.factor

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

core/io/io-docs.factor

@@ -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" } "." }
 $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
 { $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." }
 $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
 { $values { "string" string } }
 { $description "Writes a newline-terminated string to " { $link output-stream } "." }
@@ -279,12 +192,7 @@ $nl
 { $subsection stream-flush }
 { $subsection stream-write1 }
 { $subsection stream-write }
-{ $subsection stream-format }
 { $subsection stream-nl }
-{ $subsection make-span-stream }
-{ $subsection make-block-stream }
-{ $subsection make-cell-stream }
-{ $subsection stream-write-table }
 { $see-also "io.timeouts" } ;
 
 ARTICLE: "stdio" "Default input and output streams"
@@ -347,15 +255,6 @@ $nl
 { $subsection print }
 { $subsection nl }
 { $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:"
 { $subsection with-output-stream }
 { $subsection with-output-stream* }

core/io/io.factor

@@ -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.
 USING: hashtables generic kernel math namespaces make sequences
 continuations destructors assocs ;
@@ -13,11 +13,6 @@ GENERIC: stream-write1 ( ch stream -- )
 GENERIC: stream-write ( str stream -- )
 GENERIC: stream-flush ( 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-write ] keep stream-nl ;
@@ -46,7 +41,6 @@ SYMBOL: error-stream
 : flush ( -- ) output-stream get stream-flush ;
 
 : nl ( -- ) output-stream get stream-nl ;
-: format ( str style -- ) output-stream get stream-format ;
 
 : with-input-stream* ( stream quot -- )
     input-stream swap with-variable ; inline
@@ -68,30 +62,6 @@ SYMBOL: error-stream
     [ [ drop dispose dispose ] 3curry ] 3bi
     [ ] 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 ;
 
 : bl ( -- ) " " write ;

core/io/streams/nested/authors.txt

@@ -1 +0,0 @@
-Slava Pestov

core/io/streams/nested/nested-docs.factor

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

core/io/streams/nested/nested.factor

@@ -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 ;

core/io/streams/nested/summary.txt

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

core/io/streams/plain/plain-docs.factor

@@ -1,15 +1,6 @@
 USING: help.markup help.syntax io ;
 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"
 
 HELP: plain-writer

core/io/streams/plain/plain.factor

@@ -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.
-USING: kernel io io.streams.nested ;
+USING: kernel io ;
 IN: io.streams.plain
 
 MIXIN: plain-writer
 
 M: plain-writer stream-nl
     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> ;

core/io/streams/string/string.factor

@@ -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.
 USING: accessors io kernel math namespaces sequences sbufs
 strings generic splitting continuations destructors
@@ -17,21 +17,8 @@ SINGLETON: null-encoding
 
 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>
 
-: format-table ( table -- seq )
-    flip [ format-column ] map-last
-    flip [ " " join ] map ;
-
 M: growable dispose drop ;
 
 M: growable stream-write1 push ;
@@ -78,8 +65,3 @@ M: growable stream-read-partial
     [ <string-reader> ] dip with-input-stream ; inline
 
 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> ;

core/vocabs/loader/loader.factor

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

extra/fuel/help/help.factor

@@ -95,7 +95,7 @@ PRIVATE>
     [ [ see ] with-string-writer \ $code swap 2array ] bi 3array ; inline
 
 : (fuel-word-def) ( name -- str )
-    fuel-find-word [ [ def>> pprint ] with-string-writer ] when* ; inline
+    fuel-find-word [ [ def>> pprint ] with-string-writer ] [ f ] if* ; inline
 
 : (fuel-vocab-summary) ( name -- str ) >vocab-link summary ; inline
 

extra/inverse/inverse-docs.factor

@@ -14,7 +14,17 @@ HELP: undo
 HELP: define-inverse
 { $values { "word" "a word" } { "quot" "the inverse" } }
 { $description "Defines the inverse of a given word, taking no arguments from the quotation, only the stack." }
-{ $see-also define-pop-inverse } ;
+{ $see-also define-dual define-involution define-pop-inverse } ;
+
+HELP: define-dual
+{ $values { "word1" "a word" } { "word2" "a word" } }
+{ $description "Defines the inverse of each word as being the other one." }
+{ $see-also define-inverse define-involution } ;
+
+HELP: define-involution
+{ $values { "word" "a word" } }
+{ $description "Defines a word as being its own inverse." }
+{ $see-also define-dual define-inverse } ;
 
 HELP: define-pop-inverse
 { $values { "word" "a word" } { "n" "number of arguments to be taken from the inverted quotation" } { "quot" "a quotation" } }

extra/inverse/inverse-tests.factor

@@ -75,3 +75,8 @@ C: <nil> nil
 [ { 3 } ] [ { 1 2 3 } [ { 1 2 } prepend ] undo ] unit-test
 [ { 1 2 3 } [ { 1 2 } append ] undo ] must-fail
 [ { 1 2 3 } [ { 2 3 } prepend ] undo ] must-fail
+
+[ [ sq ] ] [ [ sqrt ] [undo] ] unit-test
+[ [ sqrt ] ] [ [ sq ] [undo] ] unit-test
+[ [ not ] ] [ [ not ] [undo] ] unit-test
+[ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] undo ] unit-test

extra/inverse/inverse.factor

@@ -20,6 +20,11 @@ M: fail summary drop "Matching failed" ;
 
 : define-inverse ( word quot -- ) "inverse" set-word-prop ;
 
+: define-dual ( word1 word2 -- )
+    2dup swap [ 1quotation define-inverse ] 2bi@ ;
+
+: define-involution ( word -- ) dup 1quotation define-inverse ;
+
 : define-math-inverse ( word quot1 quot2 -- )
     pick 1quotation 3array "math-inverse" set-word-prop ;
 
@@ -129,28 +134,24 @@ MACRO: undo ( quot -- ) [undo] ;
 
 ! Inverse of selected words
 
-\ swap [ swap ] define-inverse
+\ swap define-involution
 \ dup [ [ =/fail ] keep ] define-inverse
 \ 2dup [ over =/fail over =/fail ] define-inverse
 \ 3dup [ pick =/fail pick =/fail pick =/fail ] define-inverse
 \ pick [ [ pick ] dip =/fail ] define-inverse
 \ tuck [ swapd [ =/fail ] keep ] define-inverse
 
-\ not [ not ] define-inverse
+\ not define-involution
 \ >boolean [ { t f } memq? assure ] define-inverse
 
-\ tuple>array [ >tuple ] define-inverse
+\ tuple>array \ >tuple define-dual
-\ >tuple [ tuple>array ] define-inverse
+\ reverse define-involution
-\ reverse [ reverse ] define-inverse
 
 \ undo 1 [ [ call ] curry ] define-pop-inverse
 \ map 1 [ [undo] [ over sequence? assure map ] curry ] define-pop-inverse
 
-\ exp [ log ] define-inverse
+\ exp \ log define-dual
-\ log [ exp ] define-inverse
+\ sq \ sqrt define-dual
-\ not [ not ] define-inverse
-\ sq [ sqrt ] define-inverse
-\ sqrt [ sq ] define-inverse
 
 ERROR: missing-literal ;
 
@@ -204,8 +205,7 @@ DEFER: _
 \ first3 [ 3array ] define-inverse
 \ first4 [ 4array ] define-inverse
 
-\ prefix [ unclip ] define-inverse
+\ prefix \ unclip define-dual
-\ unclip [ prefix ] define-inverse
 \ suffix [ dup but-last swap peek ] define-inverse
 
 \ append 1 [ [ ?tail assure ] curry ] define-pop-inverse

misc/fuel/fuel-syntax.el

@@ -94,7 +94,7 @@
   "\\_<-?[0-9]+\\.[0-9]*\\([eE][+-]?[0-9]+\\)?\\_>")
 
 (defconst fuel-syntax--bad-string-regex
-  "\"[^\"]*$")
+  "\"\\([^\"]\\|\\\\\"\\)*\n")
 
 (defconst fuel-syntax--word-definition-regex
   (fuel-syntax--second-word-regex
@@ -226,7 +226,7 @@
     ;; CHARs:
     ("CHAR: \\(.\\)\\( \\|$\\)" (1 "w"))
     ;; Strings
-    ("\\(\"\\)[^\n\r\f]*\\(\"\\)" (1 "\"") (2 "\""))
+    ("\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\\"?\\)*\\(\"\\)" (1 "\"") (3 "\""))
     ;; Let and lambda:
     ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
     ("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]"))