From:	SMTP%"RELAY-INFO-VAX@CRVAX.SRI.COM" 14-MAR-1994 21:08:11.88
To:	EVERHART
CC:	
Subj:	Tree program in DCL

From: rsimms@hubcap.clemson.edu (Robert Simms)
X-Newsgroups: comp.os.vms
Subject: Tree program in DCL
Date: 11 Mar 94 19:43:47 GMT
Organization: Clemson University
Lines: 261
Message-ID: <rsimms.763415027@hubcap>
NNTP-Posting-Host: hubcap.clemson.edu
Keywords: tree dcl
To: Info-VAX@CRVAX.SRI.COM
X-Gateway-Source-Info: USENET

 ! XTREE.COM	v4.0	Draws a directory tree on a VT1xx
 !
 ! Syntax:
 !	@XTREE {option{,option...}}
 !
 !	where an option is of the form:
 !		{NO}GRAPHICS	- specify whether or not to use graphics chars.
 !		{NO}EMPTY	- specify inclusion status of empty directories
 !		OUTPUT=filename	- the output file
 !		ROOT=dirname	- the root directory for the tree.
 !		{NO}PURGE	- specify whether or not to purge OUTPUT
 !	all options are expected to be in parameter 1, so don't use spaces in
 !	or between options (an alternative is to use a quote before the
 !	options or have a quote at the end of the symbol for the comm. proc.
 !	All options may be abbreviated so long as they are not abbreviated
 !	to a point of ambiguity.
 !	e.g. @XTREE "ROOT=[mydir],EMP    to show all of my dirs, incl empty ones
 !           XTREE root=disk1:[000000],NOEMP,OUT=OURTREE.tr,PURGE,NOGRAPH
 !               will generate a tree of all the accessible directories on
 !		disk1, sending output to file ourtree.tr, purging such a file
 !		if it already exists, and using +|- chars for printing purposes.
 !		Note: quotes aren't necessary if the symbol is defined like
 !		      this:   XTREE=="@disk:[dir]xtree.com """
 !
 ! written by DMWalp      on March 7th, 1982
 ! modified by A. Sorrell on Oct 12, 1982 for VT1xx terminal
 !	Requires: a to be run on a VT1xx if output is a terminal
 ! modified by R. Simms on December 20, 1988 to accept non-root directories
 !	and to deal with long directory names.  Recursive appearance of
 !	[000000] directory has been fixed.  Output contains only
 !	directories that have files in them and to which the user has
 !	access.  Default dir is assumed if none is supplied.
 ! modified by R. Simms on May 29, 1990 to alternately give no graphics
 !	output for printing.
 ! modified by R. Simms on May 29, 1990 to alternately check that directories
 !	contain files or that sufficient privilege exists to view files in
 !	a directory before it is added to the tree.
 ! modified by R. Simms on October 22, 1991 to use Eric Bennett's option
 !	parsing method.
 !
$ verify_was_on = F$VERIFY("NO")
$ ON CONTROL_Y THEN GOTO abort
$ esc[0,8] = 27
$ w = "WRITE sys$command"
 !
$ p1 = F$EDIT(p1,"COLLAPSE,UPCASE")
 !
 ! Command line parsing routine
 !
$ optlist = " EMPTY GRAPHICS OUTPUT PURGE ROOT "
 !
 ! Defaults
 !
$ opt_EMPTY = 1
$ opt_ROOT = "[]"
$ opt_GRAPHICS = 1
$ opt_OUTPUT = "sys$output"
$ opt_PURGE = 1
 !
 ! Option processing
 !
$ get_opts:
$	option = F$ELEMENT(0,"=",F$ELEMENT(0,",",p1))
$	IF option .EQS. "" THEN GOTO done_opts
$	p1 = p1 -option
$	optvalue = 1
$	IF F$EXTRACT(0,1,p1) .EQS. "="
$	THEN	IF F$EXTRACT(1,1,p1) .EQS. """"
$		THEN	optvalue = F$ELEMENT(1,"""",p1)
$			p1 = p1 -"=""" -optvalue -""""
$		ELSE	optvalue = F$ELEMENT(0,",",p1) -"="
$			p1 = p1 -"=" -optvalue
$		ENDIF
$	ENDIF
$	IF F$EXTRACT(0,1,p1) .NES. "," THEN p1 = p1 -F$ELEMENT(0,",",p1)
$	p1 = p1 -","
$	IF F$EXTRACT(0,2,option) .EQS. "NO"
$	THEN	option = option -"NO"
$	optvalue = 0
$	ENDIF
$	optpos = F$LOCATE( " "+option, optlist)
$	optname = F$ELEMENT(1, " ", F$EXTRACT( optpos, 32, optlist))
$	IF optname .EQS. " "
$	THEN	w "Unknown option: "+option
$		GOTO get_opts
$	ENDIF
$	IF F$EXTRACT( F$LENGTH( optname)-1, 1, optname) .EQS. "*"
$	THEN	w "Ambiguous option: "+option
$		GOTO get_opts
$	ENDIF
$	opt_'optname' = optvalue
$	GOTO get_opts
$ done_opts:
 !
$ opt_CHECK = .NOT. opt_EMPTY
$ IF opt_OUTPUT .EQS. "0" .OR opt_OUTPUT .EQS. 1 THEN opt_OUTPUT = "sys$output"
$ IF opt_OUTPUT .EQS. "sys$output" THEN opt_PURGE = 0
 !
$ IF .NOT. opt_GRAPHICS
$ THEN
$	hi	= ""
$	ho	= ""
$	ctrln	= ""
$	ctrlo	= ""
$	!Line Characters
$	vert	= "|"
$	right_t	= "+"
$	down_t	= "+"
$	dash	= "-"
$	corner	= "+"
$ ELSE
$	hi = esc +"[1m"
$	ho = esc +"[m"
$	ctrln[0,8] = %XE
$	ctrlo[0,8] = %XF
$	!Line Characters
$	vert    = "x"
$	right_t = "t"
$	down_t  = "w"
$	dash    = "q"
$	corner  = "m"
$ ENDIF
 !
 ! Make sure the directory exists.  Defaults to default.
 !
$ opt_ROOT = F$PARSE(opt_ROOT +"*.*;*")
$ IF opt_ROOT .EQS. ""
$ THEN 
$	WRITE sys$output hi,"  Directory not found.", ho
$	EXIT
$ ENDIF
 !
 ! extract the disk and directory fields
 !
$ disk  = F$PARSE(opt_ROOT,,,"NODE") +F$PARSE(opt_ROOT,,,"DEVICE")
$ dir_ROOT  = F$PARSE(opt_ROOT,,,"DIRECTORY")
 ! strip delimiters
 !
$ dir_root = dir_root -"<" -"[" -">" -"]"
 ! set up the output file
 ! test if output is terminal it is a VT1xx
 !
$ output_device = F$PARSE(opt_OUTPUT, "DEVICE")
$ IF F$GETDVI(output_device, "DEVCLASS") .NE. 66 THEN GOTO device_ok
$ devdepend2 = F$GETDVI(output_device, "DEVDEPEND2")
$ IF (devdepend2 .AND. %X20000000) .NE. 0 THEN GOTO device_ok	!DEC_CRT
$ WRITE sys$output "Sorry, must be run on a VT1xx"
$ EXIT
$device_ok:
$ ON CONTROL_Y THEN GOTO clean_up
$ OPEN /SHARE=READ /WRITE output 'opt_OUTPUT'
$ gm = ""
$ IF opt_GRAPHICS THEN gm = esc +")0"	! into graphics mode
 ! initialize things
 !
$ line_0 = ""
$ level = 1
$ entry_1 = dir_root
$ GOTO call_pre_case
$return_pre_case:
$ level_1_dir = dir_root
$ line_1 = gm +hi +"''entry_1'" +ho
$ gm = ""
$push:
 ! push down a level
 !
$ old_level = level
$ level	    = level +1
$ parsed_spec_'level' = F$PARSE("*.DIR", -
				disk, -
				"<" +level_'old_level'_dir +">")
$nogo:
$ next_entry_'level' = F$SEARCH(parsed_spec_'level', level)
$ IF (F$SEARCH(disk +"<" +level_'old_level'_dir -
	+"." +F$PARSE(next_entry_'level',,, "NAME") +">*.*" ,100).EQS."") -
	.AND. (next_entry_'level' .NES. "") .AND. opt_CHECK THEN GOTO nogo
$ IF F$LOCATE("000000.DIR",next_entry_'level') .LT. -
	F$LENGTH(next_entry_'level') THEN GOTO nogo
 ! IF search fails no more levels
 !
$ IF next_entry_'level' .NES. "" THEN GOTO more_levels
$ WRITE output line_'old_level'
$ GOTO pop
$more_levels:
 ! mark this as the first entry and not the last entry
 !
$ last_'level' = 0
$ first_'level' = 1
$list_loop:
 ! for each each subdirectory
 ! test if this entry is the last in the list
 ! make the entry the file name field
 ! Capitalize and lower case entry name
 !
$ entry_'level' = next_entry_'level'
$nogo2:
$ next_entry_'level' = F$SEARCH(parsed_spec_'level', level)
$ IF (F$SEARCH(disk +"<" +level_'old_level'_dir -
	+"." +F$PARSE(next_entry_'level',,, "NAME") +">*.*" ,100).EQS."") -
	.AND. (next_entry_'level' .NES. "") .AND. opt_CHECK THEN GOTO nogo2
$ IF next_entry_'level' .EQS. "" THEN last_'level' = 1
$ entry_'level' = F$PARSE(entry_'level',,, "NAME")
$call_pre_case:
$ entry_'level' = F$EXTRACT(0,1,entry_'level') -
	+F$EXTRACT(1,F$LENGTH(entry_'level'),F$EDIT(entry_'level',"LOWERCASE"))
$ IF level .EQ. 1 THEN GOTO return_pre_case
 !
 ! figure out the attaching character
 !     | not first |        first
 ! ----------+-----------+----------
 !  not last | right "T" | down "T"
 ! ----------+-----------+----------
 !    last   | right "L" |  dash
 !
$ end_pad = right_t
$ IF first_'level' THEN end_pad = down_t
$ IF last_'level' THEN end_pad = corner
$ IF first_'level' .AND. last_'level' THEN end_pad = dash
 ! append dashes, attach character and new entry to line
 !
$ len = F$LENGTH(entry_'old_level')
$ line_'level' = line_'old_level' +ctrln +-
	F$FAO("!#*''dash'", (9 -len)*(len .LE. 9)) + -
	end_pad + -
	ctrlo +hi +entry_'level' +ho
 ! blank out the entry and may be add place vertical bar connector
 !
$ pad_'old_level' = F$FAO("!#* ",(len.gt.9)*(len-9))
$ entry_'old_level' = pad_'old_level' +ctrln +"         ''vert'"
$ IF last_'level' THEN entry_'old_level' = pad_'old_level' +"          "
 ! fix up the lower level output line
 !
$ old_old_level = old_level -1
$ line_'old_level' = line_'old_old_level' +entry_'old_level'
 ! calculate the directory specification for the next level
 !
$ level_'level'_dir = level_'old_level'_dir +"." +entry_'level'
$ GOTO push
$pop:
 ! restore parameters
 !
$ level = old_level
$ old_level = old_level -1
$ old_old_level = old_level -1
$ IF level .EQ. 1 THEN GOTO clean_up	! initial level all done
$ first_'level' = 0			! mark end of first entry
$ entry_'old_level' = pad_'old_level' +"         "	! blank out the entry
$ line_'old_level' = line_'old_old_level' +entry_'old_level'
$ IF last_'level' THEN GOTO pop		! done with this level
$ GOTO list_loop			! for each sub-directory loop
$clean_up:
$ WRITE output  ho, ctrlo
$ CLOSE output
$ IF (opt_OUTPUT .NES. "sys$output") .AND. opt_PURGE
$ THEN	PURGE/NOLOG 'opt_OUTPUT'
$	RENAME/NOLOG 'opt_OUTPUT' ;1
$ ENDIF
$abort:
$ IF verify_was_on THEN SET VERIFY
$ EXIT


