diff --git a/basis/call/call-docs.factor b/basis/call/call-docs.factor new file mode 100644 index 0000000000..463bfdac09 --- /dev/null +++ b/basis/call/call-docs.factor @@ -0,0 +1,32 @@ +! Copyright (C) 2009 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax quotations effects words ; +IN: call + +ABOUT: "call" + +ARTICLE: "call" "Calling code with known stack effects" +"The " { $vocab-link "call" } " vocabulary allows for arbitrary quotations to be called from code accepted by the optimizing compiler. This is done by specifying the stack effect of the quotation literally. It is checked at runtime that the stack effect is accurate." +{ $subsection POSTPONE: call( } +{ $subsection POSTPONE: execute( } +{ $subsection call-effect } +{ $subsection execute-effect } ; + +HELP: call( +{ $syntax "[ ] call( foo -- bar )" } +{ $description "Calls the quotation on the top of the stack, asserting that it has the given stack effect. The quotation does not need to be known at compile time." } ; + +HELP: call-effect +{ $values { "quot" quotation } { "effect" effect } } +{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." } ; + +HELP: execute( +{ $syntax "word execute( foo -- bar )" } +{ $description "Calls the word on the top of the stack, aserting that it has the given stack effect. The word does not need to be known at compile time." } ; + +HELP: execute-effect +{ $values { "word" word } { "effect" effect } } +{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." } ; + +{ execute-effect call-effect } related-words +{ POSTPONE: call( POSTPONE: execute( } related-words diff --git a/basis/call/call-tests.factor b/basis/call/call-tests.factor index 4a59a6d2fb..a2bd11b06a 100644 --- a/basis/call/call-tests.factor +++ b/basis/call/call-tests.factor @@ -8,3 +8,8 @@ IN: call.tests [ 1 2 [ + ] call( x y -- z a ) ] must-fail [ 1 2 3 { 4 } ] [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test [ [ + ] call( x y -- z ) ] must-infer + +[ 3 ] [ 1 2 \ + execute( x y -- z ) ] unit-test +[ 1 2 \ + execute( -- z ) ] must-fail +[ 1 2 \ + execute( x y -- z a ) ] must-fail +[ \ + execute( x y -- z ) ] must-infer diff --git a/basis/call/call.factor b/basis/call/call.factor index 363b024dff..9b49acf64a 100644 --- a/basis/call/call.factor +++ b/basis/call/call.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: kernel macros fry summary sequences generalizations accessors -continuations effects.parser parser ; +continuations effects.parser parser words ; IN: call ERROR: wrong-values values quot length-required ; @@ -22,3 +22,9 @@ MACRO: call-effect ( effect -- quot ) : call( ")" parse-effect parsed \ call-effect parsed ; parsing + +: execute-effect ( word effect -- ) + [ [ execute ] curry ] dip call-effect ; inline + +: execute( + ")" parse-effect parsed \ execute-effect parsed ; parsing diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor index 1a1abc9f7b..3cb7523bdc 100644 --- a/basis/html/templates/chloe/compiler/compiler.factor +++ b/basis/html/templates/chloe/compiler/compiler.factor @@ -83,7 +83,7 @@ ERROR: unknown-chloe-tag tag ; : compile-chloe-tag ( tag -- ) dup main>> dup tags get at - [ curry call( -- ) ] + [ call( tag -- ) ] [ unknown-chloe-tag ] ?if ; diff --git a/basis/html/templates/fhtml/fhtml.factor b/basis/html/templates/fhtml/fhtml.factor index e76a812bef..78202d6460 100644 --- a/basis/html/templates/fhtml/fhtml.factor +++ b/basis/html/templates/fhtml/fhtml.factor @@ -72,6 +72,6 @@ TUPLE: fhtml path ; C: fhtml M: fhtml call-template* ( filename -- ) - '[ _ path>> utf8 file-contents eval-template ] call( -- ) ; + [ path>> utf8 file-contents eval-template ] call( filename -- ) ; INSTANCE: fhtml template diff --git a/extra/lists/authors.txt b/basis/lists/authors.txt similarity index 100% rename from extra/lists/authors.txt rename to basis/lists/authors.txt diff --git a/extra/lists/lazy/authors.txt b/basis/lists/lazy/authors.txt similarity index 100% rename from extra/lists/lazy/authors.txt rename to basis/lists/lazy/authors.txt diff --git a/extra/lists/lazy/examples/authors.txt b/basis/lists/lazy/examples/authors.txt similarity index 100% rename from extra/lists/lazy/examples/authors.txt rename to basis/lists/lazy/examples/authors.txt diff --git a/extra/lists/lazy/examples/examples-tests.factor b/basis/lists/lazy/examples/examples-tests.factor similarity index 100% rename from extra/lists/lazy/examples/examples-tests.factor rename to basis/lists/lazy/examples/examples-tests.factor diff --git a/extra/lists/lazy/examples/examples.factor b/basis/lists/lazy/examples/examples.factor similarity index 100% rename from extra/lists/lazy/examples/examples.factor rename to basis/lists/lazy/examples/examples.factor diff --git a/extra/lists/lazy/lazy-docs.factor b/basis/lists/lazy/lazy-docs.factor similarity index 100% rename from extra/lists/lazy/lazy-docs.factor rename to basis/lists/lazy/lazy-docs.factor diff --git a/extra/lists/lazy/lazy-tests.factor b/basis/lists/lazy/lazy-tests.factor similarity index 100% rename from extra/lists/lazy/lazy-tests.factor rename to basis/lists/lazy/lazy-tests.factor diff --git a/extra/lists/lazy/lazy.factor b/basis/lists/lazy/lazy.factor similarity index 100% rename from extra/lists/lazy/lazy.factor rename to basis/lists/lazy/lazy.factor diff --git a/extra/lists/lazy/old-doc.html b/basis/lists/lazy/old-doc.html similarity index 100% rename from extra/lists/lazy/old-doc.html rename to basis/lists/lazy/old-doc.html diff --git a/extra/lists/lazy/summary.txt b/basis/lists/lazy/summary.txt similarity index 100% rename from extra/lists/lazy/summary.txt rename to basis/lists/lazy/summary.txt diff --git a/extra/lists/lazy/tags.txt b/basis/lists/lazy/tags.txt similarity index 100% rename from extra/lists/lazy/tags.txt rename to basis/lists/lazy/tags.txt diff --git a/extra/lists/lists-docs.factor b/basis/lists/lists-docs.factor similarity index 100% rename from extra/lists/lists-docs.factor rename to basis/lists/lists-docs.factor diff --git a/extra/lists/lists-tests.factor b/basis/lists/lists-tests.factor similarity index 100% rename from extra/lists/lists-tests.factor rename to basis/lists/lists-tests.factor diff --git a/extra/lists/lists.factor b/basis/lists/lists.factor similarity index 100% rename from extra/lists/lists.factor rename to basis/lists/lists.factor diff --git a/extra/lists/summary.txt b/basis/lists/summary.txt similarity index 100% rename from extra/lists/summary.txt rename to basis/lists/summary.txt diff --git a/extra/lists/tags.txt b/basis/lists/tags.txt similarity index 100% rename from extra/lists/tags.txt rename to basis/lists/tags.txt diff --git a/basis/wrap/strings/strings-docs.factor b/basis/wrap/strings/strings-docs.factor new file mode 100644 index 0000000000..e20780d3ac --- /dev/null +++ b/basis/wrap/strings/strings-docs.factor @@ -0,0 +1,25 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup strings math ; +IN: wrap.strings + +ABOUT: "wrap.strings" + +ARTICLE: "wrap.strings" "String word wrapping" +"The " { $vocab-link "wrap.strings" } " vocabulary implements word wrapping for simple strings, assumed to be in monospace font." +{ $subsection wrap-lines } +{ $subsection wrap-string } +{ $subsection wrap-indented-string } ; + +HELP: wrap-lines +{ $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } } +{ $description "Given a string, divides it into a sequence of lines where each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ; + +HELP: wrap-string +{ $values { "string" string } { "width" integer } { "newstring" string } } +{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ; + +HELP: wrap-indented-string +{ $values { "string" string } { "width" integer } { "indent" string } { "newstring" string } } +{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space. Before each line, the indent string is added." } ; + diff --git a/basis/wrap/strings/strings-tests.factor b/basis/wrap/strings/strings-tests.factor new file mode 100644 index 0000000000..0bea9b5d32 --- /dev/null +++ b/basis/wrap/strings/strings-tests.factor @@ -0,0 +1,41 @@ +! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: wrap.strings tools.test multiline ; +IN: wrap.strings.tests + +[ + <" This is a +long piece +of text +that we +wish to +word wrap."> +] [ + <" This is a long piece of text that we wish to word wrap."> 10 + wrap-string +] unit-test + +[ + <" This is a + long piece + of text + that we + wish to + word wrap."> +] [ + <" This is a long piece of text that we wish to word wrap."> 12 + " " wrap-indented-string +] unit-test + +[ "this text\nhas lots\nof spaces" ] +[ "this text has lots of spaces" 12 wrap-string ] unit-test + +[ "hello\nhow\nare\nyou\ntoday?" ] +[ "hello how are you today?" 3 wrap-string ] unit-test + +[ "aaa\nbb cc\nddddd" ] [ "aaa bb cc ddddd" 6 wrap-string ] unit-test +[ "aaa\nbb ccc\ndddddd" ] [ "aaa bb ccc dddddd" 6 wrap-string ] unit-test +[ "aaa bb\ncccc\nddddd" ] [ "aaa bb cccc ddddd" 6 wrap-string ] unit-test +[ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test + +\ wrap-string must-infer diff --git a/basis/wrap/strings/strings.factor b/basis/wrap/strings/strings.factor new file mode 100644 index 0000000000..7009352f2a --- /dev/null +++ b/basis/wrap/strings/strings.factor @@ -0,0 +1,29 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: wrap kernel sequences fry splitting math ; +IN: wrap.strings + + ] map + ] map ; + +: join-elements ( wrapped-lines -- lines ) + [ " " join ] map ; + +: join-lines ( strings -- string ) + "\n" join ; + +PRIVATE> + +: wrap-lines ( lines width -- newlines ) + [ split-lines ] dip '[ _ dup wrap join-elements ] map concat ; + +: wrap-string ( string width -- newstring ) + wrap-lines join-lines ; + +: wrap-indented-string ( string width indent -- newstring ) + [ length - wrap-lines ] keep '[ _ prepend ] map join-lines ; diff --git a/basis/wrap/words/words-docs.factor b/basis/wrap/words/words-docs.factor new file mode 100644 index 0000000000..422aea0ac3 --- /dev/null +++ b/basis/wrap/words/words-docs.factor @@ -0,0 +1,25 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup math kernel ; +IN: wrap.words + +ABOUT: "wrap.words" + +ARTICLE: "wrap.words" "Word object wrapping" +"The " { $vocab-link "wrap.words" } " vocabulary implements word wrapping on abstract word objects, which have certain properties making it a more suitable input representation than strings." +{ $subsection wrap-words } +{ $subsection word } +{ $subsection } ; + +HELP: wrap-words +{ $values { "words" { "a sequence of " { $instance word } "s" } } { "line-max" integer } { "line-ideal" integer } { "lines" "a sequence of sequences of words" } } +{ $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given maximum. The returned set of lines is optimized to minimize the square of the deviation of each line from the ideal width. It is not guaranteed to be the minimal number of lines. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ; + +HELP: word +{ $class-description "A word is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Words can be created with " { $link } "." } +{ $see-also wrap-words } ; + +HELP: +{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "word" word } } +{ $description "Creates a " { $link word } " object with the given parameters." } +{ $see-also wrap-words } ; diff --git a/basis/wrap/words/words-tests.factor b/basis/wrap/words/words-tests.factor new file mode 100644 index 0000000000..7598b382ba --- /dev/null +++ b/basis/wrap/words/words-tests.factor @@ -0,0 +1,82 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test wrap.words sequences ; +IN: wrap.words.tests + +[ + { + { + T{ word f 1 10 f } + T{ word f 2 10 f } + T{ word f 3 2 t } + } + { + T{ word f 4 10 f } + T{ word f 5 10 f } + } + } +] [ + { + T{ word f 1 10 f } + T{ word f 2 10 f } + T{ word f 3 2 t } + T{ word f 4 10 f } + T{ word f 5 10 f } + } 35 35 wrap-words [ { } like ] map +] unit-test + +[ + { + { + T{ word f 1 10 f } + T{ word f 2 10 f } + T{ word f 3 9 t } + T{ word f 3 9 t } + T{ word f 3 9 t } + } + { + T{ word f 4 10 f } + T{ word f 5 10 f } + } + } +] [ + { + T{ word f 1 10 f } + T{ word f 2 10 f } + T{ word f 3 9 t } + T{ word f 3 9 t } + T{ word f 3 9 t } + T{ word f 4 10 f } + T{ word f 5 10 f } + } 35 35 wrap-words [ { } like ] map +] unit-test + +[ + { + { + T{ word f 1 10 t } + T{ word f 1 10 f } + T{ word f 3 9 t } + } + { + T{ word f 2 10 f } + T{ word f 3 9 t } + } + { + T{ word f 4 10 f } + T{ word f 5 10 f } + } + } +] [ + { + T{ word f 1 10 t } + T{ word f 1 10 f } + T{ word f 3 9 t } + T{ word f 2 10 f } + T{ word f 3 9 t } + T{ word f 4 10 f } + T{ word f 5 10 f } + } 35 35 wrap-words [ { } like ] map +] unit-test + +\ wrap-words must-infer diff --git a/basis/wrap/words/words.factor b/basis/wrap/words/words.factor new file mode 100644 index 0000000000..00f257a5cf --- /dev/null +++ b/basis/wrap/words/words.factor @@ -0,0 +1,40 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: sequences kernel splitting.monotonic accessors wrap grouping ; +IN: wrap.words + +TUPLE: word key width break? ; +C: word + +> ] map sum ; + +: make-element ( whites blacks -- element ) + [ append ] [ [ words-length ] bi@ ] 2bi ; + +: ?first2 ( seq -- first/f second/f ) + [ 0 swap ?nth ] + [ 1 swap ?nth ] bi ; + +: split-words ( seq -- half-elements ) + [ [ break?>> ] bi@ = ] monotonic-split ; + +: ?first-break ( seq -- newseq f/element ) + dup first first break?>> + [ unclip-slice f swap make-element ] + [ f ] if ; + +: make-elements ( seq f/element -- elements ) + [ 2 [ ?first2 make-element ] map ] dip + [ prefix ] when* ; + +: words>elements ( seq -- newseq ) + split-words ?first-break make-elements ; + +PRIVATE> + +: wrap-words ( words line-max line-ideal -- lines ) + [ words>elements ] 2dip wrap [ concat ] map ; + diff --git a/basis/wrap/wrap-docs.factor b/basis/wrap/wrap-docs.factor index 59c0352bc7..feac7c51a7 100644 --- a/basis/wrap/wrap-docs.factor +++ b/basis/wrap/wrap-docs.factor @@ -6,36 +6,6 @@ IN: wrap ABOUT: "wrap" ARTICLE: "wrap" "Word wrapping" -"The " { $vocab-link "wrap" } " vocabulary implements word wrapping. There is support for simple string wrapping, with the following words:" -{ $subsection wrap-lines } -{ $subsection wrap-string } -{ $subsection wrap-indented-string } -"Additionally, the vocabulary provides capabilities to wrap arbitrary groups of things, in units called segments." -{ $subsection wrap-segments } -{ $subsection segment } -{ $subsection } ; - -HELP: wrap-lines -{ $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } } -{ $description "Given a string, divides it into a sequence of lines where each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ; - -HELP: wrap-string -{ $values { "string" string } { "width" integer } { "newstring" string } } -{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ; - -HELP: wrap-indented-string -{ $values { "string" string } { "width" integer } { "indent" string } { "newstring" string } } -{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space. Before each line, the indent string is added." } ; - -HELP: wrap-segments -{ $values { "segments" { "a sequence of " { $instance segment } "s" } } { "line-max" integer } { "line-ideal" integer } { "lines" "a sequence of sequences of words" } } -{ $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given maximum. The returned set of lines is optimized to minimize the square of the deviation of each line from the ideal width. It is not guaranteed to be the minimal number of lines. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ; - -HELP: segment -{ $class-description "A segment is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Elements can be created with " { $link } "." } -{ $see-also wrap-segments } ; - -HELP: -{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "segment" segment } } -{ $description "Creates a " { $link segment } " object with the given parameters." } -{ $see-also wrap-segments } ; +"The " { $vocab-link "wrap" } " vocabulary implements word wrapping. Wrapping can take place based on simple strings, assumed to be monospace, or abstract word objects." +{ $vocab-subsection "String word wrapping" "wrap.strings" } +{ $vocab-subsection "Word object wrapping" "wrap.words" } ; diff --git a/basis/wrap/wrap-tests.factor b/basis/wrap/wrap-tests.factor deleted file mode 100644 index eeea3850d5..0000000000 --- a/basis/wrap/wrap-tests.factor +++ /dev/null @@ -1,118 +0,0 @@ -! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov -! See http://factorcode.org/license.txt for BSD license. -USING: tools.test wrap multiline sequences ; -IN: wrap.tests - -[ - { - { - T{ segment f 1 10 f } - T{ segment f 2 10 f } - T{ segment f 3 2 t } - } - { - T{ segment f 4 10 f } - T{ segment f 5 10 f } - } - } -] [ - { - T{ segment f 1 10 f } - T{ segment f 2 10 f } - T{ segment f 3 2 t } - T{ segment f 4 10 f } - T{ segment f 5 10 f } - } 35 35 wrap-segments [ { } like ] map -] unit-test - -[ - { - { - T{ segment f 1 10 f } - T{ segment f 2 10 f } - T{ segment f 3 9 t } - T{ segment f 3 9 t } - T{ segment f 3 9 t } - } - { - T{ segment f 4 10 f } - T{ segment f 5 10 f } - } - } -] [ - { - T{ segment f 1 10 f } - T{ segment f 2 10 f } - T{ segment f 3 9 t } - T{ segment f 3 9 t } - T{ segment f 3 9 t } - T{ segment f 4 10 f } - T{ segment f 5 10 f } - } 35 35 wrap-segments [ { } like ] map -] unit-test - -[ - { - { - T{ segment f 1 10 t } - T{ segment f 1 10 f } - T{ segment f 3 9 t } - } - { - T{ segment f 2 10 f } - T{ segment f 3 9 t } - } - { - T{ segment f 4 10 f } - T{ segment f 5 10 f } - } - } -] [ - { - T{ segment f 1 10 t } - T{ segment f 1 10 f } - T{ segment f 3 9 t } - T{ segment f 2 10 f } - T{ segment f 3 9 t } - T{ segment f 4 10 f } - T{ segment f 5 10 f } - } 35 35 wrap-segments [ { } like ] map -] unit-test - -[ - <" This is a -long piece -of text -that we -wish to -word wrap."> -] [ - <" This is a long piece of text that we wish to word wrap."> 10 - wrap-string -] unit-test - -[ - <" This is a - long piece - of text - that we - wish to - word wrap."> -] [ - <" This is a long piece of text that we wish to word wrap."> 12 - " " wrap-indented-string -] unit-test - -[ "this text\nhas lots\nof spaces" ] -[ "this text has lots of spaces" 12 wrap-string ] unit-test - -[ "hello\nhow\nare\nyou\ntoday?" ] -[ "hello how are you today?" 3 wrap-string ] unit-test - -[ "aaa\nbb cc\nddddd" ] [ "aaa bb cc ddddd" 6 wrap-string ] unit-test -[ "aaa\nbb ccc\ndddddd" ] [ "aaa bb ccc dddddd" 6 wrap-string ] unit-test -[ "aaa bb\ncccc\nddddd" ] [ "aaa bb cccc ddddd" 6 wrap-string ] unit-test -[ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test - -\ wrap-string must-infer -\ wrap-segments must-infer diff --git a/basis/wrap/wrap.factor b/basis/wrap/wrap.factor index f54c858bf4..55fe10283a 100644 --- a/basis/wrap/wrap.factor +++ b/basis/wrap/wrap.factor @@ -1,10 +1,10 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences math arrays locals fry accessors lists splitting call make combinators.short-circuit namespaces grouping splitting.monotonic ; IN: wrap - element @@ -93,65 +93,3 @@ SYMBOL: line-ideal min-cost post-process ] with-scope ; - -PRIVATE> - -TUPLE: segment key width break? ; -C: segment - -> ] map sum ; - -: make-element ( whites blacks -- element ) - [ append ] [ [ segments-length ] bi@ ] 2bi ; - -: ?first2 ( seq -- first/f second/f ) - [ 0 swap ?nth ] - [ 1 swap ?nth ] bi ; - -: split-segments ( seq -- half-elements ) - [ [ break?>> ] bi@ = ] monotonic-split ; - -: ?first-break ( seq -- newseq f/element ) - dup first first break?>> - [ unclip-slice f swap make-element ] - [ f ] if ; - -: make-elements ( seq f/element -- elements ) - [ 2 [ ?first2 make-element ] map ] dip - [ prefix ] when* ; - -: segments>elements ( seq -- newseq ) - split-segments ?first-break make-elements ; - -PRIVATE> - -: wrap-segments ( segments line-max line-ideal -- lines ) - [ segments>elements ] 2dip wrap [ concat ] map ; - - ] map - ] map ; - -: join-elements ( wrapped-lines -- lines ) - [ " " join ] map ; - -: join-lines ( strings -- string ) - "\n" join ; - -PRIVATE> - -: wrap-lines ( lines width -- newlines ) - [ split-lines ] dip '[ _ dup wrap join-elements ] map concat ; - -: wrap-string ( string width -- newstring ) - wrap-lines join-lines ; - -: wrap-indented-string ( string width indent -- newstring ) - [ length - wrap-lines ] keep '[ _ prepend ] map join-lines ; diff --git a/basis/xml/writer/writer.factor b/basis/xml/writer/writer.factor index 4b80e0818e..4f5bad1aa5 100755 --- a/basis/xml/writer/writer.factor +++ b/basis/xml/writer/writer.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: hashtables kernel math namespaces sequences strings assocs combinators io io.streams.string accessors -xml.data wrap xml.entities unicode.categories fry ; +xml.data wrap.strings xml.entities unicode.categories fry ; IN: xml.writer SYMBOL: sensitive-tags