fhp - tags

Descripción del contenido de la página

Módulo del programa fhp para crear las marcas básicas de XHTML.

Etiquetas:

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

: &nbsp;  S" &nbsp;" >>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!)