sub set_prompt( string prompt )
!	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.

! Labels
!	none.

! Constants
%include "$ssdef"  %from %library "sys$library:basic$starlet.tlb"
%include "$libdef" %from %library "sys$library:basic$starlet.tlb"

! Types
record fixed_len
    string		strng = 512
end record

! Variables
declare long		return_status, prefix_status, suffix_status,	&
			upper_case_status
declare word		len_dir
declare string		command_line, prefix, suffix, upper_case,	&
			match, translate, quote, disk
declare fixed_len	cur_dir

common (flags) byte	fill1, fill2, fill3, log_qual

! Procedures
!	none.

! Functions
external long function	lib$get_symbol, sys$setddir, lib$sys_trnlog

! Initialize translation table for str$translate - used as a convert
! to lowercase function.
match     = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
translate = "abcdefghijklmnopqrstuvwxyz"

quote = chr$(34%)

! Check for the existance of these DCL symbols which can be used
! to customize the prompt.
prefix_status = lib$get_symbol( "prompt_prefix", prefix )
suffix_status = lib$get_symbol( "prompt_suffix", suffix )
upper_case_status = lib$get_symbol( "upper_case", upper_case )

if upper_case_status = ss$_normal then
    prompt = edit$(prompt, 32%)
else
    call str$translate( prompt, prompt, translate, match )
end if
if prefix_status  = ss$_normal then prompt = prefix + prompt end if
if suffix_status = ss$_normal then
    prompt = prompt + suffix
else
    if suffix_status = lib$_nosuchsym then
	prompt = prompt + "> "
    end if
end if

command_line = "set prompt=" + quote + mid(prompt, 0%, 32%) + quote

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

call lib$do_command( command_line )

subend