extra/html/parser/printer/printer.factor

   1 USING: accessors assocs combinators html.parser
   2 html.parser.utils io io.streams.string kernel math namespaces
   3 regexp sequences strings unicode ;
   4 IN: html.parser.printer
   5
   6 SYMBOL: indentation "  " indentation set-global
   7 SYMBOL: #indentations
   8
   9 : indent ( -- )
  10     #indentations get indentation get '[ _ write ] times ;
  11
  12 TUPLE: html-printer ;
  13 TUPLE: text-printer < html-printer ;
  14 TUPLE: src-printer < html-printer ;
  15 TUPLE: html-prettyprinter < html-printer ;
  16
  17 HOOK: print-text-tag html-printer ( tag -- )
  18 HOOK: print-comment-tag html-printer ( tag -- )
  19 HOOK: print-dtd-tag html-printer ( tag -- )
  20 HOOK: print-opening-tag html-printer ( tag -- )
  21 HOOK: print-closing-tag html-printer ( tag -- )
  22
  23 ERROR: unknown-tag-error tag ;
  24
  25 : print-tag ( tag -- )
  26     {
  27         { [ dup name>> text = ] [ print-text-tag ] }
  28         { [ dup name>> comment = ] [ print-comment-tag ] }
  29         { [ dup name>> dtd = ] [ print-dtd-tag ] }
  30         { [ dup name>> string? ]
  31             [
  32                 dup closing?>>
  33                 [ print-closing-tag ] [ print-opening-tag ] if
  34             ]
  35         }
  36         [ unknown-tag-error ]
  37     } cond ;
  38
  39 : print-tags ( vector -- )
  40     0 #indentations [ [ print-tag ] each ] with-variable ;
  41
  42 : html-text. ( vector -- )
  43     T{ text-printer } html-printer [ print-tags ] with-variable ;
  44
  45 : html-text ( vector -- string )
  46     [ html-text. ] with-string-writer ;
  47
  48 : html-src. ( vector -- )
  49     T{ src-printer } html-printer [ print-tags ] with-variable ;
  50
  51 : html-src ( vector -- string )
  52     [ html-src. ] with-string-writer ;
  53
  54 SYMBOLS: preformatted? script? style? ;
  55
  56 M: text-printer print-opening-tag
  57     name>> {
  58         { "br" [ nl indent ] }
  59         { "ol" [ nl indent ] }
  60         { "ul" [ nl indent ] }
  61         { "li" [ " * " write ] }
  62         { "blockquote" [ #indentations inc indent ] }
  63         { "pre" [ preformatted? on ] }
  64         { "script" [ script? on ] }
  65         { "style" [ style? on ] }
  66         [ drop ]
  67     } case ;
  68
  69 M: text-printer print-closing-tag
  70     name>> {
  71         [ "blockquote" = [ #indentations dec ] when ]
  72         [
  73             { "p" "blockquote" "h1" "h2" "h3" "h4" "h5" }
  74             member? [ nl indent nl indent ] when
  75         ]
  76         [
  77             { "ul" "ol" "li" "tr" } member? [ nl indent ] when
  78         ]
  79         [ { "th" "td" } member? [ bl ] when ]
  80         [ "pre" = [ preformatted? off ] when ]
  81         [ "script" = [ script? off ] when ]
  82         [ "style" = [ style? off ] when ]
  83     } cleave ;
  84
  85 M: text-printer print-comment-tag drop ;
  86
  87 M: text-printer print-dtd-tag drop ;
  88
  89 : collapse-spaces ( text -- text' )
  90     preformatted? get [ R/ \s+/ " " re-replace ] unless ;
  91
  92 M: text-printer print-text-tag
  93     script? get style? get or
  94     [ drop ] [ text>> collapse-spaces write ] if ;
  95
  96 M: html-printer print-text-tag
  97     text>> write ;
  98
  99 M: html-printer print-comment-tag
 100     "<!--" write text>> write "-->" write ;
 101
 102 M: html-printer print-dtd-tag
 103     "<!" write text>> write ">" write ;
 104
 105 : print-attributes ( hashtable -- )
 106     [ [ bl write "=" write ] [ ?quote write ] bi* ] assoc-each ;
 107
 108 M: src-printer print-opening-tag
 109     "<" write
 110     [ name>> write ] [ attributes>> print-attributes ] bi
 111     ">" write ;
 112
 113 M: src-printer print-closing-tag
 114     "</" write name>> write ">" write ;
 115
 116 : prettyprint-html ( vector -- )
 117     T{ html-prettyprinter } html-printer [ print-tags ] with-variable ;
 118
 119 M: html-prettyprinter print-opening-tag
 120     name>>
 121     [ indent "<" write write ">\n" write ]
 122     ! These tags usually don't have any closing tag associated with them.
 123     [ { "br" "img" } member? [ #indentations inc ] unless ] bi ;
 124
 125 M: html-prettyprinter print-closing-tag
 126     ! These tags usually don't have any closing tag associated with them.
 127     [ { "br" "img" } member? [ #indentations dec ] unless ]
 128     [ indent "</" write name>> write ">\n" write ] bi ;
 129
 130 M: html-prettyprinter print-text-tag
 131     text>> [ blank? ] trim [ indent write "\n" write ] unless-empty ;