summaryrefslogtreecommitdiff
path: root/web/noweb/src/icon/htmltoc.icn
blob: fd29051070699647e586161c706182207c35018f (plain)
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