number ;
: number>euler ( n -- str )
- number>string string>digits 3 0 pad-left [ number>string ] map concat ;
+ number>string 3 CHAR: 0 pad-left ;
-: solution-path ( n -- str )
- number>euler dup [
- "project-euler" vocab-root ?resource-path %
- os "windows" = [
- "\\project-euler\\" % % "\\" % % ".factor" %
- ] [
- "/project-euler/" % % "/" % % ".factor" %
- ] if
- ] "" make ;
+: solution-path ( n -- str/f )
+ number>euler "project-euler." swap append vocab where
+ dup [ first ?resource-path ] when ;
PRIVATE>
: problem-solved? ( n -- ? )
- solution-path exists? ;
+ solution-path ;
: run-project-euler ( -- )
problem-prompt dup problem-solved? [
diff --git a/extra/shufflers/shufflers-tests.factor b/extra/shufflers/shufflers-tests.factor
index d59e18d0dc..5bcdab8068 100644
--- a/extra/shufflers/shufflers-tests.factor
+++ b/extra/shufflers/shufflers-tests.factor
@@ -1,7 +1,5 @@
USING: shufflers tools.test ;
-[ { 1 1 0 0 1 0 } ] [ BIN: 010011 2 6 translate ] unit-test
-
SHUFFLE: abcd 4
[ ] [ 1 2 3 4 abcd- ] unit-test
[ 1 2 1 2 ] [ 1 2 3 abc-abab ] unit-test
diff --git a/extra/xml/test/templating.factor b/extra/xml/test/templating.factor
index ca2d973510..0ee4ae51b0 100644
--- a/extra/xml/test/templating.factor
+++ b/extra/xml/test/templating.factor
@@ -40,4 +40,4 @@ M: object (r-ref) drop ;
sample-doc string>xml dup template xml>string
] with-scope ;
-[ "foo" ] [ test-refs ] unit-test
+[ "\n
foo" ] [ test-refs ] unit-test
diff --git a/extra/xml/test/test.factor b/extra/xml/test/test.factor
index 8c4757517d..80a508787e 100644
--- a/extra/xml/test/test.factor
+++ b/extra/xml/test/test.factor
@@ -26,7 +26,7 @@ SYMBOL: xml-file
] unit-test
[ V{ "fa&g" } ] [ xml-file get "x" get-id tag-children ] unit-test
[ "that" ] [ xml-file get "this" swap at ] unit-test
-[ "" ]
+[ "\n" ]
[ "" string>xml xml>string ] unit-test
[ "abcd" ] [
"abcd" string>xml
@@ -44,5 +44,7 @@ SYMBOL: xml-file
at swap "z" >r tuck r> swap set-at
T{ name f "blah" "z" f } swap at ] unit-test
[ "foo" ] [ "" string>xml children>string ] unit-test
-[ "bar baz" ]
+[ "\nbar baz" ]
[ "bar" string>xml [ " baz" append ] map xml>string ] unit-test
+[ "\n\n bar\n" ]
+[ " bar " string>xml pprint-xml>string ] unit-test
diff --git a/extra/xml/writer/writer.factor b/extra/xml/writer/writer.factor
index b0b707fd42..7bd1cc3046 100644
--- a/extra/xml/writer/writer.factor
+++ b/extra/xml/writer/writer.factor
@@ -4,18 +4,60 @@ USING: hashtables kernel math namespaces sequences strings
io io.streams.string xml.data assocs ;
IN: xml.writer
-: write-entities
+SYMBOL: xml-pprint?
+SYMBOL: sensitive-tags
+SYMBOL: indentation
+SYMBOL: indenter
+" " indenter set-global
+
+: sensitive? ( tag -- ? )
+ sensitive-tags get swap [ names-match? ] curry contains? ;
+
+: ?indent ( -- )
+ xml-pprint? get [
+ nl indentation get indenter get [ write ] each
+ ] when ;
+
+: indent ( -- )
+ xml-pprint? get [ 1 indentation +@ ] when ;
+
+: unindent ( -- )
+ xml-pprint? get [ -1 indentation +@ ] when ;
+
+: trim-whitespace ( string -- no-whitespace )
+ [ [ blank? not ] find drop 0 or ] keep
+ [ [ blank? not ] find-last drop [ 1+ ] [ 0 ] if* ] keep
+ subseq ;
+
+: ?filter-children ( children -- no-whitespace )
+ xml-pprint? get [
+ [ dup string? [ trim-whitespace ] when ] map
+ [ dup empty? swap string? and not ] subset
+ ] when ;
+
+: entities-out
H{
{ CHAR: < "<" }
{ CHAR: > ">" }
{ CHAR: & "&" }
+ } ;
+
+: quoted-entities-out
+ H{
+ { CHAR: & "&" }
{ CHAR: ' "'" }
{ CHAR: " """ }
} ;
-: chars>entities ( str -- str )
+: escape-string-by ( str table -- escaped )
#! Convert <, >, &, ' and " to HTML entities.
- [ [ dup write-entities at [ % ] [ , ] ?if ] each ] "" make ;
+ [ [ dupd at [ % ] [ , ] ?if ] curry each ] "" make ;
+
+: escape-string ( str -- newstr )
+ entities-out escape-string-by ;
+
+: escape-quoted-string ( str -- newstr )
+ quoted-entities-out escape-string-by ;
: print-name ( name -- )
dup name-space f like
@@ -27,27 +69,35 @@ IN: xml.writer
" " write
swap print-name
"=\"" write
- chars>entities write
+ escape-quoted-string write
"\"" write
] assoc-each ;
GENERIC: write-item ( object -- )
M: string write-item
- chars>entities write ;
+ escape-string write ;
+
+: write-tag ( tag -- )
+ CHAR: < write1
+ dup print-name tag-attrs print-attrs ;
M: contained-tag write-item
- CHAR: < write1
- dup print-name tag-attrs print-attrs
- "/>" write ;
+ write-tag "/>" write ;
+
+: write-children ( tag -- )
+ indent tag-children ?filter-children
+ [ ?indent write-item ] each unindent ;
+
+: write-end-tag ( tag -- )
+ ?indent " write1 ;
M: open-tag write-item
- CHAR: < write1
- dup print-name
- dup tag-attrs print-attrs
- CHAR: > write1
- dup tag-children [ write-item ] each
- " write1 ;
+ xml-pprint? [ [
+ over sensitive? not and xml-pprint? set
+ dup write-tag CHAR: > write1
+ dup write-children write-end-tag
+ ] keep ] change ;
M: comment write-item
"" write ;
@@ -62,7 +112,7 @@ M: instruction write-item
"" write ;
+ "\"?>\n" write ;
: write-chunk ( seq -- )
[ write-item ] each ;
@@ -79,3 +129,22 @@ M: instruction write-item
: xml>string ( xml -- string )
[ write-xml ] string-out ;
+: with-xml-pprint ( sensitive-tags quot -- )
+ [
+ swap [ assure-name ] map sensitive-tags set
+ 0 indentation set
+ xml-pprint? on
+ call
+ ] with-scope ; inline
+
+: pprint-xml-but ( xml sensitive-tags -- )
+ [ print-xml ] with-xml-pprint ;
+
+: pprint-xml ( xml -- )
+ f pprint-xml-but ;
+
+: pprint-xml>string-but ( xml sensitive-tags -- string )
+ [ xml>string ] with-xml-pprint ;
+
+: pprint-xml>string ( xml -- string )
+ f pprint-xml>string-but ;
diff --git a/extra/xml/xml-docs.factor b/extra/xml/xml-docs.factor
index e1c4d035fd..785538332a 100644
--- a/extra/xml/xml-docs.factor
+++ b/extra/xml/xml-docs.factor
@@ -7,14 +7,29 @@ strings sequences io ;
HELP: string>xml
{ $values { "string" "a string" } { "xml" "an xml document" } }
{ $description "converts a string into an " { $link xml }
- " datatype for further processing" }
-{ $see-also xml>string xml-reprint } ;
+ " datatype for further processing" } ;
+
+HELP: read-xml
+{ $values { "stream" "a stream that supports readln" }
+ { "xml" "an XML document" } }
+{ $description "exausts the given stream, reading an XML document from it" } ;
+
+HELP: file>xml
+{ $values { "filename" "a string representing a filename" }
+ { "xml" "an XML document" } }
+{ $description "opens the given file, reads it in as XML, closes the file and returns the corresponding XML tree" } ;
+
+{ string>xml read-xml file>xml } related-words
HELP: xml>string
{ $values { "xml" "an xml document" } { "string" "a string" } }
{ $description "converts an xml document (" { $link xml } ") into a string" }
-{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" }
-{ $see-also string>xml xml-reprint write-xml } ;
+{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ;
+
+HELP: pprint-xml>string
+{ $values { "xml" "an xml document" } { "string" "a string" } }
+{ $description "converts an xml document (" { $link xml } ") 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" } ;
HELP: xml-parse-error
{ $class-description "the exception class that all parsing errors in XML documents are in." } ;
@@ -22,20 +37,34 @@ HELP: xml-parse-error
HELP: xml-reprint
{ $values { "string" "a string of XML" } }
{ $description "parses XML and prints it out again, for testing purposes" }
-{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" }
-{ $see-also write-xml xml>string string>xml } ;
+{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ;
HELP: write-xml
{ $values { "xml" "an XML document" } }
{ $description "prints the contents of an XML document (" { $link xml } ") to stdio" }
-{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" }
-{ $see-also xml>string xml-reprint read-xml } ;
+{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ;
-HELP: read-xml
-{ $values { "stream" "a stream that supports readln" }
- { "xml" "an XML document" } }
-{ $description "exausts the given stream, reading an XML document from it" }
-{ $see-also write-xml string>xml } ;
+HELP: print-xml
+{ $values { "xml" "an XML document" } }
+{ $description "prints the contents of an XML document (" { $link xml } ") to stdio, followed by a newline" }
+{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ;
+
+HELP: pprint-xml
+{ $values { "xml" "an XML document" } }
+{ $description "prints the contents of an XML document (" { $link xml } ") to stdio in a prettyprinted form." }
+{ $notes "does not preserve what type of quotes were used or what data was omitted from version declaration" } ;
+
+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 print-xml write-xml pprint-xml xml-reprint pprint-xml>string pprint-xml>string-but pprint-xml-but } related-words
HELP: PROCESS:
{ $syntax "PROCESS: word" }
@@ -318,26 +347,27 @@ HELP: with-html-entities
{ $description "calls the given quotation using HTML entity values" }
{ $see-also html-entities with-entities } ;
-HELP: file>xml
-{ $values { "filename" "a string representing a filename" }
- { "xml" "an XML document" } }
-{ $description "opens the given file, reads it in as XML, closes the file and returns the corresponding XML tree" }
-{ $see-also string>xml read-xml } ;
-
-ARTICLE: { "xml" "basic" } "Basic words for XML processing"
- "These are the most basic words needed for processing an XML document"
- $nl
- "Parsing XML:"
+ARTICLE: { "xml" "reading" } "Reading XML"
+ "The following words are used to read something into an XML document"
{ $subsection string>xml }
{ $subsection read-xml }
{ $subsection xml-chunk }
- { $subsection file>xml }
- "Printing XML"
- { $subsection xml>string }
- { $subsection write-xml }
+ { $subsection file>xml } ;
+
+ARTICLE: { "xml" "writing" } "Writing XML"
+ "These words are used in implementing prettyprint"
{ $subsection write-item }
{ $subsection write-chunk }
- "Other"
+ "These words are used to print XML normally"
+ { $subsection xml>string }
+ { $subsection write-xml }
+ { $subsection print-xml }
+ "These words are used to prettyprint XML"
+ { $subsection pprint-xml>string }
+ { $subsection pprint-xml>string-but }
+ { $subsection pprint-xml }
+ { $subsection pprint-xml-but }
+ "This word reads and writes XML"
{ $subsection xml-reprint } ;
ARTICLE: { "xml" "classes" } "XML data classes"
@@ -433,7 +463,8 @@ ARTICLE: { "xml" "intro" } "XML"
"The XML module attempts to implement the XML 1.1 standard, converting strings of text into XML and vice versa. It currently is a work in progress."
$nl
"The XML module was implemented by Daniel Ehrenberg, with contributions from the Factor community"
- { $subsection { "xml" "basic" } }
+ { $subsection { "xml" "reading" } }
+ { $subsection { "xml" "writing" } }
{ $subsection { "xml" "classes" } }
{ $subsection { "xml" "construct" } }
{ $subsection { "xml" "utils" } }