3 ! Copyright (C) 2004 Chris Double.
4 ! See http://factorcode.org/license.txt for BSD license.
6 USING: io kernel namespaces prettyprint quotations
7 sequences strings words xml.entities compiler.units effects ;
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.
15 ! HTML tags can be used in a number of different ways. The highest
16 ! level involves a similar syntax to HTML:
18 ! <p> "someoutput" write </p>
20 ! <p> will output the opening tag and </p> will output the closing
21 ! tag with no attributes.
23 ! <p "red" =class p> "someoutput" write </p>
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
32 ! Any writes after this will appear after the opening tag.
34 ! Values for attributes can be used directly without any stack
38 ! <a =href a> "Click me" write </a>
41 ! <a "http://" prepend =href a> "click" write </a>
44 ! <a [ "http://" % % ] "" make =href a> "click" write </a>
46 ! Tags that have no 'closing' equivalent have a trailing tag/> form:
48 ! <input "text" =type "name" =name "20" =size input/>
50 : elements-vocab ( -- vocab-name ) "html.elements" ;
54 : write-html ( str -- )
55 H{ { html t } } format ;
57 : print-html ( str -- )
58 write-html "\n" write-html ;
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 ;
67 : <foo> "<" swap ">" 3append ;
69 : empty-effect T{ effect f 0 0 } ;
71 : def-for-html-word-<foo> ( name -- )
72 #! Return the name and code for the <foo> patterned
74 dup <foo> swap [ <foo> write-html ] curry
75 empty-effect html-word ;
79 : def-for-html-word-<foo ( name -- )
80 #! Return the name and code for the <foo patterned
82 <foo dup [ write-html ] curry
83 empty-effect html-word ;
87 : def-for-html-word-foo> ( name -- )
88 #! Return the name and code for the foo> patterned
90 foo> [ ">" write-html ] empty-effect html-word ;
92 : </foo> "</" swap ">" 3append ;
94 : def-for-html-word-</foo> ( name -- )
95 #! Return the name and code for the </foo> patterned
97 </foo> dup [ write-html ] curry empty-effect html-word ;
99 : <foo/> "<" swap "/>" 3append ;
101 : def-for-html-word-<foo/> ( name -- )
102 #! Return the name and code for the <foo/> patterned
104 dup <foo/> swap [ <foo/> write-html ] curry
105 empty-effect html-word ;
107 : foo/> "/>" append ;
109 : def-for-html-word-foo/> ( name -- )
110 #! Return the name and code for the foo/> patterned
112 foo/> [ "/>" write-html ] empty-effect html-word ;
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> ;
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/> ;
129 : write-attr ( value name -- )
133 escape-quoted-string write-html
136 : attribute-effect T{ effect f { "string" } 0 } ;
138 : define-attribute-word ( name -- )
140 [ write-attr ] curry attribute-effect html-word ;
142 ! Define some closed HTML tags
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
150 ! Define some open HTML tags
156 ] [ define-open-html-word ] each
158 ! Define some attributes
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
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 ;
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.
178 <html "http://www.w3.org/1999/xhtml" =xmlns "en" =xml:lang "en" =lang html>
179 <head> <title> swap write </title> </head>
183 : render-error ( message -- )
184 <span "error" =class span> escape-string write </span> ;