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 <<
  61
  62 : html-word ( name def effect -- )
  63     #! Define 'word creating' word to allow
  64     #! dynamically creating words.
  65     >r >r elements-vocab create r> r> define-declared ;
  66
  67 : <foo> "<" swap ">" 3append ;
  68
  69 : empty-effect T{ effect f 0 0 } ;
  70
  71 : def-for-html-word-<foo> ( name -- )
  72     #! Return the name and code for the <foo> patterned
  73     #! word.
  74     dup <foo> swap [ <foo> write-html ] curry
  75     empty-effect html-word ;
  76
  77 : <foo "<" prepend ;
  78
  79 : def-for-html-word-<foo ( name -- )
  80     #! Return the name and code for the <foo patterned
  81     #! word.
  82     <foo dup [ write-html ] curry
  83     empty-effect html-word ;
  84
  85 : foo> ">" append ;
  86
  87 : def-for-html-word-foo> ( name -- )
  88     #! Return the name and code for the foo> patterned
  89     #! word.
  90     foo> [ ">" write-html ] empty-effect html-word ;
  91
  92 : </foo> "</" swap ">" 3append ;
  93
  94 : def-for-html-word-</foo> ( name -- )
  95     #! Return the name and code for the </foo> patterned
  96     #! word.
  97     </foo> dup [ write-html ] curry empty-effect html-word ;
  98
  99 : <foo/> "<" swap "/>" 3append ;
 100
 101 : def-for-html-word-<foo/> ( name -- )
 102     #! Return the name and code for the <foo/> patterned
 103     #! word.
 104     dup <foo/> swap [ <foo/> write-html ] curry
 105     empty-effect html-word ;
 106
 107 : foo/> "/>" append ;
 108
 109 : def-for-html-word-foo/> ( name -- )
 110     #! Return the name and code for the foo/> patterned
 111     #! word.
 112     foo/> [ "/>" write-html ] empty-effect html-word ;
 113
 114 : define-closed-html-word ( name -- )
 115     #! Given an HTML tag name, define the words for
 116     #! that closable HTML tag.
 117     dup def-for-html-word-<foo>
 118     dup def-for-html-word-<foo
 119     dup def-for-html-word-foo>
 120     def-for-html-word-</foo> ;
 121
 122 : define-open-html-word ( name -- )
 123     #! Given an HTML tag name, define the words for
 124     #! that open HTML tag.
 125     dup def-for-html-word-<foo/>
 126     dup def-for-html-word-<foo
 127     def-for-html-word-foo/> ;
 128
 129 : write-attr ( value name -- )
 130     " " write-html
 131     write-html
 132     "='" write-html
 133     escape-quoted-string write-html
 134     "'" write-html ;
 135
 136 : attribute-effect T{ effect f { "string" } 0 } ;
 137
 138 : define-attribute-word ( name -- )
 139     dup "=" prepend swap
 140     [ write-attr ] curry attribute-effect html-word ;
 141
 142 ! Define some closed HTML tags
 143 [
 144     "h1" "h2" "h3" "h4" "h5" "h6" "h7" "h8" "h9"
 145     "ol" "li" "form" "a" "p" "html" "head" "body" "title"
 146     "b" "i" "ul" "table" "tbody" "tr" "td" "th" "pre" "textarea"
 147     "script" "div" "span" "select" "option" "style" "input"
 148 ] [ define-closed-html-word ] each
 149
 150 ! Define some open HTML tags
 151 [
 152     "input"
 153     "br"
 154     "link"
 155     "img"
 156 ] [ define-open-html-word ] each
 157
 158 ! Define some attributes
 159 [
 160     "method" "action" "type" "value" "name"
 161     "size" "href" "class" "border" "rows" "cols"
 162     "id" "onclick" "style" "valign" "accesskey"
 163     "src" "language" "colspan" "onchange" "rel"
 164     "width" "selected" "onsubmit" "xmlns" "lang" "xml:lang"
 165     "media" "title" "multiple"
 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> ;
 182
 183 : render-error ( message -- )
 184     <span "error" =class span> escape-string write </span> ;