135 lines
4.7 KiB
Forth
Executable File
135 lines
4.7 KiB
Forth
Executable File
\ html5cgi.fs -- Generate HTML5 tags for CGI script
|
|
\ 2016 David Meyer <papa@sdf.org> +JMJ
|
|
|
|
\ Tags are generate with words with format *X*, where X usually corresponds to the
|
|
\ tag to be generated, and which generally have a stack effect like:
|
|
\
|
|
\ ( c-prefix c-content [c-attrib ...] -- c-result )
|
|
\
|
|
\ Where: c-prefix is a pointer to a counted string containing the preceding contents
|
|
\ of the current element; 0 when the current tag will be the first
|
|
\ contents of the element.
|
|
\ c-content is a pointer to the contents for the current tag.
|
|
\ c-attrib points to one or more optional strings for tag attributes.
|
|
\ c-result points to a string concatenating the prefix contents with the current
|
|
\ tag (input strings are recycled to the heap).
|
|
|
|
\ Supported tags/structure:
|
|
\ *http-resp*
|
|
\ *html*
|
|
\ *head*
|
|
\ *title*, *style*, *meta*, *base*
|
|
\ *body*
|
|
\ *article*, *aside*, *div*, *header*, *footer*, *nav*, *section*
|
|
\ *a*, *blockquote* *h1*, *h2*, *h3*, *h4*, *h5*, *h6*, *hr*, *img*, *pre*
|
|
\ *map*
|
|
\ *area*
|
|
\ *p*
|
|
\ *b*, *br*, *em*, *strong*
|
|
\ *ol*, *ul*
|
|
\ *li*
|
|
\ *dl*
|
|
\ *dt*, *dd*
|
|
\ *table*
|
|
\ *thead*, *tbody*
|
|
\ *tr*
|
|
\ *th*, *td*
|
|
\ *form*
|
|
\ *input*, *label*
|
|
|
|
include heapstr.fs
|
|
|
|
|
|
s" <b>" $alloc constant C-B
|
|
s" </b>" $alloc constant C-/B
|
|
s" <blockquote>" $alloc constant C-BQUOTE
|
|
s\" </blockquote>\n" $alloc constant C-/BQUOTE
|
|
s\" <body>\n" $alloc constant C-BODY
|
|
s\" </body>\n" $alloc constant C-/BODY
|
|
s\" <br />\n" $alloc constant C-BR
|
|
s" <em>" $alloc constant C-EM
|
|
s" </em>" $alloc constant C-/EM
|
|
s" <h1>" $alloc constant C-H1
|
|
s\" </h1>\n" $alloc constant C-/H1
|
|
s" <h2>" $alloc constant C-H2
|
|
s\" </h2>\n" $alloc constant C-/H2
|
|
s" <h3>" $alloc constant C-H3
|
|
s\" </h3>\n" $alloc constant C-/H3
|
|
s" <h4>" $alloc constant C-H4
|
|
s\" </h4>\n" $alloc constant C-/H4
|
|
s" <h5>" $alloc constant C-H5
|
|
s\" </h5>\n" $alloc constant C-/H5
|
|
s" <h6>" $alloc constant C-H6
|
|
s\" </h6>\n" $alloc constant C-/H6
|
|
s\" <head>\n" $alloc constant C-HEAD
|
|
s\" </head>\n" $alloc constant C-/HEAD
|
|
s\" <hr />\n" $alloc constant C-HR
|
|
s\" <html>\n" $alloc constant C-HTML
|
|
s\" </html>\n" $alloc constant C-/HTML
|
|
s\" Content-type: text/html\n\n<!DOCTYPE html>\n" $alloc
|
|
constant C-HTTP-HTML5
|
|
s" <li>" $alloc constant C-LI
|
|
s\" </li>\n" $alloc constant C-/LI
|
|
s" <ol>" $alloc constant C-OL
|
|
s\" </ol>\n" $alloc constant C-/OL
|
|
s" <p>" $alloc constant C-P
|
|
s\" </p>\n" $alloc constant C-/P
|
|
s" <strong>" $alloc constant C-STRONG
|
|
s" </strong>" $alloc constant C-/STRONG
|
|
s" <title>" $alloc constant C-TITLE
|
|
s\" </title>\n" $alloc constant C-/TITLE
|
|
s" <ul>" $alloc constant C-UL
|
|
s\" </ul>\n" $alloc constant C-/UL
|
|
|
|
: empty-tag ( c-prefix c-tag -- c-result ) 1 c$catx ;
|
|
|
|
: simple-tag ( c-prefix c-content c-open c-close -- c-result )
|
|
\g Generate tag with format: <X>Tag contents</X>
|
|
rot swap 1 c$catx 2 c$catx
|
|
over if 0 c$catx else nip then
|
|
;
|
|
|
|
: *blockquote* ( c-prefix c-content -- c-result ) C-BQUOTE C-/BQUOTE simple-tag ;
|
|
|
|
: *b* ( c-prefix c-content -- c-result ) C-B C-/B simple-tag ;
|
|
|
|
: *body* ( c-content -- c-body ) C-/BODY 1 c$catx C-BODY swap 2 c$catx ;
|
|
|
|
: *br* ( c-prefix -- c-result ) C-BR empty-tag ;
|
|
|
|
: *em* ( c-prefix c-content -- c-result ) C-EM C-/EM simple-tag ;
|
|
|
|
: *h1* ( c-prefix c-content -- c-result ) C-H1 C-/H1 simple-tag ;
|
|
|
|
: *h2* ( c-prefix c-content -- c-result ) C-H2 C-/H2 simple-tag ;
|
|
|
|
: *h3* ( c-prefix c-content -- c-result ) C-H3 C-/H3 simple-tag ;
|
|
|
|
: *h4* ( c-prefix c-content -- c-result ) C-H4 C-/H4 simple-tag ;
|
|
|
|
: *h5* ( c-prefix c-content -- c-result ) C-H5 C-/H5 simple-tag ;
|
|
|
|
: *h6* ( c-prefix c-content -- c-result ) C-H6 C-/H6 simple-tag ;
|
|
|
|
: *head* ( c-content -- c-result ) C-/HEAD 1 c$catx C-HEAD swap 2 c$catx ;
|
|
|
|
: *hr* ( c-prefix -- c-result ) C-HR empty-tag ;
|
|
|
|
: *html* ( c-head c-body -- c-result ) C-/HTML 1 c$catx 0 c$catx C-HTML swap 2 c$catx ;
|
|
|
|
: *http-html5* ( c-content -- c-result ) C-HTTP-HTML5 swap 2 c$catx ;
|
|
|
|
: *li* ( c-prefix c-content -- c-result ) C-LI C-/LI simple-tag ;
|
|
|
|
: *ol* ( c-prefix c-content -- c-result ) C-OL C-/OL simple-tag ;
|
|
|
|
: *p* ( c-prefix c-content -- c-result ) C-P C-/P simple-tag ;
|
|
|
|
: *strong* ( c-prefix c-content -- c-result ) C-STRONG C-/STRONG simple-tag ;
|
|
|
|
: *title* ( c-prefix c-content -- c-result ) C-TITLE C-/TITLE simple-tag ;
|
|
|
|
: *ul* ( c-prefix c-content -- c-result ) C-UL C-/UL simple-tag ;
|
|
|
|
|