aboutsummaryrefslogtreecommitdiff
path: root/pkg/utilities/nttools/thedit/tkw.x
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/utilities/nttools/thedit/tkw.x')
-rw-r--r--pkg/utilities/nttools/thedit/tkw.x405
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
generated by cgit (git 2.34.1) at 2025-09-20 08:24:15 -0400