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