Initial commit

1 files changed, 162 insertions, 0 deletions

diff --git a/pkg/utilities/nttools/tchcol/tchcol.x b/pkg/utilities/nttools/tchcol/tchcol.x
new file mode 100644
index 00000000..c7a1c985
--- /dev/null
+++ b/pkg/utilities/nttools/tchcol/tchcol.x
@@ -0,0 +1,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