Repatch (from linux) of OSX IRAF

1 files changed, 698 insertions, 0 deletions

diff --git a/pkg/xtools/dttext.x b/pkg/xtools/dttext.x
new file mode 100644
index 00000000..387d8654
--- /dev/null
+++ b/pkg/xtools/dttext.x
@@ -0,0 +1,698 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<time.h>
+include	<ctype.h>
+include	<ctotok.h>
+include	<error.h>
+include	<fset.h>
+include	<pkg/dttext.h>
+
+.help dttext May85 "Simple Text Database Tools"
+.ih
+DESCRIPTION
+
+The database created, accessed, and modified by these procedures is
+a simple text file.  The purpose of these tools is to act as
+an interum database facility until the sophisticated IRAF database
+package is available.  The database model consists of
+comment lines which begin with a #, records, and fields within records.
+Records and fields (except array fields) have the same format, a keyword
+followed by data and terminated by a newline.  Records have the keyword
+'begin' and the data is any following text.  Thus a record can be identified
+by anything from a single character to an entire string.  A record contains
+all the following lines until the next record or the end of the file.
+Whitespace before and after the keyword is ignored.  The user is responsible
+for adding indentation to clarify the structure
+of the database.  However, the user can create a database with any
+style of whitespace that satisfies the keyword/value syntax.
+
+The array fields have a slightly different format.  The field begins just
+like an integer valued field; keyword followed by an integer.  The integer
+value is the number of array elements.  The following lines
+contain the array values, one per line.  Because the field name
+line has the same structure as an integer valued field the array
+length can be determined before reading the array values by reading
+the field as integer valued.
+
+For arrays with more than one column per line the dtscan procedure is
+used to scan a line and then the FMTIO garg procedures are used to
+decode the columns.  The user read the array field as an integer to get
+the number of lines and to position FIO to start reading the lines.
+
+There are four types of fields currently supported.  These are integer
+valued fields, real valued fields, string valued fields, and real arrays.
+It is up to the user to know the type of value for each field.  Note
+that the integer and real fields may be accessed as string valued.
+
+Records are referenced by a record number.  When a database is mapped
+each record which is unique is given a sequential record number.
+When more than one record has the same record identifier then only
+the last record is mapped.
+
+There are limitations imposed by the text file format.  A database
+may only be read or appended.  To update a record a new record must
+be written.  A later record with the same name takes precedence.
+
+Errors are handled through the standard error handling system of IRAF.
+Thus, uncaught errors will terminate the task with a message.  If it
+is possible that a field will not be present then the task can catch
+the error and take appropriate action.
+.ih
+DATABASE MAPPING
+
+When a database is mapped READ_ONLY then the records in the database
+are found and a structure created.  The structure is given in the file
+"dttext.h".  The important elements of the structure are:
+
+.nf
+
+	    DT(dt)		# Database FIO channel
+	    DT_NRECS(dt)	# Number of records
+	    DT_NAME(dt, rec)	# Record name
+	    DT_OFFSET(dt, rec)	# FIO offset
+.fi
+.ih
+PROCEDURES
+
+The procedures separate into three types, procedures to map and unmap
+the database, procedures to access the database, and procedures to make
+entries in the database.  The access routines reference a particular
+record.  To access a record by name the procedure dtlocate returns
+the record number or EOF.  The put routines write to the end of
+the database.  It is important to enter a record because otherwise
+added fields will be associated with the preceding record.  The put
+time command puts a comment line with the time.
+
+.nf
+	   dt = dtmap (database, mode)		# NEW_FILE, READ_ONLY or APPEND
+	   dt = dtmap1 (database, name, mode)	# Use a directory as a database
+		dtremap (dt, database, name,mode) # Remap a database
+		dtunmap (dt)
+
+       record = dtlocate (dt, recname)
+
+		dtgstr (dt, record, field, str, maxchar)
+	value = dtget[ird] (dt, record, field)
+		dtgar (dt, record, field, array, len_array, npts)
+
+		dtptime (dt)
+		dtput (dt, format)
+.fi
+.ih
+EXAMPLES
+
+The following is an example record from a database.
+
+.nf
+# Fri 15:13:13 05-Apr-85 Example
+begin	NGC1952 B
+	title	NGC1952 B filter centered
+	ra	12:40:20
+	dec	+5:20:15
+	flags	4
+		3.1
+		9.2
+		1
+		4
+	exp	3600
+.fi
+
+
+The following example reads the example record and writes a new record.
+
+.nf
+	iferr {
+	    dt = dtmap (database, READ_ONLY)
+	    record = dtlocate (dt, "NGC1952 B")
+	    call dtgstr (dt, record, "title", title, SZ_TITLE)
+	    ra = dtgetr (dt, record, "RA")
+	    dec = dtgetr (dt, record, "DEC")
+
+	    # Get length of array for dynamic allocation.
+	    nflags = dtgeti (dt, record, "flags")
+	    call salloc (flags, nflags, TY_REAL)
+	    call dtgar (dt, record, "flags", Memr[flags], nflags, nflags)
+	}
+
+	dt = dtmap (database, APPEND)
+	call dtptime (dt)
+	call dtput (dt, "begin\tNGC1952 Objects\n")
+	call dtput (dt, "\tobjects\t10\n)
+	do i = 1, 10 {
+	    call dtput (dt, "\t\t%g\n")
+		call pargr (objects[i])
+	}
+	call dtclose (dt)
+.fi
+
+The following is a database entry for a list which is read by the code below.
+
+.nf
+# Fri 15:13:13 05-Apr-85 Example
+begin	Table 1
+	1	apples		10	macintosh
+	2	oranges		8	valencia
+	3	potatoes	3	idaho
+
+
+	# Code to read database table.
+
+	record = dtlocate (dt, "Table 1")
+	call seek (DT(dt), DT_OFFSET(dt, record))
+	while (scan (DT(dt)) != EOF) {
+	    call gargi (n)
+	    call gargwrd (fruit[1, n])
+	    call gargi (number[n])
+	    call gargstr (comment[1, n])
+	}
+
+To read sequentially through a database:
+
+	# Code to read sequentially through a database.
+
+	do i = 1, DB_NRECS(db) {
+	    call printf ("%s\n")
+		call pargstr (DB_NAME(db, i))
+	}
+.fi
+.ih
+SEE ALSO
+Source code
+.endhelp
+
+
+# DTMAP -- Map a database.
+
+pointer procedure dtmap (database, mode)
+
+char	database[ARB]			# Database file
+int	mode				# FIO mode
+
+int	i, nrec
+int	dt_alloc1, dt_alloc2
+pointer	dt, str
+
+int	open(), fscan(), strlen()
+bool	streq()
+long	note()
+errchk	delete, open
+
+begin
+	if (mode == NEW_FILE)
+	    iferr (call delete (database))
+		;
+
+	i = open (database, mode, TEXT_FILE)
+
+	call calloc (dt, DT_LEN, TY_STRUCT)
+	DT(dt) = i
+
+	if (mode != READ_ONLY)
+	    return (dt)
+
+	dt_alloc1 = DT_ALLOC
+	dt_alloc2 = DT_ALLOC * SZ_LINE
+	call malloc (DT_OFFSETS(dt), dt_alloc1, TY_LONG)
+	call malloc (DT_NAMES(dt), dt_alloc1, TY_INT)
+	call malloc (DT_MAP(dt), dt_alloc2, TY_CHAR)
+	call malloc (str, SZ_LINE, TY_CHAR)
+
+	nrec = 1
+	DT_NRECS(dt) = 0
+	DT_NAMEI(dt, nrec) = 0
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (DT_NAME(dt, nrec), SZ_LINE)
+
+	    if (streq (DT_NAME(dt, nrec), "begin")) {
+	        call gargstr (Memc[str], SZ_LINE)
+		for (i=str; IS_WHITE(Memc[i]); i=i+1)
+		    ;
+		call strcpy (Memc[i], DT_NAME(dt,nrec), SZ_LINE)
+
+		for (i = 1; i < nrec; i = i + 1)
+		    if (streq (DT_NAME(dt, i), DT_NAME(dt, nrec)))
+			break
+
+		if (i < nrec)
+		    DT_OFFSET(dt, i) = note (DT(dt))
+		else {
+		    DT_NRECS(dt) = nrec
+		    DT_OFFSET(dt, nrec) = note (DT(dt))
+		    DT_NAMEI(dt, nrec+1) = DT_NAMEI(dt, nrec) +
+			strlen (DT_NAME(dt, nrec)) + 1
+		    nrec = nrec + 1
+		}
+
+		if (nrec == dt_alloc1) {
+		    dt_alloc1 = dt_alloc1 + DT_ALLOC
+		    call realloc (DT_OFFSETS(dt), dt_alloc1, TY_LONG)
+		    call realloc (DT_NAMES(dt), dt_alloc1, TY_INT)
+		}
+		if (DT_NAMEI(dt, nrec) + SZ_LINE >= dt_alloc2) {
+		    dt_alloc2 = dt_alloc2 + DT_ALLOC * SZ_LINE
+		    call realloc (DT_MAP(dt), dt_alloc2, TY_CHAR)
+		}
+	    }
+	}
+
+	call realloc (DT_MAP(dt), DT_NAMEI(dt, nrec), TY_CHAR)
+	call realloc (DT_OFFSETS(dt), DT_NRECS(dt), TY_LONG)
+	call realloc (DT_NAMES(dt), DT_NRECS(dt), TY_INT)
+	call mfree (str, TY_CHAR)
+
+	return (dt)
+end
+
+
+# DTCLOSE -- Close database.
+
+procedure dtunmap (dt)
+
+pointer	dt				# Database file descriptor
+
+begin
+	if (dt == NULL)
+	    return
+	call close (DT(dt))
+	call mfree (DT_MAP(dt), TY_CHAR)
+	call mfree (DT_OFFSETS(dt), TY_LONG)
+	call mfree (DT_NAMES(dt), TY_INT)
+	call mfree (dt, TY_STRUCT)
+end
+
+
+# DTLOCATE -- Locate a database record.
+
+int procedure dtlocate (dt, name)
+
+pointer	dt				# DTTEXT pointer
+char	name[ARB]			# Record name
+
+int	i
+
+bool	streq()
+
+begin
+	do i = 1, DT_NRECS(dt) {
+	    if (streq (name, DT_NAME(dt, i)))
+		return (i)
+	}
+
+#	call printf ("Record = %s\n")
+#	    call pargstr (name)
+#	call flush (STDOUT)
+	call error (0, "Database record not found")
+end
+
+
+# DTGSTR -- Get a string field
+
+procedure dtgstr (dt, record, field, str, maxchar)
+
+pointer	dt				# Database file descriptor
+int	record				# Database index
+char	field[ARB]			# Database field
+char	str[maxchar]			# String value
+int	maxchar				# Maximum characters for string
+
+char	name[SZ_LINE]
+int	i, fscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > DT_NRECS(dt)))
+	    call error (0, "Database record request out of bounds")
+
+	call seek (DT(dt), DT_OFFSET(dt, record))
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargstr (str, maxchar)
+		for (i=1; IS_WHITE(str[i]); i=i+1)
+		    ;
+		if (i > 1)
+		    call strcpy (str[i], str, maxchar)
+		return
+	    }
+	}
+
+	call error (0, "Database field not found")
+end
+
+
+# DTGETI -- Get an integer field
+
+int procedure dtgeti (dt, record, field)
+
+pointer	dt				# DTTEXT pointer
+int	record				# Database index
+char	field[ARB]			# Database field
+
+int	ival				# Field value
+char	name[SZ_LINE]
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > DT_NRECS(dt)))
+	    call error (0, "Database record request out of bounds")
+
+	call seek (DT(dt), DT_OFFSET(dt, record))
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargi (ival)
+		if (nscan() == 2)
+		   return (ival)
+		else
+		   call error (0, "Error in database field value")
+	    }
+	}
+
+	call error (0, "Database field not found")
+end
+
+
+# DTGETR -- Get an real field
+
+real procedure dtgetr (dt, record, field)
+
+pointer	dt				# DTTEXT pointer
+int	record				# Database index
+char	field[ARB]			# Database field
+
+real	rval
+char	name[SZ_LINE]
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > DT_NRECS(dt)))
+	    call error (0, "Database record request out of bounds")
+
+	call seek (DT(dt), DT_OFFSET(dt, record))
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargr (rval)
+		if (nscan() == 2)
+		   return (rval)
+		else
+		   call error (0, "Error in database field value")
+	    }
+	}
+
+	call error (0, "Database field not found")
+end
+
+
+# DTGETD -- Get a doubel precision field.
+
+double procedure dtgetd (dt, record, field)
+
+pointer dt                              # DTTEXT pointer
+int     record                          # Database index
+char    field[ARB]                      # Database field
+
+double  dval
+char    name[SZ_LINE]
+
+int     fscan(), nscan()
+bool    streq()
+
+begin
+        if ((record < 1) || (record > DT_NRECS(dt)))
+            call error (0, "Database record request out of bounds")
+
+        call seek (DT(dt), DT_OFFSET(dt, record))
+
+        while (fscan (DT(dt)) != EOF) {
+            call gargwrd (name, SZ_LINE)
+
+            if (streq (name, "begin"))
+                break
+            else if (streq (name, field)) {
+                call gargd (dval)
+                if (nscan() == 2)
+                   return (dval)
+                else
+                   call error (0, "Error in database field value")
+            }
+        }
+
+        call error (0, "Database field not found")
+end
+
+
+# DTGAR -- Get a real array field
+
+procedure dtgar (dt, record, field, array, len_array, npts)
+
+pointer	dt				# DTTEXT pointer
+int	record				# Database index
+char	field[ARB]			# Database field
+real	array[len_array]		# Array values
+int	len_array			# Length of array
+int	npts				# Number of points in the array
+
+char	name[SZ_LINE]
+int	i
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > DT_NRECS(dt)))
+	    call error (0, "Database record request out of bounds")
+
+	call seek (DT(dt), DT_OFFSET(dt, record))
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargi (npts)
+		if (nscan() != 2)
+		    call error (0, "Error in database field value")
+
+		npts = min (npts, len_array)
+		for (i = 1; i <= npts; i = i + 1) {
+		    if (fscan (DT(dt)) == EOF)
+		        call error (0, "Error in database field value")
+
+		    call gargr (array[i])
+		    if (nscan() != 1)
+		        call error (0, "Error in database field value")
+		}
+		return
+	    }
+	}
+
+	call error (0, "Database field not found")
+end
+
+
+# DTGAD -- Get a double array field
+
+procedure dtgad (dt, record, field, array, len_array, npts)
+
+pointer	dt				# DTTEXT pointer
+int	record				# Database index
+char	field[ARB]			# Database field
+double	array[len_array]		# Array values
+int	len_array			# Length of array
+int	npts				# Number of points in the array
+
+char	name[SZ_LINE]
+int	i
+
+int	fscan(), nscan()
+bool	streq()
+
+begin
+	if ((record < 1) || (record > DT_NRECS(dt)))
+	    call error (0, "Database record request out of bounds")
+
+	call seek (DT(dt), DT_OFFSET(dt, record))
+
+	while (fscan (DT(dt)) != EOF) {
+	    call gargwrd (name, SZ_LINE)
+
+	    if (streq (name, "begin"))
+		break
+	    else if (streq (name, field)) {
+		call gargi (npts)
+		if (nscan() != 2)
+		    call error (0, "Error in database field value")
+
+		npts = min (npts, len_array)
+		for (i = 1; i <= npts; i = i + 1) {
+		    if (fscan (DT(dt)) == EOF)
+		        call error (0, "Error in database field value")
+
+		    call gargd (array[i])
+		    if (nscan() != 1)
+		        call error (0, "Error in database field value")
+		}
+		return
+	    }
+	}
+
+	call error (0, "Database field not found")
+end
+
+
+# DTPTIME -- Put a time string with a comment
+
+procedure dtptime (dt)
+
+pointer	dt				# DTTEXT pointer
+
+char	timestr[SZ_TIME]
+long	time, clktime()
+
+begin
+	time = clktime (0)
+	call cnvtime (time, timestr, SZ_TIME)
+	call fprintf (DT(dt), "# %s\n")
+	    call pargstr (timestr)
+end
+
+
+# DTPUT -- Print to database.
+
+procedure dtput (dt, format)
+
+pointer	dt				# DTTEXT pointer
+char	format[ARB]			# String format
+
+begin
+	call fprintf (DT(dt), format)
+end
+
+# DTSCAN -- Scan database.
+
+int procedure dtscan (dt)
+
+pointer	dt				# DTTEXT pointer
+
+int	fscan()
+
+begin
+	return (fscan (DT(dt)))
+end
+
+
+include	<finfo.h>
+
+# DTMAP1 -- Map database.
+#
+# The database name may be a regular file or a directory.  If it is a
+# directory a database file with the name given by key is read or appended.
+
+pointer procedure dtmap1 (database, key, mode)
+
+char	database[ARB]		# Database
+char	key[ARB]		# Key
+int	mode			# Mode
+
+pointer	sp, dbfile, dt
+
+int	isdirectory(), access(), stridxs()
+pointer	dtmap()
+
+errchk	dtmap()
+
+begin
+	call smark (sp)
+	call salloc (dbfile, SZ_PATHNAME + SZ_FNAME, TY_CHAR)
+
+	# Check if the database does not exist create it as a directory.
+
+	if (access (database, READ_ONLY, DIRECTORY_FILE) == NO)
+	    if ((mode == APPEND) || (mode == NEW_FILE)) {
+		if (stridxs (".", database) != 0)
+		    call error (0,
+			"Periods not allowed in database directory name")
+		iferr (call fmkdir (database))
+		    call error (0, "Can't make database directory")
+	    }
+
+	if (isdirectory (database, Memc[dbfile], SZ_PATHNAME + SZ_FNAME) > 0)
+	    call strcat (key, Memc[dbfile], SZ_PATHNAME + SZ_FNAME)
+	else
+	    call strcpy (database, Memc[dbfile], SZ_PATHNAME + SZ_FNAME)
+
+	dt = dtmap (Memc[dbfile], mode)
+	call strcpy (database, DT_DNAME(dt), DT_SZFNAME)
+	call strcpy (key, DT_FNAME(dt), DT_SZFNAME)
+	DT_MODE(dt) = mode
+
+	call sfree (sp)
+	return (dt)
+end
+
+
+# DTREMAP -- Check if database needs to be remapped.
+#
+# If the pointer is null simply map the database.
+# If the pointer is not null check if the requested database is the same
+# as the current one and if not close the current database and map the
+# new one.  Note that remapping between read and append will not update
+# the entry data structure to include any information written.
+
+procedure dtremap (dt, dname, fname, mode)
+
+pointer	dt			# Database pointer
+char	dname[ARB]		# Directory name
+char	fname[ARB]		# File name
+int	mode			# Mode
+
+int	i, open()
+bool	strne()
+pointer	dbfile, dtmap1()
+errchk	dtmap1, dtunmap
+
+begin
+	if (dt != NULL) {
+	    if (strne (dname, DT_DNAME(dt)) || strne (fname, DT_FNAME(dt))) {
+		call dtunmap (dt)
+	    } else if (mode != DT_MODE(dt)) {
+		i = SZ_PATHNAME + SZ_FNAME
+		call malloc (dbfile, i, TY_CHAR)
+		call fstats (DT(dt), F_FILENAME, Memc[dbfile], i)
+		call close (DT(dt))
+		iferr (i = open (Memc[dbfile], mode, TEXT_FILE)) {
+		    DT(dt) = NULL
+		    call dtunmap (dt)
+		    call mfree (dbfile, TY_CHAR)
+		    call erract (EA_ERROR)
+		}
+		DT(dt) = i
+		DT_MODE(dt) = mode
+		call mfree (dbfile, TY_CHAR)
+	    }
+	}
+
+	if (dt == NULL) {
+	    i = dtmap1 (dname, fname, mode)
+	    dt = i
+	}
+end