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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
#line 37 "htmltoc.nw"
$define sentinel "<tableofcontents>"
$define sentinel_end "</tableofcontents>"
#line 44 "htmltoc.nw"
record ioc(number, level, text)
#line 46 "htmltoc.nw"
global contents
#line 52 "htmltoc.nw"
procedure readfile(f)
local old_contents
intoc := &null
contents := []
old_contents := []
no := 0
file := list()
while l := read(f) do l ? {
#line 71 "htmltoc.nw"
if =sentinel then {
intoc := "in table of contents"
put(file, l)
} else if =sentinel_end then {
intoc := &null
put(file, l)
} else if \intoc then {
put(old_contents, l)
} else if /intoc then {
if
#line 88 "htmltoc.nw"
(pre := tab(upto('<')), ="<", skip(), tab(any('hH')), n := tab(many(&digits)),
skip(), =">")
#line 80 "htmltoc.nw"
then {
#line 102 "htmltoc.nw"
if (c := tab(upto('<')), ="</", skip(), tab(any('hH')), =n, skip(), =">") then {
no +:= 1
c ? c := strip_toc_anchors() || tab(0)
addcontents(no, n, c)
#line 112 "htmltoc.nw"
put(file, pre || "<h" || n || "><a name=toc" || no || ">" || c ||
"</a></h" || n || ">" || tab(0))
#line 107 "htmltoc.nw"
} else
write(&errout, "Unterminated <h", n, ">", tab(0), "...")
#line 82 "htmltoc.nw"
} else
put(file, l)
}
#line 60 "htmltoc.nw"
}
if \intoc then {
push(old_contents, sentinel_end)
every l := !copy(old_contents) do l ? {
#line 71 "htmltoc.nw"
if =sentinel then {
intoc := "in table of contents"
put(file, l)
} else if =sentinel_end then {
intoc := &null
put(file, l)
} else if \intoc then {
put(old_contents, l)
} else if /intoc then {
if
#line 88 "htmltoc.nw"
(pre := tab(upto('<')), ="<", skip(), tab(any('hH')), n := tab(many(&digits)),
skip(), =">")
#line 80 "htmltoc.nw"
then {
#line 102 "htmltoc.nw"
if (c := tab(upto('<')), ="</", skip(), tab(any('hH')), =n, skip(), =">") then {
no +:= 1
c ? c := strip_toc_anchors() || tab(0)
addcontents(no, n, c)
#line 112 "htmltoc.nw"
put(file, pre || "<h" || n || "><a name=toc" || no || ">" || c ||
"</a></h" || n || ">" || tab(0))
#line 107 "htmltoc.nw"
} else
write(&errout, "Unterminated <h", n, ">", tab(0), "...")
#line 82 "htmltoc.nw"
} else
put(file, l)
}
#line 63 "htmltoc.nw"
}
}
return file
end
#line 92 "htmltoc.nw"
procedure skip()
suspend tab(many(' \t')) | ""
end
#line 117 "htmltoc.nw"
procedure strip_toc_anchors()
local s, p
if (="<a name=toc", tab(many(&digits)), =">", s := strip_toc_anchors(), ="</a>") then
return s
else {
s := to_next_anchor_or_end_anchor() | runerr(1, "never found an anchor")
if pos(0) | at_end_anchor() then
return s
else
return s || tab_past_anchor_start() || strip_toc_anchors() ||
tab_past_anchor_end()
}
end
#line 132 "htmltoc.nw"
procedure at_end_anchor()
&subject[&pos:0] ?
return tab_past_anchor_end()
end
procedure at_start_anchor()
&subject[&pos:0] ?
return tab_past_anchor_start()
end
procedure tab_past_anchor_end()
suspend ="<" || optwhite() || ="/" || optwhite() || =("a"|"A") || optwhite() || =">"
end
procedure tab_past_anchor_start()
suspend ="<" || optwhite() || =("a"|"A") || white() || tab(upto('>')) || =">"
end
procedure to_next_anchor_or_end_anchor()
return (1(tab(upto('<')), at_start_anchor() | at_end_anchor()) | tab(0)) \ 1
end
procedure white()
suspend tab(many(' \t'))
end
procedure optwhite()
suspend white() | ""
end
#line 171 "htmltoc.nw"
procedure addcontents(no, n, s)
if map(s) ~== "contents" & find(n, toclevels) then
put(contents, ioc(no, n, strip_tags(s)))
return
end
procedure strip_tags(s)
s ? {
r := ""
while r ||:= tab(upto('<')) do (tab(upto('>')), =">")
return r || tab(0)
}
end
#line 191 "htmltoc.nw"
global minlevel
procedure tocindent(level)
return repl(" ", level-minlevel)
end
procedure writetoc()
local level
minlevel := 99
every minlevel >:= (!contents).level
level := minlevel - 1 # triggers opening list
every l := !contents do {
#line 215 "htmltoc.nw"
while level > l.level do {
write(tocindent(level), "</ul>")
level -:= 1
}
while level < l.level do {
level +:= 1
write(tocindent(level), "<ul compact>")
}
#line 205 "htmltoc.nw"
write(tocindent(level),
"<li><a href=\"#toc", l.number, "\">", l.text, "</a></li>")
}
#line 226 "htmltoc.nw"
while level >= minlevel do {
write(tocindent(level), "</ul>")
level -:= 1
}
#line 209 "htmltoc.nw"
end
#line 235 "htmltoc.nw"
procedure add_contents(f)
file := readfile(f)
every l := !file do {
write(l)
if match(sentinel, l) then writetoc()
}
end
#line 246 "htmltoc.nw"
global toclevels
procedure main(args)
if args[1] ? (="-", toclevels := tab(many(&digits)), pos(0)) then get(args)
else toclevels := "2345"
if *args = 0 then add_contents(&input)
else every add_contents(openfile(!args))
return
end
procedure openfile(f)
return open(f) | stop("Cannot open file ", f)
end
#line 259 "htmltoc.nw"
procedure rcsinfo ()
return "$Id: htmltoc.nw,v 1.20 2008/10/06 01:03:05 nr Exp nr $" ||
"$Name: v2_12 $"
end
|