Artifact b5a7b8fe874dd1a51a68455568abd9111cbede23:
# -*- tcl -*-
# Copyright (c) 2001-2008 Andreas Kupries <andreas_kupries@sourceforge.net>
#
# 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;
set textMap {
& & < < > >
\xa0 \xb0 ° \xc0 À \xd0 Ð \xe0 à \xf0 ð
\xa1 ¡ \xb1 ± \xc1 Á \xd1 Ñ \xe1 á \xf1 ñ
\xa2 ¢ \xb2 ² \xc2 Â \xd2 Ò \xe2 â \xf2 ò
\xa3 £ \xb3 ³ \xc3 Ã \xd3 Ó \xe3 ã \xf3 ó
\xa4 ¤ \xb4 ´ \xc4 Ä \xd4 Ô \xe4 ä \xf4 ô
\xa5 ¥ \xb5 µ \xc5 Å \xd5 Õ \xe5 å \xf5 õ
\xa6 ¦ \xb6 ¶ \xc6 Æ \xd6 Ö \xe6 æ \xf6 ö
\xa7 § \xb7 · \xc7 Ç \xd7 × \xe7 ç \xf7 ÷
\xa8 ¨ \xb8 ¸ \xc8 È \xd8 Ø \xe8 è \xf8 ø
\xa9 © \xb9 ¹ \xc9 É \xd9 Ù \xe9 é \xf9 ù
\xaa ª \xba º \xca Ê \xda Ú \xea ê \xfa ú
\xab « \xbb » \xcb Ë \xdb Û \xeb ë \xfb û
\xac ¬ \xbc ¼ \xcc Ì \xdc Ü \xec ì \xfc ü
\xad ­ \xbd ½ \xcd Í \xdd Ý \xed í \xfd ý
\xae ® \xbe ¾ \xce Î \xde Þ \xee î \xfe þ
\xaf &hibar; \xbf ¿ \xcf Ï \xdf ß \xef ï \xff ÿ
{"} "
} ; # " 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
set markupMap { {&} {\1&} {<} {\1<} {>} {\1>} {"} {\1"} }
global finalMap
set finalMap $textMap
lappend finalMap {\1&} {&} {\1<} {<} {\1>} {>} {\1"} {"}
proc htmlEscape {text} {
global textMap
return [string map $textMap $text]
}
proc fmt_postprocess {text} {
global finalMap
if 0 {
puts_stderr ____________________________________________________________
puts_stderr $text
puts_stderr ____________________________________________________________
}
# Put protected characters into their final form.
set text [string map $finalMap $text]
# Remove leading/trailing whitespace from paragraphs.
regsub -all "<p>\[\t\n \]*" $text {<p>} text
regsub -all "\[\t\n \]*</p>" $text {</p>} text
# Remove trailing linebreaks from paragraphs.
while {[regsub -all "<br>\[\t\n \]*</p>" $text {</p>} text]} continue
# Remove empty paragraphs
regsub -all "<p>\[\t\n \]*</p>" $text {} text
# Separate paragraphs
regsub -all "</p><p>" $text "</p>\n<p>" text
# Separate bigger structures
foreach outer {div p dl ul ol} {
foreach inner {div p dl ul ol} {
regsub -all "</${outer}><${inner}" $text "</${outer}>\n<${inner}" text
regsub -all "</${outer}></${inner}" $text "</${outer}>\n</${inner}" text
}
}
regsub -all "<li><dl" $text "<li>\n<dl" text
regsub -all "<li><ol" $text "<li>\n<ol" text
regsub -all "<li><ul" $text "<li>\n<ul" text
regsub -all "</dl></li" $text "</dl>\n</li" text
regsub -all "</ol></li" $text "</ol>\n</li" text
regsub -all "</ul></li" $text "</ul>\n</li" text
# Remove empty lines.
regsub -all "\n\n\n*" $text \n text
if 0 {
puts_stderr @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
puts_stderr $text
puts_stderr @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
}
return $text
}
# markup text --
# Protect markup characters in $text with \1.
# These will be stripped out in PostProcess.
#
proc markup {text} {
global markupMap
return [string map $markupMap $text]
}
proc use_bg {} {
set c [bgcolor]
#puts stderr "using $c"
if {$c == {}} {return ""}
return bgcolor=$c
}
proc nbsp {} {return [markup " "]}
proc p {} {return [markup <p>]}
proc ptop {} {return [markup "<p valign=top>"]}
proc td {} {return [markup "<td [use_bg]>"]}
proc trtop {} {return [markup "<tr valign=top [use_bg]>"]}
proc tr {} {return [markup "<tr [use_bg]>"]}
proc sect {s} {return [markup <b>]$s[markup </b><br><hr>]}
proc link {text url} {return [markup "<a href=\"$url\">"]$text[markup </a>]}
proc table {} {return [markup "<table [border] width=100% cellspacing=0 cellpadding=0>"]}
proc btable {} {return [markup "<table border=1 width=100% cellspacing=0 cellpadding=0>"]}
proc stable {} {return [markup "<table [border] cellspacing=0 cellpadding=0>"]}
proc link {text url} {return [markup "<a href=\"$url\">"]$text[markup </a>]}
proc tcl_cmd {cmd} {return "[markup <b>]\[$cmd][markup </b>]"}
proc wget {url} {exec /usr/bin/wget -q -O - $url 2>/dev/null}
proc url {tag text 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]
}
proc img {tag alt img} {
proc $tag {} [list return "\1<img alt=\"$alt\" src=\"$img\"\1>"]
}
proc protect {text} {return [string map [list & "&" < "<" > ">"] $text]}
proc strong {text} {tag_ strong $text}
proc em {text} {tag_ em $text}
proc bold {text class} {tag_ b $text class $class}
proc italic {text class} {tag_ i $text class $class}
proc span {text class} {tag_ span $text class $class}
proc tag {t} {return [markup <$t>]}
proc taga {t av} {
# av = attribute value ...
set avt [list]
foreach {a v} $av {lappend avt "$a=\"$v\""}
return [markup "<$t [join $avt]>"]
}
proc tag/ {t} {return [markup </$t>]}
proc tag_ {t block args} {
# args = key value ...
if {$args == {}} {return "[tag $t]$block[tag/ $t]"}
return "[taga $t $args]$block[tag/ $t]"
}
proc tag* {t args} {
if {[llength $args]} {
taga $t $args
} else {
tag $t
}
}
proc ht_comment {text} {
return "[markup <]! -- [join [split $text \n] " -- "]\n --[markup >]"
}
# wrap content gi --
# Returns $content wrapped inside <$gi> ... </$gi> tags.
#
proc wrap {content gi} {
return "[tag $gi]${content}[tag/ $gi]"
}
proc startTag {x args} {if {[llength $args]} {taga $x $args} else {tag $x}}
proc endTag {x} {tag/ $x}
proc anchor {name text} {
return [taga a [list name $name]]$text[tag/ a]
}