From 6372395b8a42510e67471043b4c7d39ed4d21ea9 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 29 Jan 2009 13:33:04 -0600 Subject: [PATCH] Fixing everything I broke? --- basis/farkup/farkup.factor | 2 +- basis/html/components/components.factor | 4 +- basis/html/elements/elements.factor | 33 +++-- .../templates/chloe/compiler/compiler.factor | 2 +- basis/http/server/server.factor | 1 + basis/lcs/diff2html/diff2html-tests.factor | 2 +- basis/syndication/syndication.factor | 2 +- basis/xml/errors/errors.factor | 4 +- .../xml/interpolate/interpolate-tests.factor | 4 +- basis/xml/interpolate/interpolate.factor | 4 +- basis/xml/tests/templating.factor | 4 +- basis/xml/tests/xmltest.factor | 2 +- basis/xml/utilities/utilities.factor | 2 +- basis/xml/writer/writer-docs.factor | 45 ++---- basis/xml/writer/writer-tests.factor | 6 +- basis/xml/writer/writer.factor | 128 ++++++++---------- 16 files changed, 108 insertions(+), 137 deletions(-) diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index ccd12b83f2..b9e62717eb 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -236,7 +236,7 @@ M: f (write-farkup) ; parse-farkup (write-farkup) ; : write-farkup ( string -- ) - farkup>xml write-xml-chunk ; + farkup>xml write-xml ; : convert-farkup ( string -- string' ) [ write-farkup ] with-string-writer ; diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor index e63447ec55..462c9b3c78 100644 --- a/basis/html/components/components.factor +++ b/basis/html/components/components.factor @@ -19,7 +19,7 @@ GENERIC: render* ( value name renderer -- xml ) [ f swap ] if ] 2dip - render* write-xml-chunk + render* write-xml [ render-error ] when* ; xml-chunk ; +M: html render* 2drop ; diff --git a/basis/html/elements/elements.factor b/basis/html/elements/elements.factor index 7bca545df5..9e7504d436 100644 --- a/basis/html/elements/elements.factor +++ b/basis/html/elements/elements.factor @@ -1,11 +1,9 @@ -! cont-html v0.6 -! -! Copyright (C) 2004 Chris Double. +! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. - USING: io io.styles kernel namespaces prettyprint quotations 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 @@ -135,17 +133,18 @@ SYMBOL: html "" write-html ; : simple-page ( title head-quot body-quot -- ) - #! Call the quotation, with all output going to the - #! body of an html page with the given title. - spin - xhtml-preamble - - - write - call - - call - ; inline + [ with-string-writer ] bi@ + + + + + <-> + <-> + + <-> + + XML> write-xml ; : render-error ( message -- ) - escape-string write ; + [XML <-> XML] write-xml ; diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor index 4410cd7599..cd5de4ceb6 100644 --- a/basis/html/templates/chloe/compiler/compiler.factor +++ b/basis/html/templates/chloe/compiler/compiler.factor @@ -90,7 +90,7 @@ ERROR: unknown-chloe-tag tag ; { [ dup [ tag? ] [ xml? ] bi or ] [ compile-tag ] } { [ dup string? ] [ escape-string [write] ] } { [ dup comment? ] [ drop ] } - [ [ write-xml-chunk ] [code-with] ] + [ [ write-xml ] [code-with] ] } cond ; : with-compiler ( quot -- quot' ) diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index b4af727caa..a886d7bae7 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -12,6 +12,7 @@ io.encodings.utf8 io.encodings.ascii io.encodings.binary io.streams.limited +io.streams.string io.servers.connection io.timeouts io.crlf diff --git a/basis/lcs/diff2html/diff2html-tests.factor b/basis/lcs/diff2html/diff2html-tests.factor index d261a4659a..0c2ed34f45 100644 --- a/basis/lcs/diff2html/diff2html-tests.factor +++ b/basis/lcs/diff2html/diff2html-tests.factor @@ -3,4 +3,4 @@ USING: lcs.diff2html lcs kernel tools.test strings sequences xml.writer ; 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 diff --git a/basis/syndication/syndication.factor b/basis/syndication/syndication.factor index 58b2279cb1..b23910e200 100644 --- a/basis/syndication/syndication.factor +++ b/basis/syndication/syndication.factor @@ -81,7 +81,7 @@ TUPLE: entry title url description date ; [ { "content" "summary" } any-tag-named dup children>> [ string? not ] contains? - [ children>> [ write-xml-chunk ] with-string-writer ] + [ children>> xml>string ] [ children>string ] if >>description ] [ diff --git a/basis/xml/errors/errors.factor b/basis/xml/errors/errors.factor index df38724412..304b38f2bd 100644 --- a/basis/xml/errors/errors.factor +++ b/basis/xml/errors/errors.factor @@ -194,7 +194,7 @@ M: bad-prolog summary ( obj -- str ) [ dup call-next-method write "Misplaced XML prolog" print - prolog>> write-prolog nl + prolog>> write-xml nl ] with-string-writer ; TUPLE: capitalized-prolog < xml-error-at name ; @@ -258,7 +258,7 @@ M: misplaced-directive summary ( obj -- str ) [ dup call-next-method write "Misplaced directive:" print - dir>> write-xml-chunk nl + dir>> write-xml nl ] with-string-writer ; TUPLE: bad-name < xml-error-at name ; diff --git a/basis/xml/interpolate/interpolate-tests.factor b/basis/xml/interpolate/interpolate-tests.factor index 35c4e793ea..9be85a11e2 100644 --- a/basis/xml/interpolate/interpolate-tests.factor +++ b/basis/xml/interpolate/interpolate-tests.factor @@ -51,8 +51,8 @@ IN: xml.interpolate.tests false=<-> url=<-> string=<-> word=<->/> XML> pprint-xml>string ] unit-test -[ "3" ] [ 3 [XML <-> XML] xml-chunk>string ] unit-test -[ "" ] [ f [XML <-> XML] xml-chunk>string ] unit-test +[ "3" ] [ 3 [XML <-> XML] xml>string ] unit-test +[ "" ] [ f [XML <-> XML] xml>string ] unit-test \ parsed ] dip [ \ interpolate-xml parsed ] when ; inline diff --git a/basis/xml/tests/templating.factor b/basis/xml/tests/templating.factor index b35d7372e3..618e785d05 100644 --- a/basis/xml/tests/templating.factor +++ b/basis/xml/tests/templating.factor @@ -9,10 +9,10 @@ SYMBOL: ref-table GENERIC: (r-ref) ( xml -- ) M: tag (r-ref) - sub-tag over at* [ + dup sub-tag attr [ ref-table get at >>children drop - ] [ 2drop ] if ; + ] [ drop ] if* ; M: object (r-ref) drop ; : template ( xml -- ) diff --git a/basis/xml/tests/xmltest.factor b/basis/xml/tests/xmltest.factor index a6a28e15a3..a8024ce151 100644 --- a/basis/xml/tests/xmltest.factor +++ b/basis/xml/tests/xmltest.factor @@ -11,7 +11,7 @@ TUPLE: xml-test id uri sections description type ; [ "ID" attr >>id ] [ "URI" attr >>uri ] [ "SECTIONS" attr >>sections ] - [ children>> xml-chunk>string >>description ] + [ children>> xml>string >>description ] } cleave ; : parse-tests ( xml -- tests ) diff --git a/basis/xml/utilities/utilities.factor b/basis/xml/utilities/utilities.factor index 48cbeceb22..924ae56aa4 100644 --- a/basis/xml/utilities/utilities.factor +++ b/basis/xml/utilities/utilities.factor @@ -38,7 +38,7 @@ IN: xml.utilities tags@ swap [ tag-named? ] with filter ; : 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 ) assure-name '[ _ _ tag-with-attr? ] find nip ; diff --git a/basis/xml/writer/writer-docs.factor b/basis/xml/writer/writer-docs.factor index b470403e84..a26a7377fd 100644 --- a/basis/xml/writer/writer-docs.factor +++ b/basis/xml/writer/writer-docs.factor @@ -1,56 +1,41 @@ ! Copyright (C) 2005, 2009 Daniel Ehrenberg ! 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 ABOUT: "xml.writer" ARTICLE: "xml.writer" "Writing XML" - "These words are used in implementing prettyprint" - { $subsection write-xml-chunk } - "These words are used to print XML normally" - { $subsection xml>string } + "These words are used to print XML preserving whitespace in text nodes" { $subsection write-xml } + { $subsection xml>string } "These words are used to prettyprint XML" { $subsection pprint-xml>string } - { $subsection pprint-xml>string-but } { $subsection pprint-xml } - { $subsection pprint-xml-but } ; - -HELP: write-xml-chunk -{ $values { "object" "an XML element" } } -{ $description "writes an XML element to " { $link output-stream } "." } -{ $see-also write-xml-chunk write-xml } ; + "Certain variables can be changed to mainpulate prettyprinting" + { $subsection sensitive-tags } + { $subsection indenter } + "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." ; HELP: xml>string -{ $values { "xml" "an xml document" } { "string" "a string" } } -{ $description "converts an XML document into a string" } -{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ; +{ $values { "xml" "an XML document" } { "string" "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 "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 -{ $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." } -{ $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 { $values { "xml" "an XML document" } } { $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 { $values { "xml" "an XML document" } } { $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 -{ $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 +{ xml>string write-xml pprint-xml pprint-xml>string } related-words diff --git a/basis/xml/writer/writer-tests.factor b/basis/xml/writer/writer-tests.factor index dcf7f1023d..d09ae08b3f 100644 --- a/basis/xml/writer/writer-tests.factor +++ b/basis/xml/writer/writer-tests.factor @@ -7,7 +7,7 @@ IN: xml.writer.tests \ write-xml must-infer \ xml>string 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 { space "" } { main "foo" } } name>string ] unit-test @@ -51,11 +51,11 @@ IN: xml.writer.tests ]> &foo;"} pprint-reprints-as -[ t ] [ "" dup string>xml-chunk xml-chunk>string = ] unit-test +[ t ] [ "" dup string>xml-chunk xml>string = ] unit-test [ "" ] [ "" string>xml xml>string ] unit-test [ "bar baz" ] [ "bar" string>xml [ " baz" append ] map xml>string ] unit-test [ "\n\n bar\n" ] [ " bar " string>xml pprint-xml>string ] unit-test -[ "" ] [ "" xml-chunk>string ] unit-test +[ "" ] [ "" xml>string ] unit-test diff --git a/basis/xml/writer/writer.factor b/basis/xml/writer/writer.factor index 8e2dc4bfbf..600c9d233d 100644 --- a/basis/xml/writer/writer.factor +++ b/basis/xml/writer/writer.factor @@ -5,14 +5,15 @@ assocs combinators io io.streams.string accessors xml.data wrap xml.entities unicode.categories fry ; IN: xml.writer -SYMBOL: xml-pprint? SYMBOL: sensitive-tags -SYMBOL: indentation SYMBOL: indenter " " indenter set-global " write ; -M: contained-tag write-xml-chunk +M: contained-tag write-xml write-tag "/>" write ; : write-children ( tag -- ) indent children>> ?filter-children - [ write-xml-chunk ] each unindent ; + [ write-xml ] each unindent ; : write-end-tag ( tag -- ) ?indent " write1 ; -M: open-tag write-xml-chunk +M: open-tag write-xml xml-pprint? get [ { [ sensitive? not xml-pprint? get and xml-pprint? set ] @@ -98,110 +99,95 @@ M: open-tag write-xml-chunk } cleave ] dip xml-pprint? set ; -M: unescaped write-xml-chunk +M: unescaped write-xml string>> write ; -M: comment write-xml-chunk +M: comment write-xml "" write ; -M: element-decl write-xml-chunk - "> write " " write ] - [ content-spec>> write ">" write ] - bi ; +: write-decl ( decl name quot: ( decl -- slot ) -- ) + "> write bl ] + swap '[ @ write ">" write ] bi ; inline -M: attlist-decl write-xml-chunk - "> write " " write ] - [ att-defs>> write ">" write ] - bi ; +M: element-decl write-xml + "ELEMENT" [ content-spec>> ] write-decl ; -M: notation-decl write-xml-chunk - "> write " " write ] - [ id>> write ">" write ] - bi ; +M: attlist-decl write-xml + "ATTLIST" [ att-defs>> ] write-decl ; -M: entity-decl write-xml-chunk +M: notation-decl write-xml + "NOTATION" [ id>> ] write-decl ; + +M: entity-decl write-xml "> [ " % " write ] when ] [ name>> write " \"" write ] [ def>> f xml-pprint? - [ write-xml-chunk ] with-variable + [ write-xml ] with-variable "\">" write ] tri ; -M: system-id write-xml-chunk - "SYSTEM '" write system-literal>> write "'" write ; +M: system-id write-xml + "SYSTEM" write bl system-literal>> write-quoted ; -M: public-id write-xml-chunk - "PUBLIC '" write - [ pubid-literal>> write "' '" write ] - [ system-literal>> write "'" write ] bi ; +M: public-id write-xml + "PUBLIC" write bl + [ pubid-literal>> write-quoted bl ] + [ system-literal>> write-quoted ] bi ; : write-internal-subset ( dtd -- ) [ "[" write indent - directives>> [ ?indent write-xml-chunk ] each + directives>> [ ?indent write-xml ] each unindent ?indent "]" write ] when* ; -M: doctype-decl write-xml-chunk +M: doctype-decl write-xml ?indent "> write " " write ] - [ external-id>> [ write-xml-chunk " " write ] when* ] + [ external-id>> [ write-xml " " write ] when* ] [ internal-subset>> write-internal-subset ">" write ] tri ; -M: directive write-xml-chunk +M: directive write-xml "> write CHAR: > write1 nl ; -M: instruction write-xml-chunk +M: instruction write-xml "> write "?>" write ; -M: number write-xml-chunk +M: number write-xml "Numbers are not allowed in XML" throw ; -M: sequence write-xml-chunk - [ write-xml-chunk ] each ; +M: sequence write-xml + [ write-xml ] each ; -PRIVATE> +M: prolog write-xml + "> write-quoted ] + [ " encoding=" write encoding>> write-quoted ] + [ standalone>> [ " standalone=\"yes\"" write ] when ] tri + "?>" write ; -: write-prolog ( xml -- ) - "> write - "\" encoding=\"" write dup encoding>> write - standalone>> [ "\" standalone=\"yes" write ] when - "\"?>" write ; - -: write-xml ( xml -- ) +M: xml write-xml { - [ prolog>> write-prolog ] - [ before>> write-xml-chunk ] - [ body>> write-xml-chunk ] - [ after>> write-xml-chunk ] + [ prolog>> write-xml ] + [ before>> write-xml ] + [ body>> write-xml ] + [ after>> write-xml ] } cleave ; -M: xml write-xml-chunk - body>> write-xml-chunk ; +PRIVATE> : xml>string ( xml -- string ) [ write-xml ] with-string-writer ; -: xml-chunk>string ( object -- string ) - [ write-xml-chunk ] with-string-writer ; - -: pprint-xml-but ( xml sensitive-tags -- ) +: pprint-xml ( xml -- ) [ - [ assure-name ] map sensitive-tags set + sensitive-tags [ [ assure-name ] map ] change 0 indentation set xml-pprint? on write-xml ] 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 ) - f pprint-xml>string-but ; + [ pprint-xml ] with-string-writer ;