! Explanations at end of file
$	SUB__STATUS = %x10000000			! Inhibit display (bit 28)
$	SUB__SUCCESS = SUB__STATUS + %x0001		! Severity 1 (success)
$	SUB__FATAL   = SUB__STATUS + %x0004
$	on warning   then exit SUB__STATUS .or. $STATUS
$	on control_y then exit SUB__FATAL		! Severity 4 (fatal error)
$	if f$type(SUB__STATUS) .eqs. "" then exit %x10000000
$!
$	if f$trnlnm("$COM") .eqs. ""
$	then
$		$COM = f$environment("PROCEDURE")
$		$COM = f$parse($COM,,,"DEVICE")+f$parse($COM,,,"DIRECTORY")
$		@'$COM'LIBINIT
$	endif
$!	if P1 .eqs. "" then exit SUB__SUCCESS
$	goto 'P1
$ VER_SYMBOL:
$	P3 = f$edit(P3,"TRIM,UPCASE")
$	if P4 .eqs. "" then P4 = 31
$	'P2 == f$fao(P3+" is limited !UL characters", f$integer(P4))
$	if f$length(P3) .gt. P4 then exit SUB__SUCCESS
$	V = "$0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_"+P5
$	'P2 == ""
$	I = -1
$ VS10:	I = I+1
$	if I .ge. f$length(P3) then exit SUB__SUCCESS
$	if f$locate(f$extract(I,1,P3),V) .lt. f$length(V) then goto VS10
$	'P2 == f$fao(P3+" contains the invalid character ""!AS""", f$extract(I,1,P3))
$	exit SUB__SUCCESS
$ LOOKUP_KEY:
$	'P2 == ""
$	if P3 .eqs. "" then exit SUB__SUCCESS
$	P3 = "," + f$edit(P3,"UPCASE")
$	P4 = "," + f$edit(P4,"UPCASE") + ","
$	P4_tail = f$extract(f$locate(P3,P4)+1,999,P4)
$	'P2 == f$element(0,",",P4_TAIL)
$	if P5 .eqs. "" .and. f$locate(P3,P4_TAIL) .ne. f$length(P4_TAIL) then 'P2 == ""
$	exit SUB__SUCCESS
$ ASK:
$	if P3 .eqs. "B" .and. P5 .nes. "" .and. f$type(P5) .eqs. "INTEGER" then P5 = f$element(P5,"/","NO/YES")
$	if P4 .eqs. "" then P4 = " "
$	if f$extract(f$length(P4)-1,1,P4) .nes. " " then P4 = P4+" "
$	if P5 .nes. "" then P4 = P4+"["+P5+"]"
$	if f$locate("S",P6) .ne. f$length(P6) then say ""
$	if f$locate("H",P6) .ne. f$length(P6) then @'P7
!
$ A10:	read LIB$ECHO /prompt="''P4'" INPUT /end_of_file=A_EOF
$	INPUT = f$edit(INPUT,"TRIM")
$	if INPUT .eqs. "" then INPUT = P5
$	if INPUT .eqs. ""
$	then
$		signal ASK W INPUTREQ "Please enter a value; there is no default"
$	else if INPUT .eqs. "?"
$	then
$		if P7 .nes. "" then @'P7
$		if P7 .eqs. "" then say "There is no help for this question"
$	else
$		goto A_'P3
$ A_B:		INPUT = f$edit(INPUT,"UPCASE")
$		if f$locate(INPUT,"YES") .eq. 0 .or. f$locate(INPUT,"NO") .eq. 0
$		then
$			INPUT = INPUT .and. 1
$			goto A19
$		endif
$		signal ASK W YESNOREQ "Please answer YES or NO"
$		goto A15
$ A_I:		if f$type(INPUT) .eqs. "INTEGER"
$		then
$			INPUT = f$integer(INPUT)
$			goto A19
$		endif
$		signal ASK W INTREQ "The input must be an integer"
$		goto A15
$ A_S:		if f$edit(INPUT,"UPCASE,TRIM,COLLAPSE") .eqs. "EXIT" .and. -
		   f$locate("Z",P6) .ne. f$length(P6) then goto A_EOF
$		if f$locate("U",P6) .ne. f$length(P6) then INPUT = f$edit(INPUT,"UPCASE")
$		if f$locate("T",P6) .ne. f$length(P6) then INPUT = f$edit(INPUT,"TRIM")
$		if f$locate("C",P6) .ne. f$length(P6) then INPUT = f$edit(INPUT,"COLLAPSE")
$		goto A19
$ A15:
$	endif
$	endif
$	goto A10
$ A_EOF:
$	INPUT = "^Z"
$	if f$locate("Z",P6) .ne. f$length(P6) then goto A19
$	signal ASK I INVCTRLZ "End-of-file is not a valid response"
$	goto A10
$ A19:	'P2 == INPUT
$	exit SUB__SUCCESS
$ SIGNAL:
$	if f$type(LIB__SIGNAL_QUIET) .eqs. "STRING"
$	then
$		if f$locate(P3,LIB__SIGNAL_QUIET) .nes. f$length(LIB__SIGNAL_QUIET) then goto S19
$	endif
$	if P5 .eqs. "" then goto S19
$	PREFIX = f$fao("%!AS-!AS-!AS, ",P2,P3,P4)
$	I = 4
$ S10:	I = I+1
$	if I .gt. 8 then goto S19
$	if P'I .eqs. "" then goto S19
$	TEXT = P'I
$	if f$type(TEXT) .eqs. "INTEGER" then TEXT = f$message(TEXT)
$	if f$extract(0,1,TEXT) .nes. "%" then TEXT = PREFIX+TEXT
$	if I .gt. 5 then TEXT[0,1] := "-"
$	say TEXT
$	goto S10
$ S19:
$	if P3 .eqs. "W" then P3 = "I"
$	I = f$locate(P3,"WSEIF")
$	if I .eq. 5 then I = 2
$	exit SUB__STATUS+I
$ SYMBOL_SET:
$	'P2 == 0
$	if f$type('P3) .eqs. "" then exit SUB__SUCCESS	! Doesn't exist
$	if 'P3 .eqs. P4	then exit SUB__SUCCESS		! Blank
$	'P2 == 1
$	exit SUB__SUCCESS
$ UNIQUE_NAME:
$	if f$type(UNIQ) .eqs. "" then UNIQ == 0
$	UNIQ == (UNIQ+1)-(UNIQ+1)/100*100
$	'P2 == f$fao("!AS!8AS!2ZL!AS", f$element(0,"?",P3),f$extract(12,11,f$time())-":"-":"-".", -
		UNIQ, f$element(1,"?",P3))
$	exit SUB__SUCCESS
$ KEY_NUMERIC:
$	if f$type(LIB__KEYNUM) .eqs. "" then LIB__KEYNUM == "nonumeric"
$	if LIB__KEYNUM .eqs. "nonumeric"
$	then
$		LIB__KEYNUM ==   "numeric"
$	else
$		LIB__KEYNUM == "nonumeric"
$	endif
$	say "set terminal/"+LIB__KEYNUM
$	set terminal/'LIB__KEYNUM
$	exit SUB__SUCCESS
$ KEY_CHANGE_EDT:
$	if P2 .eqs. ""
$	then
$		if edt .eqs. "edit/edt"
$		then
$			e*dt == "edit/tpu"
$		else
$			e*dt == "edit/edt"
$		endif
$	endif
$!	LIB__EDITOR == edt
$	say "  Default editor (edt): ",edt
$	say "  PF3 = ''edt' ''P2'"
$	define/key/nolog  PF3  "''edt' ''P2'" /terminate /echo
$	exit SUB__SUCCESS
$ KEY_CHANGE_WID:
$	if f$type(LIB__KEYWID) .eqs. "" then LIB__KEYWID == "80"
$	OLDKEY = LIB__KEYWID
$	if OLDKEY .eqs.  "80"
$	then
$		LIB__KEYWID == "132"
$		dir :== dir/column=6
$	else
$		LIB__KEYWID ==  "80"
$		dir :== dir/column=4
$	endif
$	set terminal/width='LIB__KEYWID
$	exit SUB__SUCCESS
!+
NAME:
	LIBSUB
INPUT:
	P1 : label of required action$	 P2,... : see description

VER_SYMBOL	***** Check the validity of a symbol string
	Check length and individual characters
	P2 : Global symbol to receive result
	P3 : String to be checked
	P4 : Optional maximum string length (def 31)
	P5 : Optional valid characters (def: standard letters, digits,
		dollar and underscore)
	Result: The null string if the string is OK. Otherwise a message
		fragment describing the error
LOOKUP_KEY	***** Look up a keyword in a list
	Looks up a keyword or its abbreviation in a list of valid keywords.
	P2 : Global symbol to receive the result
	P3 : The keyword or a (unique) abbreviation thereof
	P4 : A comma-separated list of valid keywords
	P5 : .nes. ""  : the full first matching keyword is returned in P2;
			 else the null string is returned
	     .eqs. ""  : the full first matching keyword is returned in P2,
			 if it's unique; else the null string is returned
ASK		***** Echo procedure
	P2 : global symbol receiving result
	P3 : Data type (B=boolean (Y/N),I=integer,S=string
	P4 : query string
	P5 : Default (optional)
	P6 : comma separated list of options (H = display help before
		prompting, S = skip line before prompting, U,T,C=Upcase,Trim,
		Collapse query,Z=allow CTRL-Z as answer)
	P7 : Help specifier (optional) in the form of a command procedure name
		(plus arguments; no @)
	Proper data type is returned: boolean (0/1), integer or string. "^Z"
		if CTRL-Z is entered.
SIGNAL		***** Signal informational or error message
	P2 : procedure name
	P3 : message severity (S,I,W,E,F)
	P4 : message identification
	P5 : message text
	P6 : additional message lines or status codes
UNIQUE_NAME	***** Generate unique file name
	P2 : Global symbol to receive result
	P3 : Pattern specifying the format of the name. It must contain a
		question mark (?)
	Result: the name consists of the pattern with the question mark
		replaced with a ten-digit number.
	The number is composed of eight digits of time and a two-digit counter
PROCEDURE:
	If the logical $COM does not exist the procedure LIBINIT is executed
MODIFICATION HISTORY:
	AUG/SEP-1991, Paul Hick (ARC)