From:	ESDSDF::BRUCE        "Bruce Zielinski (866-6372)" 20-JAN-1988 15:22
To:	ARISIA::EVERHART
Subj:	New version of DRAWTREE.  ""Fixed"" problem with long directory names."

Glenn,
	Here is a new version of DRAWTREE.COM.  I "fixed" the problem with
looonnnggg directory names by changing the name to 8 characters followed
by a "*" (indicating continuation).  I could have made the length of each
level greater, but that could cause truncation problems if people have deeply
nested directories.  I also fixed a problem with a symbol name that occurred
when the directory name entered caused an error.  Regardless what you entered
at the new prompt, you got the current directory structure.  If you know anyone
else who would like a copy...

		Thanks,
		Bruce

$ on_verify = 'f$verify(0)
$   !
$   !	DRAWTREE.COM	Draws a directory tree on a VT100
$   !
$   !	written by DMWalp	on March 7th, 1982
$   !
$   !   Editors:  DMW  D. M. Walp
$   !             JBF  James B. Fischer
$   !             JRC  James R. Cutler
$   !             BCZ  Bruce C. Zielinski
$   !
$   !   Versn Who Date        Comment
$   !    1.0  DMW  7-Mar-1985 Initial Version
$   !    1.1  JBF  6-Apr-1984 made VT100 optional by making P3 non-null
$   !    1.2  JBF  2-Jul-1985 Added support for VT-2xx series terminals
$   !    1.3  JRC  13 Mar 1986 Changed case loop to only touch upper case
$   !    1.4  BCZ  10 Apr 1987 Added logicals, don't need "[","]" will
$   !                          assume current tree if no directory specified
$   !			       and you can specify sub-directory and get
$   !			       whole tree.
$   !    1.5  BCZ  08 Jul 1987 Added the capability to start tree program
$   !                          at any level of a tree.
$   !    1.6  BCZ  20 Jan 1988 Fixed problem with directory names longer
$   !                          than 9 characters.  Changes name to 8 chars
$   !                          and a "*".
$   !
$   !	Requires: a to be run on a VT100 if output is a terminal
$   !	Parameters:  P1 - The disk directory sepcification ( will only prompt if
$   !			   directory doesn't exist ).  Sub-directories allowed.
$   !		     P2 - Output ( default is SYS$OUTPUT, no prompting )
$   !                P3 - null implies VT100 device, non-null implies printer
$   !
$ START:
$   say = "write sys$output"
$   ON CONTROL_Y THEN EXIT
$   SET NOON
$   output_file = P2
$   IF output_file .EQS. "" THEN output_file = "SYS$OUTPUT"
$!
$   CNTRLN[0,8] = 14
$   CNTRLO[0,8] = 15
$   ESC[0,8]    = 27
$   padt = "t"
$   padw = "w"
$   padm = "m"
$   padq = "q"
$   graphics_on  = "''ESC')0"
$   graphics_off = "''CNTRLO'"
$   pad_chars	= "qqqqqqqqq"	! graphic dash
$   ESCAPE1     = "''ESC'[4;7m"
$   ESCAPE2     = "''ESC'[m''cntrln'"
$   old_lvl_pad = "         x"
$!
$!
$ check_term:
$   !	test if output terminal is a VT100
$   !
$   if "''p3'" .NES. "" then $ goto NOT_VT100
$   output_device = F$PARSE ( output_file, "DEVICE" )
$   IF F$GETDVI ( output_device, "DEVCLASS" ) .NE.  66 THEN GOTO check_root
$   IF F$GETDVI ( output_device, "DEVTYPE"  ) .EQ.  96 THEN GOTO check_root
$   IF F$GETDVI ( output_device, "DEVTYPE"  ) .EQ.  98 THEN GOTO check_root
$   IF F$GETDVI ( output_device, "DEVTYPE"  ) .EQ. 110 THEN GOTO check_root
$ NOT_VT100:
$   CNTRLN = ""
$   CNTRLO = ""
$   ESC    = ""
$   padt = "+"
$   padw = "+"
$   padm = "+"
$   padq = "-"
$   graphics_on  = ""
$   graphics_off = ""
$   pad_chars	= "---------"	! graphic dash
$   ESCAPE1     = ""
$   ESCAPE2     = ""
$   old_lvl_pad = "         |"
$!
$ goto check_root
$ prompt_directory:
$ write sys$output ""
$ write sys$output "  Directory ''p1' not found.  Please try again."
$ write sys$output ""
$ p1:=""
$ ROOT:=""
$   INQUIRE p1 "Root Directory "
$ check_root:
$   if p1 .eqs. "." then $ p1 = f$logical("sys$login")
$   if p1 .eqs. "^" then $ p1 = ""
$ IF P1 .EQS. "" THEN GOTO NO_LOGICAL
$ IF "''F$LOGICAL(P1)'" .EQS. "" THEN GOTO NO_LOGICAL
$ P1:='F$LOGICAL(P1)
$ goto check_root
$ NO_LOGICAL:
$   root = P1
$   if ROOT .nes. "" then goto TEST_prompt
$   ROOT:='F$DIRECTORY()
$   TMPLOC='F$LOCATE(".",ROOT)
$   TMPLEN='F$LENGTH(ROOT)
$   if tmploc .eq. tmplen then goto past_prompt
$   ROOT:='F$EXTRACT(0,TMPLOC,ROOT)"]"
$   GOTO PAST_PROMPT
$ TEST_PROMPT:
$ LENGTH = 'F$LENGTH(root)
$ LOCAT = 'F$LOCATE(":",root)
$ IF LENGTH .EQ. F$LOCATE("[",root) THEN $ BRA1:="["
$ IF LENGTH .EQ. F$LOCATE("]",root) THEN $ BRA2:="]"
$ IF 'LENGTH' .EQ. 'LOCAT' THEN locat = 0
$ IF LOCAT .NE. 0 THEN LOCAT=LOCAT+1
$ ROOT:="''F$EXTRACT(0,locat,ROOT)'''BRA1'''f$extract(locat,length,ROOT)'''BRA2'"
$   !
$ loop1:
$   log_disk	= F$PARSE ( root, , , "DEVICE" )
$   tmp_root	= F$PARSE ( root, , , "DIRECTORY" )
$   log_disk = F$EXTRACT(0,F$LOCATE(":",log_disk),log_disk)
$   tmp_disk = f$trnlnm("''log_disk'")
$   if tmp_disk .eqs. "" then goto loop2
$   log_disk = "''tmp_disk'"
$   if f$locate(".",log_disk) .eq. f$length(log_disk) then goto loop2
$   root = f$extract(0,f$locate("]",log_disk),log_disk)+f$extract(1,f$length(tmp_root),tmp_root)
$   goto loop1
$ loop2:
$ log_disk = F$EXTRACT(0,F$LOCATE(":",log_disk),log_disk)
$ A=F$TRNLNM("''log_disk'")
$ IF A .EQS. "" THEN GOTO CONT1
$ log_disk=A
$ GOTO loop2
$ CONT1:
$ past_prompt:
$   tmp_root	= F$PARSE ( root, , , "DIRECTORY" )
$ log_root = ""
$ rt_bracket = ""
$ lt_bracket = ""
$ if f$locate(".",tmp_root) .eq. f$length(tmp_root) then goto skip_def_it
$ loop3:
$ if f$locate(".",tmp_root) .eq. f$length(tmp_root) then goto def_it
$ rt_bracket := "]"
$ lt_bracket := "["
$ log_root = "''log_root'"+f$extract(0,f$locate(".",tmp_root)+1,tmp_root)
$ tmp_root = f$extract(f$locate(".",tmp_root)+1,f$length(tmp_root),tmp_root)
$ goto loop3
$ def_it:
$ DEF/NOLOG/TRANS=(CONC,TERM) TREE_TOP_DIR 'log_disk':'log_root''rt_bracket'
$ root := "tree_top_dir:''lt_bracket'''tmp_root'"
$ skip_def_it:
$   !
$   !	test if the directory exists
$   !
$   parse_root = F$PARSE ( root + "*.*;*" )
$   IF parse_root .EQS. "" THEN GOTO prompt_directory
$   IF F$SEARCH ( parse_root ) .EQS. "" THEN GOTO prompt_directory
$
$   !	extract the disk and directory fields
$   !
$   disk	= F$PARSE ( parse_root, , , "DEVICE" )
$   dir_root	= F$PARSE ( parse_root, , , "DIRECTORY" )
$
$   !	test it is not a sub-directory
$   !	strip delimiters
$   !
$   IF F$LOCATE ( ".", dir_root ) .NES. F$LENGTH ( dir_root ) -
	THEN GOTO prompt_directory
$   dir_root = dir_root - "<" - "[" - ">" - "]"
$
$   !	set up the output file
$
$   ON CONTROL_Y THEN GOTO abort
$   OPEN/WRITE output 'output_file'
$   TIME = F$EXTRACT(0,17,"''F$TIME()'")
$   WRITE OUTPUT "Directory Tree Structure for: ''root' on ''TIME'"
$
$   WRITE output "''graphics_on'"	! into graphics mode
$
$   !	initialize things
$   !
$   line_0      = ""
$   level	= 1
$   last_line_level = 99
$   base_line = 2
$   old_base_line = 99
$   as_long_flag = 0
$   entry_1     = dir_root
$   GOTO call_pre_case
$ return_pre_case:
$   level_1_dir = dir_root
$   line_1	= "''ESCAPE1'''entry_1'''ESCAPE2'"
$
$ push:
$   !	push down a level
$   !
$   old_level = level
$   level     = level + 1
$   parsed_spec_'level' = F$PARSE ( "*.DIR", -
				    disk, -
				     "<" + level_'old_level'_dir + ">" )
$ nxt_entry:
$   next_entry_'level'	= F$SEARCH ( parsed_spec_'level', level )
$   temp_entry = next_entry_'level'
$   temp_entry = F$PARSE ( "''temp_entry'", , , "NAME")
$   if ((temp_entry .eqs. dir_root) .and. -
	(dir_root .eqs. "000000")) then $ goto nxt_entry
$
$   ! if search fails no more levels
$   !
$   IF next_entry_'level' .NES. "" THEN GOTO more_levels
$   lvl_gtr_base = 0
$   BLWB = 0
$   if base_line .lt. old_base_line   then $ BLWB = 1
$   OLGTB = 0
$   if last_line_level .gt. base_line then $ OLGTB = 1
$   LNEL = 0
$   if old_level .ne. base_line       then $ LNEL = 1
$   OLNEOL = 0
$   if last_line_level .ne. old_base_line then $ olneol = 1
$   spcr_flag = 0
$   if blwb .and. as_long_flag then spcr_flag = 1
$   if olgtb .and. lnel .and. olneol then spcr_flag = 1
$   if spcr_flag then $ write output spacer
$   WRITE output line_'old_level'
$   as_long_flag = 0
$   old_base_line = base_line
$   last_line_level = 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 sub-directory
$   !	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'
$   next_entry_'level'	= F$SEARCH ( parsed_spec_'level', level )
$   IF next_entry_'level' .EQS. "" THEN last_'level' = 1
$   entry_'level' = F$PARSE ( entry_'level', , , "NAME" )
$ call_pre_case:
$!%%%
$ if f$length(entry_'level') .gt. 9 then -
      entry_'level' = f$extract(0,8,entry_'level') + "*"
$   entry_length = F$LENGTH ( entry_'level' )
$   counter	 = 1
$ case_loop:
$   IF counter .EQ. entry_length THEN GOTO end_case
$	char_val = f$cvui( 0, 8, f$extract( counter, 1, entry_'level' ) )
$	if ( char_val .lt. 65 .or. char_val .gt. 90 ) then goto not_uc
$	    entry_'level'[8*'counter',8] = char_val + 32
$ not_uc:
$   counter = counter + 1
$   GOTO case_loop
$ end_case:
$   IF level .EQ. 1 THEN GOTO return_pre_case
$
$   !	fiqure out the attaching character
$   !		  | not first |	  first
$   !	----------+-----------+----------
$   !	 not last | right "T" | down "T"
$   !	----------+-----------+----------
$   !	   last	  | right "L" |	  dash
$   !
$					     end_pad = "''padt'"
$   IF first_'level'			THEN end_pad = "''padw'"
$   IF			   last_'level' THEN end_pad = "''padm'"
$   IF first_'level' .AND. last_'level' THEN end_pad = "''padq'"
$
$   !	append dashes, attach character and new entry to line
$   !
$   line_'level' = line_'old_level' + -
		   F$EXTRACT ( F$LENGTH ( entry_'old_level' ), -
			       9, -
			       pad_chars ) + -
		   end_pad + -
		   "''CNTRLO'''ESCAPE1'" + entry_'level' + -
		   "''ESCAPE2'''CNTRLN'"
$
$   !	blank out the entry and may be add place vertical bar connector
$   !
$   entry_'old_level' = old_lvl_pad
$   IF last_'level' THEN entry_'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'
$   if level .ge. last_line_level then $ as_long_flag = 1
$
$   !	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
$   base_line = 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' = "         "	! blank out the entry
$   line_'old_level' = line_'old_old_level' + entry_'old_level'
$   spacer = line_'old_old_level' + old_lvl_pad
$   IF last_'level' THEN GOTO pop	! done with this level
$   GOTO list_loop		  	! for each sub-directory loop 
$
$ abort:
$   WRITE output "''ESCAPE2'"
$ clean_up:
$   WRITE output "''GRAPHICS_OFF'"
$   CLOSE output
$   IF on_verify THEN SET VERIFY