Initial commit

4 files changed, 1401 insertions, 0 deletions

diff --git a/pkg/utilities/nttools/thedit/mkpkg b/pkg/utilities/nttools/thedit/mkpkg
new file mode 100644
index 00000000..5b9e150a
--- /dev/null
+++ b/pkg/utilities/nttools/thedit/mkpkg
@@ -0,0 +1,13 @@
+# Update thedit in the ttools package library.
+# Author: HODGE, 10-MAY-2000
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	t_thedit.x	<error.h> <evexpr.h> <ctype.h> <lexnum.h> <tbset.h>
+	t_thselect.x	<error.h> <evexpr.h> <ctype.h> <tbset.h>
+	tkw.x		<ctype.h> <finfo.h> <time.h> <tbset.h>
+	;
diff --git a/pkg/utilities/nttools/thedit/t_thedit.x b/pkg/utilities/nttools/thedit/t_thedit.x
new file mode 100644
index 00000000..3fac69de
--- /dev/null
+++ b/pkg/utilities/nttools/thedit/t_thedit.x
@@ -0,0 +1,833 @@
+include	<error.h>
+include	<evexpr.h>
+include <ctype.h>
+include	<lexnum.h>
+include	<tbset.h>
+
+define	SZ_TABLENAME	(SZ_FNAME)	# max size of a table name
+define	SZ_KEYWORDNAME	31		# max size of a keyword name
+
+define	OP_EDIT		1		# hedit opcodes
+define	OP_DELETE	2
+define	OP_PRINT	3
+
+
+# thedit -- Edit or view selected keywords of a table header or headers.  This
+# editor performs a single edit operation upon a relation, e.g., upon a set
+# of keywords of a set of tables.  Templates and expressions may be used to
+# automatically select the tables and keywords to be edited, and to compute
+# the new value of each keyword.
+#
+# Phil Hodge, 10-May-2000  Task created, based on hedit.
+# Phil Hodge, 26-May-2000  When adding a keyword, check for invalid characters.
+# Phil Hodge, 31-May-2000  Add "keywords" i_nrows, etc.
+# Phil Hodge, 19-Jul-2000  In he_getop, call tkw_special before tbhgtt,
+#		rather than explicitly checking for $I.
+# Phil Hodge,  8-Sep-2000  Require value = "\." or "\," in order to actually
+#		set a keyword value to "." or ",".  ("\," is for protection
+#		against accidentally typing "," instead of ".".)
+#		In he_add_keyword, include the new value in the message
+#		(if show=yes).  In he_put_keyword, include both the old and
+#		new values in the message.
+# Phil Hodge,  4-Mar-2002  Call xev_freeop to free memory allocated by evexpr.
+# Phil Hodge,  1-Apr-2003  Fix incorrect calling sequence for tkw_open
+#		in he_delete.
+
+procedure t_thedit()
+
+pointer	keywords		# template listing keywords to be processed
+pointer	valexpr			# the value expression (if op=edit|add)
+
+pointer tnt
+pointer	sp, s_valexpr, table, template, buf
+pointer tp			# pointer to table struct
+pointer kw			# pointer to table keyword struct
+pointer vip			# for deleting whitespace in valexpr
+pointer newval			# valexpr after evaluation
+int	operation, show
+int	ip, ctowrd()
+int	nkw, tkw_len()		# number of keywords that match the template
+int	dtype			# data type of expression
+
+pointer	tbtopn()
+pointer tkw_open()
+bool	clgetb(), streq()
+bool	tbhisc()
+int	btoi(), tbnopenp(), tbnget()
+int	i, strlen()
+errchk	he_print, he_delete, he_add_keyword, he_put_keyword, he_evaluate
+
+begin
+	call smark (sp)
+	call salloc (buf,       SZ_FNAME, TY_CHAR)
+	call salloc (table,     SZ_FNAME, TY_CHAR)
+	call salloc (keywords,  SZ_LINE,  TY_CHAR)
+	call salloc (template,  SZ_FNAME, TY_CHAR)
+	call salloc (s_valexpr, SZ_LINE,  TY_CHAR)
+	call salloc (newval,    SZ_LINE,  TY_CHAR)
+
+	# Get the list of table names.
+	tnt = tbnopenp ("table")
+
+	# Determine type of operation to be performed.  The default operation
+	# is edit.
+
+	operation = OP_EDIT
+	if (clgetb ("delete"))
+	    operation = OP_DELETE
+
+	# Get list of keywords to be edited, added, or deleted.
+	call clgstr ("keywords", Memc[keywords], SZ_LINE)
+	do i = 1, strlen (Memc[keywords]) {
+	    if (Memc[keywords+i-1] == ',')
+		Memc[keywords+i-1] = ' '	# replace comma with blank
+	}
+
+	# The value expression parameter is not used for the delete operation.
+	if (operation != OP_DELETE) {
+	    call clgstr ("value", Memc[s_valexpr], SZ_LINE)
+	    for (vip=s_valexpr;  IS_WHITE (Memc[vip]);  vip=vip+1)
+		;
+	    valexpr = vip
+	    while (Memc[vip] != EOS)
+		vip = vip + 1
+	    while (vip > valexpr && IS_WHITE (Memc[vip-1]))
+		vip = vip - 1
+	    Memc[vip] = EOS
+	} else {
+	    Memc[s_valexpr] = EOS
+	    valexpr = s_valexpr
+	}
+	# Check for value = ",", which could be a typo.
+	if (streq (Memc[valexpr], ",")) {
+	    call error (1,
+	"In order to set a keyword value to ',' you must use value='\,'")
+	} else if (streq (Memc[valexpr], "\,")) {
+	    call strcpy (",", Memc[valexpr], SZ_LINE)
+	}
+
+	# Get switches.  If the expression value is ".", meaning print value
+	# rather than edit, then we do not use the switches.
+
+	if (streq (Memc[valexpr], ".")) {
+	    operation = OP_PRINT
+	    show = NO
+	} else {
+	    show = btoi (clgetb ("show"))
+	}
+
+	# In order to set the keyword value to ".", specify value="\.".
+	if (streq (Memc[valexpr], "\."))
+	    call strcpy (".", Memc[valexpr], SZ_LINE)
+
+	# Main processing loop.  A table is processed in each pass through
+	# the loop.
+
+	while (tbnget (tnt, Memc[table], SZ_FNAME) != EOF) {
+
+	    # Open the current table.
+	    iferr {
+		if (operation == OP_PRINT)
+		    tp = tbtopn (Memc[table], READ_ONLY,  NULL)
+		else
+		    tp = tbtopn (Memc[table], READ_WRITE, NULL)
+	    } then {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Get a list of all the keywords in the header.
+	    kw = tkw_open (tp)
+
+	    # for each keyword or template in blank-separated list ...
+	    ip = 1
+	    while (ctowrd (Memc[keywords], ip, Memc[template], SZ_FNAME) > 0) {
+
+		# Find all keywords that match the current keyword template.
+		call tkw_find (tp, kw, Memc[template])
+		nkw = tkw_len (kw)
+
+		if (operation == OP_PRINT) {
+
+		    call he_print (tp, kw, Memc[table], Memc[template])
+
+		} else if (operation == OP_DELETE) {
+
+		    call he_delete (tp, kw, Memc[table], Memc[template], show)
+
+		} else {
+
+		    # interpret the value string
+		    call he_getopsettable (tp, Memc[table], Memc[template])
+		    call he_evaluate (Memc[valexpr],
+				Memc[newval], SZ_LINE, dtype)
+
+		    # No keywords match the template, or the keyword is
+		    # history or comment?
+		    if (nkw == 0 || tbhisc (Memc[template])) {
+
+			# Add a new keyword.
+			call he_add_keyword (tp, Memc[table], Memc[template],
+				Memc[newval], dtype, show)
+
+		    } else {
+
+			call he_put_keyword (tp, kw, Memc[table],
+				Memc[template], Memc[newval], dtype, show)
+		    }
+		}
+	    }
+
+	    # Close the keyword list and the table.
+	    call tkw_close (kw)
+	    call tbtclo (tp)
+
+	    call flush (STDOUT)
+	}
+
+	call tbnclose (tnt)
+	call sfree (sp)
+end
+
+
+# This routine prints the value of the keyword or keywords that match
+# the template.
+
+procedure he_print (tp, kw, table, template)
+
+pointer tp		# i: pointer to table struct
+pointer kw		# i: pointer to keyword struct
+char	table[ARB]	# i: table name
+char	template[ARB]	# i: keyword name or template (for warning message)
+#--
+pointer sp
+pointer value, comment
+char	keyword[SZ_KEYWORD]	# keyword name
+int	nkw		# number of keywords
+int	k
+int	tkw_len()
+
+begin
+	nkw = tkw_len (kw)
+
+	if (nkw == 0) {
+	    call eprintf ("Warning:  keyword(s) `%s' not found.\n")
+		call pargstr (template)
+	} else {
+	    call smark (sp)
+	    call salloc (value, SZ_FNAME, TY_CHAR)
+	    call salloc (comment, SZ_FNAME, TY_CHAR)
+	    do k = 1, nkw {
+		call he_gval (tp, kw, k,
+			keyword, Memc[value], Memc[comment], SZ_FNAME)
+		call printf ("%s,%s = %s")
+		    call pargstr (table)
+		    call pargstr (keyword)
+		    call he_pargstr (Memc[value])
+		if (Memc[comment] != EOS) {
+		    call printf (" / %s")
+			call pargstr (Memc[comment])
+		}
+		call printf ("\n")
+	    }
+	    call sfree (sp)
+	}
+end
+
+procedure he_gval (tp, kw, k, keyword, value, comment, maxch)
+
+pointer tp			# i: pointer to table struct
+pointer kw			# i: pointer to keyword struct
+int	k			# i: index in list of matched keywords
+char	keyword[SZ_KEYWORD]	# o: keyword name
+char	value[ARB]		# o: value of keyword
+char	comment[ARB]		# o: comment, or null
+int	maxch			# i: size of value and comment strings
+#--
+pointer sp
+pointer sval
+int	i
+int	keynum			# index in list of all keywords in header
+int	dtype			# data type of keyword
+bool	tbhisc()
+errchk	tbhgnp, tbhgcm, tkw_special
+
+begin
+	call smark (sp)
+	call salloc (sval, SZ_FNAME, TY_CHAR)
+
+	call tkw_getkw (kw, k, keynum, keyword, SZ_KEYWORD)
+
+	if (keynum > 0) {
+
+	    call tbhgnp (tp, keynum, keyword, dtype, Memc[sval])
+
+	    # Delete leading whitespace.
+	    do i = 0, SZ_FNAME-1 {
+		if (Memc[sval+i] == EOS)
+		    break
+		if (!IS_WHITE(Memc[sval+i]))
+		    break
+	    }
+	    call strcpy (Memc[sval+i], value, maxch)
+
+	    if (tbhisc (keyword))
+		comment[1] = EOS
+	    else
+		call tbhgcm (tp, keyword, comment, maxch)
+
+	} else {
+
+	    call tkw_special (tp, keyword, value, maxch)
+	    comment[1] = EOS
+	}
+
+	call sfree (sp)
+end
+
+# This routine deletes one or more keywords from the header.
+# The list of all keywords in the header and the list of keywords that
+# match the template will be reassigned after deleting.
+
+procedure he_delete (tp, kw, table, template, show)
+
+pointer tp		# i: pointer to table struct
+pointer kw		# io: pointer to keyword struct
+char	table[ARB]	# i: table name
+char	template[ARB]	# i: keyword name or template
+int	show		# i: print info?
+#--
+char	keyword[SZ_KEYWORD]	# keyword name
+int	nkw		# number of keywords
+int	keynum		# index in list of all keywords in header
+int	k
+pointer tkw_open()
+int	tkw_len()
+errchk	tbhdel
+
+begin
+	nkw = tkw_len (kw)
+
+	if (nkw == 0) {
+	    call eprintf ("Warning:  keyword(s) `%s' not found.\n")
+		call pargstr (template)
+	} else {
+
+	    do k = nkw, 1, -1 {
+		call tkw_getkw (kw, k, keynum, keyword, SZ_KEYWORD)
+		if (keynum <= 0) {
+		    call eprintf (
+			"Warning:  can't delete special keyword %s.\n")
+			call pargstr (keyword)
+		    next
+		}
+		call tbhdel (tp, keynum)
+		if (show == YES) {
+		    call printf ("%s,%s deleted\n")
+			call pargstr (table)
+			call pargstr (keyword)
+		}
+	    }
+
+	    # Update the list of the current keywords, since we've deleted some.
+	    call tkw_close (kw)
+	    kw = tkw_open (tp)
+	}
+end
+
+# This routine adds a new keyword to the header.
+
+procedure he_add_keyword (tp, table, keyword, newval, dtype, show)
+
+pointer tp		# i: pointer to table struct
+char	table[ARB]	# i: table name
+char	keyword[ARB]	# i: keyword name or template
+char	newval[ARB]	# i: value to assign to keyword
+int	dtype		# i: data type of newval
+int	show		# i: print info?
+#--
+int	i
+bool	bval
+int	ival
+real	rval
+double	dval
+int	nscan()
+errchk	tbhadd, tbhadr, tbhadi, tbhadb, tbhadt
+
+begin
+	# Check that the keyword name is valid.
+	do i = 1, SZ_KEYWORD {
+
+	    if (keyword[i] == EOS)
+		break
+
+	    if (keyword[i] == '*' || keyword[i] == '?') {
+		call eprintf (
+	"Warning:  keyword `%s' doesn't match any keyword in the header;\n")
+		    call pargstr (keyword)
+		call eprintf ("  this keyword template will be ignored.\n")
+		return
+	    }
+
+	    # All the following are OK:
+	    if (IS_UPPER(keyword[i]))
+		next
+	    if (IS_LOWER(keyword[i]))
+		next
+	    if (IS_DIGIT(keyword[i]))
+		next
+	    if (keyword[i] == '_' || keyword[i] == '-')
+		next
+
+	    # If we get here, the character is invalid.
+	    call eprintf ("Warning:  invalid character `%c' in keyword `%s';\n")
+		call pargc (keyword[i])
+		call pargstr (keyword)
+	    call eprintf ("  this keyword will not be added to the header.\n")
+	    return
+	}
+
+	switch (dtype) {
+	case TY_DOUBLE:
+	    call sscan (newval)
+		call gargd (dval)
+	    if (nscan() < 1) {
+		call eprintf ("can't interpret %s as a floating point value\n")
+		    call pargstr (newval)
+		call error (1, "")
+	    }
+	    call tbhadd (tp, keyword, dval)
+
+	case TY_REAL:
+	    call sscan (newval)
+		call gargr (rval)
+	    if (nscan() < 1) {
+		call eprintf ("can't interpret %s as a floating point value\n")
+		    call pargstr (newval)
+		call error (1, "")
+	    }
+	    call tbhadr (tp, keyword, rval)
+
+	case TY_INT:
+	    call sscan (newval)
+		call gargi (ival)
+	    if (nscan() < 1) {
+		call eprintf ("can't interpret %s as an integer\n")
+		    call pargstr (newval)
+		call error (1, "")
+	    }
+	    call tbhadi (tp, keyword, ival)
+
+	case TY_BOOL:
+	    call sscan (newval)
+		call gargb (bval)
+	    if (nscan() < 1) {		# shouldn't happen
+		call eprintf ("can't interpret %s as a boolean value\n")
+		    call pargstr (newval)
+		call error (1, "")
+	    }
+	    call tbhadb (tp, keyword, bval)
+
+	default:
+	    call tbhadt (tp, keyword, newval)
+	}
+
+	if (show == YES) {
+	    call printf ("add %s,%s = %s\n")
+		call pargstr (table)
+		call pargstr (keyword)
+		call he_pargstr (newval)
+	}
+end
+
+procedure he_put_keyword (tp, kw, table, template, newval, dtype, show)
+
+pointer tp		# i: pointer to table struct
+pointer kw		# i: pointer to keyword struct
+char	table[ARB]	# i: table name
+char	template[ARB]	# i: keyword name or template
+char	newval[ARB]	# i: value to assign to keyword
+int	dtype		# i: data type of newval
+int	show		# i: print info?
+#--
+bool	bval
+int	ival
+real	rval
+double	dval
+char	oldval[SZ_FNAME]	# current value of keyword (if show is YES)
+char	keyword[SZ_KEYWORD]	# name of current keyword
+int	keynum		# index in list of all keywords in header
+int	k
+int	nkw, tkw_len()
+int	nscan()
+errchk	tbhptd, tbhptr, tbhpti, tbhptb, tbhptt
+
+begin
+	nkw = tkw_len (kw)
+
+	# for each keyword that matches the template ...
+	do k = 1, nkw {
+
+	    call tkw_getkw (kw, k, keynum, keyword, SZ_KEYWORD)
+	    if (keynum <= 0) {
+		call eprintf ("Warning:  can't modify special keyword %s.\n")
+		    call pargstr (keyword)
+		next
+	    }
+
+	    if (show == YES) {		# get the current value
+		call tbhgtt (tp, keyword, oldval, SZ_FNAME)
+	    }
+
+	    switch (dtype) {
+	    case TY_DOUBLE:
+		call sscan (newval)
+		    call gargd (dval)
+		if (nscan() < 1) {
+		    call eprintf (
+			"can't interpret %s as a floating point value\n")
+			call pargstr (newval)
+		    call error (1, "")
+		}
+		call tbhptd (tp, keyword, dval)
+
+	    case TY_REAL:
+		call sscan (newval)
+		    call gargr (rval)
+		if (nscan() < 1) {
+		    call eprintf (
+			"can't interpret %s as a floating point value\n")
+			call pargstr (newval)
+		    call error (1, "")
+		}
+		call tbhptr (tp, keyword, rval)
+
+	    case TY_INT:
+		call sscan (newval)
+		    call gargi (ival)
+		if (nscan() < 1) {
+		    call eprintf ("can't interpret %s as an integer\n")
+			call pargstr (newval)
+		    call error (1, "")
+		}
+		call tbhadi (tp, keyword, ival)
+
+	    case TY_BOOL:
+		call sscan (newval)
+		    call gargb (bval)
+		if (nscan() < 1) {		# shouldn't happen
+		    call eprintf ("can't interpret %s as a boolean value\n")
+			call pargstr (newval)
+		    call error (1, "")
+		}
+		call tbhadb (tp, keyword, bval)
+
+	    default:
+		call tbhptt (tp, keyword, newval)
+	    }
+
+	    if (show == YES) {
+		call printf ("%s,%s updated:  %s -> %s\n")
+		    call pargstr (table)
+		    call pargstr (keyword)
+		    call he_pargstr (oldval)
+		    call he_pargstr (newval)
+	    }
+	}
+end
+
+# This routine copies the value from valexpr to newval and interprets
+# the data type of the result.  If valexpr begins with "(", it will be
+# passed to evexpr to evaluate it, and the resulting string will be
+# returned as newval.
+
+procedure he_evaluate (valexpr, newval, maxch, dtype)
+
+char	valexpr[ARB]		# i: value expression
+char	newval[ARB]		# o: value
+int	maxch			# i: size of newval
+int	dtype			# o: data type of expression
+#--
+pointer o			# evexpr pointer
+pointer evexpr()
+int	locpr()
+bool	streq()
+int	he_dtype()
+extern	he_getop()
+
+begin
+	if (streq (valexpr, ".")) {
+
+	    call strcpy (valexpr, newval, maxch)
+	    dtype = TY_CHAR		# irrelevant
+
+	} else if (valexpr[1] == '(') {
+
+	    # Evaluate the expression given in parentheses.
+	    o = evexpr (valexpr, locpr (he_getop), 0)
+
+	    switch (O_TYPE(o)) {	# evexpr only supports these data types
+	    case TY_BOOL:
+		dtype = TY_BOOL
+		call sprintf (newval, maxch, "%b")
+		    call pargb (O_VALB(o))
+	    case TY_CHAR:
+		dtype = TY_CHAR
+		call sprintf (newval, maxch, "%s")
+		    call pargstr (O_VALC(o))
+	    case TY_INT:
+		dtype = TY_INT
+		call sprintf (newval, maxch, "%d")
+		    call pargi (O_VALI(o))
+	    case TY_REAL:
+		dtype = TY_REAL
+		call sprintf (newval, maxch, "%g")
+		    call pargr (O_VALR(o))
+	    default:
+		call error (1, "unknown expression datatype")
+	    }
+	    call xev_freeop (o)
+	    call mfree (o, TY_STRUCT)
+
+	} else {
+
+	    # Interpret the data type, and copy the string from valexpr to
+	    # newval.
+	    dtype = he_dtype (valexpr, newval, maxch)
+	}
+end
+
+# This function returns the data type of value, and it copies value to
+# newval.  If the data type is boolean, don't complain if the user gave
+# the value in a nonstandard form, such as "T" or "F", but then assign
+# the standard "yes" or "no" to newval (that's the reason for copying
+# value to newval).
+
+int procedure he_dtype (value, newval, maxch)
+
+char	value[ARB]	# i: the value encoded as a string
+char	newval[ARB]	# o: same as lower case value, unless type is boolean
+int	maxch		# i: max size of newval
+#--
+int	dtype		# the data type, to be returned
+bool	numeric
+int	tok_type, ip, numlen
+int	lexnum()
+int	strlen()
+bool	streq()
+
+begin
+	# Use newval for scratch, to convert to lower case for the
+	# tests on boolean data type.
+	call strcpy (value, newval, maxch)
+	call strlwr (newval)
+
+	if (streq (newval, "yes") ||
+	    streq (newval, "true") ||
+	    streq (newval, "t")) {
+
+	    dtype = TY_BOOL
+
+	    call strcpy ("yes", newval, maxch)
+
+	} else if (streq (newval, "no") ||
+		   streq (newval, "false") ||
+		   streq (newval, "f")) {
+
+	    dtype = TY_BOOL
+
+	    call strcpy ("no", newval, maxch)
+
+	} else {
+
+	    ip = 1
+	    tok_type = lexnum (value, ip, numlen)
+	    numeric = (tok_type != LEX_NONNUM && numlen == strlen (value))
+
+	    if (numeric) {
+		if (tok_type == LEX_OCTAL || tok_type == LEX_DECIMAL ||
+		    tok_type == LEX_HEX) {
+		    dtype = TY_INT
+		} else if (tok_type == LEX_REAL) {
+		    dtype = TY_DOUBLE
+		} else {
+		    dtype = TY_CHAR		# shouldn't happen
+		}
+	    } else {
+		dtype = TY_CHAR
+	    }
+
+	    call strcpy (value, newval, maxch)
+	}
+
+	return (dtype)
+end
+
+# HE_GETOP -- Satisfy an operand request from EVEXPR.  The value of the
+# current keyword is gotten from the table header.
+#
+# Note that HE_GETOPSETTABLE must first have been called to save the
+# table pointer and keyword name in the common block.
+
+procedure he_getop (operand, o)
+
+char	operand[ARB]		# operand name
+pointer	o			# operand (output)
+
+pointer sp
+pointer keyword		# scratch for current keyword name
+pointer value		# scratch for value
+pointer newvalue	# value in lower case; "yes" or "no" for bool value
+int	dtype		# data type of keyword
+pointer	h_tp		# getop common
+char	h_table[SZ_TABLENAME]
+char	h_keyword[SZ_KEYWORDNAME]
+common	/hegop2/ h_tp, h_table, h_keyword
+int	he_dtype()
+bool	streq()
+errchk	tbhgtt
+
+begin
+	call smark (sp)
+	call salloc (value, SZ_FNAME, TY_CHAR)
+	call salloc (newvalue, SZ_FNAME, TY_CHAR)
+	call salloc (keyword, SZ_KEYWORDNAME, TY_CHAR)
+
+	if (streq (operand, "$"))
+	    call strcpy (h_keyword, Memc[keyword], SZ_KEYWORDNAME)
+	else
+	    call strcpy (operand, Memc[keyword], SZ_KEYWORDNAME)
+
+	# Get the value and interpret its data type.
+	iferr {
+	    call tkw_special (h_tp, Memc[keyword], Memc[value], SZ_FNAME)
+	} then {
+	    call tbhgtt (h_tp, Memc[keyword], Memc[value], SZ_FNAME)
+	}
+
+	dtype = he_dtype (Memc[value], Memc[newvalue], SZ_FNAME)
+
+	switch (dtype) {
+	case TY_BOOL:
+	    call xev_initop (o, 0, TY_BOOL)
+	    O_VALB(o) = (streq (Memc[newvalue], "yes"))
+
+	case TY_SHORT, TY_INT, TY_LONG:
+	    call xev_initop (o, 0, TY_INT)
+	    call sscan (Memc[value])
+		call gargi (O_VALI(o))
+
+	case TY_REAL, TY_DOUBLE, TY_COMPLEX:
+	    call xev_initop (o, 0, TY_REAL)
+	    call sscan (Memc[value])
+		call gargr (O_VALR(o))
+
+	default:
+	    call xev_initop (o, SZ_LINE, TY_CHAR)
+	    call strcpy (Memc[value], O_VALC(o), SZ_LINE)
+	}
+
+	call sfree (sp)
+end
+
+
+# HE_GETOPSETTABLE -- Copy the table pointer, table name, and keyword name
+# to a common block in preparation for a getop call by EVEXPR.
+
+procedure he_getopsettable (tp, table, keyword)
+
+pointer	tp			# table descriptor of table to be edited
+char	table[ARB]		# name of table to be edited
+char	keyword[ARB]		# name of keyword to be edited
+
+pointer	h_tp			# getop common
+char	h_table[SZ_TABLENAME]
+char	h_keyword[SZ_KEYWORDNAME]
+common	/hegop2/ h_tp, h_table, h_keyword
+
+begin
+	h_tp = tp
+	call strcpy (table, h_table, SZ_TABLENAME)
+	call strcpy (keyword, h_keyword, SZ_KEYWORDNAME)
+end
+
+
+# HE_ENCODEOP -- Encode an operand as returned by EVEXPR as a string.  EVEXPR
+# operands are restricted to the datatypes bool, int, real, and string.
+
+procedure he_encodeop (o, outstr, maxch)
+
+pointer	o			# operand to be encoded
+char	outstr[ARB]		# output string
+int	maxch			# max chars in outstr
+
+begin
+	switch (O_TYPE(o)) {
+	case TY_BOOL:
+	    call sprintf (outstr, maxch, "%b")
+		call pargb (O_VALB(o))
+	case TY_CHAR:
+	    call sprintf (outstr, maxch, "%s")
+		call pargstr (O_VALC(o))
+	case TY_INT:
+	    call sprintf (outstr, maxch, "%d")
+		call pargi (O_VALI(o))
+	case TY_REAL:
+	    call sprintf (outstr, maxch, "%g")
+		call pargr (O_VALR(o))
+	default:
+	    call error (1, "unknown expression datatype")
+	}
+end
+
+
+# HE_PARGSTR -- Pass a string to a printf statement, enclosing the string
+# in quotes if it contains any whitespace.
+
+procedure he_pargstr (str)
+
+char	str[ARB]		# string to be printed
+int	ip
+bool	quoteit
+pointer	sp, op, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	op = buf
+	Memc[op] = '"'
+	op = op + 1
+
+	# Copy string to scratch buffer, enclosed in quotes.  Check for
+	# embedded whitespace.
+
+	quoteit = false
+	for (ip=1;  str[ip] != EOS;  ip=ip+1) {
+	    if (IS_WHITE(str[ip])) {		# detect whitespace
+		quoteit = true
+		Memc[op] = str[ip]
+	    } else if (str[ip] == '\n') {	# prettyprint newlines
+		Memc[op] = '\\'
+		op = op + 1
+		Memc[op] = 'n'
+	    } else				# normal characters
+		Memc[op] = str[ip]
+
+	    if (ip < SZ_LINE)
+		op = op + 1
+	}
+
+	# If whitespace was seen pass the quoted string, otherwise pass the
+	# original input string.
+
+	if (quoteit) {
+	    Memc[op] = '"'
+	    op = op + 1
+	    Memc[op] = EOS
+	    call pargstr (Memc[buf])
+	} else
+	    call pargstr (str)
+
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/thedit/t_thselect.x b/pkg/utilities/nttools/thedit/t_thselect.x
new file mode 100644
index 00000000..db6f9077
--- /dev/null
+++ b/pkg/utilities/nttools/thedit/t_thselect.x
@@ -0,0 +1,150 @@
+include	<error.h>
+include	<evexpr.h>
+include <ctype.h>
+include	<tbset.h>
+
+define	SZ_TABLENAME	(SZ_FNAME)	# max size of a table name
+define	SZ_KEYWORDNAME	31		# max size of a keyword name
+
+
+# thselect -- Print table keyword values, if the specified expression is true.
+#
+# Phil Hodge, 19-Jul-2000  Task created, based on hselect.
+# Phil Hodge,  4-Mar-2002  Free memory allocated by evexpr.
+
+procedure t_thselect()
+
+pointer keywords		# template listing keywords to be processed
+pointer expr			# boolean expression to be evaluated
+
+pointer tnt
+pointer sp, table
+pointer tp			# pointer to table struct
+int	i
+
+pointer tbtopn()
+int	tbnopenp(), tbnget()
+int	strlen()
+errchk	he_select
+
+begin
+	call smark (sp)
+	call salloc (table,     SZ_FNAME, TY_CHAR)
+	call salloc (keywords,  SZ_LINE,  TY_CHAR)
+	call salloc (expr,      SZ_LINE,  TY_CHAR)
+
+	# Get the list of table names.
+	tnt = tbnopenp ("table")
+
+	# Get the list of keyword names.
+	call clgstr ("keywords", Memc[keywords], SZ_LINE)
+	do i = 1, strlen (Memc[keywords]) {
+	    if (Memc[keywords+i-1] == ',')
+		Memc[keywords+i-1] = ' '	# replace comma with blank
+	}
+
+	# Get the boolean expression.
+	call clgstr ("expr", Memc[expr], SZ_LINE)
+
+	# Main processing loop.  A table is processed in each pass through
+	# the loop.
+
+	while (tbnget (tnt, Memc[table], SZ_FNAME) != EOF) {
+
+	    # Open the current table.
+	    iferr {
+		tp = tbtopn (Memc[table], READ_ONLY,  NULL)
+	    } then {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Get the full table name (including extension if FITS).
+	    call tbtnam (tp, Memc[table], SZ_FNAME)
+
+	    call he_getopsettable (tp, Memc[table], Memc[keywords])
+
+	    iferr {
+		call hs_select (tp, Memc[table], Memc[keywords], Memc[expr])
+	    } then {
+		call erract (EA_WARN)
+		call tbtclo (tp)
+		next
+	    }
+
+	    call tbtclo (tp)
+	}
+
+	call tbnclose (tnt)
+	call sfree (sp)
+end
+
+procedure hs_select (tp, table, keywords, expr)
+
+pointer tp		# i: pointer to table struct
+char table[ARB]		# i: name of current table
+char keywords[ARB]	# i: blank-separated list of keyword names
+char expr[ARB]		# i: boolean expression
+#--
+pointer sp
+pointer template	# one keyword name (may include wildcard characters)
+pointer value, comment
+char	keyword[SZ_KEYWORD]	# current keyword name
+pointer o
+pointer evexpr()
+int	locpr()
+extern	he_getop()
+pointer kw, tkw_open()
+int	ip, ctowrd()
+int	nkw		# number of keywords
+int	k		# loop index in list of matched keywords
+int	tkw_len()
+bool	first		# true if first keyword (template) in keywords
+errchk	evexpr
+
+begin
+	call smark (sp)
+	call salloc (template, SZ_FNAME, TY_CHAR)
+	call salloc (value, SZ_FNAME, TY_CHAR)
+	call salloc (comment, SZ_FNAME, TY_CHAR)
+
+	# Evaluate the boolean expression.
+	o = evexpr (expr, locpr(he_getop), 0)
+	if (O_TYPE(o) != TY_BOOL)
+	    call error (1, "expression must be boolean")
+
+	# Print the values of the listed keywords if the expression is true.
+	if (O_VALB(o)) {
+
+	    # Get a list of all the keywords in the header.
+	    kw = tkw_open (tp)
+
+	    # for each keyword or template in blank-separated list ...
+	    ip = 1
+	    first = true
+	    while (ctowrd (keywords, ip, Memc[template], SZ_FNAME) > 0) {
+
+		# Find all keywords that match the current keyword template.
+		call tkw_find (tp, kw, Memc[template])
+		nkw = tkw_len (kw)
+
+		# Get and print the keyword values.
+		do k = 1, nkw {
+		    call he_gval (tp, kw, k,
+				keyword, Memc[value], Memc[comment], SZ_FNAME)
+		    if (!first)
+			call printf ("\t")
+		    call printf ("%s")
+			call he_pargstr (Memc[value])
+		    first = false
+		}
+	    }
+	    call printf ("\n")
+	    call flush (STDOUT)
+	    call tkw_close (kw)
+	}
+
+	call xev_freeop (o)
+	call mfree (o, TY_STRUCT)
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/thedit/tkw.x b/pkg/utilities/nttools/thedit/tkw.x
new file mode 100644
index 00000000..9cb9d371
--- /dev/null
+++ b/pkg/utilities/nttools/thedit/tkw.x
@@ -0,0 +1,405 @@
+include <ctype.h>
+include <finfo.h>	# for file creation or modification time
+include <time.h>
+include <tbset.h>
+
+# This file contains a set of routines for finding header keywords in a
+# table.
+#
+# kw = tkw_open (tp)
+# call tkw_close (kw)
+# call tkw_find (tp, kw, keyword)
+# nkw = tkw_len (kw)
+# call tkw_reopen (tp, kw, keyword)
+# call tkw_getkw (kw, k, keynum, keyword, maxch)
+# call tkw_special (tp, keyword, value, maxch)
+#
+# Phil Hodge, 10-May-2000  Subroutines created.
+# Phil Hodge, 31-May-2000  Add "keywords" i_nrows, etc.
+# Phil Hodge, 19-Jul-2000  Add support for $I (equivalent to i_table).
+# Phil Hodge, 15-Jul-2009  Remove ttype from calling sequence for tbparse.
+
+define	NUM_SPECIAL	7		# number of keywords such as i_nrows
+define	N_I_TABLE	1		# index number for i_table
+define	N_I_FILE	2		# index number for i_file
+define	N_I_CTIME	3
+define	N_I_NROWS	4
+define	N_I_NCOLS	5
+define	N_I_NPAR	6
+define	N_I_TYPE	7
+
+define	SZ_KW_LIST	5
+define	SZ_KW_SPACING	(SZ_KEYWORD+2)	# spacing of keywords in KW_NAME
+
+define	NUM_KEYWORDS	Memi[$1]	# total number of keywords
+define	NUM_MATCH	Memi[$1+1]	# number of keywords that match template
+define	KW_NAME_PTR	Memi[$1+2]	# list of keyword names
+define	KW_TYPE_PTR	Memi[$1+3]	# list of keyword data types
+define	KW_MATCH_PTR	Memi[$1+4]	# indexes of keywords matching template
+define	KW_NAME		Memc[KW_NAME_PTR($1) + ($2-1)*SZ_KW_SPACING]
+define	KW_TYPE		Memi[KW_TYPE_PTR($1) + $2-1]
+define	KW_MATCH	Memi[KW_MATCH_PTR($1) + $2-1]
+
+# get list of all keywords in header
+
+pointer procedure tkw_open (tp)
+
+pointer tp		# i: pointer to table struct
+#--
+pointer kw		# o: pointer to keyword list struct
+char	keyword[SZ_KEYWORD]	# current keyword
+int	dtype			# data type of current keyword
+char	value[SZ_PARREC]	# value of current keyword
+int	i
+int	npar			# number of keywords excluding i_nrows, etc
+int	keynum			# index for keyword number
+int	tbpsta()
+errchk	tbhgnp
+
+begin
+	call malloc (kw, SZ_KW_LIST, TY_POINTER)
+
+	npar = tbpsta (tp, TBL_NPAR)
+
+	NUM_KEYWORDS(kw) = NUM_SPECIAL + npar
+	NUM_MATCH(kw) = 0			# initial value
+
+	call calloc (KW_NAME_PTR(kw),
+		SZ_KW_SPACING * NUM_KEYWORDS(kw), TY_CHAR)
+
+	call calloc (KW_TYPE_PTR(kw), NUM_KEYWORDS(kw), TY_INT)
+	call calloc (KW_MATCH_PTR(kw), NUM_KEYWORDS(kw), TY_INT)
+
+	# First assign names for the special keywords i_nrows, etc.
+	# This list must agree with those in tkw_special, and the
+	# number of such keywords must be no larger than NUM_SPECIAL.
+
+	call strcpy ("i_table", KW_NAME(kw,N_I_TABLE), SZ_KEYWORD)
+	KW_TYPE(kw,N_I_TABLE) = TY_CHAR
+
+	call strcpy ("i_file", KW_NAME(kw,N_I_FILE), SZ_KEYWORD)
+	KW_TYPE(kw,N_I_FILE) = TY_INT
+
+	call strcpy ("i_ctime", KW_NAME(kw,N_I_CTIME), SZ_KEYWORD)
+	KW_TYPE(kw,N_I_CTIME) = TY_INT
+
+	call strcpy ("i_nrows", KW_NAME(kw,N_I_NROWS), SZ_KEYWORD)
+	KW_TYPE(kw,N_I_NROWS) = TY_INT
+
+	call strcpy ("i_ncols", KW_NAME(kw,N_I_NCOLS), SZ_KEYWORD)
+	KW_TYPE(kw,N_I_NCOLS) = TY_INT
+
+	call strcpy ("i_npar", KW_NAME(kw,N_I_NPAR), SZ_KEYWORD)
+	KW_TYPE(kw,N_I_NPAR) = TY_INT
+
+	call strcpy ("i_type", KW_NAME(kw,N_I_TYPE), SZ_KEYWORD)
+	KW_TYPE(kw,N_I_TYPE) = TY_CHAR
+
+	keynum = 1
+	do i = NUM_SPECIAL+1, NUM_KEYWORDS(kw) {
+
+	    call tbhgnp (tp, keynum, keyword, dtype, value)
+	    call strcpy (keyword, KW_NAME(kw,i), SZ_KEYWORD)
+	    KW_TYPE(kw,i) = dtype
+	    keynum = keynum + 1
+	}
+
+	return (kw)
+end
+
+# free memory for keyword list
+
+procedure tkw_close (kw)
+
+pointer kw		# io: pointer to keyword list struct
+
+begin
+	if (kw != NULL) {
+	    call mfree (KW_NAME_PTR (kw), TY_CHAR)
+	    call mfree (KW_TYPE_PTR (kw), TY_INT)
+	    call mfree (KW_MATCH_PTR (kw), TY_INT)
+	    call mfree (kw, TY_POINTER)
+	    kw = NULL
+	}
+end
+
+# expand template for current keyword
+# This can be called repeatedly after tkw_open.  Each time it is called,
+# the previous list will be overwritten.
+
+procedure tkw_find (tp, kw, keyword)
+
+pointer tp		# i: pointer to table struct
+pointer kw		# i: pointer to keyword list struct
+char	keyword[ARB]	# i: keyword name template
+#--
+pointer sp
+pointer template	# keyword converted to upper case, etc
+char	pat[SZ_FNAME]	# encoded pattern
+int	lenpat
+int	k		# counter for keywords that match template
+int	i, nmatch
+int	strlen()
+int	patmake(), pat_amatch()
+errchk	uc_template, patmake, pat_amatch
+
+begin
+	call smark (sp)
+	call salloc (template, SZ_FNAME, TY_CHAR)
+
+	# Convert the keyword to upper case (except for special keywords).
+	call uc_template (keyword, Memc[template], SZ_FNAME)
+
+	lenpat = patmake (Memc[template], pat, SZ_FNAME)
+
+	k = 0
+	do i = 1, NUM_KEYWORDS(kw) {
+
+	    if (strlen (KW_NAME(kw,i)) < 1)	# ignore blank keywords
+		next
+
+	    nmatch = pat_amatch (KW_NAME(kw,i), 1, pat)
+	    if (nmatch == strlen (KW_NAME(kw,i))) {
+		k = k + 1
+		KW_MATCH(kw,k) = i
+	    }
+	}
+	NUM_MATCH(kw) = k
+
+	call sfree (sp)
+end
+
+# get all current keywords and expand template again
+
+procedure tkw_reopen (tp, kw, keyword)
+
+pointer tp		# i: pointer to table struct
+pointer kw		# io: pointer to keyword list struct
+char	keyword[ARB]	# i: keyword name template
+#--
+pointer tkw_open()
+
+begin
+	call tkw_close (kw)
+	kw = tkw_open (tp)
+	call tkw_find (tp, kw, keyword)
+end
+
+# This routine converts the keyword template to upper case (except for
+# special keywords) and replaces "*" with "?*" for use with patmake.
+
+procedure uc_template (keyword, template, maxch)
+
+char	keyword[ARB]	# i: keyword template
+char	template[ARB]	# o: template converted to upper case
+int	maxch		# i: max length of template string
+#--
+char	ch
+int	ip, op
+int	strncmp()
+bool	streq()
+
+begin
+	# Make "$I" equivalent to i_table.
+	if (streq (keyword, "$I")) {
+	    call strcpy ("i_table", template, maxch)
+	    return
+	}
+
+	# Copy special keywords to output without change.
+	if (strncmp (keyword, "i_", 2) == 0) {
+	    call strcpy (keyword, template, maxch)
+	    return
+	}
+
+	ip = 1
+	op = 1
+	ch = keyword[ip]
+
+	while (ch != EOS) {
+
+	    # Map "*" into "?*".
+	    if (ch == '*' && ip > 1) {
+		template[op] = '?'
+		op = op + 1
+	    }
+
+	    if (op > maxch)
+		call error (1, "keyword template string is too long")
+
+	    if (IS_LOWER(ch))
+		template[op] = TO_UPPER(ch)
+	    else
+		template[op] = ch
+
+	    op = op + 1
+	    ip = ip + 1
+	    ch = keyword[ip]
+	}
+	template[op] = EOS
+end
+
+# This function returns the number of keywords that matched the template,
+# i.e. after calling tkw_find.
+
+int procedure tkw_len (kw)
+
+pointer kw		# i: pointer to keyword list struct
+
+begin
+	return (NUM_MATCH(kw))
+end
+
+# This routine can be used to loop through the list of matched keywords,
+# returning the keyword number and name.  k is the index in the list of
+# keywords that match the template, and keynum is the index of the keyword
+# in the header.  k runs from 1 to tkw_len.  keynum can be passed to
+# tbhgnp to get a keyword or to tbhdel to delete a keyword.
+
+procedure tkw_getkw (kw, k, keynum, keyword, maxch)
+
+pointer kw		# i: pointer to keyword list struct
+int	k		# i: index of keyword in list of match keywords
+int	keynum		# o: keyword number in header
+char	keyword[ARB]	# o: keyword name
+int	maxch		# i: max length of keyword string
+#--
+int	knum
+
+begin
+	if (k < 1 || k > NUM_MATCH(kw))
+	    call error (1, "tkw_getkw:  index is out of range")
+
+	knum = KW_MATCH(kw,k)
+	keynum = knum - NUM_SPECIAL
+
+	call strcpy (KW_NAME(kw,knum), keyword, maxch)
+end
+
+# This routine returns the value of one of the special keywords.
+
+procedure tkw_special (tp, keyword, value, maxch)
+
+pointer tp			# i: pointer to table struct
+char	keyword[ARB]		# i: current keyword
+char	value[ARB]		# o: value of keyword
+int	maxch			# i: size of value string
+#--
+pointer sp
+pointer tablename		# name of table
+pointer filename		# name of table without brackets
+pointer hduname			# returned by tbparse and ignored
+int	hdu			# ignored
+int	junk, tbparse()
+long	ostruct[LEN_FINFO]	# contains info about file
+long	ctime			# creation or modification time
+char	datestr[SZ_TIME]	# ctime converted to a string
+int	finfo()
+int	tbltype, tbl_subtype
+int	tbpsta()
+bool	streq()
+
+begin
+	call smark (sp)
+
+	if (streq (keyword, "$I") || streq (keyword, "i_table")) {
+
+	    # The table name.
+	    call tbtnam (tp, value, maxch)
+
+	} else if (streq (keyword, "i_file")) {
+
+	    # The name of the file containing the table.
+	    call salloc (tablename, SZ_FNAME, TY_CHAR)
+	    call salloc (filename, SZ_FNAME, TY_CHAR)
+	    call salloc (hduname, SZ_FNAME, TY_CHAR)
+
+	    call tbtnam (tp, Memc[tablename], SZ_FNAME)
+	    junk = tbparse (Memc[tablename], Memc[filename],
+			Memc[hduname], SZ_FNAME, hdu)
+	    call strcpy (Memc[filename], value, maxch)
+
+	} else if (streq (keyword, "i_ctime")) {
+
+	    # The time the file was created (or last modified).
+	    call salloc (tablename, SZ_FNAME, TY_CHAR)
+	    call salloc (filename, SZ_FNAME, TY_CHAR)
+	    call salloc (hduname, SZ_FNAME, TY_CHAR)
+
+	    # Get file name.
+	    call tbtnam (tp, Memc[tablename], SZ_FNAME)
+	    junk = tbparse (Memc[tablename], Memc[filename],
+			Memc[hduname], SZ_FNAME, hdu)
+
+	    if (finfo (Memc[filename], ostruct) == ERR)
+		call error (1, "Can't get info about file")
+
+	    ctime = FI_CTIME(ostruct)
+	    call cnvtime (ctime, datestr, SZ_TIME)
+	    call strcpy (datestr, value, maxch)
+
+	} else if (streq (keyword, "i_nrows")) {
+
+	    # The number of rows in the table.
+	    call sprintf (value, maxch, "%d")
+		call pargi (tbpsta (tp, TBL_NROWS))
+
+	} else if (streq (keyword, "i_ncols")) {
+
+	    # The number of columns in the table.
+	    call sprintf (value, maxch, "%d")
+		call pargi (tbpsta (tp, TBL_NCOLS))
+
+	} else if (streq (keyword, "i_npar")) {
+
+	    # The number of header keywords in the table.
+	    call sprintf (value, maxch, "%d")
+		call pargi (tbpsta (tp, TBL_NPAR))
+
+	} else if (streq (keyword, "i_type")) {
+
+	    # The type of the table.
+	    tbltype = tbpsta (tp, TBL_WHTYPE)
+	    tbl_subtype = tbpsta (tp, TBL_SUBTYPE)
+
+	    if (tbltype == TBL_TYPE_TEXT) {
+
+		if (tbl_subtype == TBL_SUBTYPE_SIMPLE)
+		    call strcpy ("text", value, maxch)
+		else if (tbl_subtype == TBL_SUBTYPE_EXPLICIT)
+		    call strcpy ("text with explicit column definitions",
+				value, maxch)
+		else
+		    call strcpy ("text", value, maxch)
+
+	    } else if (tbltype == TBL_TYPE_FITS) {
+
+		if (tbl_subtype == TBL_SUBTYPE_ASCII)
+		    call strcpy ("fits ascii", value, maxch)
+		else if (tbl_subtype == TBL_SUBTYPE_BINTABLE)
+		    call strcpy ("fits binary", value, maxch)
+		else if (tbl_subtype == TBL_SUBTYPE_IMAGE)
+		    call strcpy ("fits primary header", value, maxch)
+		else
+		    call strcpy ("fits", value, maxch)
+
+	    } else if (tbltype == TBL_TYPE_S_ROW) {
+
+		call strcpy ("stsdas row ordered", value, maxch)
+
+	    } else if (tbltype == TBL_TYPE_S_COL) {
+
+		call strcpy ("stsdas column ordered", value, maxch)
+
+	    } else {
+		call strcpy ("unknown", value, maxch)
+	    }
+
+	} else {
+
+	    call sfree (sp)
+	    call error (1, "not a special keyword")
+	}
+
+	call sfree (sp)
+end