1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
# -*- tcl -*-
# Copyright (c) 2001-2019 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 [string trimleft $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 MakeLink {l t} { link $l $t }
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 imagelink {alt img} {
return [markup "<img alt=\"$alt\" src=\"$img\">"]
}
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 <]!-- [htmlEscape [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]
}
|
