_html.tcl

Go to the documentation of this file.

/*  -*- tcl -*-*/
/*  Helper rules for the creation of the memchan website from the .exp files.*/
/*  General formatting instructions ...*/

/*  htmlEscape text --*/
/*  Replaces HTML markup characters in $text with the*/
/*  appropriate entity references.*/
/* */

global textMap;
    textMap =  {
    &    &amp;    <    &lt;     >    &gt;       
    \xa0 &nbsp;   \xb0 &deg;    \xc0 &Agrave; \xd0 &ETH;    \xe0 &agrave; \xf0 &eth;
    \xa1 &iexcl;  \xb1 &plusmn; \xc1 &Aacute; \xd1 &Ntilde; \xe1 &aacute; \xf1 &ntilde;
    \xa2 &cent;   \xb2 &sup2;   \xc2 &Acirc;  \xd2 &Ograve; \xe2 &acirc;  \xf2 &ograve;
    \xa3 &pound;  \xb3 &sup3;   \xc3 &Atilde; \xd3 &Oacute; \xe3 &atilde; \xf3 &oacute;
    \xa4 &curren; \xb4 &acute;  \xc4 &Auml;   \xd4 &Ocirc;  \xe4 &auml;   \xf4 &ocirc;
    \xa5 &yen;    \xb5 &micro;  \xc5 &Aring;  \xd5 &Otilde; \xe5 &aring;  \xf5 &otilde;
    \xa6 &brvbar; \xb6 &para;   \xc6 &AElig;  \xd6 &Ouml;   \xe6 &aelig;  \xf6 &ouml;
    \xa7 &sect;   \xb7 &middot; \xc7 &Ccedil; \xd7 &times;  \xe7 &ccedil; \xf7 &divide;
    \xa8 &uml;    \xb8 &cedil;  \xc8 &Egrave; \xd8 &Oslash; \xe8 &egrave; \xf8 &oslash;
    \xa9 &copy;   \xb9 &sup1;   \xc9 &Eacute; \xd9 &Ugrave; \xe9 &eacute; \xf9 &ugrave;
    \xaa &ordf;   \xba &ordm;   \xca &Ecirc;  \xda &Uacute; \xea &ecirc;  \xfa &uacute;
    \xab &laquo;  \xbb &raquo;  \xcb &Euml;   \xdb &Ucirc;  \xeb &euml;   \xfb &ucirc;
    \xac &not;    \xbc &frac14; \xcc &Igrave; \xdc &Uuml;   \xec &igrave; \xfc &uuml;
    \xad &shy;    \xbd &frac12; \xcd &Iacute; \xdd &Yacute; \xed &iacute; \xfd &yacute;
    \xae &reg;    \xbe &frac34; \xce &Icirc;  \xde &THORN;  \xee &icirc;  \xfe &thorn;
    \xaf &hibar;  \xbf &iquest; \xcf &Iuml;   \xdf &szlig;  \xef &iuml;   \xff &yuml;
    {"} &quot;
} ; /*  " make the emacs highlighting code happy.*/

/*  Handling of HTML delimiters in content:*/
/* */
/*  Plain text is initially passed through unescaped;*/
/*  internally-generated markup is protected by preceding it with \1.*/
/*  The final PostProcess step strips the escape character from*/
/*  real markup and replaces markup characters from content*/
/*  with entity references.*/
/* */

global   markupMap
      markupMap =  { {&} {\1&}  {<} {\1<}  {>} {\1>} {"} {\1"} } 
global   finalMap
      finalMap =  $textMap
lappend  finalMap {\1&} {&}  {\1<} {<}  {\1>} {>} {\1"} {"}


ret  htmlEscape (type text) {
    global textMap
    return [string map $textMap $text]
}

ret  fmt_postprocess (type text)    {
    global finalMap
    return [string map $finalMap $text]
}

/*  markup text --*/
/*  Protect markup characters in $text with \1.*/
/*  These will be stripped out in PostProcess.*/
/* */
ret  markup (type text) {
    global markupMap
    return [string map $markupMap $text]
}

ret  use_bg () {
    set c [bgcolor]
    #puts stderr "using $c"
    if {$c == {}} {return ""}
    return bgcolor=$c
}


ret  nbsp   ()         {return [markup "&nbsp;"]}
ret  p      ()         {return [markup <p>]}
ret  ptop   ()         {return [markup "<p valign=top>"]}
ret  td     ()         {return [markup "<td [use_bg]>"]}
ret  trtop  ()         {return [markup "<tr valign=top [use_bg]>"]}
ret  tr     ()         {return [markup "<tr            [use_bg]>"]}
ret  sect   (type s)        {return [markup "<b>$s</b><br><hr>"]}
ret  link   (type text , type url) {return [markup "<a href=\"$url\">$text</a>"]}
ret  table  ()         {return [markup "<table [border] width=100% cellspacing=0 cellpadding=0>"]}
ret  btable ()         {return [markup "<table border=1 width=100% cellspacing=0 cellpadding=0>"]}
ret  stable ()         {return [markup "<table [border] cellspacing=0 cellpadding=0>"]}


ret  tcl_cmd (type cmd) {return "[markup <b>]\[$cmd][markup </b>]"}
ret  wget    (type url) {exec /usr/bin/wget -q -O - $url 2>/dev/null}

ret  url (type tag , type text , type url) {
    set body {
    switch -exact -- $what {
        link {return {\1<a href="%url%"\1>%text%\1</a\1>}} ; ## TODO - markup
        text {return {%text%}}
        url  {return {%url%}}
    }
    }
    proc $tag {{what link}} [string map [list %text% $text %url% $url] $body]
}

ret  img (type tag , type alt , type img) {
    proc $tag {} [list return "\1<img alt=\"$alt\" src=\"$img\"\1>"]
}

ret  protect (type text) {return [string map [list & "&amp;" < "&lt;" > "&gt;"] $text]}


ret  tag  (type t) {return [markup <$t>]}
ret  taga (type t , type av) {
    # av = attribute value ...
    set avt [list]
    foreach {a v} $av {lappend avt "$a=\"$v\""}
    return [markup "<$t [join $avt]>"]
}
ret  tag/ (type t) {return [markup </$t>]}
ret  tag_ (type t , type block , type args) {
    # args = key value ...
    if {$args == {}} {return "[tag $t]$block[tag/ $t]"}
    return "[taga $t $args]$block[tag/ $t]"
}


ret  ht_comment (type text)   {return "[markup <]! -- [join [split $text \n] "   -- "]\n   --[markup >]"}

/*  wrap content gi --*/
/*  Returns $content wrapped inside <$gi> ... </$gi> tags.*/
/* */
ret  wrap (type content , type gi) {
    return "[tag $gi]${content}[tag/ $gi]"
}
ret  startTag (type x , type args) {if {[llength $args]} {taga $x $args} else {tag $x}}
ret  endTag   (type x) {tag/ $x}