fhp - core
Descripción del contenido de la página
Módulo principal del programa fhp.
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" ĉ" s" ĉ" str-exchange-all
s" Ĉ" s" Ĉ" str-exchange-all
s" ĝ" s" ĝ" str-exchange-all
s" Ĝ" s" Ĝ" str-exchange-all
s" ĥ" s" ĥ" str-exchange-all
s" Ĥ" s" Ĥ" str-exchange-all
s" ĵ" s" ĵ" str-exchange-all
s" Ĵ" s" Ĵ" str-exchange-all
s" ŝ" s" ŝ" str-exchange-all
s" Ŝ" s" Ŝ" str-exchange-all
s" ŭ" s" ŭ" str-exchange-all
s" Ŭ" s" Ŭ" str-exchange-all
\ Spanish letters and punctuation marks:
s" á" s" á" str-exchange-all
s" Á" s" Á" str-exchange-all
s" é" s" é" str-exchange-all
s" É" s" É" str-exchange-all
s" í" s" í" str-exchange-all
s" Í" s" Í" str-exchange-all
s" ó" s" ó" str-exchange-all
s" Ó" s" Ó" str-exchange-all
s" ú" s" ú" str-exchange-all
s" Ú" s" Ú" str-exchange-all
s" ü" s" ü" str-exchange-all
s" ü" s" ü" str-exchange-all
s" Ü" s" Ü" str-exchange-all
s" Ü" s" Ü" str-exchange-all
s" ñ" s" ñ" str-exchange-all
s" Ñ" s" Ñ" str-exchange-all
s" ¿" s" ¿" str-exchange-all
s" ¡" s" ¡" str-exchange-all
\ Other languages:
s" à" s" à" str-exchange-all
s" ä" s" ä" str-exchange-all
s" À" s" À" str-exchange-all
s" È" s" È" str-exchange-all
s" ô" s" ô" str-exchange-all
s" ö" s" ö" str-exchange-all
s" Ç" s" Ç" str-exchange-all
s" ç" s" ç" str-exchange-all
\ Misc:
s" ª" s" ª" str-exchange-all
s" «" s" «" str-exchange-all
s" «" s" «" str-exchange-all
s" ·" s" ·" str-exchange-all
s" º" s" º" str-exchange-all
s" »" s" »" str-exchange-all
s" »" 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!)