Program Down 
!	Version 1.00
!	Written by Michael W. Wheeler (mww@tntech.bitnet)
!	VAX Basic V3.1
!	Copyright (c) by Michael W. Wheeler, September 1987
!	This program is intended for Public Domain, and may not be sold or
!	marketed in any form without the permision and written consent
!	from the author Michael W. Wheeler.  I retain all copyrights to
!	this program, in either the original or modified forms, and no
!	violation, deletion, or change of the copyright notice is
!	allowed.  Futhermore, I will have no liability or responsibilty
!	to any user with respect to loss or damage caused directly or
!	indirectly by this program.

! History:
!	The first incarnation of this utility was in
!	the form a DCL command procedure.  It was *SLOW*
!	and no one ever used it much (not even me).

!	The first version to be written in a compiled language
!	was written in VAX Fortran.  It didn't have *ANY* bells
!	and whistles except for some cli stuff.  It was also a
!	very poor hack and was not readable in the least.  Fortran
!	just isn't given to easy/clean string handling.

!	Translated the program into VAX Basic and cleaned
!	up the code to make it more readable.  I also added
!	a million and one bells and whistles.
!	Some of which are:
!		Uses the Command Language Interpreter (CLI) to
!	    parse the command line.
!		Uses SMG Term Table Database to get the terminal
!	    capabilities for direct cursor addressing, erasing
!	    the screen, and erasing from the cursor to the end
!	    of line.
!		Uses the VMS Help facility to provide a robust
!	    help mechanism to the user.
!		Uses the VMS Message facility for all messages
!	    to the user, thus making all program messages
!	    tailorable via the DCL command set message.
!		Supports cursor movement by using the arrow
!	    keys, Next screen and Previous screen keys, DCL command
!	    line editing control keys, and emacs control keys.
!		Supports changes in the terminal settings via
!	    the DCL command set terminal.  Supported qualifiers
!	    for set terminal are: /WIDTH, /PAGE, /SCOPE.

! Labels
!	none.

! Constants
%include "$ssdef" %from %library "sys$library:basic$starlet.tlb"
%include "$jpidef" %from %library "sys$library:basic$starlet.tlb"
external long constant	cli$_normal, cli$_present, msg_usage,		&
			msg_iquit, msg_rip0, msg_rip1, msg_rip2,	&
			msg_rip3, msg_rip4, msg_rip5, msg_rip6,		&
			msg_rip7, msg_rip8, msg_rip9
declare byte constant	TRUE = -1, FALSE = 0

! Types
record fixed_len
    string		strng = 512
end record

! Variables
external long		downcld, errou
declare long		return_status
declare word		len_dir, imagenm_len, l_braket, dot,		&
			num_spaces1, num_spaces2
declare string		command_line, disk, imagenm, image_name
declare fixed_len	cur_dir

common (flags) byte	dir, prompt, help, log_qual

! Procedures
!	none.

! Functions
external word function	find_last by desc ( string, string )
external long function	cli$dcl_parse, cli$present, sys$setddir,	&
			lib$sys_trnlog, lib$getjpi

! Get image name for use in program messages to the user.

return_status = lib$getjpi(	jpi$_imagname by ref,,,,	&
				imagenm by desc,		&
				imagenm_len by ref )
call lib$signal( sys_status by value )	if (return_status and 1%) = 0% 
l_braket = find_last("]", imagenm)
imagenm = mid(imagenm, l_braket + 1%, imagenm_len - l_braket)
dot = instr(1%, imagenm, ".")
imagenm = mid(imagenm, 1%, dot - 1%)
imagenm_len = len(imagenm)

! Open standard I/O files so program can be manipulated from DCL.
open "sys$output" for output as file 2%

! Qualifier present booleans

dir = FALSE
prompt = FALSE
help = FALSE

! Get the invoking command line.

call lib$get_foreign( command_line by desc )
command_line = "down " + command_line

! Make sure that cli$dcl_parse has a routine to call if an error occurs.

call lib$establish( errou )
    return_status = cli$dcl_parse( command_line, downcld )
call lib$revert

if return_status = cli$_normal then
    ! If the parse want okay then check to see what was on the command line.
    if cli$present("directory") = cli$_present then dir = TRUE end if
    if cli$present("prompt") = cli$_present then prompt = TRUE end if
    if cli$present("log") = cli$_present then log_qual = TRUE end if
    if cli$present("help") = cli$_present then help = TRUE end if
    call cli$dispatch
else
    ! Trying to trick me aren't you...well, take this.
    if imagenm_len < 9% then
	num_spaces1 = (10% - imagenm_len) / 2%
	num_spaces2 = num_spaces1
	if mod(imagenm_len,2%) <> 0% then num_spaces2 = num_spaces2 + 1% end if
	image_name = space$(num_spaces1) + imagenm + space$(num_spaces2)
    else
	if imagenm_len = 9% then
	    image_name = " " + imagenm
	else
	    image_name = mid(imagenm, 1%, 10%)
	end if
    end if
    call lib$signal(msg_usage by value, 1% by value, imagenm by desc)
    call lib$signal(msg_iquit by value, 1% by value, imagenm by desc)
    call lib$signal(msg_rip0 by value)
    call lib$signal(msg_rip1 by value)
    call lib$signal(msg_rip2 by value)
    call lib$signal(msg_rip3 by value)
    call lib$signal(msg_rip4 by value, 1% by value, image_name by desc)
    call lib$signal(msg_rip5 by value, 1% by value, date$(0%) by desc)
    call lib$signal(msg_rip6 by value, 1% by value, time$(0%) by desc)
    call lib$signal(msg_rip7 by value)
    call lib$signal(msg_rip8 by value)
    call lib$signal(msg_rip9 by value)
end if

! Log the directory change if /LOG was on the command line.

if log_qual then
    disk = "SYS$DISK"
    return_status = lib$sys_trnlog(  disk by desc,, disk by desc,,, )
    if (return_status and 1%) = 0% then call lib$signal( return_status by value ) end if
    return_status = sys$setddir( 0% by value,		&
				 len_dir by ref,	&
				 cur_dir::strng by desc )
    if (return_status and 1%) = 0% then call lib$signal( return_status by value ) end if
    print #2%, disk;mid(cur_dir::strng, 0%, len_dir)
end if

! Close and exit with the latest status code returned to us.

close 2%
call sys$exit( return_status by value )

end program