extra/html/parser/printer/printer.factor

   1 USING: accessors assocs combinators fry html.parser
   2 html.parser.utils io io.streams.string kernel math namespaces
   3 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 M: text-printer print-opening-tag
  55     name>> {
  56         { "br" [ nl indent ] }
  57         ! { "ol" [ nl indent ] }
  58         ! { "ul" [ nl indent ] }
  59         { "li" [ " * " write ] }
  60         { "blockquote" [ #indentations inc indent ] }
  61         [ drop ]
  62     } case ;
  63
  64 M: text-printer print-closing-tag
  65     name>> {
  66         [ "blockquote" = [ #indentations dec ] when ]
  67         [
  68             { "p" "blockquote" "h1" "h2" "h3" "h4" "h5" }
  69             member? [ nl indent nl indent ] when
  70         ]
  71         [
  72             { "ul" "ol" "li" "tr" } member? [ nl indent ] when
  73         ]
  74         [ "td" = [ bl ] when ]
  75     } cleave ;
  76
  77 M: text-printer print-comment-tag drop ;
  78
  79 M: html-printer print-text-tag ( tag -- )
  80     text>> write ;
  81
  82 M: html-printer print-comment-tag ( tag -- )
  83     "<!--" write text>> write "-->" write ;
  84
  85 M: html-printer print-dtd-tag ( tag -- )
  86     "<!" write text>> write ">" write ;
  87
  88 : print-attributes ( hashtable -- )
  89     [ [ bl write "=" write ] [ ?quote write ] bi* ] assoc-each ;
  90
  91 M: src-printer print-opening-tag ( tag -- )
  92     "<" write
  93     [ name>> write ] [ attributes>> print-attributes ] bi
  94     ">" write ;
  95
  96 M: src-printer print-closing-tag ( tag -- )
  97     "</" write name>> write ">" write ;
  98
  99 : prettyprint-html ( vector -- )
 100     T{ html-prettyprinter } html-printer [ print-tags ] with-variable ;
 101
 102 M: html-prettyprinter print-opening-tag ( tag -- )
 103     name>>
 104     [ indent "<" write write ">\n" write ]
 105     ! These tags usually don't have any closing tag associated with them.
 106     [ { "br" "img" } member? [ #indentations inc ] unless ] bi ;
 107
 108 M: html-prettyprinter print-closing-tag ( tag -- )
 109     ! These tags usually don't have any closing tag associated with them.
 110     [ { "br" "img" } member? [ #indentations dec ] unless ]
 111     [ indent "</" write name>> write ">\n" write ] bi ;
 112
 113 M: html-prettyprinter print-text-tag ( tag -- )
 114     text>> [ blank? ] trim [ indent write "\n" write ] unless-empty ;