From 99172b6f79132e840719adae02489162228f02c7 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <ehrenbed@carleton.edu>
Date: Wed, 30 Jan 2008 15:03:02 -0600
Subject: [PATCH] Changes in XML prettyprinter

---
 extra/xml/entities/entities.factor | 26 +++++++++++++++++-
 extra/xml/writer/writer.factor     | 42 +++++++-----------------------
 2 files changed, 35 insertions(+), 33 deletions(-)

diff --git a/extra/xml/entities/entities.factor b/extra/xml/entities/entities.factor
index a52f5be3dc..b90613ec79 100644
--- a/extra/xml/entities/entities.factor
+++ b/extra/xml/entities/entities.factor
@@ -1,8 +1,32 @@
 ! Copyright (C) 2005, 2006 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces kernel ;
+USING: namespaces kernel assocs sequences ;
 IN: xml.entities
 
+: entities-out
+    H{
+        { CHAR: < "&lt;"   }
+        { CHAR: > "&gt;"   }
+        { CHAR: & "&amp;"  }
+    } ;
+
+: quoted-entities-out
+    H{
+        { CHAR: & "&amp;"  }
+        { CHAR: ' "&apos;" }
+        { CHAR: " "&quot;" }
+    } ;
+
+: escape-string-by ( str table -- escaped )
+    #! Convert <, >, &, ' and " to HTML entities.
+    [ [ 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 ;
+
 : entities
     H{
         { "lt"    CHAR: <  }
diff --git a/extra/xml/writer/writer.factor b/extra/xml/writer/writer.factor
index 7bd1cc3046..f943f24ccd 100644
--- a/extra/xml/writer/writer.factor
+++ b/extra/xml/writer/writer.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: hashtables kernel math namespaces sequences strings
-io io.streams.string xml.data assocs ;
+io io.streams.string xml.data assocs wrap xml.entities ;
 IN: xml.writer
 
 SYMBOL: xml-pprint?
@@ -13,10 +13,11 @@ SYMBOL: indenter
 : sensitive? ( tag -- ? )
     sensitive-tags get swap [ names-match? ] curry contains? ;
 
+: indent-string ( -- string )
+    indentation get indenter get <repetition> concat ;
+
 : ?indent ( -- )
-    xml-pprint? get [
-        nl indentation get indenter get <repetition> [ write ] each
-    ] when ;
+    xml-pprint? get [ nl indent-string write ] when ;
 
 : indent ( -- )
     xml-pprint? get [ 1 indentation +@ ] when ;
@@ -35,30 +36,6 @@ SYMBOL: indenter
         [ dup empty? swap string? and not ] subset
     ] when ;
 
-: entities-out
-    H{
-        { CHAR: < "&lt;"   }
-        { CHAR: > "&gt;"   }
-        { CHAR: & "&amp;"  }
-    } ;
-
-: quoted-entities-out
-    H{
-        { CHAR: & "&amp;"  }
-        { CHAR: ' "&apos;" }
-        { CHAR: " "&quot;" }
-    } ;
-
-: escape-string-by ( str table -- escaped )
-    #! Convert <, >, &, ' and " to HTML entities.
-    [ [ 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
     [ write CHAR: : write1 ] when*
@@ -76,10 +53,11 @@ SYMBOL: indenter
 GENERIC: write-item ( object -- )
 
 M: string write-item
-    escape-string write ;
+    escape-string xml-pprint? over empty? not and
+    [ nl 80 indent-string indented-break ] when write ;
 
 : write-tag ( tag -- )
-    CHAR: < write1
+    ?indent CHAR: < write1
     dup print-name tag-attrs print-attrs ;
 
 M: contained-tag write-item
@@ -87,7 +65,7 @@ M: contained-tag write-item
 
 : write-children ( tag -- )
     indent tag-children ?filter-children
-    [ ?indent write-item ] each unindent ;
+    [ write-item ] each unindent ;
 
 : write-end-tag ( tag -- )
     ?indent "</" write print-name CHAR: > write1 ;
@@ -112,7 +90,7 @@ M: instruction write-item
     "<?xml version=\"" write dup prolog-version write
     "\" encoding=\"" write dup prolog-encoding write
     prolog-standalone [ "\" standalone=\"yes" write ] when
-    "\"?>\n" write ;
+    "\"?>" write ;
 
 : write-chunk ( seq -- )
     [ write-item ] each ;