1 files changed, 567 insertions, 0 deletions

diff --git a/pkg/system/help/xhelp/xhdir.x b/pkg/system/help/xhelp/xhdir.x
new file mode 100644
index 00000000..3c951afa
--- /dev/null
+++ b/pkg/system/help/xhelp/xhdir.x
@@ -0,0 +1,567 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <diropen.h>
+include	<ctype.h>
+include	<finfo.h>
+
+include "xhelp.h"
+
+
+# Pattern matching definitions.
+define  PATCHARS        "*?[" 		
+
+# Browsing command dictionary.
+define	DIR_CMDS "|dirlist|loadfile|open|template|home|up|root|rescan|save|"
+define	DIRLIST		1		# get the directory listing
+define	LOADFILE	2		# load the requested file
+define	OPEN		3		# load the requested file
+define	TEMPLATE	4		# filename matching template
+define	HOME		5		# goto the user's home$
+define	UP		6		# go up one directory
+define	ROOT		7		# go to the root directory
+define	RESCAN		8		# rescan current directory
+define	SAVE		9		# save to the requested file
+
+
+# XH_DIRECTORY -- Process the directory browsing command.
+
+procedure xh_directory (xh, command)
+
+pointer	xh					#i task descriptor
+char	command[ARB]				#i command option
+
+pointer	sp, dir, file, pattern, path, fmt
+pointer task, pkg, opt, type
+int	ncmd, overwrite
+int	strdic(), strcmp(), envgets()
+
+begin
+	# Allocate working space and clear it.
+	call smark (sp)
+	call salloc (dir, SZ_PATHNAME, TY_CHAR) 	
+	call salloc (path, SZ_PATHNAME, TY_CHAR) 	
+	call salloc (file, SZ_FNAME, TY_CHAR)
+	call salloc (pattern, SZ_FNAME, TY_CHAR)
+	call salloc (fmt, SZ_FNAME, TY_CHAR)
+	call salloc (task, SZ_FNAME, TY_CHAR)
+	call salloc (pkg, SZ_FNAME, TY_CHAR)
+	call salloc (opt, SZ_FNAME, TY_CHAR)
+	call salloc (type, SZ_FNAME, TY_CHAR)
+
+	call aclrc (Memc[dir], SZ_FNAME)
+	call aclrc (Memc[path], SZ_FNAME)
+	call aclrc (Memc[file], SZ_FNAME)
+	call aclrc (Memc[fmt], SZ_FNAME)
+	call aclrc (Memc[pattern], SZ_FNAME)
+	call aclrc (Memc[task], SZ_FNAME)
+	call aclrc (Memc[pkg], SZ_FNAME)
+	call aclrc (Memc[opt], SZ_FNAME)
+	call aclrc (Memc[type], SZ_FNAME)
+
+	ncmd = strdic (command, command, SZ_LINE, DIR_CMDS)
+	switch (ncmd) {
+	    case DIRLIST:
+		call gargwrd (Memc[dir], SZ_PATHNAME) 	# get the dirname
+		if (strcmp ("../", Memc[dir]) == 0) {
+		    call xh_updir (xh)
+		} else {
+		    call sprintf (Memc[path], SZ_PATHNAME, "%s%s")
+		        call pargstr (CURDIR(xh))
+		        call pargstr (Memc[dir])
+		    call xh_set_curdir (xh, Memc[path])
+		    call xh_dirlist (xh, CURDIR(xh), PATTERN(xh))
+	            call xh_selection (xh, CURDIR(xh))
+		}
+
+	    case LOADFILE:
+		call gargwrd (Memc[file], SZ_FNAME) 	# get the filename
+		call sprintf (Memc[path], SZ_PATHNAME, "%s%s")
+		    call pargstr (CURDIR(xh))
+		    call pargstr (Memc[file])
+		call xh_open_file (xh, "helpres", Memc[path], YES, YES)
+	        call xh_selection (xh, Memc[path])
+
+	    case OPEN:
+		call gargwrd (Memc[file], SZ_FNAME) 	# get the filename
+		call xh_ldfile (xh, Memc[file])
+
+	    case TEMPLATE:
+		call gargwrd (Memc[pattern], SZ_FNAME) 	# set the template
+		call xh_set_pattern (xh, Memc[pattern])
+		call xh_dirlist (xh, CURDIR(xh), PATTERN(xh))
+
+	    case HOME:
+		if (envgets ("home", Memc[dir], SZ_PATHNAME) != EOF) {
+		    call xh_set_curdir (xh, Memc[dir])
+		    call xh_dirlist (xh, CURDIR(xh), PATTERN(xh))
+	   	}
+
+	    case UP:
+		call xh_updir (xh)
+
+	    case ROOT:
+		call xh_set_curdir (xh, "/")
+		call xh_dirlist (xh, CURDIR(xh), PATTERN(xh))
+
+	    case RESCAN:
+		call xh_dirlist (xh, CURDIR(xh), PATTERN(xh))
+
+	    case SAVE:
+		call gargwrd (Memc[path], SZ_FNAME) 	# get the filename
+		call gargwrd (Memc[file], SZ_FNAME) 	# get the output fname
+		call gargi (overwrite) 			# get the overwrite flag
+		call gargwrd (Memc[fmt], SZ_FNAME) 	# get the save format
+		call xh_save_file (xh, Memc[path], Memc[file], Memc[fmt],
+		    overwrite)
+	}
+
+	call sfree (sp)
+end
+
+
+# XH_DIRLIST -- Given the directory name and a file template return the
+# directory contents.
+
+procedure xh_dirlist (xh, directory, pattern)
+
+pointer	xh					#i task descriptor
+char	directory[ARB]				#i directory to read
+char	pattern[ARB]				#i matching template
+
+pointer	sp, path, fname, patbuf
+pointer	dp, fp, ip, op, ep, sym
+bool	match_extension
+int	dd, n, patlen
+int	nfiles, ndirs, lastch
+
+pointer	stopen(), stenter()
+int	diropen(), xh_isdir(), strncmp(), stridxs()
+int	patmake(), patmatch(), strlen(), getline()
+
+begin
+	call smark (sp)
+	call salloc (path, SZ_PATHNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (patbuf, SZ_LINE, TY_CHAR)
+
+	call aclrc (Memc[patbuf], SZ_LINE)
+
+	# If this isn't a directory just return silently.
+	if (xh_isdir (directory, Memc[path], SZ_PATHNAME) == 0) {
+	    call sfree (sp)
+	    return
+	}
+	
+	# Open the requested directory
+	dd = diropen (directory, PASS_HIDDEN_FILES)
+
+	# Set up the pattern matching code.  We recognize selecting all files
+	# with a particular extension as a special case, since this case is
+	# very common and can be done much more efficiently if we don't use
+	# the general pattern matching code.  If we have no pattern set the
+	# length to zero to indicate that everything will match.
+
+	if (pattern[1] == EOS) {
+	    patlen = 0
+	} else {
+	    match_extension = (strncmp (pattern, "*.", 2) == 0 &&
+		stridxs (PATCHARS, pattern[3]) <= 0)
+	    if (match_extension)
+		patlen = strlen (pattern)
+	    else {
+		# Convert file matching pattern into general pattern string.
+		Memc[fname] = '^'
+		op = fname + 1
+		lastch = 0
+		for (ip=1;  pattern[ip] != EOS;  ip=ip+1) {
+		    if (pattern[ip] == '*' && lastch != '?' && lastch != ']') {
+			Memc[op] = '?'
+			op = op + 1
+		    }
+		    lastch = pattern[ip]
+		    Memc[op] = lastch
+		    op = op + 1
+		}
+		Memc[op] = '$'
+		op = op + 1
+		Memc[op] = EOS
+			
+		# Compile the pattern.
+		patlen = patmake (pattern, Memc[patbuf], SZ_LINE)
+	    }
+	}
+
+	# Initialize counters.
+	ndirs  = 0
+	nfiles = 0
+	dp = NULL
+	fp = NULL
+
+	# Accumulate the contents into the directory and files lists.  We
+	# match files against the given template, all directories are
+	# matched regardless.
+	for (n=0; n != EOF; ) {
+	    n = getline (dd, Memc[fname])
+	    if (n < 1)
+		break
+	    n = n - 1
+	    Memc[fname+n] = EOS			# stomp the newline
+
+	    # See if this is a directory.
+	    call sprintf (Memc[path], SZ_PATHNAME, "%s%s")
+		call pargstr (CURDIR(xh))
+		call pargstr (Memc[fname])
+	    if (xh_isdir (Memc[path], Memc[path], SZ_PATHNAME) > 0) {
+		ndirs = ndirs + 1
+
+		# If this is the first directory initialize the symbol table.
+		if (ndirs == 1)
+		    dp = stopen ("dirlist", LEN_INDEX, LEN_STAB, SZ_SBUF)
+
+		# Enter the directory name into the symbol table.
+		call strcat ("/", Memc[fname], SZ_FNAME)
+		sym = stenter (dp, Memc[fname], strlen(Memc[fname])+1)
+
+	    } else {
+		# Check if the file matches the given pattern.
+		if (patlen > 0) {
+		    if (match_extension) {
+			if (n < patlen)
+			    next
+			ep = fname + n - 1
+			for (ip=patlen; ip > 2; ip=ip-1) {
+			    if (Memc[ep] != pattern[ip])
+				break
+			    ep = ep - 1
+			}
+			if (pattern[ip] != '.' || Memc[ep] != '.')
+			    next
+		    } else if (patmatch (Memc[fname], Memc[patbuf]) <= 0)
+			next
+		}
+
+		# We have a match.
+		nfiles = nfiles + 1
+
+		# If this is the first file initialize the symbol table.
+		if (nfiles == 1)
+		    fp = stopen ("filelist", LEN_INDEX, LEN_STAB, SZ_SBUF)
+
+		# Enter the directory name into the symbol table.
+		sym = stenter (fp, Memc[fname], strlen(Memc[fname])+1)
+	    }
+	}
+
+	# Send the results to the GUI.
+	call xh_putlist (xh, dp, "directory", "dirlist")
+	call xh_putlist (xh, fp, "directory", "filelist")
+
+	# Clean up.
+	if (dp != NULL)
+	    call stclose (dp)
+	if (fp != NULL)
+	    call stclose (fp)
+	call close (dd)
+	call sfree (sp)
+end
+
+
+# XH_PUTLIST -- Given the symtab for the directory contents construct a
+# list suitable for a message to the GUI.  The 'arg' parameter is passed
+# to indicate which type of list this is.
+
+procedure xh_putlist (xh, stp, param, arg)
+
+pointer	xh					#i task descriptor
+pointer	stp					#i symtab ptr for list
+char	param[ARB]				#i GUI param to notify
+char	arg[ARB]				#i GUI param arg
+
+pointer	sp, list, msg, sym, name, ip
+int	nchars
+
+pointer	sthead(), stnext(), stname()
+int	stsize(), gstrcpy(), strcmp(), strlen()
+
+begin
+	# Return if there is no symtab information.
+	if (stp == NULL) {
+	    call smark (sp)
+	    call salloc (msg, SZ_FNAME , TY_CHAR)
+	    call sprintf (Memc[msg], SZ_FNAME, "%s { }")
+	        call pargstr (arg)
+
+	    call gmsg (XH_GP(xh), param, Memc[msg]) 	# send it to the GUI
+	    call gflush (XH_GP(xh))
+	    call sfree (sp)
+	    return
+	}
+
+	# Allocate space for the list.
+	nchars =  stsize (stp) + 1
+
+	call smark (sp)
+	call salloc (list, nchars , TY_CHAR)
+	call aclrc (Memc[list], nchars)
+	ip = list
+
+	# Build the list from the symtab.
+        for (sym = sthead (stp); sym != NULL; sym = stnext (stp,sym)) {
+	    name = stname(stp,sym)
+	    if (strcmp (Memc[name], "./") != 0) {
+	        ip = ip + gstrcpy (Memc[name], Memc[ip], SZ_FNAME)
+	        ip = ip + gstrcpy (" ", Memc[ip], SZ_FNAME)
+	    }
+	}
+
+	# Sort the list.
+	call xh_sort_list (Memc[list])
+
+	# Allocate space for the message buffer.  The "+ 6" is space for
+	# the brackets around the list in the message created below.
+	nchars = nchars + strlen (arg) + 6
+	call salloc (msg, nchars, TY_CHAR)
+	call aclrc (Memc[msg], nchars)
+	ip = msg
+
+	# Begin the message by adding the arg and make a Tcl list of the
+	# contents.
+	call sprintf (Memc[msg], nchars, "%s { ")
+	    call pargstr (arg)
+	call strcat (Memc[list], Memc[msg], nchars)
+	call strcat (" }", Memc[msg], nchars)
+
+	# Finally, send it to the GUI.
+	call gmsg (XH_GP(xh), param, Memc[msg])
+	call gflush (XH_GP(xh))
+
+	call sfree (sp)
+end
+
+
+# XH_LDFILE -- Load the requested file.  If this is a file display it's
+# contents and update the browser with it's directory, otherwise if it's
+# a directory jump the browser to that directory.
+
+procedure xh_ldfile (xh, file)
+
+pointer	xh					#i task descriptor
+char	file[ARB]				#i requested file/dir
+
+pointer	sp, ip, dir, parent, path
+int	nchars
+int	access(), strlen(), xh_isdir()
+
+begin
+	call smark (sp)
+	call salloc (dir, SZ_PATHNAME, TY_CHAR)
+	call salloc (path, SZ_PATHNAME, TY_CHAR)
+	call salloc (parent, SZ_PATHNAME, TY_CHAR)
+
+	# Expand the current directory to a host path.
+	call fdirname (file, Memc[dir], SZ_PATHNAME)
+
+	if (xh_isdir (Memc[dir], Memc[path], SZ_PATHNAME) > 0) {
+	    # Set the curdir and load it's contents.
+	    call xh_set_curdir (xh, Memc[path])
+	    call xh_dirlist (xh, CURDIR(xh), PATTERN(xh))
+	    call xh_selection (xh, Memc[path])
+	} 
+
+	if (access(file,0,0) == YES && 
+	    xh_isdir (file, Memc[path], SZ_PATHNAME) == 0) {
+	        # Work backwards to the parent '/', be sure to skip the trailing
+	        # backslash already in the dirname.
+	        ip = dir + strlen (Memc[dir]) - 2
+	        while (Memc[ip] != '/' && ip > dir) 
+	            ip = ip - 1
+
+	        nchars = ip - dir
+	        if (nchars > 0)
+	            call strcpy (Memc[dir], Memc[parent], nchars)
+	        else
+	            call strcpy ("/", Memc[parent], nchars)
+
+	        # Set the parent dir and load it's contents.
+	        call xh_set_curdir (xh, Memc[parent])
+	        call xh_dirlist (xh, CURDIR(xh), PATTERN(xh))
+
+	        # Now load the file itself.
+	        call xh_open_file (xh, "helpres", file, YES, YES)
+	        call xh_selection (xh, file)
+	}
+
+	call sfree (sp)
+end
+
+
+# XH_UPDIR -- Go up to the parent directory and return contents.
+
+procedure xh_updir (xh)
+
+pointer	xh					#i task descriptor
+
+pointer	sp, ip, dir, parent
+int	nchars, strlen()
+
+begin
+	call smark (sp)
+	call salloc (dir, SZ_PATHNAME, TY_CHAR)
+	call salloc (parent, SZ_PATHNAME, TY_CHAR)
+
+	# Expand the current directory to a host path.
+	call fdirname (CURDIR(xh), Memc[dir], SZ_PATHNAME)
+
+	# Work backwards to the parent '/', be sure to skip the trailing
+	# backslash already in the dirname.
+	ip = dir + strlen (Memc[dir]) - 2
+	while (Memc[ip] != '/' && ip > dir) 
+	    ip = ip - 1
+
+	nchars = ip - dir
+	if (nchars > 0)
+	    call strcpy (Memc[dir], Memc[parent], nchars)
+	else
+	    call strcpy ("/", Memc[parent], nchars)
+
+	# Set the parent dir and load it's contents.
+	call xh_set_curdir (xh, Memc[parent])
+	call xh_dirlist (xh, CURDIR(xh), PATTERN(xh))
+	call xh_selection (xh, CURDIR(xh))
+
+	call sfree (sp)
+end
+
+
+# XH_SET_CURDIR -- Set the filename matching template pattern.
+
+procedure xh_set_curdir (xh, dir)
+
+pointer	xh					#i task descriptor
+char	dir[ARB]				#i current directory
+
+pointer	sp, dirbuf
+int	strlen()
+
+begin
+	call smark (sp)
+	call salloc (dirbuf, SZ_PATHNAME, TY_CHAR)
+
+	call strcpy (dir, CURDIR(xh), SZ_PATHNAME)
+	if (dir[strlen(dir)] != '/')
+	    call strcat ("/", CURDIR(xh), SZ_PATHNAME)
+
+	call sprintf (Memc[dirbuf], SZ_PATHNAME, "curdir %s")
+	    call pargstr (CURDIR(xh))
+
+	call gmsg (XH_GP(xh), "directory", Memc[dirbuf])
+	call gflush (XH_GP(xh))
+
+	call sfree (sp)
+end
+
+
+# XH_SET_PATTERN -- Set the filename matching template pattern.
+
+procedure xh_set_pattern (xh, pattern)
+
+pointer	xh					#i task descriptor
+char	pattern[ARB]				#i template pattern
+
+pointer	sp, patbuf
+
+begin
+	call smark (sp)
+	call salloc (patbuf, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[patbuf], SZ_FNAME, "template %s")
+	    call pargstr (pattern)
+
+	call strcpy (pattern, PATTERN(xh), SZ_FNAME)
+	call gmsg (XH_GP(xh), "directory", Memc[patbuf])
+	call gflush (XH_GP(xh))
+
+	call sfree (sp)
+end
+
+
+# XH_SELECTION -- Set the selected filename.
+
+procedure xh_selection (xh, selection)
+
+pointer	xh					#i task descriptor
+char	selection[ARB]				#i selection
+
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_FNAME, "selection %s")
+	    call pargstr (selection)
+
+	call gmsg (XH_GP(xh), "directory", Memc[buf])
+	call gflush (XH_GP(xh))
+	call sfree (sp)
+end
+
+
+# XH_ISDIR -- Test whether the named file is a directory.  Check first to
+# see if it is a subdirectory of the current directory. If VFN is a directory,
+# return the OS pathname of the directory in pathname, and the number of
+# chars in the pathname as the function value.  Otherwise return 0.
+
+int procedure xh_isdir (vfn, pathname, maxch)
+
+char	vfn[ARB]		# name to be tested
+char	pathname[ARB]		# receives path of directory
+int	maxch			# max chars out
+
+bool	isdir
+pointer	sp, fname, op
+int	ip, fd, nchars, ch
+long	file_info[LEN_FINFO]
+int	finfo(), diropen(), gstrcpy(), strlen()
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Copy the VFN string, minus any whitespace on either end.
+	op = fname
+	for (ip=1;  vfn[ip] != EOS;  ip=ip+1) {
+	    ch = vfn[ip]
+	    if (!IS_WHITE (ch)) {
+		Memc[op] = ch
+		op = op + 1
+	    }
+	}
+	Memc[op] = EOS
+
+	isdir = false
+	if (finfo (Memc[fname], file_info) != ERR) {
+	    isdir = (FI_TYPE(file_info) == FI_DIRECTORY)
+
+	    if (isdir) {
+		call fdirname (Memc[fname], pathname, maxch)
+		nchars = strlen (pathname)
+	    }
+
+	} else {
+	    # If we get here, the VFN is the name of a new file.
+	    ifnoerr (fd = diropen (Memc[fname], 0)) {
+		call close (fd)
+		isdir = true
+	    }
+	    nchars = gstrcpy (Memc[fname], pathname, maxch)
+	}
+
+	call sfree (sp)
+	if (isdir)
+	    return (nchars)
+	else {
+	    pathname[1] = EOS
+	    return (0)
+	}
+end