# -*- 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 "<${inner}" $text "\n<${inner}" text regsub -all "\n\n\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\"$alt\""] } 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 ]} 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> ... 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] }