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
|
############################################################################
#
# File: adlutils.icn
#
# Subject: Procedures to process address lists
#
# Author: Ralph E. Griswold
#
# Date: January 3, 1994
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# Procedures used by programs that process address lists:
#
# nextadd() get next address
# writeadd(add) write address
# get_country(add) get country
# get_state(add) get state (U.S. addresses only)
# get_city(add) get city (U.S. addresses only)
# get_zipcode(add) get ZIP code (U.S. addresses only)
# get_lastname(add) get last name
# get_namepfx(add) get name prefix
# get_title(add) get name title
# format_country(s) format country name
#
############################################################################
#
# Links: lastname, io, namepfx, title
#
############################################################################
link lastname, io, namepfx, title
record label(header, text, comments)
procedure nextadd()
local comments, header, line, text
initial { # Get to first label.
while line := Read() do
line ? {
if ="#" then {
PutBack(line)
break
}
}
}
header := Read() | fail
comments := text := ""
while line := Read() do
line ? {
if pos(0) then next # Skip empty lines.
else if ="*" then comments ||:= "\n" || line
else if ="#" then { # Header for next label.
PutBack(line)
break # Done with current label.
}
else text ||:= "\n" || line
}
every text | comments ?:= { # Strip off leading newline, if any.
move(1)
tab(0)
}
return label(header, text, comments)
end
procedure writeadd(add)
if *add.text + *add.comments = 0 then return
write(add.header)
if *add.text > 0 then write(add.text)
if *add.comments > 0 then write(add.comments)
return
end
procedure get_country(add)
trim(add.text) ? {
while tab(upto('\n')) do move(1)
if tab(0) ? {
tab(-1)
any(&digits)
} then return "U.S.A."
else return tab(0)
}
end
procedure get_state(add)
trim(add.text) ? {
while tab(upto('\n')) do move(1)
="APO"
while tab(upto(',')) do move(1)
tab(many(' '))
return (tab(any(&ucase)) || tab(any(&ucase))) | "XX"
}
end
procedure get_city(add) # only works for U.S. addresses
local result
result := ""
trim(add.text) ? {
while tab(upto('\n')) do move(1)
result := ="APO"
result ||:= tab(upto(','))
return result
}
end
procedure get_zipcode(add)
local zip
trim(add.text) ? {
while tab(upto('\n')) do move(1) # get to last line
while tab(upto(' ')) do tab(many(' ')) # get to last field
zip := tab(0)
if *zip = 5 & integer(zip) then return zip
else if *zip = 10 & zip ? {
integer(move(5)) & ="-" & integer(tab(0))
}
then return zip
else return "9999999999" # "to the end of the universe"
}
end
procedure get_lastname(add)
return lastname(add.text ? tab(upto('\n') | 0))
end
procedure get_namepfx(add)
return namepfx(add.text ? tab(upto('\n') | 0))
end
procedure get_title(add)
return title(add.text ? tab(upto('\n') | 0))
end
procedure format_country(s)
local t, word
s := map(s)
t := ""
s ? while tab(upto(&lcase)) do {
word := tab(many(&lcase))
if word == "of" then t ||:= word
else t ||:= {
word ? {
map(move(1),&lcase,&ucase) || tab(0)
}
}
t ||:= move(1)
}
return t
end
|