extra/html/elements/elements.factor

   1 ! cont-html v0.6
   2 !
   3 ! Copyright (C) 2004 Chris Double.
   4 ! See http://factorcode.org/license.txt for BSD license.
   5
   6 USING: io kernel namespaces prettyprint quotations
   7 sequences strings words xml.entities compiler.units effects ;
   8
   9 IN: html.elements
  10
  11 ! These words are used to provide a means of writing
  12 ! formatted HTML to standard output with a familiar 'html' look
  13 ! and feel in the code.
  14 !
  15 ! HTML tags can be used in a number of different ways. The highest
  16 ! level involves a similar syntax to HTML:
  17 !
  18 ! <p> "someoutput" write </p>
  19 !
  20 ! <p> will output the opening tag and </p> will output the closing
  21 ! tag with no attributes.
  22 !
  23 ! <p "red" =class p> "someoutput" write </p>
  24 !
  25 ! This time the opening tag does not have the '>'. It pushes
  26 ! a namespace on the stack to hold the attributes and values.
  27 ! Any attribute words used will store the attribute and values
  28 ! in that namespace. Before the attribute word should come the
  29 ! value of that attribute.
  30 ! The finishing word will print out the operning tag including
  31 ! attributes.
  32 ! Any writes after this will appear after the opening tag.
  33 !
  34 ! Values for attributes can be used directly without any stack
  35 ! operations:
  36 !
  37 ! (url -- )
  38 ! <a =href a> "Click me" write </a>
  39 !
  40 ! (url -- )
  41 ! <a "http://" prepend =href a> "click" write </a>
  42 !
  43 ! (url -- )
  44 ! <a [ "http://" % % ] "" make =href a> "click" write </a>
  45 !
  46 ! Tags that have no 'closing' equivalent have a trailing tag/> form:
  47 !
  48 ! <input "text" =type "name" =name "20" =size input/>
  49
  50 : elements-vocab ( -- vocab-name ) "html.elements" ;
  51
  52 SYMBOL: html
  53
  54 : write-html ( str -- )
  55     H{ { html t } } format ;
  56
  57 : print-html ( str -- )
  58     write-html "\n" write-html ;
  59
  60 : html-word ( name def effect -- )
  61     #! Define 'word creating' word to allow
  62     #! dynamically creating words.
  63     >r >r elements-vocab create r> r> define-declared ;
  64
  65 : <foo> "<" swap ">" 3append ;
  66
  67 : empty-effect T{ effect f 0 0 } ;
  68
  69 : def-for-html-word-<foo> ( name -- )
  70     #! Return the name and code for the <foo> patterned
  71     #! word.
  72     dup <foo> swap [ <foo> write-html ] curry
  73     empty-effect html-word ;
  74
  75 : <foo "<" prepend ;
  76
  77 : def-for-html-word-<foo ( name -- )
  78     #! Return the name and code for the <foo patterned
  79     #! word.
  80     <foo dup [ write-html ] curry
  81     empty-effect html-word ;
  82
  83 : foo> ">" append ;
  84
  85 : def-for-html-word-foo> ( name -- )
  86     #! Return the name and code for the foo> patterned
  87     #! word.
  88     foo> [ ">" write-html ] empty-effect html-word ;
  89
  90 : </foo> "</" swap ">" 3append ;
  91
  92 : def-for-html-word-</foo> ( name -- )
  93     #! Return the name and code for the </foo> patterned
  94     #! word.
  95     </foo> dup [ write-html ] curry empty-effect html-word ;
  96
  97 : <foo/> "<" swap "/>" 3append ;
  98
  99 : def-for-html-word-<foo/> ( name -- )
 100     #! Return the name and code for the <foo/> patterned
 101     #! word.
 102     dup <foo/> swap [ <foo/> write-html ] curry
 103     empty-effect html-word ;
 104
 105 : foo/> "/>" append ;
 106
 107 : def-for-html-word-foo/> ( name -- )
 108     #! Return the name and code for the foo/> patterned
 109     #! word.
 110     foo/> [ "/>" write-html ] empty-effect html-word ;
 111
 112 : define-closed-html-word ( name -- )
 113     #! Given an HTML tag name, define the words for
 114     #! that closable HTML tag.
 115     dup def-for-html-word-<foo>
 116     dup def-for-html-word-<foo
 117     dup def-for-html-word-foo>
 118     def-for-html-word-</foo> ;
 119
 120 : define-open-html-word ( name -- )
 121     #! Given an HTML tag name, define the words for
 122     #! that open HTML tag.
 123     dup def-for-html-word-<foo/>
 124     dup def-for-html-word-<foo
 125     def-for-html-word-foo/> ;
 126
 127 : write-attr ( value name -- )
 128     " " write-html
 129     write-html
 130     "='" write-html
 131     escape-quoted-string write-html
 132     "'" write-html ;
 133
 134 : attribute-effect T{ effect f { "string" } 0 } ;
 135
 136 : define-attribute-word ( name -- )
 137     dup "=" prepend swap
 138     [ write-attr ] curry attribute-effect html-word ;
 139
 140 [
 141     ! Define some closed HTML tags
 142     [
 143         "h1" "h2" "h3" "h4" "h5" "h6" "h7" "h8" "h9"
 144         "ol" "li" "form" "a" "p" "html" "head" "body" "title"
 145         "b" "i" "ul" "table" "tbody" "tr" "td" "th" "pre" "textarea"
 146         "script" "div" "span" "select" "option" "style" "input"
 147     ] [ define-closed-html-word ] each
 148
 149     ! Define some open HTML tags
 150     [
 151         "input"
 152         "br"
 153         "link"
 154         "img"
 155     ] [ define-open-html-word ] each
 156
 157     ! Define some attributes
 158     [
 159         "method" "action" "type" "value" "name"
 160         "size" "href" "class" "border" "rows" "cols"
 161         "id" "onclick" "style" "valign" "accesskey"
 162         "src" "language" "colspan" "onchange" "rel"
 163         "width" "selected" "onsubmit" "xmlns" "lang" "xml:lang"
 164         "media" "title" "multiple"
 165     ] [ define-attribute-word ] each
 166 ] with-compilation-unit