steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixing everything I broke?

db4
Daniel Ehrenberg 2009-01-29 13:33:04 -06:00
parent 356ee5ced5
commit 6372395b8a
16 changed files with 108 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/farkup/farkup.factor
View File

@ -236,7 +236,7 @@ M: f (write-farkup) ;
parse-farkup (write-farkup) ; parse-farkup (write-farkup) ;
: write-farkup ( string -- ) : write-farkup ( string -- )
farkup>xml write-xml-chunk ; farkup>xml write-xml ;
: convert-farkup ( string -- string' ) : convert-farkup ( string -- string' )
[ write-farkup ] with-string-writer ; [ write-farkup ] with-string-writer ;

4
basis/html/components/components.factor
View File

@ -19,7 +19,7 @@ GENERIC: render* ( value name renderer -- xml )
[ f swap ] [ f swap ]
if if
] 2dip ] 2dip
render* write-xml-chunk render* write-xml
[ render-error ] when* ; [ render-error ] when* ;
<PRIVATE <PRIVATE
@ -176,4 +176,4 @@ M: comparison render*
! HTML component ! HTML component
SINGLETON: html SINGLETON: html
M: html render* 2drop string>xml-chunk ; M: html render* 2drop <unescaped> ;

33
basis/html/elements/elements.factor
View File

@ -1,11 +1,9 @@
! cont-html v0.6 ! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg.
!
! 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 io.styles 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 ; xml.data xml.interpolate urls math math.parser combinators
present fry io.streams.string xml.writer ;
IN: html.elements IN: html.elements
@ -135,17 +133,18 @@ SYMBOL: html
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">" write-html ; "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">" write-html ;
: simple-page ( title head-quot body-quot -- ) : simple-page ( title head-quot body-quot -- )
#! Call the quotation, with all output going to the [ with-string-writer <unescaped> ] bi@
#! body of an html page with the given title. <XML
spin <?xml version="1.0"?>
xhtml-preamble <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html "http://www.w3.org/1999/xhtml" =xmlns "en" =xml:lang "en" =lang html> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head> <head>
<title> write </title> <title><-></title>
call <->
</head> </head>
<body> call </body> <body><-></body>
</html> ; inline </html>
XML> write-xml ;
: render-error ( message -- ) : render-error ( message -- )
<span "error" =class span> escape-string write </span> ; [XML <span class="error"><-></span> XML] write-xml ;

2
basis/html/templates/chloe/compiler/compiler.factor
View File

@ -90,7 +90,7 @@ ERROR: unknown-chloe-tag tag ;
{ [ dup [ tag? ] [ xml? ] bi or ] [ compile-tag ] } { [ dup [ tag? ] [ xml? ] bi or ] [ compile-tag ] }
{ [ dup string? ] [ escape-string [write] ] } { [ dup string? ] [ escape-string [write] ] }
{ [ dup comment? ] [ drop ] } { [ dup comment? ] [ drop ] }
[ [ write-xml-chunk ] [code-with] ] [ [ write-xml ] [code-with] ]
} cond ; } cond ;
: with-compiler ( quot -- quot' ) : with-compiler ( quot -- quot' )

1
basis/http/server/server.factor
View File

@ -12,6 +12,7 @@ io.encodings.utf8
io.encodings.ascii io.encodings.ascii
io.encodings.binary io.encodings.binary
io.streams.limited io.streams.limited
io.streams.string
io.servers.connection io.servers.connection
io.timeouts io.timeouts
io.crlf io.crlf

2
basis/lcs/diff2html/diff2html-tests.factor
View File

@ -3,4 +3,4 @@
USING: lcs.diff2html lcs kernel tools.test strings sequences xml.writer ; USING: lcs.diff2html lcs kernel tools.test strings sequences xml.writer ;
IN: lcs.diff2html.tests IN: lcs.diff2html.tests
[ ] [ "hello" "heyo" [ 1string ] { } map-as diff htmlize-diff xml-chunk>string drop ] unit-test [ ] [ "hello" "heyo" [ 1string ] { } map-as diff htmlize-diff xml>string drop ] unit-test

2
basis/syndication/syndication.factor
View File

@ -81,7 +81,7 @@ TUPLE: entry title url description date ;
[ [
{ "content" "summary" } any-tag-named { "content" "summary" } any-tag-named
dup children>> [ string? not ] contains? dup children>> [ string? not ] contains?
[ children>> [ write-xml-chunk ] with-string-writer ] [ children>> xml>string ]
[ children>string ] if >>description [ children>string ] if >>description
] ]
[ [

4
basis/xml/errors/errors.factor
View File

@ -194,7 +194,7 @@ M: bad-prolog summary ( obj -- str )
[ [
dup call-next-method write dup call-next-method write
"Misplaced XML prolog" print "Misplaced XML prolog" print
prolog>> write-prolog nl prolog>> write-xml nl
] with-string-writer ; ] with-string-writer ;
TUPLE: capitalized-prolog < xml-error-at name ; TUPLE: capitalized-prolog < xml-error-at name ;
@ -258,7 +258,7 @@ M: misplaced-directive summary ( obj -- str )
[ [
dup call-next-method write dup call-next-method write
"Misplaced directive:" print "Misplaced directive:" print
dir>> write-xml-chunk nl dir>> write-xml nl
] with-string-writer ; ] with-string-writer ;
TUPLE: bad-name < xml-error-at name ; TUPLE: bad-name < xml-error-at name ;

4
basis/xml/interpolate/interpolate-tests.factor
View File

@ -51,8 +51,8 @@ IN: xml.interpolate.tests
<XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML> <XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML>
pprint-xml>string ] unit-test pprint-xml>string ] unit-test
[ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml-chunk>string ] unit-test [ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml>string ] unit-test
[ "<x></x>" ] [ f [XML <x><-></x> XML] xml-chunk>string ] unit-test [ "<x></x>" ] [ f [XML <x><-></x> XML] xml>string ] unit-test
\ <XML must-infer \ <XML must-infer
[ { } "" interpolate-xml ] must-infer [ { } "" interpolate-xml ] must-infer

4
basis/xml/interpolate/interpolate.factor
View File

@ -3,7 +3,7 @@
USING: xml xml.state kernel sequences fry assocs xml.data USING: xml xml.state kernel sequences fry assocs xml.data
accessors strings make multiline parser namespaces macros accessors strings make multiline parser namespaces macros
sequences.deep generalizations words combinators sequences.deep generalizations words combinators
math present arrays ; math present arrays unicode.categories ;
IN: xml.interpolate IN: xml.interpolate
<PRIVATE <PRIVATE
@ -95,7 +95,7 @@ M: xml-chunk interpolate-xml
} cond ; } cond ;
: parse-def ( accum delimiter quot -- accum ) : parse-def ( accum delimiter quot -- accum )
[ parse-multiline-string 1 short head* ] dip call [ parse-multiline-string [ blank? ] trim ] dip call
[ extract-variables collect ] keep swap [ extract-variables collect ] keep swap
[ number<-> parsed ] dip [ number<-> parsed ] dip
[ \ interpolate-xml parsed ] when ; inline [ \ interpolate-xml parsed ] when ; inline

4
basis/xml/tests/templating.factor
View File

@ -9,10 +9,10 @@ SYMBOL: ref-table
GENERIC: (r-ref) ( xml -- ) GENERIC: (r-ref) ( xml -- )
M: tag (r-ref) M: tag (r-ref)
sub-tag over at* [ dup sub-tag attr [
ref-table get at ref-table get at
>>children drop >>children drop
] [ 2drop ] if ; ] [ drop ] if* ;
M: object (r-ref) drop ; M: object (r-ref) drop ;
: template ( xml -- ) : template ( xml -- )

2
basis/xml/tests/xmltest.factor
View File

@ -11,7 +11,7 @@ TUPLE: xml-test id uri sections description type ;
[ "ID" attr >>id ] [ "ID" attr >>id ]
[ "URI" attr >>uri ] [ "URI" attr >>uri ]
[ "SECTIONS" attr >>sections ] [ "SECTIONS" attr >>sections ]
[ children>> xml-chunk>string >>description ] [ children>> xml>string >>description ]
} cleave ; } cleave ;
: parse-tests ( xml -- tests ) : parse-tests ( xml -- tests )

2
basis/xml/utilities/utilities.factor
View File

@ -38,7 +38,7 @@ IN: xml.utilities
tags@ swap [ tag-named? ] with filter ; tags@ swap [ tag-named? ] with filter ;
: tag-with-attr? ( elem attr-value attr-name -- ? ) : tag-with-attr? ( elem attr-value attr-name -- ? )
rot dup tag? [ at = ] [ 3drop f ] if ; rot dup tag? [ swap attr = ] [ 3drop f ] if ;
: tag-with-attr ( tag attr-value attr-name -- matching-tag ) : tag-with-attr ( tag attr-value attr-name -- matching-tag )
assure-name '[ _ _ tag-with-attr? ] find nip ; assure-name '[ _ _ tag-with-attr? ] find nip ;

45
basis/xml/writer/writer-docs.factor
View File

@ -1,56 +1,41 @@
! Copyright (C) 2005, 2009 Daniel Ehrenberg ! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.syntax help.markup io strings ; USING: help.syntax help.markup io strings xml.data ;
IN: xml.writer IN: xml.writer
ABOUT: "xml.writer" ABOUT: "xml.writer"
ARTICLE: "xml.writer" "Writing XML" ARTICLE: "xml.writer" "Writing XML"
"These words are used in implementing prettyprint" "These words are used to print XML preserving whitespace in text nodes"
{ $subsection write-xml-chunk }
"These words are used to print XML normally"
{ $subsection xml>string }
{ $subsection write-xml } { $subsection write-xml }
{ $subsection xml>string }
"These words are used to prettyprint XML" "These words are used to prettyprint XML"
{ $subsection pprint-xml>string } { $subsection pprint-xml>string }
{ $subsection pprint-xml>string-but }
{ $subsection pprint-xml } { $subsection pprint-xml }
{ $subsection pprint-xml-but } ; "Certain variables can be changed to mainpulate prettyprinting"
{ $subsection sensitive-tags }
HELP: write-xml-chunk { $subsection indenter }
{ $values { "object" "an XML element" } } "All of these words operate on arbitrary pieces of XML: they can take, as in put, XML documents, comments, tags, strings (text nodes), XML chunks, etc." ;
{ $description "writes an XML element to " { $link output-stream } "." }
{ $see-also write-xml-chunk write-xml } ;
HELP: xml>string HELP: xml>string
{ $values { "xml" "an xml document" } { "string" "a string" } } { $values { "xml" "an XML document" } { "string" "a string" } }
{ $description "converts an XML document into a string" } { $description "This converts an XML document " { $link xml } " into a string. It can also be used to convert any piece of XML to a string, eg an " { $link xml-chunk } " or " { $link comment } "." }
{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; { $notes "This does not preserve what type of quotes were used or what data was omitted from version declaration, as that information isn't present in the XML data representation. The whitespace in the text nodes of the original document is preserved." } ;
HELP: pprint-xml>string HELP: pprint-xml>string
{ $values { "xml" "an xml document" } { "string" "a string" } } { $values { "xml" "an XML document" } { "string" "a string" } }
{ $description "converts an XML document into a string in a prettyprinted form." } { $description "converts an XML document into a string in a prettyprinted form." }
{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; { $notes "This does not preserve what type of quotes were used or what data was omitted from version declaration, as that information isn't present in the XML data representation. The whitespace in the text nodes of the original document is preserved." } ;
HELP: write-xml HELP: write-xml
{ $values { "xml" "an XML document" } } { $values { "xml" "an XML document" } }
{ $description "prints the contents of an XML document to " { $link output-stream } "." } { $description "prints the contents of an XML document to " { $link output-stream } "." }
{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; { $notes "This does not preserve what type of quotes were used or what data was omitted from version declaration, as that information isn't present in the XML data representation. The whitespace in the text nodes of the original document is preserved." } ;
HELP: pprint-xml HELP: pprint-xml
{ $values { "xml" "an XML document" } } { $values { "xml" "an XML document" } }
{ $description "prints the contents of an XML document to " { $link output-stream } " in a prettyprinted form." } { $description "prints the contents of an XML document to " { $link output-stream } " in a prettyprinted form." }
{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; { $notes "This does not preserve what type of quotes were used or what data was omitted from version declaration, as that information isn't present in the XML data representation. Whitespace is also not preserved." } ;
HELP: pprint-xml-but { xml>string write-xml pprint-xml pprint-xml>string } related-words
{ $values { "xml" "an XML document" } { "sensitive-tags" "a sequence of names" } }
{ $description "Prettyprints an XML document, leaving the whitespace of the tags with names in sensitive-tags intact." }
{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ;
HELP: pprint-xml>string-but
{ $values { "xml" "an XML document" } { "sensitive-tags" "a sequence of names" } { "string" string } }
{ $description "Prettyprints an XML document, returning the result as a string and leaving the whitespace of the tags with names in sensitive-tags intact." }
{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ;
{ xml>string write-xml pprint-xml pprint-xml>string pprint-xml>string-but pprint-xml-but } related-words

6
basis/xml/writer/writer-tests.factor
View File

@ -7,7 +7,7 @@ IN: xml.writer.tests
\ write-xml must-infer \ write-xml must-infer
\ xml>string must-infer \ xml>string must-infer
\ pprint-xml must-infer \ pprint-xml must-infer
\ pprint-xml-but must-infer ! Add a test for pprint-xml with sensitive-tags
[ "foo" ] [ T{ name { main "foo" } } name>string ] unit-test [ "foo" ] [ T{ name { main "foo" } } name>string ] unit-test
[ "foo" ] [ T{ name { space "" } { main "foo" } } name>string ] unit-test [ "foo" ] [ T{ name { space "" } { main "foo" } } name>string ] unit-test
@ -51,11 +51,11 @@ IN: xml.writer.tests
]> ]>
<x>&foo;</x>"} pprint-reprints-as <x>&foo;</x>"} pprint-reprints-as
[ t ] [ "<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.1//EN' 'http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd' >" dup string>xml-chunk xml-chunk>string = ] unit-test [ t ] [ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\" >" dup string>xml-chunk xml>string = ] unit-test
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a b=\"c\"/>" ] [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a b=\"c\"/>" ]
[ "<a b='c'/>" string>xml xml>string ] unit-test [ "<a b='c'/>" string>xml xml>string ] unit-test
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo>bar baz</foo>" ] [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo>bar baz</foo>" ]
[ "<foo>bar</foo>" string>xml [ " baz" append ] map xml>string ] unit-test [ "<foo>bar</foo>" string>xml [ " baz" append ] map xml>string ] unit-test
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<foo>\n bar\n</foo>" ] [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<foo>\n bar\n</foo>" ]
[ "<foo> bar </foo>" string>xml pprint-xml>string ] unit-test [ "<foo> bar </foo>" string>xml pprint-xml>string ] unit-test
[ "<foo'>" ] [ "<foo'>" <unescaped> xml-chunk>string ] unit-test [ "<foo'>" ] [ "<foo'>" <unescaped> xml>string ] unit-test

128
basis/xml/writer/writer.factor
View File

@ -5,14 +5,15 @@ assocs combinators io io.streams.string accessors
xml.data wrap xml.entities unicode.categories fry ; xml.data wrap xml.entities unicode.categories fry ;
IN: xml.writer IN: xml.writer
SYMBOL: xml-pprint?
SYMBOL: sensitive-tags SYMBOL: sensitive-tags
SYMBOL: indentation
SYMBOL: indenter SYMBOL: indenter
" " indenter set-global " " indenter set-global
<PRIVATE <PRIVATE
SYMBOL: xml-pprint?
SYMBOL: indentation
: sensitive? ( tag -- ? ) : sensitive? ( tag -- ? )
sensitive-tags get swap '[ _ names-match? ] contains? ; sensitive-tags get swap '[ _ names-match? ] contains? ;
@ -49,22 +50,22 @@ PRIVATE>
<PRIVATE <PRIVATE
: write-quoted ( string -- )
CHAR: " write1 write CHAR: " write1 ;
: print-attrs ( assoc -- ) : print-attrs ( assoc -- )
[ [
" " write [ bl print-name "=" write ]
swap print-name [ escape-quoted-string write-quoted ] bi*
"=\"" write
escape-quoted-string write
"\"" write
] assoc-each ; ] assoc-each ;
PRIVATE> PRIVATE>
GENERIC: write-xml-chunk ( object -- ) GENERIC: write-xml ( object -- )
<PRIVATE <PRIVATE
M: string write-xml-chunk M: string write-xml
escape-string xml-pprint? get [ escape-string xml-pprint? get [
dup [ blank? ] all? dup [ blank? ] all?
[ drop "" ] [ drop "" ]
@ -78,17 +79,17 @@ M: string write-xml-chunk
: write-start-tag ( tag -- ) : write-start-tag ( tag -- )
write-tag ">" write ; write-tag ">" write ;
M: contained-tag write-xml-chunk M: contained-tag write-xml
write-tag "/>" write ; write-tag "/>" write ;
: write-children ( tag -- ) : write-children ( tag -- )
indent children>> ?filter-children indent children>> ?filter-children
[ write-xml-chunk ] each unindent ; [ write-xml ] each unindent ;
: write-end-tag ( tag -- ) : write-end-tag ( tag -- )
?indent "</" write print-name CHAR: > write1 ; ?indent "</" write print-name CHAR: > write1 ;
M: open-tag write-xml-chunk M: open-tag write-xml
xml-pprint? get [ xml-pprint? get [
{ {
[ sensitive? not xml-pprint? get and xml-pprint? set ] [ sensitive? not xml-pprint? get and xml-pprint? set ]
@ -98,110 +99,95 @@ M: open-tag write-xml-chunk
} cleave } cleave
] dip xml-pprint? set ; ] dip xml-pprint? set ;
M: unescaped write-xml-chunk M: unescaped write-xml
string>> write ; string>> write ;
M: comment write-xml-chunk M: comment write-xml
"<!--" write text>> write "-->" write ; "<!--" write text>> write "-->" write ;
M: element-decl write-xml-chunk : write-decl ( decl name quot: ( decl -- slot ) -- )
"<!ELEMENT " write "<!" write swap write bl
[ name>> write " " write ] [ name>> write bl ]
[ content-spec>> write ">" write ] swap '[ @ write ">" write ] bi ; inline
bi ;
M: attlist-decl write-xml-chunk M: element-decl write-xml
"<!ATTLIST " write "ELEMENT" [ content-spec>> ] write-decl ;
[ name>> write " " write ]
[ att-defs>> write ">" write ]
bi ;
M: notation-decl write-xml-chunk M: attlist-decl write-xml
"<!NOTATION " write "ATTLIST" [ att-defs>> ] write-decl ;
[ name>> write " " write ]
[ id>> write ">" write ]
bi ;
M: entity-decl write-xml-chunk M: notation-decl write-xml
"NOTATION" [ id>> ] write-decl ;
M: entity-decl write-xml
"<!ENTITY " write "<!ENTITY " write
[ pe?>> [ " % " write ] when ] [ pe?>> [ " % " write ] when ]
[ name>> write " \"" write ] [ [ name>> write " \"" write ] [
def>> f xml-pprint? def>> f xml-pprint?
[ write-xml-chunk ] with-variable [ write-xml ] with-variable
"\">" write "\">" write
] tri ; ] tri ;
M: system-id write-xml-chunk M: system-id write-xml
"SYSTEM '" write system-literal>> write "'" write ; "SYSTEM" write bl system-literal>> write-quoted ;
M: public-id write-xml-chunk M: public-id write-xml
"PUBLIC '" write "PUBLIC" write bl
[ pubid-literal>> write "' '" write ] [ pubid-literal>> write-quoted bl ]
[ system-literal>> write "'" write ] bi ; [ system-literal>> write-quoted ] bi ;
: write-internal-subset ( dtd -- ) : write-internal-subset ( dtd -- )
[ [
"[" write indent "[" write indent
directives>> [ ?indent write-xml-chunk ] each directives>> [ ?indent write-xml ] each
unindent ?indent "]" write unindent ?indent "]" write
] when* ; ] when* ;
M: doctype-decl write-xml-chunk M: doctype-decl write-xml
?indent "<!DOCTYPE " write ?indent "<!DOCTYPE " write
[ name>> write " " write ] [ name>> write " " write ]
[ external-id>> [ write-xml-chunk " " write ] when* ] [ external-id>> [ write-xml " " write ] when* ]
[ internal-subset>> write-internal-subset ">" write ] tri ; [ internal-subset>> write-internal-subset ">" write ] tri ;
M: directive write-xml-chunk M: directive write-xml
"<!" write text>> write CHAR: > write1 nl ; "<!" write text>> write CHAR: > write1 nl ;
M: instruction write-xml-chunk M: instruction write-xml
"<?" write text>> write "?>" write ; "<?" write text>> write "?>" write ;
M: number write-xml-chunk M: number write-xml
"Numbers are not allowed in XML" throw ; "Numbers are not allowed in XML" throw ;
M: sequence write-xml-chunk M: sequence write-xml
[ write-xml-chunk ] each ; [ write-xml ] each ;
PRIVATE> M: prolog write-xml
"<?xml version=" write
[ version>> write-quoted ]
[ " encoding=" write encoding>> write-quoted ]
[ standalone>> [ " standalone=\"yes\"" write ] when ] tri
"?>" write ;
: write-prolog ( xml -- ) M: xml write-xml
"<?xml version=\"" write dup version>> write
"\" encoding=\"" write dup encoding>> write
standalone>> [ "\" standalone=\"yes" write ] when
"\"?>" write ;
: write-xml ( xml -- )
{ {
[ prolog>> write-prolog ] [ prolog>> write-xml ]
[ before>> write-xml-chunk ] [ before>> write-xml ]
[ body>> write-xml-chunk ] [ body>> write-xml ]
[ after>> write-xml-chunk ] [ after>> write-xml ]
} cleave ; } cleave ;
M: xml write-xml-chunk PRIVATE>
body>> write-xml-chunk ;
: xml>string ( xml -- string ) : xml>string ( xml -- string )
[ write-xml ] with-string-writer ; [ write-xml ] with-string-writer ;
: xml-chunk>string ( object -- string ) : pprint-xml ( xml -- )
[ write-xml-chunk ] with-string-writer ;
: pprint-xml-but ( xml sensitive-tags -- )
[ [
[ assure-name ] map sensitive-tags set sensitive-tags [ [ assure-name ] map ] change
0 indentation set 0 indentation set
xml-pprint? on xml-pprint? on
write-xml write-xml
] with-scope ; ] with-scope ;
: pprint-xml ( xml -- )
f pprint-xml-but ;
: pprint-xml>string-but ( xml sensitive-tags -- string )
[ pprint-xml-but ] with-string-writer ;
: pprint-xml>string ( xml -- string ) : pprint-xml>string ( xml -- string )
f pprint-xml>string-but ; [ pprint-xml ] with-string-writer ;