From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- pkg/utilities/nttools/thedit/mkpkg | 13 + pkg/utilities/nttools/thedit/t_thedit.x | 833 ++++++++++++++++++++++++++++++ pkg/utilities/nttools/thedit/t_thselect.x | 150 ++++++ pkg/utilities/nttools/thedit/tkw.x | 405 +++++++++++++++ 4 files changed, 1401 insertions(+) create mode 100644 pkg/utilities/nttools/thedit/mkpkg create mode 100644 pkg/utilities/nttools/thedit/t_thedit.x create mode 100644 pkg/utilities/nttools/thedit/t_thselect.x create mode 100644 pkg/utilities/nttools/thedit/tkw.x (limited to 'pkg/utilities/nttools/thedit') 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 + t_thselect.x + tkw.x + ; 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 +include +include +include +include + +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 +include +include +include + +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 +include # for file creation or modification time +include +include + +# 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 -- cgit