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