fhp - core

Descripción del contenido de la página

Módulo principal del programa fhp.

Etiquetas:

Código fuente

CR .( fhp-core )

\ Copyright (C) 2005,2006,2007,2010,2012 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 is the fhp core.

\ 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

\ 2015-02-04: Header updated; layout a bit changed.
\
\ 2012-03-28: Some file names updated (.f --> .fs).
\
\ 2010-10-07: First code to support the Simplilo's format output.
\
\ 2007-05-25: New global value XHTML-VERSION . The old flag constant
\ XHTML11 now is a word to keep compatilibilty with the old code.
\
\ 2007-04-25: Added all alias to create in CSS files. Just syntactic
\ sugar.
\
\ 2007-04-11: New global flag XHTML11 .
\
\ 2007-04-09: New words: :HTML :HTML|| :HTML\ .  Words renamed: :HTML\
\ :HTML\\ .
\
\ 2007-03-21: New word SEMICOLON>HTML .
\
\ 2006-12-08: Bug fixed in HTML<< .
\
\ 2006-12-06: Bug fixed in HTML<< .
\
\ 2006-12-04: Added HTML>SCREEN and HTML>FILE .
\
\ 2006-12-02: '>HTML renamed TICK>HTML .  New word COLON>HTML .
\
\ 2006-11-29: New words (HTML<<) HTML<< and HTML< .
\
\ 2006-08-30: New word COMMA>HTML .
\
\ 2006-08-17: New word EMIT>HTML .
\
\ 2006-06-04: New words ?>HTML and ?>>HTML .  The word OPEN-HTML is
\ renamed CREATE-HTML .
\
\ 2006-05-25: All words that create HTML attributes are moved into a
\ new file called fhp-tags.f, with other words that create basic HTML
\ tags.
\
\ 2006-05-21: New word DOT>HTML .
\
\ 2006-04-27: New words: >CLASS-ATTRIBUTE +CLASS-ATTRIBUTE
\
\ 2006-04-26: New word HTML\ to read and print HTML code by lines.
\ HTML[ rewritten to be used inside a definition: it only compiles the
\ strings and the HTML print commands.  New word HTML( to be used in
\ interpretation mode.
\
\ 2006-04-24: HTML[ is faster: no more need for UPPER because ]HTML
\ has to be lowercase.
\
\ 2006-04-01: HTML-PARAMETER renamed >HTML-ATTRIBUTE and modified.
\ New words: >TITLE-ATTRIBUTE +TITLE-ATTRIBUTE >ALT-ATTRIBUTE
\ +ALT-ATTRIBUTE >HREFLANG-ATTRIBUTE +HREFLANG-ATTRIBUTE
\ >LONGDESC-ATTRIBUTE +LONGDESC-ATTRIBUTE >ACCESKEY-ATTRIBUTE
\ +ACCESKEY-ATTRIBUTE >WIDTH-ATTRIBUTE +WIDTH-ATTRIBUTE
\ >HEIGHT-ATTRIBUTE +HEIGHT-ATTRIBUTE
\
\ 2006-03-28: New word HTML-PARAMETER .
\
\ 2006-03-16: Changes to implement multilingual support: >>HTML
\ defered to the new word (>>HTML) .  CR>HTML modified to depend upon
\ >>HTML ; new string EOL created for that.  That way, >>HTML can be
\ redirected to a multilingual version that creates several pages
\ simultaneously.
\
\ 2006-03-14: HTML-ID renamed HTML-FID .
\
\ 2006-02-22: New words HTML-MAKE and HTML-MAKE? .
\
\ 2005-11-14: ftrac character translation system integrated.
\
\ 2005-11-09: New variables HTML-ECHO and HTML-PATH .  POSTPONE used
\ instead of [COMPILE] and COMPILE .
\
\ 2005-11-05: BL>HTML renamed SPACE>HTML .
\
\ 2005-11-04: New word CURRENT-HTML? .
\
\ 2005-10-28: FORTH> and <FORTH renamed HTML[ and ]HTML .
\
\ 2005-10-15: >HTML now prints in a new line, and the new word >>HTML
\ prints in the current line.
\
\ 2005-10-12: FORTH> modified to work in compilation mode too.
\
\ 2005-08-26: FORTH> modified again to read by words with WORD and to
\ print an end of line after the end of the input buffer.  New words
\ CR>HTML and BL>HTML .  First working version.
\
\ 2005-08-24: FORTH> modified to read by lines with PARSE .
\
\ 2005-06-06: First tests with <FORTH and FORTH> .
\
\ 2005-04-19: First sketch.
\
\ 2004-12: First ideas on paper.  Options studied: 1) Mixed code:
\ visible as HTML and compilable by Forth. Very complex.  2) The Forth
\ program makes the HTML code with database and text files, like my
\ old program "eeo" did. Simple but less versatile.  3) The Forth code
\ makes the page by itself. Simple and versatile. Choosen option.

\ .............................................................
\ Init

[undefined] fstr  [IF]  S" fstr.fs" INCLUDED  [THEN]
[undefined] ftrac [IF]  S" ftrac.fs" INCLUDED  [THEN]
\ [undefined] ftra [IF]  S" ftra.fs" INCLUDED  [THEN] \ needed when the Simplilo translation is active

MARKER fhp

\ .............................................................
\ Variables and tests

1 VALUE xhtml-version  \ possible values: 1, 11 (=1.1)

\ false VALUE xhtml11  \ old code!!!
: xhtml11  ( -- f )  xhtml-version 11 =  ;  \ for compatibility with the old code

VARIABLE html-fid
svariable html-path  0 html-path C!
svariable html-filename
VARIABLE html-echo  FALSE html-echo !  \ screen echo?
VARIABLE html-tra  FALSE html-tra !  \ translate chars?
VARIABLE html-make  TRUE html-make !  \ make HTML?

: html-make?  ( -- f )  html-make @ ;
: html-echo?  ( -- f )  html-echo @ ;

: html>screen  ( -- )  html-make off html-echo on ;
: html>file  ( -- )  html-make on html-echo off ;

: current-html?  ( c-addr u -- f )

  \ Test whether a file is the current one.

  html-filename COUNT COMPARE 0=

  ;

\ .............................................................
\ HTML files

: close-html  ( -- )

  \ Close the HTML file.

  html-make?  IF
    html-fid @ CLOSE-FILE
    ABORT" HTML file close error"
  THEN

  ;

' close-html alias close-css
' close-html alias }css

: create-html  ( c-addr u -- )

  \ Open the output HTML file.

  \ 2dup cr ." file name=" type \ debug!!!

  html-make?  IF
    2DUP  html-path COUNT 2SWAP str+ W/O CREATE-FILE
    ABORT" HTML file create error"
    html-fid !
  THEN
  html-filename place

  ;

' create-html alias create-css

: css{  ( c-addr u -- )  2DUP CR TYPE create-css  ;

\ .............................................................
\ Translations needed when the Simplilo's format output is active

: str-cr  ( -- c-addr 1 )

  \ Return a text with a line feed

  \ 2010-10-21 First version.

  10 b>str
;

\ Try with the rgx module of Forth Foundation Library:
\ rgx-create  simple_<em>_rgx
\ s" (<em>)(.*)(</em>)" simple_<em>_rgx rgx-compile
\ 0=  [if]  .( Compilation of simple_<em>_rgx failed on position ) . [then]

variable lang_span_found  0 lang_span_found !
variable span_close_anyway  0 span_close_anyway !
variable lang_em_found  0 lang_em_found !
variable lang_cite_found  0 lang_cite_found !
variable last_list_found  0 last_list_found !
1 constant ul-type
2 constant ol-type

: simplilo-tra-lang  ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )

  \ c-addr1 u1 = string to translate
  \ c-addr2 u2 = language code of the tags to translate
  \ c-addr3 u3 = transalated string

  \ 2010-10-24 First version. Support for <span> and <em>.
  \ 2010-10-25 Support for <cite>.

  2>r
  2dup s" <span xml:lang='X' lang='X'>" s" X" 2r@ str-exchange-all str-in?
  if
    s" <span xml:lang='X' lang='X'>" s" X" 2r@ str-exchange-all
    s" X((" s" X" 2r@ str-exchange-all str-exchange
    true lang_span_found !
  then

  2dup s" <span class='surname' lang='X' xml:lang='X'>" s" X" 2r@ str-exchange-all str-in?
  if
    s" <span class='surname' lang='X' xml:lang='X'>" s" X" 2r@ str-exchange-all
    s" <<span surname />>X((" s" X" 2r@ str-exchange-all str-exchange
    true lang_span_found !
    true span_close_anyway !
    s" </span>" s" ))<<span/>>" str-exchange
  then

  2dup s" <span lang='X' xml:lang='X'>" s" X" 2r@ str-exchange-all str-in?
  if
    s" <span lang='X' xml:lang='X'>" s" X" 2r@ str-exchange-all
    s" X((" s" X" 2r@ str-exchange-all str-exchange
    true lang_span_found !
  then

  \ special case with two spaces after "<span", as done by the word >span-lang-en
  2dup s" <span  xml:lang='X' lang='X'>" s" X" 2r@ str-exchange-all str-in?
  if
    s" <span  xml:lang='X' lang='X'>" s" X" 2r@ str-exchange-all
    s" //X((" s" X" 2r@ str-exchange-all str-exchange
    true lang_span_found !
  then

  2dup s" <em lang='X' xml:lang='X'>" s" X" 2r@ str-exchange-all str-in?
  if
    s" <em lang='X' xml:lang='X'>" s" X" 2r@ str-exchange-all
    s" //X((" s" X" 2r@ str-exchange-all str-exchange
    true lang_em_found !
  then

  2dup s" <em xml:lang='X' lang='X'>" s" X" 2r@ str-exchange-all str-in?
  if
    s" <em xml:lang='X' lang='X'>" s" X" 2r@ str-exchange-all
    s" //X((" s" X" 2r@ str-exchange-all str-exchange
    true lang_em_found !
  then

  2dup s" <cite lang='X' xml:lang='X'>" s" X" 2r@ str-exchange-all str-in?
  if
    s" <cite lang='X' xml:lang='X'>" s" X" 2r@ str-exchange-all
    s" //X((" s" X" 2r@ str-exchange-all str-exchange
    true lang_cite_found !
  then

  2dup s" <cite xml:lang='X' lang='X'>" s" X" 2r@ str-exchange-all str-in?
  if
    s" <cite xml:lang='X' lang='X'>" s" X" 2r@ str-exchange-all
    s" //X((" s" X" 2r@ str-exchange-all str-exchange
    true lang_cite_found !
  then

  2rdrop

  ;

: simplilo-tra-langs  ( c-addr1 u1 -- c-addr2 u2 )

  \ c-addr1 u1 = string to translate
  \ c-addr2 u2 = transalated string

  \ 2010-10-24

  s" es" simplilo-tra-lang
  s" en" simplilo-tra-lang
  s" eo" simplilo-tra-lang
  s" fr" simplilo-tra-lang
  s" it" simplilo-tra-lang
  s" de" simplilo-tra-lang
  s" la" simplilo-tra-lang
  s" ca" simplilo-tra-lang
  s" da" simplilo-tra-lang

  ;

: simplilo-tra-abbr  ( c-addr1 u1 -- c-addr2 u2 )

  s" <abbr title='kilogramo'>kg</abbr>" s" <<abbr kg />>" str-exchange
  s" <abbr title='milímetro'>mm</abbr>" s" <<abbr mm />>" str-exchange
  s" <abbr title='milimetro'>mm</abbr>" s" <<abbr mm />>" str-exchange
  s" <abbr title='centimetro'>cm</abbr>" s" <<abbr cm />>" str-exchange
  s" <abbr title='centímetro'>cm</abbr>" s" <<abbr cm />>" str-exchange
  s" <abbr title='página'>p.</abbr>" s" <<abbr p. />>" str-exchange
  s" <abbr title='paĝo'>p.</abbr>" s" <<abbr p. />>" str-exchange
  s" <abbr title='prononcu'>pr.</abbr>" s" <<abbr pr. />>" str-exchange-all
  s" <abbr title='tradukisto'>trad.</abbr>" s" tradukisto" str-exchange-all
  s" <abbr title='traductor'>trad.</abbr>" s" traductor" str-exchange-all
  s" <abbr title='David'>D.</abbr>" s" <<abbr D. David en />>" str-exchange-all
  s" <acronym title='Biciklista Esperantista Movado Internacia'>BEMI</acronym>" s" <<abbr BEMI />>" str-exchange-all
  s" <acronym lang='eo' xml:lang='eo' title='Biciklista Esperantista Movado Internacia'>BEMI</acronym>" s" <<abbr BEMI />>" str-exchange-all
  s\" <acronym title=\"Biciklista Esperantista Movado Internacia\">BEMI</acronym>" s" <<abbr BEMI />>" str-exchange-all
  s" <acronym class='first' title='Biciklista Esperantista Movado Internacia'>BEMI</acronym>" s" <<abbr BEMI />>" str-exchange-all
  s" <abbr lang='es' xml:lang='es' title='Coordinadora en defensa de la Bici'>ConBici</abbr>" s" <<abbr ConBici />>" str-exchange-all
  s" <acronym title='Hispana Esperanto-Federacio'>HEF</acronym>" s" <<abbr HEF />>" str-exchange-all

  ;

: simplilo-tra-span  ( c-addr1 u1 -- c-addr2 u2 )

  \ c-addr1 u1 = string to translate
  \ c-addr2 u2 = transalated string

  \ 2010-10-24

  begin
    2dup s" <span>" str-in?
  while
    s" <span>" s" <<html span />>" str-exchange
    false lang_span_found !
  repeat
  2dup s" <span class='author'>" str-in?
  if
    s" <span class='author'>" s" <<span author />>" str-exchange
    false lang_span_found !
  then
  2dup s" <span  class='author'>" str-in?
  if
    s" <span  class='author'>" s" <<span author />>" str-exchange
    false lang_span_found !
  then
  2dup s" <span class='surname'>" str-in?
  if
    s" <span class='surname'>" s" <<span surname />>" str-exchange
    false lang_span_found !
  then
  begin
    2dup s" </span>" str-in?
  while
    lang_span_found @
    if
      span_close_anyway @
      if
        s" </span>" s" ))<<span/>>" str-exchange
        false span_close_anyway !
      else
        s" </span>" s" ))" str-exchange
      then
      false lang_span_found !
    else
      s" </span>" s" <<span/>>" str-exchange
    then
  repeat

  ;

: simplilo-tra-strong  ( c-addr1 u1 -- c-addr2 u2 )

  \ c-addr1 u1 = string to translate
  \ c-addr2 u2 = transalated string

  \ 2011-02-10 First version.

  2dup s" <strong>" str-in?
  if
    s" <strong>" s" **" str-exchange
  then
  2dup s" </strong>" str-in?
  if
    s" </strong>" s" **" str-exchange
  then
  ;

: simplilo-tra-em  ( c-addr1 u1 -- c-addr2 u2 )

  \ c-addr1 u1 = string to translate
  \ c-addr2 u2 = transalated string

  \ 2010-10-24

  2dup s" <em>" str-in?
  if
    s" <em>" s" //" str-exchange
    false lang_em_found !
  then
  2dup s" </em>" str-in?
  if
    lang_em_found @
    if
      s" </em>" s" ))//" str-exchange
      false lang_em_found !
    else
      s" </em>" s" //" str-exchange
    then
  then

  ;

: simplilo-tra-quote  ( c-addr1 u1 -- c-addr2 u2 )

  \ c-addr1 u1 = string to translate
  \ c-addr2 u2 = transalated string

  \ 2011-02-12 First version.

  s" <blockquote>" s\" \n\"\"\n" str-exchange-all
  s" <blockquote class='normal'>" s\" \n\"\"\n" str-exchange-all
  s" <blockquote class='example'>" s\" \n\"\"\n" str-exchange-all
  s" </blockquote>" s\" \n\"\"\n" str-exchange-all
  s" <q>" s\" \"\"" str-exchange-all
  s" </q>" s\" \"\"" str-exchange-all

  ;

: simplilo-tra-paragraph  ( c-addr1 u1 -- c-addr2 u2 )

  \ c-addr1 u1 = string to translate
  \ c-addr2 u2 = transalated string

  \ 2011-02-12 First version, factored from simplilo-tra .

  s" <p>" str-cr str-exchange-all
  s" <p class='source'>" s\" \n\n{* <p> with class='source' was here *}\n" str-exchange-all
  s" </p>" str-cr str-exchange-all
  s" <br />" s" \\" str-exchange-all
  ;

: simplilo-tra-cite  ( c-addr1 u1 -- c-addr2 u2 )

  \ c-addr1 u1 = string to translate
  \ c-addr2 u2 = transalated string

  \ 2010-10-24

  2dup s" <cite>" str-in?
  if
    s" <cite>" s" //" str-exchange
    false lang_cite_found !
  then
  2dup s" <cite class='sitetitle'>" str-in?
  if
    s" <cite class='sitetitle'>" s" //" str-exchange
    false lang_cite_found !
  then
  2dup s" </cite>" str-in?
  if
    lang_cite_found @
    if
      s" </cite>" s" ))//" str-exchange
      false lang_cite_found !
    else
      s" </cite>" s" //" str-exchange
    then
  then

  ;

: simplilo-tra-lists  ( c-addr1 u1 -- c-addr2 u2 )

  \ c-addr1 u1 = string to translate
  \ c-addr2 u2 = transalated string

  \ 2010-10-24

  2dup s" <ul>" str-in?
  if
    ul-type last_list_found !
    s" <ul>" str-erase
  then
  2dup s" <ol>" str-in?
  if
    ol-type last_list_found !
    s" <ol>" str-erase
  then

  s" <li>"
  last_list_found @
  case
    ul-type  of  s" * "  endof
    ol-type  of  s" # "  endof
    s" mistake "
  endcase
  str-exchange

  s" </li>" str-erase-all

  2dup s" </ul>" str-in?
  if
    false last_list_found !
    s" </ul>" str-erase
  then
  2dup s" </ol>" str-in?
  if
    false last_list_found !
    s" </ol>" str-erase
  then

  ;

: simplilo-tra-html-entities ( c-addr u -- )

  \ Translates some HTML entities into UTF-8 characters.

  \ 2011-02-10 First version.

  \ Esperanto letters:
  s" &#265;" s" ĉ" str-exchange-all
  s" &#264;" s" Ĉ" str-exchange-all
  s" &#285;" s" ĝ" str-exchange-all
  s" &#284;" s" Ĝ" str-exchange-all
  s" &#293;" s" ĥ" str-exchange-all
  s" &#292;" s" Ĥ" str-exchange-all
  s" &#309;" s" ĵ" str-exchange-all
  s" &#308;" s" Ĵ" str-exchange-all
  s" &#349;" s" ŝ" str-exchange-all
  s" &#348;" s" Ŝ" str-exchange-all
  s" &#365;" s" ŭ" str-exchange-all
  s" &#364;" s" Ŭ" str-exchange-all
  \ Spanish letters and punctuation marks:
  s" &#225;" s" á" str-exchange-all
  s" &#193;" s" Á" str-exchange-all
  s" &#233;" s" é" str-exchange-all
  s" &#201;" s" É" str-exchange-all
  s" &#237;" s" í" str-exchange-all
  s" &#205;" s" Í" str-exchange-all
  s" &#243;" s" ó" str-exchange-all
  s" &#211;" s" Ó" str-exchange-all
  s" &#250;" s" ú" str-exchange-all
  s" &#218;" s" Ú" str-exchange-all
  s" &#252;" s" ü" str-exchange-all
  s" &uuml;" s" ü" str-exchange-all
  s" &#220;" s" Ü" str-exchange-all
  s" &Uuml;" s" Ü" str-exchange-all
  s" &#241;" s" ñ" str-exchange-all
  s" &#209;" s" Ñ" str-exchange-all
  s" &#191;" s" ¿" str-exchange-all
  s" &#161;" s" ¡" str-exchange-all
  \ Other languages:
  s" &#224;" s" à" str-exchange-all
  s" &#228;" s" ä" str-exchange-all
  s" &#192;" s" À" str-exchange-all
  s" &#200;" s" È" str-exchange-all
  s" &#244;" s" ô" str-exchange-all
  s" &#246;" s" ö" str-exchange-all
  s" &#199;" s" Ç" str-exchange-all
  s" &#231;" s" ç" str-exchange-all
  \ Misc:
  s" &#170;" s" ª" str-exchange-all
  s" &#171;" s" «" str-exchange-all
  s" &laquo;" s" «" str-exchange-all
  s" &#183;" s" ·" str-exchange-all
  s" &#186;" s" º" str-exchange-all
  s" &#187;" s" »" str-exchange-all
  s" &raquo;" s" »" str-exchange-all
  ;

: simplilo-tra  ( c-addr u -- )

  \ Do some text translations needed when the Simplilo's format output is active.

  \ 2010-10-21 First version, with <p> and <table>.
  \ 2010-10-22 Improved with <ul> and <ol>.
  \ 2010-10-24 Factored out.
  \ 2011-02-10 Improved with simplilo-tra-strong .
  \ 2011-02-11 Improved with simplilo-tra-html-entities .

  simplilo-tra-html-entities

  simplilo-tra-paragraph

  s" <table" s" {html}<table" str-exchange
  s" </table>" s" </table>{/html}" str-exchange

  simplilo-tra-lists
  simplilo-tra-langs
  simplilo-tra-span
  simplilo-tra-em
  simplilo-tra-strong
  simplilo-tra-cite
  simplilo-tra-quote
  simplilo-tra-abbr

  s" <div id='published'>" s" <<div::published:/>>" str-exchange
  \ s" <div class='leftimg'>" s" <<div:leftimg:/>>" str-exchange
  \ s" <div class='rightimg'>" s" <<div:rightimg:/>>" str-exchange

  [ false ] [if]
  2dup simple_<em>_rgx rgx-cmatch?
  if
    1 simple_<em>_rgx rgx-result swap s" //" str-slice-exchange  \ <em>
    3 simple_<em>_rgx rgx-result swap s" //" str-slice-exchange  \ </em>
  then
  [then]

  ;

\ .............................................................
\ Writing into the HTML file

: (>>html)  ( c-addr u -- )

  \ Write text into the HTML file in the current line.

  html-tra @  IF
    simplilo?
    IF  simplilo-tra
    ELSE  trac
    THEN
  THEN
  html-echo?  IF  2DUP TYPE  THEN
  html-make?  IF
    html-fid @ WRITE-FILE ABORT" file write error in (>>HTML)"
  ELSE
    2DROP
  THEN

  ;

defer >>html
' (>>html) is >>html

' >>html alias >>css

: ?>>html  ( c-addr u -- )

  \ Write text into the HTML file in the current line (if the text is not empty).

  DUP  IF >>html ELSE 2DROP THEN

  ;

' ?>>html alias ?>>css

: (html)  ( c -- )

  \ Write the following text into the HTML file in the current line, until a char is found.

  \ c = limit char

  \ 2007-04-08 Factored from HTML\\ and HTML|| .

  WORD COUNT >sbuffer >>html

  ;


: :html\\  ( "text" -- )

  \ Write the rest of the line into the HTML file in the current line.

  \ 2006-11-29
        \ 2006-12-06 Bug fixed. (>>HTML) was used instead of the defered >>HTML so the multilingual mode didn't work.
        \ 2006-12-08 Bug fixed. Added >SBUFFER . I noticed this executing the code with gforth:
                \ The string translation made by TRAC failed because it worked in a temporary area.
  \ 2007-04-08 Factored with (HTML) and renamed (was HTML<< ).

  0 (html)

  ;

' :html\\ alias :css\\

' :html\\ alias html<<  \ old name, obsolete!!!

: :html||  ( "text" -- )

  \ Write the following text into the HTML file in the current line, until a space is found.

  \ 2007-04-08

  BL (html)

  ;

' :html|| alias :css||

: emit>html  ( b -- )  b>str >>html  ;
' emit>html alias emit>css
: space>html  ( -- )  S"  " >>html  ;
' space>html alias space>css
: tick>html  ( -- ) S" '" >>html ;
' tick>html alias tick>css
: dot>html  ( -- )  S" ." >>html  ;
' dot>html alias dot>css
: comma>html  ( -- )  S" ," >>html  ;
' comma>html alias comma>css
: colon>html  ( -- ) S" :" >>html  ;
' colon>html alias colon>css
: semicolon>html  ( -- ) S" ;" >>html  ;
' semicolon>html alias semicolon>css
: quote>html  ( -- ) [CHAR] " b>str >>html  ;

: >>css;  ( c-addr u -- )  >>css semicolon>css  ;

\ end of line strings
CREATE eol  2 C, 13 C, 10 C,  ALIGN
CREATE simplilo-eol  1 C, 10 C,  ALIGN

: cr>html  ( -- )

  \ Write an end of line into the HTML file.

  html-echo?  IF  CR  THEN
  html-make?  IF
    simplilo?  IF  simplilo-eol  ELSE  eol  THEN
    COUNT >>html
  THEN

  ;

' cr>html alias cr>css

: >html  ( c-addr u -- )

  \ Write text into the HTML file in a new line.

  cr>html >>html

  ;

' >html alias >css

: :html\  ( "text" -- )

  \ Write the rest of the line into the HTML file in a new line.

  \ 2007-04-09 Renamed (was HTML< ).

  cr>html :html\\

  ;

' :html\ alias html<  \ old name, obsolete!!!

' :html\ alias :css\

: :html|  ( "text" -- )

  \ Write the following text into the HTML file in a new line, until a space is found.

  \ 2007-04-08

  cr>html :html||

  ;

' :html| alias :css|

: ?>html  ( c-addr u -- )

  \ Write text into the HTML file in a new line (if the text is not empty).

  cr>html DUP  IF >>html ELSE 2DROP THEN

  ;

' ?>html alias ?>css

\ .............................................................
\ HTML zone markers

: html[  ( -- )

  \ Compile the following HTML into the dicionary until ]html is found.

  \ 2006-04-26

  BEGIN
    BL WORD COUNT DUP
    IF  \ word found
      2DUP S" ]html" COMPARE
      IF  \ end marker not found
        POSTPONE SLITERAL
        POSTPONE >>html
        POSTPONE space>html
        FALSE
      ELSE  \ end marker found
        2DROP TRUE
      THEN
    ELSE  \ word not found
      2DROP
      POSTPONE cr>html
      REFILL 0=
    THEN
  UNTIL

  ; IMMEDIATE

: html(  ( -- )

  \ 2006-04-26

  BEGIN
    BL WORD COUNT DUP
    IF  \ word found
      2DUP S" )html" COMPARE
      IF  \ end marker not found
        >>html space>html
        FALSE
      ELSE  \ end marker found
        2DROP TRUE
      THEN
    ELSE  \ word not found
      2DROP cr>html
      REFILL 0=
    THEN
  UNTIL

  ;

: (:html)  ( -- )

  \ Discard the rest of the line and read HTML from the following lines until an empty one is found.

  \ 2007-04-09 Renamed (formerly HTML\ ). In practice it won't be used, in favour to :HTML .

  BEGIN
    REFILL
    ." "  \ :!!! I don't know why, there has to be something here; otherwise the whole thing fails
    SOURCE
    ROT OVER AND
  WHILE
    >html
  REPEAT
  2DROP

  ;

' (:html) alias html\  \ old name, obsolete!!!

: :html  ( -- )  \ obsolete!!!

  \ Read HTML until an empty line is found.
  \ This first version has one problem: it was created to start writing in a new line,
  \ but sometimes it's usefull to write in the current line.
  \ That's why I wrote the new words :HTML< and :HTML<< so I don't have to change the old code that used :HTML .

  \ 2007-04-09

  :html\ (:html)

  ;

' :html alias :css

: :html<  ( -- )

  \ Read HTML until an empty line is found.

  \ 2007-04-26

  :html\ (:html)

  ;

' :html< alias :css<

: :html<<  ( -- )

  \ Read HTML until an empty line is found.

  \ 2007-04-26

  :html\\ (:html)

  ;

' :html<< alias :css<<

.(  fhp-core ok!)