extra/html/parser/printer/printer.factor

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