fhp - tags
Descripción del contenido de la página
Módulo del programa fhp para crear las marcas básicas de XHTML.
Código fuente
CR .( fhp-tags )
\ Copyright (C) 2006,2007,2008,2009,2010 Marcos Cruz (programandala.net)
\ This file is part of
\ fhp ("Forth HTML Preprocessor") version B-00-201206
\ (http://programandala.net/en.program.fhp).
\ This module provides the basic HTML tags.
\ fhp is free software; you can redistribute it and/or modify
\ it under the terms of the GNU General Public License as published by
\ the Free Software Foundation; either version 2 of the License, or
\ (at your option) any later version.
\
\ fhp is distributed in the hope that it will be useful, but
\ WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
\ General Public License for more details.
\
\ You should have received a copy of the GNU General Public License
\ along with fhp; if not, see <http://gnu.org/licenses>.
\ fhp is written in the Forth language
\ with Gforth (http://gnu.org/software/gforth/).
\ .............................................................
\ History (in reversed order)
\ 2015-02-04: Header updated; layout a bit changed.
\
\ 2010-10-07: First support for Simplilo's format output.
\
\ 2009-10-21: Alias created: ' {tag/tag} alias {tag/}
\
\ 2009-07-30: Added {/TABLE} , {TBODY} and {/TBODY}
\
\ 2009-04-15: Added >REL-ATTRIBUTE and +REL-ATTRIBUTE
\
\ 2009-04-04: Added {div}
\
\ 2008-08-23: Added: {_} {.} {,} {:} {;} {'}
\
\ 2008-04-20: Added {/OBJECT}
\
\ 2008-04-10: Added: {pre} {/pre} {pre/pre} .
\
\ 2007-08-22: Added {/SCRIPT}
\
\ 2007-04-11: >LANG-ATTRIBUTE improved.
\
\ 2007-04-08: Hidden bug found and fixed in the second version of
\ UNTAG .
\
\ 2007-04-06: Links tags are renamed and moved here from the fhp-links
\ module. Now they will be basic tags. The more elaborated words to
\ build links will be in the the upper forthCMS level.
\
\ 2007-04-05: Added {BODY} , {/BODY} , {HTML} and {/HTML} . Added
\ {LINK} and {META} . All other meta-data and meta-link tags are
\ moved to the forthCMS-tags module.
\
\ 2007-04-04: Added {HEAD} and {/HEAD} .
\
\ 2007-02-07: Adedd LOCAL-METALINK and HTTP-METALINK .
\
\ 2007-01-31: Added {/SPAN} and {SPAN/SPAN} .
\
\ 2007-21-22: Added >TYPE-ATTRIBUTE and +TYPE-ATTRIBUTE Added &NBSP;
\
\ 2007-01-04: New words {TR} {/TR} {TD} {/TD} and {TD/TD} .
\
\ 2006-12-04: New words {KBD} {/KBD} and {KBD/KBD} .
\
\ 2006-11-22: New word TITLE and related.
\
\ 2006-10-05: Added {/A} , formerly defined in the module fhp-links.
\
\ 2006-09-14: Added {/SPAN}
\
\ 2006-09-1 Added {OL} an {/OL} .
\
\ 2006-09-09: Added {EM} {/EM} and {EM/EM} .
\
\ 2006-09-05: New fixed, faster and improved version of UNTAG .
\
\ 2006-09-02: New words >LANG-ATTRIBUTE and +LANG-ATTRIBUTE .
\ >SPAN+LANG modified; also renamed to >SPAN-LANG , and so its child
\ words.
\
\ 2006-09-01: New word UNTAG and related.
\
\ 2006-08-24: New words KEYWORDS and COMMON-KEYWORDS .
\
\ 2006-06-27: New word >SPAN+LANG and related.
\
\ 2006-06-25: Spell mistake fixed in accesskey attribute words.
\
\ 2006-06-26: New <strong> tag words.
\
\ 2006-06-24: New words for tags <h4> to <h6>, {P/P} and {TITLE/TITLE}
\ .
\
\ 2006-06-04: Word ANCHOR moved to the new module fhp-links.
\
\ 2006-05-27: Word ANCHOR taken from my application alinome-prg.
\
\ 2006-05-26: Module forked from fhp. Words that make HTML tags are
\ taken from my application alinome-prg.
\ .............................................................
\ Init
MARKER fhp-tags
\ .............................................................
\ Pseudo tags
\ Synonyms of some core words:
' space>html alias {_}
' space>html alias {space}
' dot>html alias {.}
' comma>html alias {,}
' colon>html alias {:}
' semicolon>html alias {;}
' tick>html alias {'}
' quote>html alias {"}
\ .............................................................
\ HTML tags
simplilo? [IF]
: {/a} S" ]]" >>html ;
: {blockquote} cr>html {"} {"} cr>html ;
: {/blockquote} {blockquote} ;
: {body} ;
: {/body} ;
: {br} S" \\" >>html ;
: {div} S" <<html div />>" >html ;
: {/div} S" <<div/>>" >html ;
: {dd} space>html ;
: {/dd} ;
: {dd/dd} ( c-addr u -- ) {dd} >html {/dd} ;
' {dd/dd} alias {dd/}
: {dl} cr>html ;
: {/dl} cr>html ;
: {dt} S" * **" >html ;
: {/dt} S" **" >>html ;
: {dt/dt} ( c-addr u -- ) {dt} >>html {/dt} ;
' {dt/dt} alias {dt/}
: {em} S" //" >>html ;
: {/em} {em} ;
: {em/em} ( c-addr u -- ) {em} >>html {/em} ;
' {em/em} alias {em/}
: {head} ;
: {/head} cr>html cr>html ;
: {h1} cr>html S" =" >html ;
: {/h1} cr>html ;
: {h1/h1} ( c-addr u -- ) {h1} >>html {/h1} ;
' {h1/h1} alias {h1/}
: {h2} cr>html S" ==" >html ;
: {/h2} cr>html ;
: {h2/h2} ( c-addr u -- ) {h2} >>html {/h2} ;
' {h2/h2} alias {h2/}
: {h3} cr>html S" ===" >html ;
: {/h3} cr>html ;
: {h3/h3} ( c-addr u -- ) {h3} >>html {/h3} ;
' {h3/h3} alias {h3/}
: {h4} cr>html S" ====" >html ;
: {/h4} cr>html ;
: {h4/h4} ( c-addr u -- ) {h4} >>html {/h4} ;
' {h4/h4} alias {h4/}
: {h5} cr>html S" =====" >html ;
: {/h5} cr>html ;
: {h5/h5} ( c-addr u -- ) {h5} >>html {/h5} ;
' {h5/h5} alias {h5/}
: {h6} cr>html S" ======" >html ;
: {/h6} cr>html ;
: {h6/h6} ( c-addr u -- ) {h6} >>html {/h6} ;
' {h6/h6} alias {h6/}
: {hr} S" ----" >html cr>html ;
: {html} ;
: {/html} ;
: {kbd} S" <<kbd " >>html ;
: {/kbd} S" />>" >>html ;
: {kbd/kbd} ( c-addr u -- ) {kbd} >>html {/kbd} ;
' {kbd/kbd} alias {kbd/}
: {li} S" * " >html ;
: {/li} ;
: {li/li} ( c-addr u -- ) {li} >>html {/li} ;
' {li/li} alias {li/}
: {/object} S" <<object/>>" >html ;
: {ol} S" {* <ol> *}" >html ;
: {/ol} cr>html cr>html ;
: {p} cr>html cr>html ;
: {/p} {p} ;
: {p/p} ( c-addr u -- ) {p} >>html {/p} ;
' {p/p} alias {p/}
: {pre} S" {{{" >html cr>html ;
: {/pre} S" }}}" >html cr>html ;
: {pre/pre} ( c-addr u -- ) {pre} >html {/pre} ;
' {pre/pre} alias {pre/}
: {/script} S" <<script/>>" >html ;
: {span} S" <span>" >>html ;
: {/span} S" </span>" >>html ;
: {span/span} {span} >>html {/span} ;
' {span/span} alias {span/}
: {strong} S" **" >>html ;
: {/strong} {strong} ;
: {strong/strong} {strong} >>html {/strong} ;
' {strong/strong} alias {strong/}
: {/table} s" </table>" >html ;
: {tr} S" |" >html ;
: {/tr} cr>html ;
: {tbody} s" {* <tbody> *}" >html ;
: {/tbody} s" </tbody>" >html ;
: {td} ;
: {/td} S" |" >>html ;
: {td/td} {td} >>html {/td} ;
' {td/td} alias {td/}
: {title} S" title = " >html ;
: {/title} ;
: {title/title} ( c-addr u -- ) {title} >>html {/title} ;
' {title/title} alias {title/}
: {ul} S" {* <ul> *}" >html ;
: {/ul} cr>html cr>html ;
[ELSE]
: {/a} S" </a>" >>html ;
: {blockquote} S" <blockquote>" >html ;
: {/blockquote} S" </blockquote>" >html ;
: {body} S" <body>" >html ;
: {/body} S" </body>" >html ;
: {br} S" <br />" >>html ;
: {div} S" <div>" >html ;
: {/div} S" </div>" >html ;
: {dd} S" <dd>" >html ;
: {/dd} S" </dd>" >html ;
: {dd/dd} ( c-addr u -- ) {dd} >html {/dd} ;
' {dd/dd} alias {dd/}
: {dl} S" <dl>" >html ;
: {/dl} S" </dl>" >html ;
: {dt} S" <dt>" >html ;
: {/dt} S" </dt>" >>html ;
: {dt/dt} ( c-addr u -- ) {dt} >>html {/dt} ;
' {dt/dt} alias {dt/}
: {em} S" <em>" >>html ;
: {/em} S" </em>" >>html ;
: {em/em} ( c-addr u -- ) {em} >>html {/em} ;
' {em/em} alias {em/}
: {head} S" <head>" >html ;
: {/head} S" </head>" >html ;
: {h1} S" <h1>" >html ;
: {/h1} S" </h1>" >>html ;
: {h1/h1} ( c-addr u -- ) {h1} >>html {/h1} ;
' {h1/h1} alias {h1/}
: {h2} S" <h2>" >html ;
: {/h2} S" </h2>" >>html ;
: {h2/h2} ( c-addr u -- ) {h2} >>html {/h2} ;
' {h2/h2} alias {h2/}
: {h3} S" <h3>" >html ;
: {/h3} S" </h3>" >>html ;
: {h3/h3} ( c-addr u -- ) {h3} >>html {/h3} ;
' {h3/h3} alias {h3/}
: {h4} S" <h4>" >html ;
: {/h4} S" </h4>" >>html ;
: {h4/h4} ( c-addr u -- ) {h4} >>html {/h4} ;
' {h4/h4} alias {h4/}
: {h5} S" <h5>" >html ;
: {/h5} S" </h5>" >>html ;
: {h5/h5} ( c-addr u -- ) {h5} >>html {/h5} ;
' {h5/h5} alias {h5/}
: {h6} S" <h6>" >html ;
: {/h6} S" </h6>" >>html ;
: {h6/h6} ( c-addr u -- ) {h6} >>html {/h6} ;
' {h6/h6} alias {h6/}
: {hr} S" <hr />" >html ;
: {html} S" <html>" >html ;
: {/html} S" </html>" >html ;
: {kbd} S" <kbd>" >>html ;
: {/kbd} S" </kbd>" >>html ;
: {kbd/kbd} ( c-addr u -- ) {kbd} >>html {/kbd} ;
' {kbd/kbd} alias {kbd/}
: {li} S" <li>" >html ;
: {/li} S" </li>" >>html ;
: {li/li} ( c-addr u -- ) {li} >>html {/li} ;
' {li/li} alias {li/}
: {/object} S" </object>" >html ;
: {ol} S" <ol>" >html ;
: {/ol} S" </ol>" >html ;
: {p} S" <p>" >html ;
: {/p} S" </p>" >>html ;
: {p/p} ( c-addr u -- ) {p} >>html {/p} ;
' {p/p} alias {p/}
: {pre} S" <pre>" >html ;
: {/pre} S" </pre>" >>html ;
: {pre/pre} ( c-addr u -- ) {pre} >html {/pre} ;
' {pre/pre} alias {pre/}
: {/script} S" </script>" >html ;
: {span} S" <span>" >>html ;
: {/span} S" </span>" >>html ;
: {span/span} {span} >>html {/span} ;
' {span/span} alias {span/}
: {strong} S" <strong>" >>html ;
: {/strong} S" </strong>" >>html ;
: {strong/strong} {strong} >>html {/strong} ;
' {strong/strong} alias {strong/}
: {/table} s" </table>" >html ;
: {tr} S" <tr>" >html ;
: {/tr} S" </tr>" >html ;
: {tbody} s" <tbody>" >html ;
: {/tbody} s" </tbody>" >html ;
: {td} S" <td>" >html ;
: {/td} S" </td>" >>html ;
: {td/td} {td} >>html {/td} ;
' {td/td} alias {td/}
: {title} S" <title>" >html ;
: {/title} S" </title>" >>html ;
: {title/title} ( c-addr u -- ) {title} >>html {/title} ;
' {title/title} alias {title/}
: {ul} S" <ul>" >html ;
: {/ul} S" </ul>" >html ;
[THEN]
\ .............................................................
\ HTML entities
: S" " >>html ;
\ .............................................................
\ HTML entities
\ .............................................................
\ Untag tool
false [IF]
\ This first version of UNTAG changes the string it receives.
\ That made it impossible to use the original content later.
VARIABLE untag? untag? on
VARIABLE untag-lenght
VARIABLE untag-from
VARIABLE untag-to
: untag ( c-addr1 u1 -- c-addr1 u2 )
\ Remove all HTML tags of a string.
\ 2006-09-01
2DUP untag-lenght !
DUP untag-from ! untag-to !
BEGIN
untag-lenght @
WHILE
untag-from @ C@
CASE
[CHAR] < OF untag? off ENDOF
[CHAR] > OF untag? on ENDOF
untag? @
IF
untag-from @ C@ untag-to @ C!
1 untag-to +!
THEN
ENDCASE
1 untag-from +!
-1 untag-lenght +!
REPEAT
untag-from @ untag-to @ - -
;
\ This second version of UNTAG had a bug:
\ it always returned the string in the same address!
\ That made it impossible to use the result later without moving it to a secure place.
VARIABLE untag? \ state
svariable untagged \ used only as a allocated space, the string lenght will not be updated
VARIABLE untag-from \ current char address of the original string
VARIABLE untag-to \ current char address of the new string
: untag ( c-addr1 u1 -- c-addr2 u2 )
\ Remove all HTML tags of a string.
\ 2006-09-05
untagged COUNT DROP untag-to !
SWAP untag-from !
untag? on
BEGIN
DUP
WHILE
untag-from @ C@
CASE
[CHAR] < OF untag? off ENDOF
[CHAR] > OF untag? on ENDOF
untag? @
IF
untag-from @ C@ untag-to @ C!
1 CHARS untag-to +!
THEN
ENDCASE
1 CHARS untag-from +!
1- \ counter
REPEAT
DROP \ counter
untagged COUNT DROP untag-to @ OVER -
;
[THEN]
\ The solution is simple, at last:
\ The first version with an initial call to move the string into the string buffer!
VARIABLE untag? untag? on
VARIABLE untag-lenght
VARIABLE untag-from
VARIABLE untag-to
: untag ( c-addr1 u1 -- c-addr1 u2 )
\ Remove all HTML tags of a string.
\ 2006-09-01
\ 2007-04-08
>sbuffer
2DUP untag-lenght !
DUP untag-from ! untag-to !
BEGIN
untag-lenght @
WHILE
untag-from @ C@
CASE
[CHAR] < OF untag? off ENDOF
[CHAR] > OF untag? on ENDOF
untag? @
IF
untag-from @ C@ untag-to @ C!
1 untag-to +!
THEN
ENDCASE
1 untag-from +!
-1 untag-lenght +!
REPEAT
untag-from @ untag-to @ - -
;
\ .............................................................
\ HTML attributes
: html-attribute ( c-addr1 u1 c-addr2 u2 -- )
\ Create an HTML tag attribute if the content is provided.
\ c-addr1 u1 = attribute content or empty string
\ c-addr2 u2 = attribute label (e.g. alt, title, httplang, longdesc...)
2SWAP DUP IF
space>html 2SWAP >>html
S" ='" >>html >>html tick>html
ELSE
2DROP 2DROP
THEN
;
: >html-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = attribute content
\ c-addr2 u2 = attribute label
\ c-addr3 u3 = attribute ready for a HTML tag
S" " 2SWAP str+
S" ='" str+ 2SWAP str+ S" '" str+
;
: >title-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = title attribute content
\ c-addr2 u2 = title attribute ready for a HTML tag
S" title" >html-attribute
;
: +title-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = title attribute content
\ c-addr3 u3 = ready attributes with the title one added
>title-attribute str+
;
: >alt-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = alt attribute content
\ c-addr2 u2 = alt attribute ready for a HTML tag
S" alt" >html-attribute
;
: +alt-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = alt attribute content
\ c-addr3 u3 = ready attributes with the alt one added
>alt-attribute str+
;
: >hreflang-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = hreflang attribute content
\ c-addr2 u2 = hreflang attribute ready for a HTML tag
S" hreflang" >html-attribute
;
: +hreflang-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = hreflang attribute content
\ c-addr3 u3 = ready attributes with the hreflang one added
>hreflang-attribute str+
;
: >longdesc-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = longdesc attribute content
\ c-addr2 u2 = longdesc attribute ready for a HTML tag
S" longdesc" >html-attribute
;
: +longdesc-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = longdesc attribute content
\ c-addr3 u3 = ready attributes with the longdesc one added
>longdesc-attribute str+
;
: >accesskey-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = accesskey attribute content
\ c-addr2 u2 = accesskey attribute ready for a HTML tag
S" accesskey" >html-attribute
;
: +accesskey-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = accesskey attribute content
\ c-addr3 u3 = ready attributes with the accesskey one added
>accesskey-attribute str+
;
: >width-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = width attribute content
\ c-addr2 u2 = width attribute ready for a HTML tag
S" width" >html-attribute
;
: +width-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = width attribute content
\ c-addr3 u3 = ready attributes with the width one added
>width-attribute str+
;
: >height-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = height attribute content
\ c-addr2 u2 = height attribute ready for a HTML tag
S" height" >html-attribute
;
: +height-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = height attribute content
\ c-addr3 u3 = ready attributes with the height one added
>height-attribute str+
;
: >class-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = class attribute content
\ c-addr2 u2 = class attribute ready for a HTML tag
S" class" >html-attribute
;
: +class-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = class attribute content
\ c-addr3 u3 = ready attributes with the class one added
>class-attribute str+
;
: >type-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = type attribute content
\ c-addr2 u2 = type attribute ready for a HTML tag
S" type" >html-attribute
;
: +type-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = type attribute content
\ c-addr3 u3 = ready attributes with the type one added
>type-attribute str+
;
: >xml:lang-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = lang attribute content (ISO language code)
\ 2009-10-22 Written to be used in the Atom addon of forthCMS.
\ 2009-10-24 Siplified with >HTML-ATTRIBUTE . Typo corrected.
S" xml:lang" >html-attribute
;
: +xml:lang-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = lang attribute content (ISO language code)
\ c-addr3 u3 = ready attributes with the lang one added
\ 2009-10-24
>xml:lang-attribute str+
;
: xml:lang-enough? ( -- f )
\ 2009-10-22 Sintactic sugar. In the future the rule could be more complex.
xhtml11
;
: >lang-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = lang attribute content (ISO language code)
\ 2006-09-02 Factored from >SPAN-LANG .
\ 2006-09-03 Bug fixed.
\ 2007-04-11 Improved to distingish XHTML 1.1.
\ 2009-10-22 Factored out with >XML:LANG-ATTRIBUTE . Simplified.
[ 0 ] [if] \ old version, until 2009-10-22
xhtml11 IF
S" xml:lang='" 2SWAP
ELSE
S" xml:lang='" 2OVER str+
S" ' lang='" str+ 2SWAP
str+ S" '" str+
THEN
[then]
\ Version 2009-10-22
2dup >xml:lang-attribute 2swap
xml:lang-enough? 0= if
S" lang='" 2swap str+ s" '" str+ str+
else
2drop
then
;
: +lang-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = lang attribute content (ISO language code)
\ c-addr3 u3 = ready attributes with the lang one added
>lang-attribute str+
;
: >rel-attribute ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = rel attribute content
\ c-addr2 u2 = rel attribute ready for a HTML tag
S" rel" >html-attribute
;
: +rel-attribute ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ c-addr1 u1 = ready attributes or empty string
\ c-addr2 u2 = rel attribute content
\ c-addr3 u3 = ready attributes with the rel one added
>rel-attribute str+
;
: >span-lang ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ Insert the attribute for the provided language code in the string.
\ c-addr1 u1 = string
\ c-addr2 u2 = ISO language code
\ c-addr3 u3 = new string
\ 2006-06-27
\ 2006-09-02 Factored out to >LANG-ATTRIBUTE .
S" <span " 2SWAP >lang-attribute str+
S" >" str+ 2SWAP str+
S" </span>" str+
;
: >span-lang-es ( c-addr1 u1 -- c-addr2 u2 )
\ 2006-06-27
\ Insert the Spanish language atribute in the string.
S" es" >span-lang
;
: >span-lang-eo ( c-addr1 u1 -- c-addr2 u2 )
\ 2006-06-27
\ Insert the Esperanto language atribute in the string.
S" eo" >span-lang
;
: >span-lang-en ( c-addr1 u1 -- c-addr2 u2 )
\ 2006-06-27
\ Insert the English language atribute in the string.
S" en" >span-lang
;
: >span-lang-de ( c-addr1 u1 -- c-addr2 u2 )
\ 2006-06-27
\ Insert the German language atribute in the string.
S" de" >span-lang
;
\ .............................................................
\ Meta tags
: {meta} ( c-addr1 u1 c-addr2 u2 -- )
\ Create a meta tag.
\ c-addr1 u1 = content
\ c-addr2 u2 = name
\ 2007-04-05
\ 2010-10-08 Support for Simplilo's format output.
simplilo? IF
>html S" = " >>html >>html
ELSE
S" <meta name='" >html >>html
S" ' content='" >>html >>html
S" ' />" >>html
THEN
;
: {link} ( c-addr1 u1 c-addr2 u2 -- )
\ Create a link tag.
\ c-addr1 u1 = attributes
\ c-addr2 u2 = href
\ 2007-04-05
S" <link href='" >html >>html tick>html space>html >>html S" />" >>html
;
\ .............................................................
\ Links
: {a-href ( -- )
\ Open the start <a> tag with the href attribute.
simplilo?
IF S" [[ "
ELSE S" <a href='"
THEN >>html
;
: {a-href-http ( -- )
\ Open the start <a> tag with the href attribute and adds the http protocol.
\ 2007-05-06
{a-href S" http://" >>html
;
: a} ( c-addr1 u1 c-addr2 u2 -- )
\ Close the start <a> tag adding the href content and the attributes.
\ c-addr1 u1 = attributes
\ c-addr2 u2 = href
>>html tick>html space>html >>html S" >" >>html
;
: {a-href-http}
( c-addr1 u1 c-addr2 u2 -- ) \ with HTML output
( c-addr1 u1 c-addr2 u2 c-addr3 u3 -- ) \ with Simplilo's format output
\ Create a start <a> tag for an external link, with all its content.
\ c-addr1 u1 = attributes
\ c-addr2 u2 = href without the http protocol.
\ c-addr3 u3 = link text
\ 2007-04-05 Renamed (formerly HTTP{A} ) and rewriten.
\ 2010-10-22 Support for Simplilo's format output.
simplilo?
IF
2SWAP {a-href-http
S" | " >>html
S" | " >>html
ELSE
{a-href-http
THEN
a}
;
: {a} ( c-addr1 u1 c-addr2 u2 -- )
\ Create a <a> tag.
\ c-addr1 u1 = attributes
\ c-addr2 u2 = whole href (with http protocol if needed)
\ 2007-04-06
{a-href a}
;
: {a/a} ( c-addr1 u1 c-addr2 u2 c-addr3 u3 -- )
\ Create a link.
\ c-addr1 u1 = text
\ c-addr2 u2 = attributes
\ c-addr3 u3 = whole href (with http protocol if needed)
\ 2004 04 29
simplilo? IF
S" [[ " >>html >>html
2SWAP S" | " >>html >>html
S" | " >>html >>html
S" ]]" >>html
ELSE
{a} >>html {/a}
THEN
;
.( fhp-tags ok!)