continuations hashtables
hashtables.private io kernel math
namespaces prettyprint quotations sequences splitting
-state-parser strings ;
+strings ;
IN: html.parser.printer
SYMBOL: no-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 -- )
tag-text write
"-->" write ;
-M: printer print-dtd-tag
+M: printer print-dtd-tag ( tag -- )
"<!" write
tag-text write
">" write ;
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 -- )
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 -- )
{
[ 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 } } } [
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?
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 ;
[ 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 ;
dup quoted? [ but-last-slice rest-slice >string ] when ;
: quote? ( ch -- ? ) "'\"" member? ;
-