Initial commit

1 files changed, 405 insertions, 0 deletions

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