clean up html parser prettyprinter a bit

db4
Doug Coleman 2008-06-08 16:33:07 -05:00
parent 3a941a2b65
commit a0dbee6e2a
2 changed files with 36 additions and 22 deletions

View File

@ -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 } } } [

View File

@ -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? ;