# -*- tcl -*-
# Copyright (c) 2001-2008 Andreas Kupries
#
# 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 "\[\t\n \]*" $text {
} text
regsub -all "\[\t\n \]*
" $text {
} text
# Remove trailing linebreaks from paragraphs.
while {[regsub -all "
\[\t\n \]*" $text {} text]} continue
# Remove empty paragraphs
regsub -all "\[\t\n \]*
" $text {} text
# Separate paragraphs
regsub -all "" $text "
\n" 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 "
\n\n
\n\n\n]}
proc ptop {} {return [markup ""]}
proc td {} {return [markup "
"]}
proc trtop {} {return [markup " | "]}
proc tr {} {return [markup "
"]}
proc sect {s} {return [markup ]$s[markup
]}
proc link {text url} {return [markup ""]$text[markup ]}
proc table {} {return [markup ""]}
proc btable {} {return [markup ""]}
proc stable {} {return [markup ""]}
proc link {text url} {return [markup ""]$text[markup ]}
proc tcl_cmd {cmd} {return "[markup ]\[$cmd][markup ]"}
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%text%\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"]
}
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]
}