1# -*- tcl -*- 2# Copyright (c) 2001-2008 Andreas Kupries <andreas_kupries@sourceforge.net> 3# 4# Helper rules for the creation of the memchan website from the .exp files. 5# General formatting instructions ... 6 7# htmlEscape text -- 8# Replaces HTML markup characters in $text with the 9# appropriate entity references. 10# 11 12global textMap; 13set textMap { 14 & & < < > > 15 \xa0 \xb0 ° \xc0 À \xd0 Ð \xe0 à \xf0 ð 16 \xa1 ¡ \xb1 ± \xc1 Á \xd1 Ñ \xe1 á \xf1 ñ 17 \xa2 ¢ \xb2 ² \xc2 Â \xd2 Ò \xe2 â \xf2 ò 18 \xa3 £ \xb3 ³ \xc3 Ã \xd3 Ó \xe3 ã \xf3 ó 19 \xa4 ¤ \xb4 ´ \xc4 Ä \xd4 Ô \xe4 ä \xf4 ô 20 \xa5 ¥ \xb5 µ \xc5 Å \xd5 Õ \xe5 å \xf5 õ 21 \xa6 ¦ \xb6 ¶ \xc6 Æ \xd6 Ö \xe6 æ \xf6 ö 22 \xa7 § \xb7 · \xc7 Ç \xd7 × \xe7 ç \xf7 ÷ 23 \xa8 ¨ \xb8 ¸ \xc8 È \xd8 Ø \xe8 è \xf8 ø 24 \xa9 © \xb9 ¹ \xc9 É \xd9 Ù \xe9 é \xf9 ù 25 \xaa ª \xba º \xca Ê \xda Ú \xea ê \xfa ú 26 \xab « \xbb » \xcb Ë \xdb Û \xeb ë \xfb û 27 \xac ¬ \xbc ¼ \xcc Ì \xdc Ü \xec ì \xfc ü 28 \xad ­ \xbd ½ \xcd Í \xdd Ý \xed í \xfd ý 29 \xae ® \xbe ¾ \xce Î \xde Þ \xee î \xfe þ 30 \xaf &hibar; \xbf ¿ \xcf Ï \xdf ß \xef ï \xff ÿ 31 {"} " 32} ; # " make the emacs highlighting code happy. 33 34# Handling of HTML delimiters in content: 35# 36# Plain text is initially passed through unescaped; 37# internally-generated markup is protected by preceding it with \1. 38# The final PostProcess step strips the escape character from 39# real markup and replaces markup characters from content 40# with entity references. 41# 42 43global markupMap 44set markupMap { {&} {\1&} {<} {\1<} {>} {\1>} {"} {\1"} } 45global finalMap 46set finalMap $textMap 47lappend finalMap {\1&} {&} {\1<} {<} {\1>} {>} {\1"} {"} 48 49 50proc htmlEscape {text} { 51 global textMap 52 return [string map $textMap $text] 53} 54 55proc fmt_postprocess {text} { 56 global finalMap 57 58 if 0 { 59 puts_stderr ____________________________________________________________ 60 puts_stderr $text 61 puts_stderr ____________________________________________________________ 62 } 63 64 # Put protected characters into their final form. 65 set text [string map $finalMap $text] 66 # Remove leading/trailing whitespace from paragraphs. 67 regsub -all "<p>\[\t\n \]*" $text {<p>} text 68 regsub -all "\[\t\n \]*</p>" $text {</p>} text 69 # Remove trailing linebreaks from paragraphs. 70 while {[regsub -all "<br>\[\t\n \]*</p>" $text {</p>} text]} continue 71 # Remove empty paragraphs 72 regsub -all "<p>\[\t\n \]*</p>" $text {} text 73 # Separate paragraphs 74 regsub -all "</p><p>" $text "</p>\n<p>" text 75 # Separate bigger structures 76 foreach outer {div p dl ul ol} { 77 foreach inner {div p dl ul ol} { 78 regsub -all "</${outer}><${inner}" $text "</${outer}>\n<${inner}" text 79 regsub -all "</${outer}></${inner}" $text "</${outer}>\n</${inner}" text 80 } 81 } 82 regsub -all "<li><dl" $text "<li>\n<dl" text 83 regsub -all "<li><ol" $text "<li>\n<ol" text 84 regsub -all "<li><ul" $text "<li>\n<ul" text 85 regsub -all "</dl></li" $text "</dl>\n</li" text 86 regsub -all "</ol></li" $text "</ol>\n</li" text 87 regsub -all "</ul></li" $text "</ul>\n</li" text 88 # Remove empty lines. 89 regsub -all "\n\n\n*" $text \n text 90 91 if 0 { 92 puts_stderr @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 93 puts_stderr $text 94 puts_stderr @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 95 } 96 97 return $text 98} 99 100# markup text -- 101# Protect markup characters in $text with \1. 102# These will be stripped out in PostProcess. 103# 104proc markup {text} { 105 global markupMap 106 return [string map $markupMap $text] 107} 108 109proc use_bg {} { 110 set c [bgcolor] 111 #puts stderr "using $c" 112 if {$c == {}} {return ""} 113 return bgcolor=$c 114} 115 116 117proc nbsp {} {return [markup " "]} 118proc p {} {return [markup <p>]} 119proc ptop {} {return [markup "<p valign=top>"]} 120proc td {} {return [markup "<td [use_bg]>"]} 121proc trtop {} {return [markup "<tr valign=top [use_bg]>"]} 122proc tr {} {return [markup "<tr [use_bg]>"]} 123proc sect {s} {return [markup <b>]$s[markup </b><br><hr>]} 124proc link {text url} {return [markup "<a href=\"$url\">"]$text[markup </a>]} 125proc table {} {return [markup "<table [border] width=100% cellspacing=0 cellpadding=0>"]} 126proc btable {} {return [markup "<table border=1 width=100% cellspacing=0 cellpadding=0>"]} 127proc stable {} {return [markup "<table [border] cellspacing=0 cellpadding=0>"]} 128 129proc link {text url} {return [markup "<a href=\"$url\">"]$text[markup </a>]} 130 131proc tcl_cmd {cmd} {return "[markup <b>]\[$cmd][markup </b>]"} 132proc wget {url} {exec /usr/bin/wget -q -O - $url 2>/dev/null} 133 134proc url {tag text url} { 135 set body { 136 switch -exact -- $what { 137 link {return {\1<a href="%url%"\1>%text%\1</a\1>}} ; ## TODO - markup 138 text {return {%text%}} 139 url {return {%url%}} 140 } 141 } 142 proc $tag {{what link}} [string map [list %text% $text %url% $url] $body] 143} 144 145proc img {tag alt img} { 146 proc $tag {} [list return "\1<img alt=\"$alt\" src=\"$img\"\1>"] 147} 148 149proc imagelink {alt img} { 150 return [markup "<img alt=\"$alt\" src=\"$img\">"] 151} 152 153proc protect {text} {return [string map [list & "&" < "<" > ">"] $text]} 154 155proc strong {text} {tag_ strong $text} 156proc em {text} {tag_ em $text} 157proc bold {text class} {tag_ b $text class $class} 158proc italic {text class} {tag_ i $text class $class} 159proc span {text class} {tag_ span $text class $class} 160 161proc tag {t} {return [markup <$t>]} 162proc taga {t av} { 163 # av = attribute value ... 164 set avt [list] 165 foreach {a v} $av {lappend avt "$a=\"$v\""} 166 return [markup "<$t [join $avt]>"] 167} 168proc tag/ {t} {return [markup </$t>]} 169proc tag_ {t block args} { 170 # args = key value ... 171 if {$args == {}} {return "[tag $t]$block[tag/ $t]"} 172 return "[taga $t $args]$block[tag/ $t]" 173} 174proc tag* {t args} { 175 if {[llength $args]} { 176 taga $t $args 177 } else { 178 tag $t 179 } 180} 181 182proc ht_comment {text} { 183 return "[markup <]! -- [join [split $text \n] " -- "]\n --[markup >]" 184} 185 186# wrap content gi -- 187# Returns $content wrapped inside <$gi> ... </$gi> tags. 188# 189proc wrap {content gi} { 190 return "[tag $gi]${content}[tag/ $gi]" 191} 192proc startTag {x args} {if {[llength $args]} {taga $x $args} else {tag $x}} 193proc endTag {x} {tag/ $x} 194 195 196proc anchor {name text} { 197 return [taga a [list name $name]]$text[tag/ a] 198} 199