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
|
include <ctype.h> # for IS_WHITE
include <tbset.h>
# tchcol -- change column information
# This task can be used to change the name, print format, and/or units
# for one column of a list of tables. If any of the new values is null
# or blank, the value will not be changed. If the value is "default"
# for format or units, the value will be changed to the default.
# For units the default is null.
#
# J.-C. HSU, 11-Jul-1987 design and coding
# Phil Hodge, 15-Mar-1989 rewrite in spp
# Phil Hodge, 10-Apr-1990 change SZ_COLNAME to SZ_FNAME, etc for clgstr
# Phil Hodge, 10-May-1991 allow multiple input tables;
# use "default" to set format or units to the default
# Phil Hodge, 18-Jun-1993 preserve case of newfmt to allow e.g. %12.1H
# Phil Hodge, 11-Aug-1993 print warning if text table and user has
# requested a change of column name or units
# Phil Hodge, 3-Oct-1995 Modify to use tbn instead of fnt.
# Phil Hodge, 7-Jun-1999 Delete warning messages for text tables
# (this undoes the change made on 11-Aug-1993).
# Phil Hodge, 30-Sep-1999 Remove trailing blanks from new name, units, format.
procedure tchcol()
pointer tp # pointer to table descriptor
pointer cp # pointer to column descriptor
pointer ilist # for list of tables to change
char table[SZ_FNAME] # table name
char oldname[SZ_COLNAME] # column name before being changed
char newname[SZ_COLNAME] # new column name or ""
char oldfmt[SZ_COLFMT] # print format before being changed
char newfmt[SZ_COLFMT] # new column print format or "default"
char newf[SZ_COLFMT] # new spp style print format or ""
char oldunits[SZ_COLUNITS] # column units before being changed
char newunits[SZ_COLUNITS] # new column units or "default"
char newu[SZ_COLUNITS] # new column units or ""
char newval[SZ_COLUNITS] # actual new value of format or units in table
bool verbose # if true, tell user what's happening
int i, strlen() # for stripping off trailing blanks
pointer tbtopn()
pointer tbnopenp()
int tbnget()
bool clgetb(), streq()
begin
ilist = tbnopenp ("table")
call clgstr ("oldname", oldname, SZ_COLNAME)
call clgstr ("newname", newname, SZ_COLNAME)
call clgstr ("newfmt", newfmt, SZ_COLFMT)
call clgstr ("newunits", newunits, SZ_COLUNITS)
verbose = clgetb ("verbose")
# Remove leading whitespace from new values.
call xt_stripwhite (newname)
call xt_stripwhite (newfmt)
call xt_stripwhite (newunits)
# Remove trailing whitespace from new values.
do i = strlen (newname), 1, -1 {
if (IS_WHITE(newname[i]))
newname[i] = EOS
else
break
}
do i = strlen (newfmt), 1, -1 {
if (IS_WHITE(newfmt[i]))
newfmt[i] = EOS
else
break
}
do i = strlen (newunits), 1, -1 {
if (IS_WHITE(newunits[i]))
newunits[i] = EOS
else
break
}
if (newname[1] == EOS && newfmt[1] == EOS && newunits[1] == EOS) {
call eprintf ("no change specified\n")
call tbnclose (ilist)
return
}
# Check for "default" for format or units, and copy to newf & newu.
call strcpy (newfmt, newf, SZ_COLFMT)
call strlwr (newf) # preserve case of newfmt
if (streq (newf, "default"))
newf[1] = EOS
else
call tbbftp (newfmt, newf) # convert from Fortran style
call strcpy (newunits, newu, SZ_COLUNITS)
call strlwr (newu)
if (streq (newu, "default"))
newu[1] = EOS
else
call strcpy (newunits, newu, SZ_COLUNITS) # preserve case
# Process all the tables in the list.
while (tbnget (ilist, table, SZ_FNAME) != EOF) {
if (verbose) {
call printf ("table %s\n")
call pargstr (table)
}
tp = tbtopn (table, READ_WRITE, NULL)
call tbcfnd (tp, oldname, cp, 1)
if (cp == NULL) {
call tbtclo (tp)
if ( ! verbose ) {
call printf ("table %s\n")
call pargstr (table)
}
call printf (" warning: column `%s' not found\n")
call pargstr (oldname)
next
}
if (newname[1] != EOS) {
call tbcnam (tp, cp, newname)
if (verbose) {
call printf (" column name changed from `%s' to `%s'\n")
call pargstr (oldname)
call pargstr (newname)
}
}
# newf may be EOS even if newfmt is not.
if (newfmt[1] != EOS) {
call tbcigt (cp, TBL_COL_FMT, oldfmt, SZ_COLFMT)
call tbcfmt (tp, cp, newf)
if (verbose) {
call tbcigt (cp, TBL_COL_FMT, newval, SZ_COLUNITS)
call printf (" print format changed from `%s' to `%s'\n")
call pargstr (oldfmt)
call pargstr (newval)
}
}
# newu may be EOS even if newunits is not.
if (newunits[1] != EOS) {
call tbcigt (cp, TBL_COL_UNITS, oldunits, SZ_COLUNITS)
call tbcnit (tp, cp, newu)
if (verbose) {
call tbcigt (cp, TBL_COL_UNITS, newval, SZ_COLUNITS)
call printf (" column units changed from `%s' to `%s'\n")
call pargstr (oldunits)
call pargstr (newval)
}
}
call tbtclo (tp)
if (verbose) # added 8/11/93
call flush (STDOUT)
}
call tbnclose (ilist)
end
|
