extra/html/parser/printer/printer.factor

   1 USING: accessors assocs html.parser html.parser.utils combinators
   2 continuations hashtables
   3 hashtables.private io kernel math
   4 namespaces prettyprint quotations sequences splitting
   5 strings ;
   6 IN: html.parser.printer
   7
   8 SYMBOL: printer
   9
  10 TUPLE: html-printer ;
  11 TUPLE: text-printer < html-printer ;
  12 TUPLE: src-printer < html-printer ;
  13 TUPLE: html-prettyprinter < html-printer ;
  14
  15 HOOK: print-text-tag html-printer ( tag -- )
  16 HOOK: print-comment-tag html-printer ( tag -- )
  17 HOOK: print-dtd-tag html-printer ( tag -- )
  18 HOOK: print-opening-tag html-printer ( tag -- )
  19 HOOK: print-closing-tag html-printer ( tag -- )
  20
  21 ERROR: unknown-tag-error tag ;
  22
  23 : print-tag ( tag -- )
  24     {
  25         { [ dup name>> text = ] [ print-text-tag ] }
  26         { [ dup name>> comment = ] [ print-comment-tag ] }
  27         { [ dup name>> dtd = ] [ print-dtd-tag ] }
  28         { [ dup [ name>> string? ] [ closing?>> ] bi and ]
  29             [ print-closing-tag ] }
  30         { [ dup name>> string? ]
  31             [ print-opening-tag ] }
  32         [ unknown-tag-error ]
  33     } cond ;
  34
  35 : print-tags ( vector -- ) [ print-tag ] each ;
  36
  37 : html-text. ( vector -- )
  38     T{ text-printer } html-printer [ print-tags ] with-variable ;
  39
  40 : html-src. ( vector -- )
  41     T{ src-printer } html-printer [ print-tags ] with-variable ;
  42
  43 M: html-printer print-text-tag ( tag -- ) text>> write ;
  44
  45 M: html-printer print-comment-tag ( tag -- )
  46     "<!--" write text>> write "-->" write ;
  47
  48 M: html-printer print-dtd-tag ( tag -- )
  49     "<!" write text>> write ">" write ;
  50
  51 : print-attributes ( hashtable -- )
  52     [ [ bl write "=" write ] [ ?quote write ] bi* ] assoc-each ;
  53
  54 M: src-printer print-opening-tag ( tag -- )
  55     "<" write
  56     [ name>> write ]
  57     [ attributes>> dup assoc-empty? [ drop ] [ print-attributes ] if ] bi
  58     ">" write ;
  59
  60 M: src-printer print-closing-tag ( tag -- )
  61     "</" write
  62     name>> write
  63     ">" write ;
  64
  65 SYMBOL: tab-width
  66 SYMBOL: #indentations
  67 SYMBOL: tagstack
  68
  69 : prettyprint-html ( vector -- )
  70     [
  71         T{ html-prettyprinter } printer set
  72         V{ } clone tagstack set
  73         2 tab-width set
  74         0 #indentations set
  75         print-tags
  76     ] with-scope ;
  77
  78 : print-tabs ( -- )
  79     tab-width get #indentations get * CHAR: \s <repetition> write ;
  80
  81 M: html-prettyprinter print-opening-tag ( tag -- )
  82     print-tabs "<" write
  83     name>> write
  84     ">\n" write ;
  85
  86 M: html-prettyprinter print-closing-tag ( tag -- )
  87     "</" write
  88     name>> write
  89     ">" write ;