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 urls math math.parser combinators present ;
   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> "<" swap ">" 3append ;
  69
  70 : empty-effect T{ effect f 0 0 } ;
  71
  72 : def-for-html-word-<foo> ( name -- )
  73     #! Return the name and code for the <foo> patterned
  74     #! word.
  75     dup <foo> swap [ <foo> write-html ] curry
  76     empty-effect html-word ;
  77
  78 : <foo "<" prepend ;
  79
  80 : def-for-html-word-<foo ( name -- )
  81     #! Return the name and code for the <foo patterned
  82     #! word.
  83     <foo dup [ write-html ] curry
  84     empty-effect html-word ;
  85
  86 : foo> ">" append ;
  87
  88 : def-for-html-word-foo> ( name -- )
  89     #! Return the name and code for the foo> patterned
  90     #! word.
  91     foo> [ ">" write-html ] empty-effect html-word ;
  92
  93 : </foo> "</" swap ">" 3append ;
  94
  95 : def-for-html-word-</foo> ( name -- )
  96     #! Return the name and code for the </foo> patterned
  97     #! word.
  98     </foo> dup [ write-html ] curry empty-effect html-word ;
  99
 100 : <foo/> "<" swap "/>" 3append ;
 101
 102 : def-for-html-word-<foo/> ( name -- )
 103     #! Return the name and code for the <foo/> patterned
 104     #! word.
 105     dup <foo/> swap [ <foo/> write-html ] curry
 106     empty-effect html-word ;
 107
 108 : foo/> "/>" append ;
 109
 110 : def-for-html-word-foo/> ( name -- )
 111     #! Return the name and code for the foo/> patterned
 112     #! word.
 113     foo/> [ "/>" write-html ] empty-effect html-word ;
 114
 115 : define-closed-html-word ( name -- )
 116     #! Given an HTML tag name, define the words for
 117     #! that closable HTML tag.
 118     dup def-for-html-word-<foo>
 119     dup def-for-html-word-<foo
 120     dup def-for-html-word-foo>
 121     def-for-html-word-</foo> ;
 122
 123 : define-open-html-word ( name -- )
 124     #! Given an HTML tag name, define the words for
 125     #! that open HTML tag.
 126     dup def-for-html-word-<foo/>
 127     dup def-for-html-word-<foo
 128     def-for-html-word-foo/> ;
 129
 130 : write-attr ( value name -- )
 131     " " write-html
 132     write-html
 133     "='" write-html
 134     present escape-quoted-string write-html
 135     "'" write-html ;
 136
 137 : attribute-effect T{ effect f { "string" } 0 } ;
 138
 139 : define-attribute-word ( name -- )
 140     dup "=" prepend swap
 141     [ write-attr ] curry attribute-effect html-word ;
 142
 143 ! Define some closed HTML tags
 144 [
 145     "h1" "h2" "h3" "h4" "h5" "h6" "h7" "h8" "h9"
 146     "ol" "li" "form" "a" "p" "html" "head" "body" "title"
 147     "b" "i" "ul" "table" "tbody" "tr" "td" "th" "pre" "textarea"
 148     "script" "div" "span" "select" "option" "style" "input"
 149 ] [ define-closed-html-word ] each
 150
 151 ! Define some open HTML tags
 152 [
 153     "input"
 154     "br"
 155     "link"
 156     "img"
 157 ] [ define-open-html-word ] each
 158
 159 ! Define some attributes
 160 [
 161     "method" "action" "type" "value" "name"
 162     "size" "href" "class" "border" "rows" "cols"
 163     "id" "onclick" "style" "valign" "accesskey"
 164     "src" "language" "colspan" "onchange" "rel"
 165     "width" "selected" "onsubmit" "xmlns" "lang" "xml:lang"
 166     "media" "title" "multiple" "checked"
 167 ] [ define-attribute-word ] each
 168
 169 >>
 170
 171 : xhtml-preamble ( -- )
 172     "<?xml version=\"1.0\"?>" write-html
 173     "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" write-html ;
 174
 175 : simple-page ( title quot -- )
 176     #! Call the quotation, with all output going to the
 177     #! body of an html page with the given title.
 178     xhtml-preamble
 179     <html "http://www.w3.org/1999/xhtml" =xmlns "en" =xml:lang "en" =lang html>
 180         <head> <title> swap write </title> </head>
 181         <body> call </body>
 182     </html> ; inline
 183
 184 : render-error ( message -- )
 185     <span "error" =class span> escape-string write </span> ;