program prompt_set
	implicit integer (a-z)
!
!	This program works with the DCLPROMPT modified CLI to set the current
!	prompt srting, or the reprompt (continuation) string. Each are passed
!	by reference to the executive mode storing routine as Ascic strings.
!	Each can have a maximum length of 80 bytes. A passed length of -1
!	indicates no string.
!	
!	Written by J.D. Callas 14-MAR-1983
!

	character cha
	real*8 prompt, reprompt			      !These are going to be
						      !string descriptors
	byte b_prompt(81), b_reprompt(81)

	code = lib$sget1_dd(0,prompt)
	if(.not. code)call lib$signal(%val(code))

	code = lib$sget1_dd(0,reprompt)
	if(.not. code)then
	    call lib$sfree1_dd(prompt)
	    call lib$signal(%val(code))
	endif

	if( cli$present('Prompt') )then
	    code = cli$get_value('Prompt',prompt)
	    p_len = min( lib$len(prompt), 80)
	    b_prompt(1) = p_len
	    do i = 1,p_len
		code = str$len_extr(cha,prompt,i,1)
		b_prompt(1+i) = ichar(cha)
	    enddo
	else
	    b_prompt(1) = -1
	endif

	if( cli$present('Reprompt') )then
	    code = cli$get_value('Reprompt',reprompt)
	    r_len = min( lib$len(reprompt), 80)
	    b_reprompt(1) = r_len
	    do i = 1,r_len
		code = str$len_extr(cha,reprompt,i,1)
		b_reprompt(1+i) = ichar(cha)
	    enddo
	else
	    b_reprompt(1) = -1
	endif
	
	code = lib$sfree1_dd(prompt)
	code = lib$sfree1_dd(reprompt)
	code = set_prompt(b_prompt,b_reprompt)
	if(.not.code)call exit(code)
	end