# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.

include	<ctype.h>
include	<chars.h>
include	<pattern.h>
include	<syserr.h>
include	<diropen.h>

.help fntgfn
.nf _________________________________________________________________________
File Name Template Package

This package contains routines to expand a file name template string into a
list of file names, and to access the individual elements of the list.  The
template is a list of file names, patterns, and/or list file names.  The
concatenation operator may be used within input list elements to form new
output filenames.  String substitution may also be used to form new filenames.

Sample template string:

	alpha, *.x, data* // .pix, [a-m]*, @list_file

This template would be expanded as the file "alpha", followed in successive
calls by all the files in the current directory whose names end in ".x",
followed by all files whose names begin with "data" with the extension ".pix"
appended, and so on.  The @ character signifies a list file (file containing
regular file names).

String substitution uses the first string given for the template, expands
the template, and for each filename generated by the template, substitutes
the second string to generate a new filename.  Some examples follow.

	*.%x%y%			change extension to `y'
	*%%_abc%.imh		append `_abc' to root
	nite%1%2%.1024.imh	change `nite1' to `nite2'

Main entry points:

	fntopnb - expand template and open a buffered filename list
	fntgfnb - get next filename from buffered list (sequential)
	fntrfnb - get next filename from buffered list (random)
	fntclsb - close buffered list
	fntlenb - get number of filenames in a buffered list
	fntrewb - rewind the list

Low Level Entry Points:

	 fntopn - open an unbuffered filename list
	 fntgfn - get next filename from unbuffered list
	 fntcls - close unbuffered list

The B suffix routines are the highest level and most convenient to use.
The remaining routines expand a template "on the fly" and do not permit
sorting or determination of the length of the list.
.endhelp ____________________________________________________________________

# FNTB descriptor structure.
define	LEN_FNTBHDR		5
define	FNTB_MAGIC		5164
define	B_MAGIC			Memi[$1]
define	B_SBUFPTR		Memi[$1+1]	# string buffer pointer
define	B_NSTR			Memi[$1+2]	# number of strings
define	B_STRNUM		Memi[$1+3]	# used to read list
define	B_STRINDX		Memi[$1+$2-1+4]	# index of string

# FNTU descriptor structure.
define	LEN_FNTUHDR		(10+1024+256)
define	FNTU_MAGIC		5664
define	U_MAGIC			Memi[$1]
define	U_FILDES		Memi[$1+1]
define	U_TEMPLATE		Memi[$1+2]	# pointer
define	U_TEMPLATE_INDEX	Memi[$1+3]
define	U_PATTERN		(P2C($1+10))
define	U_LDIR			(P2C($1+1034))

# Special characters and size limiting definitions.
define	TOK_DELIM		','		# token delimiter
define	LIST_FILE_CHAR		'@'		# @listfile
define	CH_EDIT			'%'		# string substitution metachar
define	SZ_PATTERN		1023
define	SZ_LDIR			255
define	SZ_PATSTR		1023
define	MAX_EDIT		8
define	MAX_PATTERNS		8

# Tokens.
define	EO_TEMPLATE		1
define	LIST_FILE		2
define	PATTERN_STRING		3
define	FILE_NAME		4

# Size limiting definitions (initial buffer sizes).
define	SZ_DEFSTRBUF		2048		# default string buffer size
define	LEN_INDEXVECTOR		256		# initial length of index vector


# FNTOPNB -- General open buffered list routine, for any type of filename list.
# Expand template into string buffer, sort if so indicated.

int procedure fntopnb (template, sort)

char	template[ARB]		# filename template
int	sort			# sort expanded patterns

int	nedit[MAX_PATTERNS], junk, nchars
bool	is_template[MAX_PATTERNS], is_edit[MAX_PATTERNS], sortlist, is_url
pointer	sp, pbuf, fname, rname, extn, ebuf, sbuf, list, ip, op, ep, pp
pointer	patp[MAX_PATTERNS], flist[MAX_PATTERNS], editp[MAX_EDIT]
int	nlists, npat, nstr, maxstr, nextch, sz_sbuf, ix, first_string, ch, i
int	fntopn(), fntgfn(), fnt_getpat(), gstrcpy(), fnt_edit(), stridx()
int	patmake(), patmatch(), strncmp()
errchk	fntopn, fntgfn, syserr, malloc, realloc

begin
	call smark (sp)
	call salloc (rname, SZ_FNAME, TY_CHAR)
	call salloc (fname, SZ_FNAME, TY_CHAR)
	call salloc (extn,  SZ_FNAME, TY_CHAR)
	call salloc (pbuf,  SZ_LINE, TY_CHAR)
	call salloc (ebuf,  SZ_LINE, TY_CHAR)

	# Allocate list descriptor.
	call malloc (list, LEN_FNTBHDR + LEN_INDEXVECTOR, TY_INT)
	call malloc (sbuf, SZ_DEFSTRBUF, TY_CHAR)

	B_MAGIC(list) = FNTB_MAGIC
	maxstr = LEN_INDEXVECTOR
	sz_sbuf = SZ_DEFSTRBUF
	nextch = 1				# offset into string buffer
	nstr = 0

	# Read the file names into the string buffer.  Dynamically adjust
	# the size of the string buffer and/or index vector as necessary.
	# There must always be at least SZ_FNAME chars left in the string
	# buffer.  The outer loop is over comma delimited fields of the
	# filename template.  The inner loop is over individual filenames.

	ix = 1
	while (fnt_getpat (template, ix, patp, npat, pbuf, SZ_LINE) > 0) {
	    first_string = nstr + 1
	    sortlist = (sort == YES)
	    nlists = 0
	    ep = ebuf

	    # Each piece of the current comma delimited template may consist
	    # of several sublists to be independently expanded and concatenated
	    # to form each output filename.  The lists must either be degenerate
	    # (a simple string) or actual lists to be expanded with FNTOPN.

	    do i = 1, npat {
		is_template[i] = false
		is_edit[i] = false
		nedit[i] = 0
		op = patp[i]

		# Examine sublist to see if it is a template or a string
		# constant.  If template, open file list.  Template
		# metacharacters may be escaped to be included in filenames.
		# If the pattern contains edit substitution sequences it
		# must be processed to remove the substitution strings.

		is_url = false
		for (ip=op;  Memc[ip] != EOS;  ip=ip+1) {
		    ch = Memc[ip]

		    if (ch == ':' && strncmp (Memc[ip+1], "//", 2) == 0) {
			# URL string.
			is_template[i] = false
			is_edit[i] = false
			is_url = true
		    } else if (!is_url && stridx (Memc[ip], "@*?[%") > 0) {
			if (ip > patp[i] && Memc[ip-1] == '\\') {
			    Memc[op-1] = ch
			    ip = ip + 1
			    ch = Memc[ip]
			} else if (ch == CH_EDIT) {
			    is_edit[i] = true
			} else {
			    if (ch == '@' && op == ip)
				sortlist = false
			    if (!is_url)
			        is_template[i] = true
			}
		    }

		    Memc[op] = ch
		    op = op + 1
		}

		Memc[op] = EOS

		# Open filename template if pattern contained metacharacters.
		# A string constant containing edit string substitution is a
		# special case, eg. "file%%_2%.ext".

		if (is_template[i] || is_edit[i]) {
		    editp[i] = ep
		    call fnt_mkpat (Memc[patp[i]], Memc[fname], SZ_FNAME,
			ep, nedit[i])
		    flist[i] = fntopn (Memc[fname])

		    # In the case of a string constant edit we do not really
		    # have a file template, but we open one anyhow just to
		    # make use of the common code and the descriptor.

		    if (!is_template[i]) {
			# Encode the pattern (containing the %%).
			junk = patmake (Memc[fname], Memc[U_PATTERN(flist[i])],
			    SZ_PATTERN)

			# Strip the %% from the pattern, leaving the "input"
			# filename in patp[i].

			op = patp[i]
			for (ip=fname;  Memc[ip] != EOS;  ip=ip+1)
			    if (Memc[ip] != CH_EDIT) {
				Memc[op] = Memc[ip]
				op = op + 1
			    }
			Memc[op] = EOS

			# Now match the stripped pattern against the %%
			# pattern.  This sets up U_PATTERN for the edit.

			junk = patmatch (Memc[patp[i]],
			    Memc[U_PATTERN(flist[i])])
		    } else
			nlists = nlists + 1
		}
	    }

	    # Expand the template into a sequence of filenames in the string
	    # buffer, saving the indices of the list elements in the STRINDX
	    # array.  Reallocate a larger buffer if necessary.  If the sublists
	    # are not all the same length the shortest list will terminate the
	    # output list.

	    repeat {
		# Concatenate the next element from each sublist; the sublists
		# may be either real lists or string constants.  Concatenate
		# only to the root filename.

		Memc[extn] = EOS
		op = fname

		do i = 1, npat {
		    # Save first extension field encountered and set op to
		    # end of root.

		    if (Memc[extn] == EOS)
			for (ip=op-1;  ip > fname;  ip=ip-1)
			    if (Memc[ip] == '.') {
				call strcpy (Memc[ip], Memc[extn], SZ_FNAME)
				op = ip
				break
			    }

		    # Concatenate the next file element.  This can be either a
		    # file name from a file template, a constant file name from
		    # a string edit expression, or a simple string constant.

		    if (!is_url && (is_template[i] || is_edit[i])) {
			ip = rname
			pp = flist[i]
			if (is_template[i]) {
			    if (fntgfn (pp, Memc[rname], SZ_FNAME) == EOF) {
				op = fname
				break

			    } else if (U_FILDES(pp) != NULL) {
				# Reading from a directory or list; set offset
				# of substring to be edited to exclude any
				# ldir prefix, since this will not have been
				# used for the pattern match.

				nchars = gstrcpy (Memc[U_LDIR(pp)],Memc[op],ARB)
				op = op + nchars
				ip = ip + nchars
			    }
			} else
			    call strcpy (Memc[patp[i]], Memc[rname], SZ_FNAME)

			op = op + fnt_edit (Memc[ip], Memc[op], editp[i],
			    nedit[i], Memc[U_PATTERN(pp)])

		    } else {
			op = op + gstrcpy (Memc[patp[i]], Memc[op], ARB)
		    }
		}

		# End of list if nothing returned.
		if (op == fname)
		    break

		# Tack extension back on.
		if (Memc[extn] != EOS)
		    op = op + gstrcpy (Memc[extn], Memc[op], ARB)

		# Need more room for list element pointers?
		nstr = nstr + 1
		if (nstr > maxstr) {
		    maxstr = maxstr + LEN_INDEXVECTOR
		    call realloc (list, LEN_FNTBHDR + maxstr, TY_INT)
		}

		# Out of space in string buffer?
		if (nextch + (op - fname) >= sz_sbuf) {
		    sz_sbuf = sz_sbuf + SZ_DEFSTRBUF
		    call realloc (sbuf, sz_sbuf, TY_CHAR)
		}

		# Save index of list element, move chars to string buffer.
		# Allow space for the EOS after each string.

		B_STRINDX(list,nstr) = nextch
		nextch = nextch +
		    gstrcpy (Memc[fname], Memc[sbuf+nextch-1], ARB) + 1

	    } until (nlists == 0)

	    do i = 1, npat
		if (is_template[i] || is_edit[i])
		    call fntcls (flist[i])

	    # If sorting is desired and the pattern did not specify an explicit
	    # list (e.g., "@listfile"), sort the last batch of filenames.

	    if (sortlist && nstr > first_string)
		call strsrt (B_STRINDX(list,first_string), Memc[sbuf],
		    nstr - first_string + 1)
	}

	# Update the string buffer descriptor, return unused buffer space.
	# Rewind the list in preparation for reading (set strnum=1).

	call realloc (sbuf, nextch, TY_CHAR)
	call realloc (list, LEN_FNTBHDR + nstr, TY_INT)

	B_NSTR(list)	= nstr
	B_STRNUM(list)	= 1
	B_SBUFPTR(list)	= sbuf

	call sfree (sp)
	return (list)
end


# FNT_MKPAT -- Take a pattern string possibly containing %a%b% string
# substitution sequences, returning a pattern string as required for PATMAKE,
# and a sequence of substitution strings for later use by FNT_EDIT to edit
# filenames matched by FNTGFN.

procedure fnt_mkpat (pat, patstr, maxch, ep, nedit)

char	pat[ARB]		# pattern with embedded substitution sequences
char	patstr[maxch]		# receives pattern as req'd by PATMAKE
int	maxch
pointer	ep			# where to put substitution string chars
int	nedit			# number of substitution chars

int	nhat
int	ip, op

begin
	nedit = 0
	nhat  = 0
	op    = 1

	for (ip=1;  pat[ip] != EOS;  ip=ip+1) {
	    if (pat[ip] == CH_EDIT) {
		if (ip > 1 && pat[ip-1] == '\\') {
		    # Moved escaped metacharacter to pattern string.
		    patstr[op] = pat[ip]
		    op = op + 1

		} else if (nhat > 0) {
		    # Copy substitution string to ebuf.
		    patstr[op] = pat[ip]
		    op = op + 1
		    nedit = nedit + 1

		    ip = ip + 1
		    while (pat[ip] != EOS && pat[ip] != CH_EDIT) {
			Memc[ep] = pat[ip]
			ep = ep + 1
			ip = ip + 1
		    }

		    Memc[ep] = EOS
		    ep = ep + 1
		    if (pat[ip] == EOS)
			ip = ip - 1
		    nhat = 0

		} else {
		    patstr[op] = pat[ip]
		    op = op + 1
		    nhat = nhat + 1
		}

	    } else {
		patstr[op] = pat[ip]
		op = op + 1
		if (op > maxch)
		    break
	    }
	}

	patstr[op] = EOS
end


# FNT_EDIT -- Perform string substitution on a matched filename, using the
# list of substitution strings written by FNT_MKPAT, the first of which is
# pointed to by EDITP.  The regions to be replaced were marked symbolically
# by the CH_EDIT characters in the user supplied pattern.  The actual indices
# of these regions depend upon the actual filename and are saved by the
# pattern matching code in the encoded pattern buffer PATBUF, for retrieval
# by PATINDEX.  Carry out the substitution and return the length of the
# output string as the function argument.

int procedure fnt_edit (in, out, editp, nedit, patbuf)

char	in[ARB]			# input string to be edited
char	out[ARB]		# receives edited string
pointer	editp			# pointer to first substitution string
int	nedit			# number of edits required
char	patbuf[ARB]		# encoded pattern

pointer	ep
int	ip1, ip2, ip, op, i
int	patindex()

begin
	ep = editp - 1
	ip = 1
	op = 1

	do i = 1, nedit {
	    # Get indices of first and last+1 characters to be substituted for
	    # in the input string.

	    ip1 = patindex (patbuf, (i-1) * 2 + 1)
	    ip2 = patindex (patbuf, (i-1) * 2 + 2)
	    if (ip1 == 0 || ip2 == 0 || ip1 > ip2)
		break		# cannot happen

	    # Copy up to first char to be replaced.
	    for (;  ip < ip1;  ip=ip+1) {
		out[op] = in[ip]
		op = op + 1
	    }

	    # Append substitution string.
	    for (ep=ep+1;  Memc[ep] != EOS;  ep=ep+1) {
		out[op] = Memc[ep]
		op = op + 1
	    }

	    # Continue at character IP2 in the input string.
	    ip = ip2
	}

	# Copy remainder of input string to the output string.
	for (;  in[ip] != EOS;  ip=ip+1) {
	    out[op] = in[ip]
	    op = op + 1
	}

	out[op] = EOS
	return (op - 1)
end


# FNTGFNB -- Return the next filename from the list.

int procedure fntgfnb (list, fname, maxch)

pointer	list			# list descriptor pointer
char	fname[ARB]		# output filename
int	maxch

pointer	strptr
int	file_number
int	gstrcpy()
errchk	syserr

begin
	if (B_MAGIC(list) != FNTB_MAGIC)
	    call syserr (SYS_FNTMAGIC)

	file_number = B_STRNUM(list)
	if (file_number > B_NSTR(list))
	    return (EOF)
	else {
	    B_STRNUM(list) = file_number + 1
	    strptr = B_SBUFPTR(list) + B_STRINDX(list,file_number) - 1
	    return (gstrcpy (Memc[strptr], fname, maxch))
	}
end


# FNTRFNB -- Return the indexed filename from the list.  For applications
# which need to access the list at random.  Returns len(fname) or EOF for
# references to nonexistent list elements.

int procedure fntrfnb (list, index, fname, maxch)

pointer	list			# list descriptor pointer
int	index			# index of list element to be returned
char	fname[ARB]		# output filename
int	maxch

pointer	strptr
int	gstrcpy()
errchk	syserr

begin
	if (B_MAGIC(list) != FNTB_MAGIC)
	    call syserr (SYS_FNTMAGIC)

	if (index < 1 || index > B_NSTR(list))
	    return (EOF)
	else {
	    strptr = B_SBUFPTR(list) + B_STRINDX(list,index) - 1
	    return (gstrcpy (Memc[strptr], fname, maxch))
	}
end


# FNTCLSB -- Close a buffered list and return all storage.

procedure fntclsb (list)

pointer	list			# list descriptor pointer
errchk	syserr

begin
	if (B_MAGIC(list) != FNTB_MAGIC)
	    call syserr (SYS_FNTMAGIC)

	call mfree (B_SBUFPTR(list), TY_CHAR)
	call mfree (list, TY_INT)
end


# FNTREWB -- Rewind a buffered filename list.

procedure fntrewb (list)

pointer	list			# list descriptor pointer
errchk	syserr

begin
	if (B_MAGIC(list) != FNTB_MAGIC)
	    call syserr (SYS_FNTMAGIC)

	B_STRNUM(list) = 1
end


# FNTLENB -- Return the number of filenames in the list.

int procedure fntlenb (list)

pointer	list			# list descriptor pointer
errchk	syserr

begin
	if (B_MAGIC(list) != FNTB_MAGIC)
	    call syserr (SYS_FNTMAGIC)

	return (B_NSTR(list))
end


# FNT_GETPAT -- Return the next comma delimited field from the template string
# with any leading or trailing whitespace stripped off.  The field may consist
# of a simple string constant, a filename template, or a sequence of either
# delimited by concatenation operators //.  We do not make any distinction here
# between string constants and patterns; return the \ with all escape sequences
# as this will be stripped by the higher level code if used to include pattern
# matching metacharacters in filenames.

int procedure fnt_getpat (template, ix, patp, npat, sbuf, maxch)

char	template[ARB]		# template from which to extract field
int	ix			# next char in template
pointer	patp[MAX_PATTERNS]	# receives pointers to sublists (patterns)
int	npat			# receives number of PATP elements set
pointer	sbuf			# used to store output strings
int	maxch			# maxch chars out

int	ch, peek
bool	is_url
pointer	op

int	strncmp(), stridx()
errchk	syserr

begin
	while (IS_WHITE(template[ix]) || template[ix] == ',')
	    ix = ix + 1

	patp[1] = sbuf
	npat = 1
	op = sbuf
	is_url = false

	#for (ch=template[ix];  ch != EOS && ch != ',';  ch=template[ix]) {
	for (ch=template[ix];  ch != EOS;  ch=template[ix]) {
	    peek = template[ix+1]
	    if (IS_WHITE (ch)) {
		# Ignore all whitespace.
		ix = ix + 1
		next

	    } else if ((is_url && ch == ',')) {
		if (stridx (peek, "+-.0123456789") == 0) {
		    break
		} else {
		    # Keep a comma in a URL followed by a digit
		    Memc[op] = ','
		    op = op + 1
		    ix = ix + 1
		}

	    } else if (!is_url && ch == ',') {
		break

	    } else if (ch == '\\' && template[ix+1] == ',') {
		# Escape a comma.
		Memc[op] = ','
		op = op + 1
		ix = ix + 2

	    } else if (!is_url && (ch == '/' && template[ix+1] == '/')) {
		# Concatenation operator: start a new sublist.
		Memc[op] = EOS
		op = op + 1
		ix = ix + 2
		npat = npat + 1
		if (npat > MAX_PATTERNS)
		    call syserr (SYS_FNTMAXPAT)
		patp[npat] = op

	    } else if (ch == ':' && strncmp ("//", template[ix+1], 2) == 0) {
		# Start of URL string, deposit in output list.
		Memc[op] = ch
		op = op + 1
		ix = ix + 1
		is_url = true

	    } else {
		# Ordinary character, deposit in output list.
		Memc[op] = ch
		op = op + 1
		ix = ix + 1
	    }

	    if (op - sbuf > maxch)
		break
	}

	Memc[op] = EOS
	return (op - sbuf)
end


# FNTGFN -- Get the next file name from the named parameter (template).
# This is the guy that does all the work.  A file name may be selected from
# a directory file or list file by pattern matching, or may come from the
# template list string itself.

int procedure fntgfn (pp, outstr, maxch)

pointer	pp			# pattern pointer
char	outstr[ARB]		# output filename
int	maxch

bool	match
pointer	ip, sp, linebuf, fname, patstr
int	nchars, token, first_ch, last_ch, status

bool	streq()
int	getline(), gpatmatch(), patmake(), nowhite(), gstrcat()
int	fnt_read_template(), fnt_open_list()
errchk	salloc, getline, close, fnt_open_list, syserr

begin
	if (pp == NULL || U_MAGIC(pp) != FNTU_MAGIC)
	    call syserr (SYS_FNTMAGIC)

	call smark (sp)					# get buffers
	call salloc (linebuf, SZ_LINE, TY_CHAR)
	call salloc (patstr, SZ_PATSTR, TY_CHAR)
	call salloc (fname, SZ_PATHNAME, TY_CHAR)

	repeat {
	    # Read file names from either list file or directory file, until
	    # one is found which matches pattern, or until EOF is reached.
	    # Make sure pattern matches the ENTIRE file name string, rather
	    # than a substring.

	    if (U_FILDES(pp) != NULL) {			# reading from a file?
		while (getline (U_FILDES(pp), Memc[linebuf]) != EOF) {
		    for (ip=linebuf;  IS_WHITE (Memc[ip]);  ip=ip+1)
			;
		    nchars = nowhite (Memc[ip], Memc[fname], maxch)
		    if (nchars == 0)			# skip blank lines
			next

		    # If the encoded pattern is the null string match anything.
		    if (Memc[U_PATTERN(pp)] == EOS) {
			match = true
		    } else if (gpatmatch (Memc[fname], Memc[U_PATTERN(pp)],
			first_ch, last_ch) > 0) {
			match = (first_ch == 1 && last_ch == nchars)
		    } else
			match = false

		    if (match) {
			call strcpy (Memc[U_LDIR(pp)], outstr, maxch)
			nchars = gstrcat (Memc[fname], outstr, maxch)
			call sfree (sp)
			return (nchars)
		    }
		}

		call close (U_FILDES(pp))
		U_FILDES(pp) = NULL
	    }

	    switch (fnt_read_template (pp, Memc[linebuf], SZ_LINE, token)) {
	    case EO_TEMPLATE:
		nchars = EOF
		outstr[1] = EOS
		call sfree (sp)
		return (nchars)

	    case LIST_FILE, PATTERN_STRING:
		# Break the pattern string into a list file or directory
		# name and a pattern.

		if (token == PATTERN_STRING) {
		    Memc[patstr] = '^'
		    ip = patstr + 1
		} else
		    ip = patstr

		U_FILDES(pp) = fnt_open_list (Memc[linebuf], Memc[ip],
		    SZ_PATSTR-1, Memc[fname], Memc[U_LDIR(pp)], token)

		# Encode the pattern.  If the pattern is matchall set encoded
		# pattern string to NULL and pattern matching will be skipped.

		if (streq (Memc[patstr], "?*"))
		    Memc[U_PATTERN(pp)] = EOS
		else {
		    status = patmake (Memc[patstr], Memc[U_PATTERN(pp)],
			SZ_PATTERN)
		    if (status == ERR)
			call syserr (SYS_FNTBADPAT)
		}
		
	    default:					# simple file name
		nchars = nowhite (Memc[linebuf], outstr, maxch)
		if (nchars > 0) {
		    call sfree (sp)
		    return (nchars)
		}
	    }
	}
end


# FNT_READ_TEMPLATE -- Get next token from template string, return integer
# code identifying the type of token.

int procedure fnt_read_template (pp, outstr, maxch, token)

pointer	pp				#I pointer to param descriptor
char	outstr[maxch]			#O receives token
int	maxch				#I max chars out
int	token				#O token type code

int	nseen, i
pointer	ip, ip_start, op, cp
int	stridx(), strncmp()

begin
	ip = U_TEMPLATE_INDEX(pp)			# retrieve pointer
	while (IS_WHITE (Memc[ip]))
	    ip = ip + 1


	switch (Memc[ip]) {
	case EOS:
	    op = 1
	    token = EO_TEMPLATE

	case LIST_FILE_CHAR:				# list file spec
	    ip = ip + 1					# skip the @
	    for (op=1;  Memc[ip] != TOK_DELIM && Memc[ip] != EOS;  op=op+1) {
		outstr[op] = Memc[ip]
		ip = ip + 1
	    }
	    token = LIST_FILE
	    if (Memc[ip] == TOK_DELIM)
		ip = ip + 1

	default:					# fname or pat string
	    token = FILE_NAME
	    # Extract token.  Determine if regular file name or pattern string.
	    # Disable metacharacters not useful for file name patterns.

	    ip_start = ip
	    for (op=1;  Memc[ip] != EOS;  ip=ip+1) {
		if (Memc[ip] == CH_ESCAPE && Memc[ip+1] != EOS) {
		    # Escape sequence.  Pass both the escape and the escaped
		    # character on to the lower level code.

		    outstr[op] = CH_ESCAPE
		    op = op + 1
		    ip = ip + 1

		} else if (Memc[ip] == TOK_DELIM) {
		    ip = ip + 1
		    break

		} else if (Memc[ip] == FNLDIR_CHAR || Memc[ip] == '/') {
		    token = FILE_NAME

		} else if (Memc[ip] == '*') {
		    # Map "*" into "?*".
		    token = PATTERN_STRING
		    outstr[op] = '?'
		    op = op + 1

		} else if (Memc[ip] == '%') {
		    # The % metacharacter must appear twice (not three times,
		    # as the high level code strips the subsitution field) to
		    # be recognized as the pattern substitution metacharacter.

		    nseen = 0
		    do i = 1, ARB {
			cp = ip_start + i - 1
			if (Memc[cp] == EOS || Memc[cp] == TOK_DELIM)
			    break
			else if (Memc[cp] == '%' && Memc[cp-1] != '\\')
			    nseen = nseen + 1
		    }
		    if (nseen < 2) {
			outstr[op] = CH_ESCAPE
			op = op + 1
		    }
		} else if (stridx (Memc[ip], "[?{") > 0)
		    token = PATTERN_STRING

		outstr[op] = Memc[ip]
		op = op + 1
	    }
	}
	    
	# Remove any trailing whitespace.
	op = op - 1
	while (op > 0 && IS_WHITE (outstr[op]))
	    op = op - 1
	outstr[op+1] = EOS

	if (op > 0)
	    if (outstr[op] == FNLDIR_CHAR || outstr[op] == '/')
		token = PATTERN_STRING

	U_TEMPLATE_INDEX(pp) = ip			# update pointer

	return (token)
end


# FNT_OPEN_LIST -- Open list file or directory.  If reading from a directory,
# open the current directory if a directory name is not given.  Extract
# pattern string (if any), and return in PATSTR.  If no pattern string is
# given, return a pattern which will match all files in the list.

int procedure fnt_open_list (str, patstr, maxch, fname, ldir, ftype)

int	maxch, ftype
char	ldir[SZ_LDIR]
char	str[ARB], patstr[maxch], fname[SZ_FNAME]
int	fd, ip, op, fnt_delim, pat_start, dirmode
int	open(), diropen()
errchk	open, diropen, fpathname

begin
	op = 1
	fnt_delim = NULL
	pat_start = NULL

	# Search for a valid directory prefix.
	for (ip=1;  str[ip] != EOS;  ip=ip+1) {
	    fname[op] = str[ip]
	    if (ftype != LIST_FILE)
		if (fname[op] == FNLDIR_CHAR || fname[op] == '//')
		    if (op == 1 || fname[op-1] != '\\') {
			fnt_delim = op
			pat_start = ip + 1
		    }
	    op = op + 1
	}
	fname[op] = EOS

	if (ftype == LIST_FILE) {
	    if (fnt_delim != NULL)
		fname[fnt_delim] = EOS
	    fd = open (fname, READ_ONLY, TEXT_FILE)
	    ldir[1] = EOS

	} else {
	    if (fnt_delim != NULL)		# specific directory
		fname[fnt_delim+1] = EOS
	    else				# current directory
		fname[1] = EOS
	    call fpathname (fname, ldir, SZ_LDIR)

	    dirmode = SKIP_HIDDEN_FILES
	    if (pat_start != NULL) {
		if (str[pat_start] == '.')
		    dirmode = PASS_HIDDEN_FILES
	    } else if (ftype != LIST_FILE && str[1] == '.')
		dirmode = PASS_HIDDEN_FILES

	    fd = diropen (ldir, dirmode)
	    call strcpy (fname, ldir, SZ_LDIR)
	}

	# If pattern string is appended to list file name, extract
	# it, otherwise set the default pattern "match all" (*).

	op = 1
	if (pat_start != NULL)
	    ip = pat_start
	else if (ftype != LIST_FILE)
	    ip = 1

	for (;  str[ip] != EOS;  ip=ip+1) {
	    patstr[op] = str[ip]
	    op = op + 1
	}

	# No pattern string given, default to "?*".
	if (op == 1) {
	    patstr[1] = CH_ANY
	    patstr[2] = CH_CLOSURE
	    op = 3
	}
	patstr[op] = EOS

	return (fd)
end


# FNTOPN -- Open and initialize the template descriptor.

pointer procedure fntopn (template)

char	template[ARB]

pointer	pp
int	nchars
int	strlen()
errchk	calloc, malloc

begin
	nchars = strlen (template)

	call calloc (pp, LEN_FNTUHDR, TY_STRUCT)
	call malloc (U_TEMPLATE(pp), nchars, TY_CHAR)

	call strcpy (template, Memc[U_TEMPLATE(pp)], nchars)
	U_TEMPLATE_INDEX(pp) = U_TEMPLATE(pp)
	U_MAGIC(pp) = FNTU_MAGIC

	return (pp)
end


# FNTCLS -- Close the template descriptor, return space.

procedure fntcls (pp)

pointer	pp
errchk	syserr

begin
	if (pp == NULL || U_MAGIC(pp) != FNTU_MAGIC)
	    call syserr (SYS_FNTMAGIC)

	if (U_FILDES(pp) != NULL)
	    call close (U_FILDES(pp))

	call mfree (U_TEMPLATE(pp), TY_CHAR)
	call mfree (pp, TY_STRUCT)
end