summaryrefslogtreecommitdiff
path: root/info/impatient/index2.icn
blob: 19913c4288073211b4ad0ba8cc855b53b4d8510d (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
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
# This Icon program is the second pass of the indexing process for TeX for the
# Impatient.  It must be preceded by index1 and by a sort of the intermediate
# file.

# This program was written by Paul Abrahams and is public domain.

record topic_entry(term, type, groupchar, pages, level)
record pgrec(number, flags)
record term_list_record(term_list, start)
procedure main(a)
	local gen, pages, term, topic
	local groupchar

	write(&errout, "Second indexing pass has started.")

# Each pass through this loop produces the entry for a single topic
# or subtopic, including both the text of the topic and its pages.

	every topic := get_topic_info() do {

# If we're starting a new group (initial character), produce the macro
# for it.
		if topic.level = 1 then { # only primary topics affect the group
			if not(\groupchar == topic.groupchar) then
				write("\\indexgroup ", groupchar := topic.groupchar)
			}
		else
			topic.type := "N" # subtopics are always printed normally

# Write the index term
		writes("\\indexentry {", topic.level - 1, "}{",
			edit_term(topic.term), "}{", topic.type, "}{")

# Write the list of pages
		write(edit_pages(topic.pages, topic.term), "}")
		}
end

procedure get_topic_info()
	local page, type, full_term, flags # info in an index item
	local term      # the index term to be printed (part of full_term)
	local item_text # holds an input item to be parsed
	local topic     # the topic we're now working on
	local term_list_info # returned term_list_record from get_term_list
	local term_list # list of index terms extracted from the input item
	local first		 # position of first thing in term_list to print
	local t			 # loop variable
	local term1		 # first term in full_term, usually the only one

	term_list := []

# At the start of each pass through this loop, `topic' contains the text of
# the index topic most recently seen together with the pages seen so far for
# that index topic.

	every !&input ? (tab(find("@@@")\1), move(3), item_text := tab(0)) do {

# Dissect the original index item, discarding the key

		item_text ? (full_term := tab(find("::")), move(2),
		 type := tab(find("::")), move(2),
		 page := tab(many('-0123456789*')), flags := tab(0))
# a page of * indicates a see-also

		term_list_info := get_term_list(full_term, term_list)
		term_list := term_list_info.term_list
		if type == (\topic).type then # no change of type
			first := term_list_info.start
		else
			first := 1 # change of type, so all terms are different
		term1 := term_list[\first]

# If we've finished the current topic, produce it and start the next one
		
		if \first then {
			suspend \topic
			topic := topic_entry(term1, type, find_groupchar(term1), [], first)
			every t := !term_list[first + 1:0] do {
				suspend topic
				topic.term := t; topic.type := "N"; topic.level +:= 1
			}	}
		put(topic.pages,
			if page == "*" then
				flags # flags here is the see-also
			else
				pgrec(page, cset(flags)))
		}
	suspend topic
	fail
end

procedure edit_term(term)
# This procedure edits `term' into a proper argument for \indexterm

	if term == " " then
		term := "\\visiblespace"
	else if *term = 1 then
		term := "\\char `\\" || term
	else if match("^^", term) then
		term := "\\twocarets " || term[3:0]
	else if term == "$$" then
		term := "\\$\\$"
# $$ is the only other 2-character sequence that has to be protected.
	return term
end	

procedure edit_pages(l, term)
# edit_pages removes duplicate pages from the page list, produces the
# macro call for a principal entry, and coalesces page ranges.
# It also converts negative numbers to roman numerals.
# Each element of l is a pgrec, except that the last (and possibly only)
# element may be a see-also string starting with *.
# The result is a list of strings
	local pg, n, m, pf, see_also, pagelist
	local l1, k

# If the last element of l is a string, remove it and set it aside.
# It's a see-also.
	if type(l[-1]) == "string" then
		{see_also := l[-1]; l := l[1:-1]}


# First pass through the page list, coalescing duplicates and combining
# their flags.

	l1 := []
	while *l > 0 do {
		pg := pop(l); n := pg.number; pf := pg.flags

# Loop over pages 2..k within a group

		while n = l[1].number do
			pf ++:= pop(l).flags

		if *(pf ** 'BE') = 2 then # delete B and E if they both occur
			pf --:= 'BE'
		put(l1, pgrec(n, pf))
		}

# Now l1 has no duplicates and no trivial page ranges.  Replace each
# page range by a single entry, inverting the order for negative page
# numbers since those indicate roman numerals.
# When we're done, l1 has a list of strings rather than a list of pgrecs.

	l := l1; l1 := []
	while *l > 0 do {
		pg := pop(l); n := pg.number; pf := pg.flags
		if *(pf ** 'E') > 0 then {
			every write(errfiles(), "Unmatched end of page range, page ",
			 integer(n), ", index term `", term, "'!")
			pf --:= 'E'
			}
		if *(pf ** 'B') > 0 then { # beginning a page range
			every k := 1 to *l do {
				pf ++:= l[k].flags
				if *(pf ** 'E') > 0 then break
				}
			if *(pf ** 'E') = 0 then {
				every write(errfiles(), "Unmatched beginning of page range, page ",
				 integer(n), ", index term `", term, "'!")
				pf := pg.flags
				}
			else {
				m := l[k].number
				if m < 0 then { # roman numerals
					m := "\\r" || -m
					n := "\\r" || -n
					}
				n := string(n || "--" || m)
				l := l[k+ 1:0]
			}	}
		else if n < 0 then
			n := "\\r" || -n
		if *(pf ** 'P') > 0 then
			n := "\\pp{" || n || "}"
		put(l1, n)
		}

# Now l1 is a list of page numbers and page ranges.
# If it's empty and we have a see-also, make it a \see and return it.

	if *l1 = 0 then
		return "\\see{" || \see_also || "}" | ""

# Turn l1 into a string and insert the comma commands \ic and \c
# \ic goes at the beginning, \c between the remaining elements.

	pagelist := "\\ic " || pop(l1) | ""
	every pagelist ||:= "\\c " || !l1

# Now attach the see-also to pagelist if we had one and return the result

	return pagelist || ("\\seealso{" || \see_also || "}" | "")
end

procedure find_groupchar(t)
# This procedure finds the character that heads the group containing
# the index term `t'.  We want all special characters in a single group
# and all digits in a single group.
# A term that begins with `\<c' or `\c' or `.c' is grouped as `c'.
	local c
	static printable, specials
	initial {
		printable := &ascii[33:-1]
		specials := string(printable -- (&ucase ++ &lcase ++ &digits))
		}

	return map(
			if t ? (tab(many('\\.<')), c := move(1)) then c
			else if any(specials, t[1]) then "+"
			else if any(&digits, t[1]) then "0"
			else t[1] | "",
		&lcase, &ucase)
end

procedure get_term_list(ft, tl)
# `ft' is the full term just read in, `tl' is the current term list
# return a record containing all the terms and the position of the first
# one that's different from the previous full term
	local tl1, pos, pos1, first, k
	
	tl1 := []
	pos := 1
	every pos1 := (find("//", ft) | 0) do
		{put(tl1, ft[pos:pos1]); pos := pos1 + 2}

	first := &null	
	every k := 1 to *tl1 do
		if not(tl1[k] == tl[k]) then
			{first := k; break}
	return term_list_record(tl1, first)
end	

procedure errfiles()
	static errf
	initial
		errf := open("index.err", "w")
	suspend &errout | errf
end