basis/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 urls math math.parser combinators present fry ;
   9
  10 IN: html.elements
  11
  12 ! These words are used to provide a means of writing
  13 ! formatted HTML to standard output with a familiar 'html' look
  14 ! and feel in the code.
  15 !
  16 ! HTML tags can be used in a number of different ways. The highest
  17 ! level involves a similar syntax to HTML:
  18 !
  19 ! <p> "someoutput" write </p>
  20 !
  21 ! <p> will output the opening tag and </p> will output the closing
  22 ! tag with no attributes.
  23 !
  24 ! <p "red" =class p> "someoutput" write </p>
  25 !
  26 ! This time the opening tag does not have the '>'. It pushes
  27 ! a namespace on the stack to hold the attributes and values.
  28 ! Any attribute words used will store the attribute and values
  29 ! in that namespace. Before the attribute word should come the
  30 ! value of that attribute.
  31 ! The finishing word will print out the operning tag including
  32 ! attributes.
  33 ! Any writes after this will appear after the opening tag.
  34 !
  35 ! Values for attributes can be used directly without any stack
  36 ! operations:
  37 !
  38 ! (url -- )
  39 ! <a =href a> "Click me" write </a>
  40 !
  41 ! (url -- )
  42 ! <a "http://" prepend =href a> "click" write </a>
  43 !
  44 ! (url -- )
  45 ! <a [ "http://" % % ] "" make =href a> "click" write </a>
  46 !
  47 ! Tags that have no 'closing' equivalent have a trailing tag/> form:
  48 !
  49 ! <input "text" =type "name" =name "20" =size input/>
  50
  51 : elements-vocab ( -- vocab-name ) "html.elements" ;
  52
  53 SYMBOL: html
  54
  55 : write-html ( str -- )
  56     H{ { html t } } format ;
  57
  58 : print-html ( str -- )
  59     write-html "\n" write-html ;
  60
  61 <<
  62
  63 : html-word ( name def effect -- )
  64     #! Define 'word creating' word to allow
  65     #! dynamically creating words.
  66     >r >r elements-vocab create r> r> define-declared ;
  67
  68 : <foo> ( str -- <str> ) "<" swap ">" 3append ;
  69
  70 : def-for-html-word-<foo> ( name -- )
  71     #! Return the name and code for the <foo> patterned
  72     #! word.
  73     dup <foo> swap '[ _ <foo> write-html ]
  74     (( -- )) html-word ;
  75
  76 : <foo ( str -- <str ) "<" prepend ;
  77
  78 : def-for-html-word-<foo ( name -- )
  79     #! Return the name and code for the <foo patterned
  80     #! word.
  81     <foo dup '[ _ write-html ]
  82     (( -- )) html-word ;
  83
  84 : foo> ( str -- foo> ) ">" append ;
  85
  86 : def-for-html-word-foo> ( name -- )
  87     #! Return the name and code for the foo> patterned
  88     #! word.
  89     foo> [ ">" write-html ] (( -- )) html-word ;
  90
  91 : </foo> ( str -- </str> ) "</" swap ">" 3append ;
  92
  93 : def-for-html-word-</foo> ( name -- )
  94     #! Return the name and code for the </foo> patterned
  95     #! word.
  96     </foo> dup '[ _ write-html ] (( -- )) html-word ;
  97
  98 : <foo/> ( str -- <str/> ) "<" swap "/>" 3append ;
  99
 100 : def-for-html-word-<foo/> ( name -- )
 101     #! Return the name and code for the <foo/> patterned
 102     #! word.
 103     dup <foo/> swap '[ _ <foo/> write-html ]
 104     (( -- )) html-word ;
 105
 106 : foo/> ( str -- str/> ) "/>" append ;
 107
 108 : def-for-html-word-foo/> ( name -- )
 109     #! Return the name and code for the foo/> patterned
 110     #! word.
 111     foo/> [ "/>" write-html ] (( -- )) html-word ;
 112
 113 : define-closed-html-word ( name -- )
 114     #! Given an HTML tag name, define the words for
 115     #! that closable HTML tag.
 116     dup def-for-html-word-<foo>
 117     dup def-for-html-word-<foo
 118     dup def-for-html-word-foo>
 119     def-for-html-word-</foo> ;
 120
 121 : define-open-html-word ( name -- )
 122     #! Given an HTML tag name, define the words for
 123     #! that open HTML tag.
 124     dup def-for-html-word-<foo/>
 125     dup def-for-html-word-<foo
 126     def-for-html-word-foo/> ;
 127
 128 : write-attr ( value name -- )
 129     " " write-html
 130     write-html
 131     "='" write-html
 132     present escape-quoted-string write-html
 133     "'" write-html ;
 134
 135 : define-attribute-word ( name -- )
 136     dup "=" prepend swap
 137     '[ _ write-attr ] (( string -- )) html-word ;
 138
 139 ! Define some closed HTML tags
 140 [
 141     "h1" "h2" "h3" "h4" "h5" "h6" "h7" "h8" "h9"
 142     "ol" "li" "form" "a" "p" "html" "head" "body" "title"
 143     "b" "i" "ul" "table" "tbody" "tr" "td" "th" "pre" "textarea"
 144     "script" "div" "span" "select" "option" "style" "input"
 145     "strong"
 146 ] [ define-closed-html-word ] each
 147
 148 ! Define some open HTML tags
 149 [
 150     "input"
 151     "br"
 152     "link"
 153     "img"
 154 ] [ define-open-html-word ] each
 155
 156 ! Define some attributes
 157 [
 158     "method" "action" "type" "value" "name"
 159     "size" "href" "class" "border" "rows" "cols"
 160     "id" "onclick" "style" "valign" "accesskey"
 161     "src" "language" "colspan" "onchange" "rel"
 162     "width" "selected" "onsubmit" "xmlns" "lang" "xml:lang"
 163     "media" "title" "multiple" "checked"
 164     "summary" "cellspacing" "align" "scope" "abbr"
 165     "nofollow" "alt"
 166 ] [ define-attribute-word ] each
 167
 168 >>
 169
 170 : xhtml-preamble ( -- )
 171     "<?xml version=\"1.0\"?>" write-html
 172     "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" write-html ;
 173
 174 : simple-page ( title quot -- )
 175     #! Call the quotation, with all output going to the
 176     #! body of an html page with the given title.
 177     xhtml-preamble
 178     <html "http://www.w3.org/1999/xhtml" =xmlns "en" =xml:lang "en" =lang html>
 179         <head> <title> swap write </title> </head>
 180         <body> call </body>
 181     </html> ; inline
 182
 183 : render-error ( message -- )
 184     <span "error" =class span> escape-string write </span> ;