aboutsummaryrefslogtreecommitdiff
path: root/pkg/utilities/nttools/tupar/tuinstr.x
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/utilities/nttools/tupar/tuinstr.x')
-rw-r--r--pkg/utilities/nttools/tupar/tuinstr.x971
1 files changed, 971 insertions, 0 deletions
diff --git a/pkg/utilities/nttools/tupar/tuinstr.x b/pkg/utilities/nttools/tupar/tuinstr.x
new file mode 100644
index 00000000..32adf46d
--- /dev/null
+++ b/pkg/utilities/nttools/tupar/tuinstr.x
@@ -0,0 +1,971 @@
+include <ctype.h> # defines IS_WHITE
+include <tbset.h>
+include "tupar.h" # defines TUPAR_EXIT & TUPAR_QUIT
+
+# tu_instr -- execute edit instruction
+# Execute one instruction regarding header parameters for a table:
+# get, put, delete, replace, type, or list.
+# The flag DONE will be set to true if the instruction is 'q' or
+# if the user's response to a prompt is EOF. Prompting is turned
+# off if the input is redirected.
+#
+# Phil Hodge, 28-Mar-1988 Subroutine created
+# Phil Hodge, 9-Sep-1988 Prompt changed for delete & replace
+# Phil Hodge, 9-Mar-1989 Change data type of header parm from char to int.
+# Phil Hodge, 23-Aug-1991 Include eq_flag, allowing quit without saving changes
+# Phil Hodge, 9-Jul-1993 Set modified=true if header was changed.
+# Phil Hodge, 7-Mar-1995 In tu_putpar, also put a comment, if present.
+# Phil Hodge, 17-May-1995 In tu_putpar, allow ' as well as " as delimiter.
+# Phil Hodge, 22-May-1996 Add "k" instruction.
+# Phil Hodge, 5-Jun-1997 In tu_getpar and tu_listpar, also print comments
+# Phil Hodge, 2-Jul-1998 In tu_putpar, check for "true" or "t" for a boolean
+# parameter; get data type from existing parameter;
+# in tu_listpar, print boolean as "yes" or "no".
+# Ellyne Kinney, 2-Feb-1999 Testing Automatic updates of IRAFRA under CVS
+# 13th try.
+
+procedure tu_instr (tp, linebuf, readonly, prompt, from_stdin,
+ iredir, save_instr, isbuf, bufsize, ibp,
+ modified, eq_flag, done, istat)
+
+pointer tp # i: pointer to table descriptor
+char linebuf[ARB] # o: scratch for input line
+bool readonly # i: was table opened readonly?
+bool prompt # i: prompt for input?
+bool from_stdin # i: get input from STDIN (or from buffer)
+bool iredir # i: input redirected?
+bool save_instr # i: save instruction?
+pointer isbuf # io: pointer to instruction buffer
+int bufsize # io: current size of instruction buffer
+int ibp # io: current index in instruction buffer
+bool modified # io: set to true if the header was modified
+int eq_flag # o: exit or quit
+bool done # o: set to true if done with current table
+int istat # o: > 0 if put or delete but table is readonly
+#--
+char instr[11] # instruction from user: q, g, p, etc.
+int ip # index in linebuf
+int clen # length of command (to check for "!")
+bool verify # verify before delete or replace?
+bool incl_num # include par numbers when listing keywords?
+int ctowrd(), tu_gline(), tu_rd_instr()
+int strlen()
+errchk tu_getpar, tu_putpar, tu_delpar, tu_replpar, tu_ch_name
+
+begin
+ # default value in case user finishes by giving an EOF
+ eq_flag = TUPAR_EXIT
+
+ istat = 0
+ done = false
+
+ if (from_stdin) {
+ # Read an instruction from STDIN into linebuf.
+ if (prompt) {
+ call eprintf (":")
+ call flush (STDOUT)
+ call flush (STDERR)
+ }
+ if (tu_gline (STDIN, linebuf) == EOF)
+ done = true
+ } else {
+ # Read an instruction from buffer into linebuf.
+ if (tu_rd_instr (Memc[isbuf], ibp, linebuf) == EOF)
+ done = true
+ }
+ if ( done )
+ return
+
+ ip = 1
+ if (ctowrd (linebuf, ip, instr, 11) <= 0) # a blank line
+ return
+ if (instr[1] == '#') # a comment line
+ return
+
+ if (instr[1] == 'e') {
+ eq_flag = TUPAR_EXIT
+ done = true
+
+ } else if (instr[1] == 'q') {
+ clen = strlen (instr)
+ if (instr[clen] == '!')
+ eq_flag = TUPAR_QUIT_NC
+ else
+ eq_flag = TUPAR_QUIT
+ done = true
+
+ } else if (instr[1] == 'g') {
+
+ call tu_getpar (tp, linebuf, ip, instr,
+ save_instr, isbuf, bufsize, ibp)
+
+ } else if (instr[1] == 'p') {
+
+ if (readonly) {
+ istat = 1
+ return
+ }
+ call tu_putpar (tp, linebuf, ip, instr,
+ save_instr, isbuf, bufsize, ibp)
+ modified = true
+
+ } else if (instr[1] == 'd') {
+
+ # Delete a header parameter specified by name or by number.
+
+ if (readonly) {
+ istat = 1
+ return
+ }
+ verify = ( ! iredir ) && (instr[2] != '!')
+ call tu_delpar (tp, linebuf, ip, verify,
+ save_instr, isbuf, bufsize, ibp, modified)
+
+ } else if (instr[1] == 'r') {
+
+ # Replace a header parameter specified by name or by number.
+
+ if (readonly) {
+ istat = 1
+ return
+ }
+ verify = ( ! iredir ) && (instr[2] != '!')
+ call tu_replpar (tp, linebuf, ip, prompt, from_stdin,
+ verify, save_instr, isbuf, bufsize, ibp,
+ modified, done)
+
+ } else if (instr[1] == 'k') {
+
+ # Change keyword name.
+
+ if (readonly) {
+ istat = 1
+ return
+ }
+ call tu_ch_name (tp, linebuf, ip,
+ save_instr, isbuf, bufsize, ibp,
+ modified)
+
+ } else if (instr[1] == 't' || instr[1] == 'l') {
+
+ # Type or list parameters; list means include keyword number.
+
+ incl_num = instr[1] == 'l' # list rather than type
+ call tu_listpar (tp, linebuf, ip, incl_num,
+ save_instr, isbuf, bufsize, ibp)
+
+ } else {
+ call eprintf ("The options are:\n")
+ call eprintf (
+ " e, q, g, p, d, r, t, l\n")
+ call eprintf (
+ " (exit, quit, get, put, delete, replace, type, list)\n")
+ call eprintf (
+ " e exit the task, saving changes\n")
+ call eprintf (
+ " q quit the task WITHOUT saving any changes\n")
+ call eprintf (
+ " g keyword get parameter with keyword `keyword'\n")
+ call eprintf (
+ " p keyword value put parameter `keyword'\n")
+ call eprintf (
+ " d keyword delete parameter `keyword'\n")
+ call eprintf (
+ " r keyword replace parameter `keyword'\n")
+ call eprintf (
+ " k oldkey newkey change keyword name\n")
+ call eprintf (
+ " t type the parameters\n")
+ call eprintf (
+ " l list parameters and show par numbers\n")
+ call eprintf (
+ " see help for further info about these instructions\n")
+ }
+end
+
+
+# tu_getpar -- get a parameter
+# The value of a parameter specified by name (not by number) will be gotten
+# and displayed. If the keyword is not found in the header, nothing will
+# be displayed (i.e. no error message). If the keyword is HISTORY, COMMENT,
+# or a blank, then all keywords of that type will be displayed.
+
+procedure tu_getpar (tp, linebuf, ip, instr,
+ save_instr, isbuf, bufsize, ibp)
+
+pointer tp # i: pointer to table descriptor
+char linebuf[ARB] # i: input line
+int ip # io: index in linebuf
+char instr[ARB] # i: the instruction (needed for data type)
+bool save_instr # i: save instruction?
+pointer isbuf # io: pointer to instruction buffer
+int bufsize # io: current size of instruction buffer
+int ibp # io: current index in instruction buffer
+#--
+char keyword[SZ_KEYWORD] # keyword for parameter
+char kwrd[SZ_KEYWORD] # keyword returned by tbhgnp
+char text[SZ_PARREC] # buffer for value of parameter
+char comment[SZ_PARREC] # buffer for comment, if any
+int dtype # data type (TY_CHAR, etc)
+double dblval
+real realval
+int intval
+bool boolval
+int npar # current number of parameters
+int k # loop index
+double tbhgtd()
+real tbhgtr()
+int tbhgti(), tbpsta()
+bool tbhgtb()
+int ctowrd()
+bool streq()
+
+begin
+ npar = tbpsta (tp, TBL_NPAR)
+
+ if (ctowrd (linebuf, ip, keyword, SZ_KEYWORD) <= 0) {
+ call eprintf ("syntax: g keyword\n")
+ return # get next instruction
+ }
+ call strupr (keyword)
+
+ # Get comment, if it exists.
+ iferr (call tbhgcm (tp, keyword, comment, SZ_PARREC))
+ comment[1] = EOS
+
+ if (instr[2] == 'r') {
+ ifnoerr (realval = tbhgtr (tp, keyword)) {
+ call printf ("%s = %g")
+ call pargstr (keyword)
+ call pargr (realval)
+ if (comment[1] == EOS) {
+ call printf ("\n")
+ } else {
+ call printf (" %s\n")
+ call pargstr (comment)
+ }
+ }
+ } else if (instr[2] == 'd') {
+ ifnoerr (dblval = tbhgtd (tp, keyword)) {
+ call printf ("%s = %g")
+ call pargstr (keyword)
+ call pargd (dblval)
+ if (comment[1] == EOS) {
+ call printf ("\n")
+ } else {
+ call printf (" %s\n")
+ call pargstr (comment)
+ }
+ }
+ } else if (instr[2] == 'i') {
+ ifnoerr (intval = tbhgti (tp, keyword)) {
+ call printf ("%s = %d")
+ call pargstr (keyword)
+ call pargi (intval)
+ if (comment[1] == EOS) {
+ call printf ("\n")
+ } else {
+ call printf (" %s\n")
+ call pargstr (comment)
+ }
+ }
+ } else if (instr[2] == 'b') {
+ ifnoerr (boolval = tbhgtb (tp, keyword)) {
+ call printf ("%s = %b")
+ call pargstr (keyword)
+ call pargb (boolval)
+ if (comment[1] == EOS) {
+ call printf ("\n")
+ } else {
+ call printf (" %s\n")
+ call pargstr (comment)
+ }
+ }
+ } else {
+ if (streq (keyword, "HISTORY") || streq (keyword, "COMMENT") ||
+ keyword[1] == EOS) {
+ # Print all history or comment or blank-keyword records.
+ do k = 1, npar {
+ call tbhgnp (tp, k, kwrd, dtype, text)
+ if (streq (keyword, kwrd)) {
+ call printf ("%s = %s\n")
+ call pargstr (keyword)
+ call pargstr (text)
+ }
+ }
+ } else {
+ ifnoerr (call tbhgtt (tp, keyword, text, SZ_PARREC)) {
+ if (comment[1] == EOS) {
+ call printf ("%s = %s\n")
+ call pargstr (keyword)
+ call pargstr (text)
+ } else {
+ call printf ("%s = '%s' %s\n")
+ call pargstr (keyword)
+ call pargstr (text)
+ call pargstr (comment)
+ }
+ }
+ }
+ }
+
+ if (save_instr)
+ call tu_save_instr (linebuf, isbuf, bufsize, ibp)
+end
+
+
+# tu_putpar -- add or replace a parameter
+# A parameter specified by name (not by number) is put into the table.
+# If the parameter already exists it will be replaced (and the data type
+# may be changed); otherwise, it will be added.
+
+procedure tu_putpar (tp, linebuf, ip, instr,
+ save_instr, isbuf, bufsize, ibp)
+
+pointer tp # i: pointer to table descriptor
+char linebuf[ARB] # i: input line
+int ip # io: index in linebuf
+char instr[ARB] # i: the instruction (needed for data type)
+bool save_instr # i: save instruction?
+pointer isbuf # io: pointer to instruction buffer
+int bufsize # io: current size of instruction buffer
+int ibp # io: current index in instruction buffer
+#--
+pointer sp
+pointer value # scratch for a string value
+char keyword[SZ_KEYWORD] # keyword for parameter
+int dtype # data type code for parameter
+bool found # parameter already in header? (ignored)
+double dblval
+real realval
+int intval
+bool boolval
+int npar # current number of parameters
+int tbpsta()
+int nchar, ctowrd(), ctod(), ctoi(), nscan(), strlen()
+bool streq()
+
+begin
+ npar = tbpsta (tp, TBL_NPAR)
+
+ if (ctowrd (linebuf, ip, keyword, SZ_KEYWORD) <= 0) {
+ call eprintf ("syntax: p keyword value\n")
+ return
+ }
+
+ call smark (sp)
+ call salloc (value, SZ_FNAME, TY_CHAR)
+
+ # Set the data type. If the user specified a type, use that.
+ # If none was specified, find out whether the parameter is
+ # already in the header, and if so, use the existing type.
+ if (instr[2] == 'r')
+ dtype = TY_REAL
+ else if (instr[2] == 'd')
+ dtype = TY_DOUBLE
+ else if (instr[2] == 'i')
+ dtype = TY_INT
+ else if (instr[2] == 'b')
+ dtype = TY_BOOL
+ else if (instr[2] == 't')
+ dtype = TY_CHAR
+ else
+ call tu_partype (tp, keyword, dtype, found)
+
+ # In each section, we use ctowrd or ctod (or something), not only
+ # to extract the value but also to skip past it so we can check for
+ # a comment.
+ if (dtype == TY_REAL) {
+ if (ctod (linebuf, ip, dblval) > 0)
+ realval = dblval
+ else
+ realval = INDEFR
+ call tbhadr (tp, keyword, realval)
+ } else if (dtype == TY_DOUBLE) {
+ if (ctod (linebuf, ip, dblval) < 1)
+ dblval = INDEFD
+ call tbhadd (tp, keyword, dblval)
+ } else if (dtype == TY_INT) {
+ if (ctoi (linebuf, ip, intval) < 1)
+ intval = INDEFI
+ call tbhadi (tp, keyword, intval)
+ } else if (dtype == TY_BOOL) {
+ nchar = ctowrd (linebuf, ip, Memc[value], SZ_FNAME)
+ call strlwr (Memc[value])
+ call sscan (Memc[value])
+ call gargb (boolval)
+ if (nscan() < 1) {
+ if (streq (Memc[value], "true") || streq (Memc[value], "t") ||
+ streq (Memc[value], "1"))
+ boolval = true
+ else
+ boolval = false
+ }
+ call tbhadb (tp, keyword, boolval)
+
+ } else {
+
+ while (IS_WHITE(linebuf[ip]))
+ ip = ip + 1
+
+ if (linebuf[ip] == '"' || linebuf[ip] == '\'') {
+ nchar = ctowrd (linebuf, ip, Memc[value], SZ_FNAME)
+ call tbhadt (tp, keyword, Memc[value])
+ } else {
+ call tbhadt (tp, keyword, linebuf[ip])
+ # Set ip to point to end of line because there's no comment.
+ ip = strlen (linebuf) + 1
+ }
+ }
+
+ # Check for a comment.
+ while (IS_WHITE(linebuf[ip]))
+ ip = ip + 1
+ if (linebuf[ip] != EOS)
+ call tbhpcm (tp, keyword, linebuf[ip])
+
+ if (save_instr)
+ call tu_save_instr (linebuf, isbuf, bufsize, ibp)
+
+ call sfree (sp)
+end
+
+
+# tu_delpar -- delete a parameter
+# A parameter is to be deleted. The user will be prompted for confirmation
+# if the input is not redirected and the instruction was not 'q!'.
+
+procedure tu_delpar (tp, linebuf, ip, verify,
+ save_instr, isbuf, bufsize, ibp, modified)
+
+pointer tp # i: pointer to table descriptor
+char linebuf[ARB] # i: input line
+int ip # i: index in linebuf
+bool verify # i: ask for verification before deleting?
+bool save_instr # i: save instruction?
+pointer isbuf # io: pointer to instruction buffer
+int bufsize # io: current size of instruction buffer
+int ibp # io: current index in instruction buffer
+bool modified # io: set to true if parameter was deleted
+#--
+char keyword[SZ_KEYWORD] # keyword for parameter
+char text[SZ_PARREC] # buffer for value of parameter
+char char_type # data type as a letter
+int dtype # data type
+int par1, par2 # range of par numbers to delete
+int i # loop index
+int parnum # keyword number
+int ctowrd()
+bool clgetb()
+
+begin
+ i = ip
+
+ if (ctowrd (linebuf, i, keyword, SZ_KEYWORD) <= 0) {
+ call eprintf ("syntax: d keyword (or d parnum)\n")
+ return
+ }
+
+ # Get the parameter numbers; = 0,-1 if not found.
+ call tu_parnum (tp, linebuf[ip], par1, par2)
+
+ # Delete in increasing numerical order. That means that if we
+ # delete every one, it will be the same par number each time.
+ # Whenever we don't delete one, we increment parnum.
+ parnum = par1
+ do i = par1, par2 {
+ # Get parameter by number.
+ call tbhgnp (tp, parnum, keyword, dtype, text)
+ if (dtype == 0)
+ call error (1, "tu_delpar: keyword miscount")
+
+ if ( verify ) {
+ # Change data type to a char.
+ switch (dtype) {
+ case TY_REAL:
+ char_type = 'r'
+ case TY_INT:
+ char_type = 'i'
+ case TY_DOUBLE:
+ char_type = 'd'
+ case TY_BOOL:
+ char_type = 'b'
+ default:
+ char_type = 't'
+ }
+ # Ask for confirmation before deleting.
+ call clputb ("go_ahead", clgetb ("delete_default"))
+ call eprintf (
+ "The following parameter is to be deleted:\n")
+ call eprintf ("%-8s %c %s\n")
+ call pargstr (keyword)
+ call pargc (char_type)
+ call pargstr (text)
+ call eprintf (" ... OK to delete")
+ call flush (STDERR)
+ if (clgetb ("go_ahead")) {
+ call tbhdel (tp, parnum) # delete it
+ modified = true
+ } else {
+ parnum = parnum + 1 # point to next parameter
+ }
+ } else {
+ # Delete without asking for confirmation.
+ call tbhdel (tp, parnum)
+ modified = true
+ }
+ }
+
+ # Note that we may save this instruction even if the parameter
+ # was not found in the current table.
+ if (save_instr)
+ call tu_save_instr (linebuf, isbuf, bufsize, ibp)
+end
+
+
+# tu_replpar -- replace a parameter
+# Replace an existing parameter, specified either by name or by number.
+# The instruction and the replacement string will be saved in the instruction
+# buffer if appropriate. Neither will be saved, however, if the keyword is
+# not found in the first table. (This is in contrast to the behavior of the
+# delete instruction.) The user will be prompted for confirmation if the
+# input is not redirected and the instruction was not 'r!'.
+
+procedure tu_replpar (tp, linebuf, ip, prompt, from_stdin,
+ verify, save_instr, isbuf, bufsize, ibp,
+ modified, done)
+
+pointer tp # i: pointer to table descriptor
+char linebuf[ARB] # i: input line
+int ip # i: index in linebuf
+bool prompt # i: prompt for input?
+bool from_stdin # i: get instructions from STDIN?
+bool verify # i: ask for verification before deleting?
+bool save_instr # i: save instruction?
+pointer isbuf # io: pointer to instruction buffer
+int bufsize # io: current size of instruction buffer
+int ibp # io: current index in instruction buffer
+bool modified # io: set to true if parameter was replaced
+bool done # io: set to false if done with current table
+#--
+char keyword[SZ_KEYWORD] # keyword for parameter
+char text[SZ_PARREC] # buffer for value of parameter
+char rtext[SZ_PARREC] # replacement value for a parameter
+char char_type # data type as a letter
+int dtype # data type (TY_CHAR, etc)
+int par1, par2 # range of keywords to replace
+int i # loop index for keyword number
+int ctowrd(), tu_gline(), tu_rd_instr()
+bool clgetb()
+
+begin
+ i = ip
+
+ if (ctowrd (linebuf, i, keyword, SZ_KEYWORD) <= 0) {
+ call eprintf ("syntax: r keyword (or r parnum)\n")
+ return
+ }
+
+ # Save the instruction; the replacement value(s) will be
+ # saved within the loop over keyword number.
+ if (save_instr)
+ call tu_save_instr (linebuf, isbuf, bufsize, ibp)
+
+ # Get the parameter numbers, 0,-1 if not found.
+ call tu_parnum (tp, linebuf[ip], par1, par2)
+
+ do i = par1, par2 {
+ # Get parameter by number.
+ call tbhgnp (tp, i, keyword, dtype, text)
+ if (dtype == 0)
+ call error (1, "tu_replpar: keyword miscount")
+
+ # Change data type to a char.
+ switch (dtype) {
+ case TY_REAL:
+ char_type = 'r'
+ case TY_INT:
+ char_type = 'i'
+ case TY_DOUBLE:
+ char_type = 'd'
+ case TY_BOOL:
+ char_type = 'b'
+ default:
+ char_type = 't'
+ }
+
+ if (prompt) {
+ # Display current value.
+ call eprintf (
+ "keyword %s, type %c; give replacement value:\n")
+ call pargstr (keyword)
+ call pargc (char_type)
+ call eprintf ("%s\n")
+ call pargstr (text)
+ }
+ # Read replacement text, either from STDIN or from instr buffer.
+ if (from_stdin) {
+ if (tu_gline (STDIN, rtext) == EOF) {
+ done = true
+ return
+ }
+ } else {
+ if (tu_rd_instr (Memc[isbuf], ibp, rtext) == EOF) {
+ done = true
+ return
+ }
+ }
+
+ # Tab is saved in the instruction buffer to mean that the
+ # value should not be changed. This allows replacing a value
+ # with blanks.
+ if (rtext[1] == EOS) {
+ call eprintf ("no action taken\n")
+ call strcpy ("\t", rtext, SZ_PARREC)
+
+ } else if (rtext[1] == '\t') {
+ ;
+
+ } else if (verify) {
+ # Prompt for confirmation.
+ call clputb ("go_ahead", clgetb ("delete_default"))
+ call eprintf ("Current parameter and its replacement are:\n")
+ call eprintf ("%-8s %c %s\n")
+ call pargstr (keyword)
+ call pargc (char_type)
+ call pargstr (text)
+ call eprintf ("%-8s %c %s\n")
+ call pargstr (keyword)
+ call pargc (char_type)
+ call pargstr (rtext)
+ call eprintf (" ... OK to replace")
+ call flush (STDERR)
+ if (clgetb ("go_ahead")) {
+ call tbhpnp (tp, i, keyword, dtype, rtext) # replace it
+ modified = true
+ } else {
+ call eprintf ("not replaced\n")
+ }
+
+ } else {
+ # Replace the value without prompting.
+ call tbhpnp (tp, i, keyword, dtype, rtext)
+ modified = true
+ }
+
+ # Save the replacement value.
+ if (save_instr)
+ call tu_save_instr (rtext, isbuf, bufsize, ibp)
+ }
+end
+
+# tu_ch_name -- change keyword name
+# Replace the name of an existing keyword without changing either the
+# value or comment.
+# The instruction and the replacement string will be saved in the instruction
+# buffer if appropriate. Neither will be saved, however, if the keyword is
+# not found in the first table. The user will be prompted for confirmation
+# if the input is not redirected and the instruction was not 'k!'.
+
+procedure tu_ch_name (tp, linebuf, ip,
+ save_instr, isbuf, bufsize, ibp,
+ modified)
+
+pointer tp # i: pointer to table descriptor
+char linebuf[ARB] # i: input line
+int ip # i: index in linebuf
+bool save_instr # i: save instruction?
+pointer isbuf # io: pointer to instruction buffer
+int bufsize # io: current size of instruction buffer
+int ibp # io: current index in instruction buffer
+bool modified # io: set to true if parameter was replaced
+#--
+char oldkey[SZ_KEYWORD] # current keyword
+char newkey[SZ_KEYWORD+1] # new keyword; extra space for testing length
+int i
+int parnum # parameter specified by number (zero)
+bool insufficient_input # true if not enough input was given
+int ctowrd(), strlen()
+errchk tbhckn
+
+begin
+ i = ip
+
+ insufficient_input = false # initial value
+
+ if (ctowrd (linebuf, i, oldkey, SZ_KEYWORD) <= 0)
+ insufficient_input = true
+ if (ctowrd (linebuf, i, newkey, SZ_KEYWORD+1) <= 0)
+ insufficient_input = true
+
+ if (insufficient_input) {
+ call eprintf ("syntax: k oldkey newkey\n")
+ return
+ }
+
+ if (strlen (newkey) > SZ_KEYWORD) {
+ call eprintf ("new keyword name is too long; limit is %d\n")
+ call pargi (SZ_KEYWORD)
+ return
+ }
+
+ # Save the instruction.
+ if (save_instr)
+ call tu_save_instr (linebuf, isbuf, bufsize, ibp)
+
+ # Replace the keyword name.
+ parnum = 0
+ call tbhckn (tp, oldkey, parnum, newkey)
+ modified = true
+end
+
+
+# tu_listpar -- list parameters
+# Either all parameters or a range of parameters specified by number
+# may be displayed. The parameter numbers may optionally be displayed.
+
+procedure tu_listpar (tp, linebuf, ip, incl_num,
+ save_instr, isbuf, bufsize, ibp)
+
+pointer tp # i: pointer to table descriptor
+char linebuf[ARB] # i: input line
+int ip # io: index in linebuf
+bool incl_num # i: include number when listing parameters?
+bool save_instr # i: save instruction?
+pointer isbuf # io: pointer to instruction buffer
+int bufsize # io: current size of instruction buffer
+int ibp # io: current index in instruction buffer
+#--
+char keyword[SZ_KEYWORD] # keyword for parameter
+char text[SZ_PARREC] # buffer for value of parameter
+char comment[SZ_PARREC] # buffer for comment, if any
+char char_type # data type as a letter
+int dtype # data type (a character constant)
+int j1, j2 # loop bounds: first & last par numbers
+int npar # current number of parameters
+int k # loop index
+int tbpsta()
+int ctoi()
+
+begin
+ npar = tbpsta (tp, TBL_NPAR)
+
+ # Get the range of keywords to list.
+ if (ctoi (linebuf, ip, j1) <= 0) {
+ j1 = 1
+ j2 = npar
+ } else if (ctoi (linebuf, ip, j2) <= 0) {
+ j2 = j1
+ }
+ if (j2 < j1) {
+ k = j1 # swap j1, j2
+ j1 = j2
+ j2 = k
+ }
+ if (j1 > npar || j2 < 1) {
+ call eprintf ("out of range; max is %d\n")
+ call pargi (npar)
+ j1 = 1 # so loop will not be executed
+ j2 = 0
+ }
+ j1 = max (j1, 1)
+ j2 = min (j2, npar)
+ do k = j1, j2 {
+ call tbhgnp (tp, k, keyword, dtype, text)
+ call tbhgcm (tp, keyword, comment, SZ_PARREC)
+ # Change data type to a char.
+ switch (dtype) {
+ case TY_REAL:
+ char_type = 'r'
+ case TY_INT:
+ char_type = 'i'
+ case TY_DOUBLE:
+ char_type = 'd'
+ case TY_BOOL:
+ char_type = 'b'
+ default:
+ char_type = 't'
+ }
+ if (incl_num) { # include keyword number
+ call printf ("%2d ")
+ call pargi (k)
+ }
+ call printf ("%-8s %c")
+ call pargstr (keyword)
+ call pargc (char_type)
+ if (comment[1] == EOS) {
+ if (dtype == TY_BOOL && text[1] == '1') {
+ call printf (" yes\n")
+ } else if (dtype == TY_BOOL && text[1] == '0') {
+ call printf (" no\n")
+ } else {
+ call printf (" %s\n")
+ call pargstr (text)
+ }
+ } else { # also print comment
+ if (char_type == 't') {
+ call printf (" '%s'") # enclose text in quotes
+ call pargstr (text)
+ } else if (dtype == TY_BOOL) {
+ if (text[1] == '1') {
+ call printf (" yes")
+ } else if (text[1] == '0') {
+ call printf (" no")
+ } else {
+ call printf (" %s")
+ call pargstr (text)
+ }
+ } else {
+ call printf (" %s") # no quotes needed
+ call pargstr (text)
+ }
+ call printf (" %s\n")
+ call pargstr (comment)
+ }
+ }
+
+ if (save_instr)
+ call tu_save_instr (linebuf, isbuf, bufsize, ibp)
+end
+
+
+# tu_gline -- getline without newline
+# Read a line using getline, and replace the newline character with EOS.
+# Either EOF or the number of char read before the newline will be returned.
+
+int procedure tu_gline (fd, linebuf)
+
+int fd # i: identifies input file
+char linebuf[ARB] # o: output buffer for text that was read
+#--
+int istat
+int k
+int getline()
+
+begin
+ istat = getline (fd, linebuf)
+ if (istat == EOF)
+ return (istat)
+
+ k = 1
+ while (linebuf[k] != EOS) {
+ if (linebuf[k] == '\n') {
+ linebuf[k] = EOS
+ break
+ }
+ k = k + 1
+ }
+ return (k-1)
+end
+
+
+# tu_parnum -- get parameter number
+# Either one or a pair of keywords may be given as input in the string
+# 'keyword', and each may be specified either by name or by number.
+# This routine reads the numbers and/or names and converts keyword
+# names to numbers. If the parameter (or either of two) is not found, or
+# if the number is larger than the number of header keywords, par1
+# will be set to 0 and par2 to -1. If only one keyword is given, par2
+# will be set equal to par1.
+
+procedure tu_parnum (tp, keyword, par1, par2)
+
+pointer tp # i: pointer to table descriptor
+char keyword[ARB] # i: keyword name or number
+int par1 # o: number of first parameter to delete
+int par2 # o: number of last parameter to delete
+#--
+char key1[SZ_KEYWORD], key2[SZ_KEYWORD]
+int ip # counter within keyword
+int ipi # counter in key1 or key2
+int temp # for swapping par1 & par2
+int npar # total number of header parameters
+int nchar
+int ctowrd(), ctoi(), tbpsta()
+
+begin
+ npar = tbpsta (tp, TBL_NPAR)
+ # Default values so a loop from par1 to par2 will not execute.
+ par1 = 0
+ par2 = -1
+
+ # Extract the first (and possibly only) word.
+ ip = 1
+ nchar = ctowrd (keyword, ip, key1, SZ_KEYWORD)
+ if (nchar < 1)
+ return # nothing given
+
+ # Interpret the first word as a number or name. First try to
+ # read it as an integer. If it's not an integer, or if there's
+ # something after an integer part (e.g. key1 = "37test"), then
+ # treat it as a keyword name.
+ ipi = 1
+ nchar = ctoi (key1, ipi, par1)
+ if ( (nchar <= 0) || (key1[ipi] != EOS) )
+ call tbhfkw (tp, key1, par1) # get the par number
+
+ if (par1 < 1) {
+ call eprintf ("warning: keyword `%s' not found\n")
+ call pargstr (key1)
+ return
+ }
+
+ nchar = ctowrd (keyword, ip, key2, SZ_KEYWORD) # read second word
+ if (nchar < 1) {
+ par2 = par1 # there was only one word
+ } else {
+ ipi = 1
+ nchar = ctoi (key2, ipi, par2)
+ if ( (nchar <= 0) || (key2[ipi] != EOS) )
+ call tbhfkw (tp, key2, par2)
+ if (par2 < 1) {
+ call eprintf ("warning: keyword `%s' not found\n")
+ call pargstr (key2)
+ return
+ }
+ if (par1 > par2) {
+ temp = par2
+ par2 = par1
+ par1 = temp
+ }
+ }
+
+ if (par1 > npar || par2 > npar) {
+ call eprintf (
+ "there are only %d header parameters; no action taken\n")
+ call pargi (npar)
+ par1 = 0
+ par2 = -1
+ }
+end
+
+
+# tu_partype -- get data type of parameter
+# This routine looks for the given keyword in the header. If it is found,
+# the data type (integer code) is returned as dtype. If not, dtype is set
+# to the default TY_CHAR, and found is set to false.
+
+procedure tu_partype (tp, keyword, dtype, found)
+
+pointer tp # i: pointer to table descriptor
+char keyword[ARB] # i: keyword name
+int dtype # o: data type (TY_INT, TY_CHAR, ...)
+bool found # o: true if keyword was found in header.
+#--
+char kwrd[SZ_KEYWORD] # keyword returned by tbhgnp
+char value[SZ_PARREC] # buffer for value of parameter
+int parnum
+
+begin
+ # Get the keyword number, or zero if it isn't in the header.
+ call tbhfkw (tp, keyword, parnum)
+
+ # Get the data type, ignoring the value.
+ if (parnum > 0) {
+ call tbhgnp (tp, parnum, kwrd, dtype, value)
+ found = true
+ } else {
+ dtype = TY_CHAR # default
+ found = false
+ }
+end
generated by cgit (git 2.34.1) at 2025-09-20 05:25:20 -0400