From a0dbee6e2a2c26e24f5a5d9ca492a684ab3d2ddf Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Jun 2008 16:33:07 -0500
Subject: [PATCH] clean up html parser prettyprinter a bit

---
 extra/html/parser/printer/printer.factor | 47 +++++++++++++++++-------
 extra/html/parser/utils/utils.factor     | 11 ++----
 2 files changed, 36 insertions(+), 22 deletions(-)

diff --git a/extra/html/parser/printer/printer.factor b/extra/html/parser/printer/printer.factor
index 3078cf23a5..d352a97688 100644
--- a/extra/html/parser/printer/printer.factor
+++ b/extra/html/parser/printer/printer.factor
@@ -2,7 +2,7 @@ USING: assocs html.parser html.parser.utils combinators
 continuations hashtables
 hashtables.private io kernel math
 namespaces prettyprint quotations sequences splitting
-state-parser strings ;
+strings ;
 IN: html.parser.printer
 
 SYMBOL: no-section
@@ -16,7 +16,8 @@ TUPLE: state section ;
 TUPLE: text-printer ;
 TUPLE: ui-printer ;
 TUPLE: src-printer ;
-UNION: printer text-printer ui-printer src-printer ;
+TUPLE: html-prettyprinter ;
+UNION: printer text-printer ui-printer src-printer html-prettyprinter ;
 HOOK: print-tag printer ( tag -- )
 HOOK: print-text-tag printer ( tag -- )
 HOOK: print-comment-tag printer ( tag -- )
@@ -47,7 +48,7 @@ M: printer print-comment-tag ( tag -- )
     tag-text write
     "-->" write ;
 
-M: printer print-dtd-tag
+M: printer print-dtd-tag ( tag -- )
     "<!" write
     tag-text write
     ">" write ;
@@ -70,8 +71,8 @@ M: printer print-closing-named-tag ( tag -- )
 
 M: src-printer print-opening-named-tag ( tag -- )
     "<" write
-    dup tag-name write
-    tag-attributes dup assoc-empty? [ drop ] [ print-attributes ] if
+    [ tag-name write ]
+    [ tag-attributes dup assoc-empty? [ drop ] [ print-attributes ] if ] bi
     ">" write ;
 
 M: src-printer print-closing-named-tag ( tag -- )
@@ -79,9 +80,30 @@ M: src-printer print-closing-named-tag ( tag -- )
     tag-name write
     ">" write ;
 
-TUPLE: unknown-tag-error tag ;
+SYMBOL: tab-width
+SYMBOL: #indentations
 
-C: <unknown-tag-error> unknown-tag-error
+: html-pp ( vector -- )
+    [
+        0 #indentations set
+        2 tab-width set
+        
+    ] with-scope ;
+
+: print-tabs ( -- )
+    tab-width get #indentations get * CHAR: \s <repetition> write ; 
+
+M: html-prettyprinter print-opening-named-tag ( tag -- )
+    print-tabs "<" write
+    tag-name write
+    ">\n" write ;
+
+M: html-prettyprinter print-closing-named-tag ( tag -- )
+    "</" write
+    tag-name write
+    ">" write ;
+
+ERROR: unknown-tag-error tag ;
 
 M: printer print-tag ( tag -- )
     {
@@ -92,15 +114,12 @@ M: printer print-tag ( tag -- )
             [ print-closing-named-tag ] }
         { [ dup tag-name string? ]
             [ print-opening-named-tag ] }
-        [ <unknown-tag-error> throw ]
+        [ unknown-tag-error ]
     } cond ;
 
-SYMBOL: tablestack
-
-: with-html-printer
-    [
-        V{ } clone tablestack set
-    ] with-scope ;
+! SYMBOL: tablestack
+! : with-html-printer ( vector quot -- )
+    ! [ V{ } clone tablestack set ] with-scope ;
 
 ! { { 1 2 } { 3 4 } }
 ! H{ { table-gap { 10 10 } } } [
diff --git a/extra/html/parser/utils/utils.factor b/extra/html/parser/utils/utils.factor
index 5083b1cec2..592503e3dd 100644
--- a/extra/html/parser/utils/utils.factor
+++ b/extra/html/parser/utils/utils.factor
@@ -1,7 +1,7 @@
 USING: assocs circular combinators continuations hashtables
 hashtables.private io kernel math
 namespaces prettyprint quotations sequences splitting
-state-parser strings ;
+state-parser strings sequences.lib ;
 IN: html.parser.utils
 
 : string-parse-end?
@@ -13,7 +13,7 @@ IN: html.parser.utils
     dup length rot length 1- - head next* ;
 
 : trim1 ( seq ch -- newseq )
-    [ ?head drop ] keep ?tail drop ;
+    [ ?head drop ] [ ?tail drop ] bi ;
 
 : single-quote ( str -- newstr )
     >r "'" r> "'" 3append ;
@@ -26,11 +26,7 @@ IN: html.parser.utils
     [ double-quote ] [ single-quote ] if ;
 
 : quoted? ( str -- ? )
-    dup length 1 > [
-        [ first ] keep peek [ = ] keep "'\"" member? and
-    ] [
-        drop f
-    ] if ;
+    [ [ first ] [ peek ] bi [ = ] keep "'\"" member? and ] [ f ] if-seq ;
 
 : ?quote ( str -- newstr )
     dup quoted? [ quote ] unless ;
@@ -39,4 +35,3 @@ IN: html.parser.utils
     dup quoted? [ but-last-slice rest-slice >string ] when ;
 
 : quote? ( ch -- ? ) "'\"" member? ;
-