! Explanation at end of file
$	MNGR__QUIET    = %x10000000		! Inhibit display (bit 28)
$	MNGR__SUCCESS  = MNGR__QUIET + %x0001	! Severity 1 (success)
$	MNGR__FATAL    = MNGR__QUIET + %x0004	! Severity 4 (fatal error)
$	MNGR__CONTROLY = MNGR__FATAL
$	on warning   then exit MNGR__QUIET .or. $STATUS
$	on control_y then exit MNGR__CONTROLY
$	if f$type(MNGR__QUIET) .eqs. "" then exit %x10000000
!
!
! ==========	Symbol definitions
!
$	MNGR_CURDIR  = f$environment("DEFAULT")
$	MNGR_DEPTH   = f$environment("DEPTH")
$	MNGR_PROFULL = f$environment("PROCEDURE")
$	MNGR_PRONAME = f$parse(MNGR_PROFULL,,,"NAME")
!
!
! ==========	Initialize symbol/logicals
!
$	if f$trnlnm("$COM") .eqs. "" then -
$	    @'f$parse(MNGR_PROFULL,,,"DEVICE")''f$parse(MNGR_PROFULL,,,"DIRECTORY")'LIBINIT
!
!
! ==========	Read file P1 to get module names, one line descriptor and
!		(optional) type of input file name
!		Only the file name part of P1 is used. The directory is
!		supposed to be $AUX; the file type .PLAY
!
$	MKPL = 0
$	if P1 .nes. ""
$	then
$		if f$extract (0,1,P1) .eqs. "@" then MKPL = 1
$		P1 = P1-"@"
$		if P1 .nes. "" then P1 = f$parse(P1,,,"NAME")
$	endif
$	STRING = ""
$ GET_MNGR:
$	MENU_FILE = f$search("$AUX:"+P1+"*.PLAY")
$	if MENU_FILE .nes. ""
$	then
$		STRING = STRING+","+f$parse(MENU_FILE,,,"NAME")
$		if P1 .eqs. "" then goto GET_MNGR
$	endif
$!
$	if STRING .eqs. ""		! No matching menu file found
$	then
$		if .not. MKPL then signal MNGR E NOMNGR -
			"No matching .PLAY files found in ''f$trnlnm("$AUX")'"
$		STRING = P1		! Continue only if new menu file is to be created
$	else
$		STRING = STRING-","
$	endif
$	if P1 .eqs. ""
$	then
$!		set noon
$!		directory $AUX:*.PLAY
$!		set on
$		@$COM:LIBTOOL CHECKMOD LIB__ANS 'STRING "" "  Available PLAY menus:"
$		P1 = LIB__ANS
$	else
$		P1 = STRING
$	endif
!
! Structure of record for each line in menu
! _T_ refers to starting position of string (in byte)
! _S_ refers to length of string (in byte)
!
! ==========	Define structure of records in *.PLAY file
!
$	MNGR_T_MOD = 0		! Module
$	MNGR_S_MOD = 10
$	MNGR_T_SUB = 10		! Submodule (usually label)
$	MNGR_S_SUB = 10
$	MNGR_T_LAB = 20		! Descriptor string
$	MNGR_S_LAB = 60		! Total record lenght 100 bytes
!
$	MNGR_NAME = P1
$	MENU_FILE = "$AUX:"+MNGR_NAME+".PLAY"
$!
$	if MKPL then goto MKPLAY
$!
$	open/read/share=read MENU 'MENU_FILE /error=OPEN_ERROR
$	goto P2_TEST
$ OPEN_ERROR:
$	signal 'MNGR_PRONAME E OPENERR "Open error on list file ''MENU_FILE'"
$ P2_TEST:
$	if P2 .nes. ""
$	then
$		read MENU /index=0/key="''P2'" RECORD /error=P2_NOT_PRESENT
$		close MENU
$		STAY = 0
$		MODULE = f$edit(f$extract(MNGR_T_MOD,MNGR_S_MOD,RECORD),"TRIM,UPCASE,COMPRESS")
$		if f$extract(f$length(MODULE)-1,1,MODULE) .eqs. "&" then -
				MODULE = f$extract(0,f$length(MODULE)-1,MODULE)
$		_'MODULE = f$edit(f$extract(MNGR_T_LAB,MNGR_S_LAB,RECORD),"TRIM")
$		LABEL = MODULE
$		SUBMODULE = f$edit(f$extract(MNGR_T_SUB,MNGR_S_SUB,RECORD),"TRIM,UPCASE,COMPRESS")
$		if SUBMODULE .nes. "" then MODULE = SUBMODULE+" "+MODULE
$		goto P2_PRESENT
$ P2_NOT_PRESENT:
$		close MENU
$		signal 'MNGR_PRONAME E NOMODULE "Module ''P2' is not available"
$ P2_PRESENT:
$	endif
!
$	on warning   then goto EMPTY_MENU
$	on control_y then goto EMPTY_MENU
$	PLAY_STOP == 1
$	MNGR_MESSAGE = ""
$	read MENU /index=0/key="+" RECORD /error=READ_TRAILER
$	MNGR_MESSAGE = f$extract(MNGR_T_LAB,MNGR_S_LAB,RECORD)
$ READ_TRAILER:
$	MNGR_CLOSING = ""
$	read MENU /index=0/key="-" RECORD /error=READ_CLEANUP
$	MNGR_CLOSING = f$extract(MNGR_T_LAB,MNGR_S_LAB,RECORD)
$ READ_CLEANUP:
$	CLEANUP = 0
$	read MENU /index=0/key="CLEANUP" RECORD /error=READ_ERASER
$	CLEANUP = 1
$ READ_ERASER:
$	ERASER = 0
$	read MENU /index=0/key="ERASER" RECORD /error=READ_REST
$	ERASER = 1
$	_ERASER = f$edit(f$extract(MNGR_T_LAB,MNGR_S_LAB,RECORD),"TRIM")
$	ERASER_MODULE = f$extract(MNGR_T_SUB,MNGR_S_SUB,RECORD)
$	ERASER_MODULE = f$edit(ERASER_MODULE,"TRIM,UPCASE,COMPRESS")+" ERASER"
$ READ_REST:
$	if P2 .nes. "" then goto EXECUTE_MODULE
!
$	MNGR_CLOCK = 0
$	read MENU /index=0/key="*" RECORD /error=NO_CLOCK
$	MNGR_CLOCK = 1
!
$ NO_CLOCK:
$	MENU_DISPLAY = ""
$	LABEL = ""
$	I = -1
$	SKEY[0,10] := ""
$ STRIP_NEXT_RECORD:
$	if SKEY .eqs. "          "
$	then
$		read MENU /index=0/key="''SKEY'"/match=GE RECORD /error=EMPTY_MENU
$	else
$		read MENU RECORD /error=CONTINUE_MODULES
$	endif
$	SKEY = "XX"
!
$	MODULE = f$edit(f$extract(MNGR_T_MOD,MNGR_S_MOD,RECORD),"TRIM,UPCASE,COMPRESS")
$	FR = f$extract(0,1,MODULE)
$	if FR .eqs. "+" .or. FR .eqs. "-" .or. FR .eqs. "*" .or. FR .eqs. "!" -
		then goto STRIP_NEXT_RECORD
$	if MODULE .eqs. "CLEANUP" .or. MODULE .eqs. "ERASER" then goto STRIP_NEXT_RECORD
!
$	if f$extract(f$length(MODULE)-1,1,MODULE) .eqs. "&"
$	then
$		MODULE = f$extract(0,f$length(MODULE)-1,MODULE)
$		if LABEL .eqs. "" then LABEL = MODULE
$	endif
!
$	I = I+1
$	MENU_DISPLAY = MENU_DISPLAY+","+MODULE
$	_'MODULE = f$edit(f$extract(MNGR_T_LAB,MNGR_S_LAB,RECORD),"TRIM")
$	if _'MODULE .eqs. "" then _'MODULE = "No description available"
$	SUBMODULE = f$edit(f$extract(MNGR_T_SUB,MNGR_S_SUB,RECORD),"TRIM,UPCASE,COMPRESS")
$	if SUBMODULE .nes. "" then 'MODULE'$$ = SUBMODULE
$	goto STRIP_NEXT_RECORD
!
$ EMPTY_MENU:
$	close/nolog MENU
$	signal 'MNGR_PRONAME E READERR "Read error on menu file ''MENU_FILE'"
$ CONTINUE_MODULES:
$	close MENU
$	on warning   then exit MNGR__QUIET .or. $STATUS
$	on control_y then exit MNGR__CONTROLY
$	if MENU_DISPLAY .eqs. "" then signal 'MNGR_PRONAME E NOMODULES "No modules read from list file ''MENU_FILE'"
$	MENU_DISPLAY = MENU_DISPLAY-","
$!	STAY = 0
$!	if P2 .nes. "" then goto TRANSLATE_P2
!
!
! ==========	Loop to display available modules (in symbol MENU_DISPLAY)
!
$ DISPLAY_MODULES:
$!
$	STAY = 1
$	if MNGR_CLOCK .and. f$search("$EXE:CLOCK.EXE") .nes. "" then run $EXE:CLOCK
$	STRING = "  List of "+MNGR_NAME+" modules"
$	say f$fao("!/!70AS LEVEL !SL!/",STRING,MNGR_DEPTH)
$	if MNGR_MESSAGE .nes. "" then say f$fao("  !AS!/",MNGR_MESSAGE)
$	I = -1
$ DISPLAY_NEXT_MODULE:
$	I = I+1
$	MODULE = f$element(I,",",MENU_DISPLAY)
$	if MODULE .nes. ","
$	then
$		say f$fao("  !12AS !AS",MODULE,_'MODULE')
$		goto DISPLAY_NEXT_MODULE
$	endif
$	if LABEL .eqs. "" then LABEL = f$element(0,",",MENU_DISPLAY)
$	echo LIB__ANS S "  Run module (^Z=Exit) ?" 'LABEL U,Z,S
$	P2 = f$element(0," ",LIB__ANS)
$	if P2 .eqs. "^Z"
$	then
$		STATUS = MNGR__SUCCESS
$		STAY = 0
$		PLAY_STOP == 0
$		goto MNGR_CONTINUE
$	endif
$	P3 = f$element(1," ",LIB__ANS)
$	if P3 .eqs. " " then P3 = ""
$	P4 = f$element(2," ",LIB__ANS)
$	if P4 .eqs. " " then P4 = ""
$	P5 = f$element(3," ",LIB__ANS)
$	if P5 .eqs. " " then P5 = ""
$	P6 = f$element(3," ",LIB__ANS)
$	if P6 .eqs. " " then P6 = ""
$	P7 = f$element(3," ",LIB__ANS)
$	if P7 .eqs. " " then P7 = ""
$	P8 = f$element(3," ",LIB__ANS)
$	if P8 .eqs. " " then P8 = ""
$!
$!
$! ==========	The value of argument P2 determines which module is run
$!
$! TRANSLATE_P2:
$!
$	if f$extract(0,1,P2) .eqs. "$"
$	then
$		on warning   then goto MNGR_ERROR
$		on control_y then goto MNGR_ERROR
$		MODULE = "DCL"
$		P2 = f$extract(1,999,P2)
$		'P2
$		STATUS = MNGR__SUCCESS
$		goto MNGR_CONTINUE
$	endif
$!
$	@$COM:LIBSUB LOOKUP_KEY LIB__ANS 'P2 'MENU_DISPLAY FIRST_MATCH
$	if LIB__ANS .eqs. ""
$	then
$		if .not. STAY then signal 'MNGR_PRONAME E NOMODULE "Module ''P2' is not available"
$		signal 'MNGR_PRONAME W NOMODULE "Module ''P2' not available"
$		goto DISPLAY_MODULES
$	endif
$	LABEL = LIB__ANS
$	MODULE = LABEL
$	if f$type('LABEL'$$) .eqs. "STRING" then MODULE = 'LABEL'$$+" "+LABEL
$!
$ EXECUTE_MODULE:
$	say f$fao("!/  **********     Module   !AS!/",MODULE)
$	say   f$fao("               > !AS <!/",_'LABEL)
$	on warning   then goto MNGR_ERROR
$	on control_y then goto MNGR_ERROR
$!
$!
$! ==========	HELP facility
$!
$	if MODULE .eqs. "HELP"
$	then
$		define/user_mode SYS$INPUT LIB$ECHO
$		help/library=$LIB:'MNGR_NAME'.HLB/page/noinstruction/prompt
$		say f$fao("!/  **********     Exit module   !AS!/",MODULE)
$		STATUS = MNGR__SUCCESS
$		PLAY_STOP == 0
$		goto MNGR_CONTINUE
$	endif
$!
$!
$! ==========	Handle stand-alone modules
$!		The module must be located in a separate .COM or .EXE file
$!		If both are present the .COM file takes precedence
$!
$	PROG = f$element(0," ",MODULE)
$	RRRUN = ""
$	if f$search("$EXE:"+PROG+".EXE") .nes. "" then RRRUN = "$ $EXE:"
$	if f$search("$COM:"+PROG+".COM") .nes. "" then RRRUN = "@ $COM:"
$	if RRRUN .eqs. ""
$	then
$		if f$element(1," ",MODULE) .eqs. "ERASER" then goto MNGR_CONTINUE
$		signal 'MNGR_PRONAME W FILNOTFOUND "No .COM or .EXE file found matching ''PROG'"
$		echo LIB__ANS B "  Search .COM/.EXE archives (YES/NO)?" NO
$		if .not. LIB__ANS then signal 'MNGR_PRONAME E CANCEL "Canceled by user"
$		@$COM:libplay tlb get COM.ARC $COM:'PROG'.COM
$		if f$search("$COM:"+PROG+".COM") .nes. ""
$		then
$			RRRUN = "@ $COM:"
$		else
$			@ $COM:libplay tlb get EXE.ARC $EXE:'PROG'.EXE
$			if f$search("$EXE:"+PROG+".EXE") .nes. "" then RRUN = "$ $EXE:"
$		endif
$	endif
$!
$	if RRRUN .eqs. "$ $EXE:"
$	then
$		define/user_mode SYS$INPUT LIB$ECHO
$		RRRUN = RRRUN+MODULE+" ''P3' ''P4' ''P5' ''P6' ''P7' ''P8'"
$	else
$		Q = """
$		RRRUN = RRRUN+MODULE+" "+Q+"''P3'"+Q+" ''P4' ''P5' ''P6' ''P7' ''P8'"
$	endif
$	RRRUN = f$edit(RRRUN,"TRIM")
$!	P2 = ""				! Temporary kludge for LIBARG
$	RRRUN
$!
$	STATUS = MNGR__SUCCESS
$	say f$fao("!/  **********     Exit module   !AS!/",MODULE)
$	goto MNGR_CONTINUE
$!
$ MNGR_ERROR:
$	STATUS = $STATUS
$	say f$fao("!/  **********     Exit module   !AS (error/control-Y)!/",MODULE)
$	goto MNGR_CONTINUE
$!
$ MNGR_CONTINUE:
$	on warning   then exit MNGR__QUIET .or. $STATUS
$	on control_y then exit MNGR__CONTROLY
$	if .not. STATUS .and. f$mode() .nes. "INTERACTIVE" then STAY = 0
$	if STAY
$	then
$		if MNGR_CLOCK .and. PLAY_STOP then echo LIB__ANS S "<hit any key to continue>" ^Z Z
$		PLAY_STOP == 1
$		goto DISPLAY_MODULES
$	endif
$	if ERASER				! Special clean-up
$	then
$		LABEL = "ERASER"
$		MODULE = ERASER_MODULE
$		ERASER = 0
$		goto EXECUTE_MODULE
$	endif
$	if CLEANUP				! Generic cleanup
$	then
$		say f$fao("!/  **********   > !AS <!/","MNGR clean-up")
$		if MNGR_CURDIR .nes. f$environment("DEFAULT") then cd 'MNGR_CURDIR
$		@$COM:LIBSUB SYMBOL_SET LIB__ANS LIB__MF_TAPEUNIT
$		if LIB__ANS then @$COM:DEV TAPMOUNT DISMOUNT
$!		@$COM:LIBSUB SYMBOL_SET LIB__ANS LIB__OD_UNIT
$!		if LIB__ANS then @$COM:DEV ODMOUNT DISMOUNT
$	endif
$	if f$environment("depth") .eqs. 1 then delete/symbol/global/nolog PLAY_STOP
$	if MNGR_CLOSING .nes. "" then say f$fao("!/  **********     !AS",MNGR_CLOSING)
$	exit MNGR__QUIET .or. STATUS
!
$ MKPLAY:
$	say "  Menu file: ", MENU_FILE
$!
$	STRING = "ADD,CREATE,LIST,UPDATE,DELETE"
$	@$COM:LIBTOOL CHECKMOD LIB__ANS 'STRING "''P2'" "  Available EDIT options:"
$	P2 = LIB__ANS
!
$	if P2 .eqs. "CREATE" .and. f$search(MENU_FILE) .nes. "" then -
$		signal 'P2 E EXISTS "Menu file ''MENU_FILE' exists already"
$	PSAVE = P2
$	if P2 .nes. "CREATE" .and. f$search(MENU_FILE) .eqs. ""
$	then
$		say "  File ''MENU_FILE' does not exist"
$		echo LIB__ANS B "  Create new menu file (YES/NO) ?" NO S
$		if .not. LIB__ANS then signal MODMNGR E CANCEL "Canceled by user"
$		P2 = "CREATE"
$	endif
!
$	if P2 .eqs. "CREATE" then call MNGR$CREATE_PLAY_FDL
!
$	if PSAVE .eqs. "CREATE" then exit MNGR__SUCCESS
$	MENU_FILE = f$search(MENU_FILE)
$	P2 = PSAVE
!
$	gosub MNGR$LIST			! Display menu file content
$	if P2 .eqs. "LIST" then exit MNGR__SUCCESS
!
$	unprot 'MENU_FILE
$	open/read/write/share=read MENU 'MENU_FILE /error=OPEN_ERROR
$	on warning   then goto GEN_ERROR
$	on control_y then goto GEN_ERROR
!
$	goto MNGR$'P2'
!
$ MNGR$ADD:
$	if .not. $STATUS then signal 'P2 W WRITEERROR -
		 "Write error on ''MENU_FILE'. Entry ignored" '$STATUS
$	if P3 .eqs. ""
$	then
$		echo LIB__ANS S "Name    (^Z=Exit)   _?" ^Z Z,S,U,C
$	else
$		LIB__ANS == f$edit(P3,"UPCASE,COLLAPSE")
$		P3 = "^Z"
$	endif
$	if LIB__ANS .eqs. "^Z" then goto CLOSE_AND_EXIT
!
$	MODULE = f$edit(LIB__ANS,"UPCASE,COLLAPSE")
$	if P4 .eqs. ""
$	then
$		echo LIB__ANS S "Program (^Z=None)   _?" ^Z Z,U,C
$		SUBMODULE = LIB__ANS
$		if SUBMODULE .eqs. "^Z" then SUBMODULE = ""
$	else
$		SUBMODULE = f$edit(P4,"UPCASE,COLLAPSE")
$	endif
$	if P5 .eqs. ""
$	then
$		echo LIB__ANS S "Title   (^Z=None)   _?" ^Z Z
$		LABEL = LIB__ANS
$	else
$		LABEL = P5
$	endif
$	say "  Adding record:"
$	say f$fao("!80*-")
$	say f$fao("!''MNGR_S_MOD'AS!''MNGR_S_SUB'AS!''MNGR_S_LAB'AS",MODULE,SUBMODULE,LABEL)
$	say f$fao("!80*-")
$	echo LIB__ANS B "		OK (YES/NO) ?" YES
$	if LIB__ANS
$	then
$		RECORD[MNGR_T_LAB,MNGR_S_LAB] := "''LABEL'"
$		RECORD[MNGR_T_MOD,MNGR_S_MOD] := "''MODULE'"
$		RECORD[MNGR_T_SUB,MNGR_S_SUB] := "''SUBMODULE'"
$		write/symbol/error=MNGR$ADD MENU RECORD
$	endif
$	if P3 .eqs. "" then goto MNGR$ADD
$	goto CLOSE_AND_EXIT
!
$ MNGR$UPDATE:
$	if .not. $STATUS then signal 'P2 W ERROR -
		"Procedure ''LIB__ANS': not found or error updating entry" '$STATUS
$	if P3 .eqs. ""
$	then
$		echo LIB__ANS S "  Update name (^Z=Exit) ?" ^Z Z,S,U,C
$	else
$		LIB__ANS == f$edit(P3,"UPCASE,COLLAPSE")
$		P3 = "^Z"		! Ensure exit on next loop
$	endif
$	if LIB__ANS .eqs. "^Z" then goto CLOSE_AND_EXIT
!
$	SKEY[0,10] := "''LIB__ANS'"
$	read/lock MENU /index=0/key="''SKEY'"/match=eq RECORD /error=MNGR$UPDATE
$	LABEL   = f$extract(MNGR_T_LAB,MNGR_S_LAB,RECORD)
$	MODULE  = f$extract(MNGR_T_MOD,MNGR_S_MOD,RECORD)
$	SUBMODULE = f$extract(MNGR_T_SUB,MNGR_S_SUB,RECORD)
$	say "  Updating record:"
$	say f$fao("!80*-")
$	say f$fao("!''MNGR_S_MOD'AS!''MNGR_S_SUB'AS!''MNGR_S_LAB'AS",MODULE,SUBMODULE,LABEL)
$	say f$fao("!80*-")
$	if P4 .eqs. ""
$	then
$		echo LIB__ANS S "  New program (^Z=Same) _?" ^Z Z,U,C
$		if LIB__ANS .nes. "^Z" then SUBMODULE = LIB__ANS
$	else
$		SUBMODULE = f$edit(P4,"UPCASE,COLLAPSE")
$	endif
$	if P5 .eqs. ""
$	then
$		echo LIB__ANS S "  New title   (^Z=Same) _?" ^Z Z
$		if LIB__ANS .nes. "^Z" then LABEL = LIB__ANS
$	else
$		LABEL = P5
$	endif
$	say "  Updated record:"
$	say f$fao("!80*-")
$	say f$fao("!''MNGR_S_MOD'AS!''MNGR_S_SUB'AS!''MNGR_S_LAB'AS",MODULE,SUBMODULE,LABEL)
$	say f$fao("!80*-")
$	echo LIB__ANS B "		OK (YES/NO) ?" YES S
$	if LIB__ANS
$	then
$		RECORD[MNGR_T_LAB,MNGR_S_LAB] := "''LABEL'"
$		RECORD[MNGR_T_SUB,MNGR_S_SUB] := "''SUBMODULE'"
$		write/symbol/update/error=MNGR$UPDATE MENU RECORD
$	endif
$	goto MNGR$UPDATE
!
$ MNGR$DELETE:
$	if .not. $STATUS then signal 'P2 W ERROR -
		"Procedure ''LIB__ANS': not found or error deleting entry" '$STATUS
$	if P3 .eqs. ""
$	then
$		echo LIB__ANS S "  Delete name ?" ^Z Z,S,U,C
$	else
$		LIB__ANS == f$edit(P3,"UPCASE,COLLAPSE")
$		P3 = "^Z"
$	endif
$	if LIB__ANS .eqs. "^Z" then goto CLOSE_AND_EXIT
!
$	SKEY[0,10] := "''LIB__ANS'"
$	read/lock MENU /index=0/key="''SKEY'"/match=eq RECORD /error=MNGR$UPDATE
$	LABEL   = f$extract(MNGR_T_LAB,MNGR_S_LAB,RECORD)
$	MODULE  = f$extract(MNGR_T_MOD,MNGR_S_MOD,RECORD)
$	SUBMODULE = f$extract(MNGR_T_SUB,MNGR_S_SUB,RECORD)
$	say "  Deleting record:"
$	say f$fao("!80*-")
$	say f$fao("!''MNGR_S_MOD'AS!''MNGR_S_SUB'AS!''MNGR_S_LAB'AS",MODULE,SUBMODULE,LABEL)
$	say f$fao("!80*-")
$	echo LIB__ANS B "		OK (YES/NO) ?" YES S
$	if LIB__ANS
$	then
$		read/delete MENU /index=0/key="''SKEY'"/match=eq RECORD /error=MNGR$DELETE
$	endif
$	goto MNGR$DELETE
!
$ MNGR$LIST:
$	open/read/share=read MENU 'MENU_FILE /error=OPEN_ERROR
$	SKEY[0,10] := ""
$	read MENU /index=0/key="''SKEY'"/match=ge RECORD /error=EOF0
$	on warning   then goto GEN_ERROR
$	on control_y then goto GEN_ERROR
$	say f$fao("!80*-")
$	say f$fao("!''MNGR_S_MOD'AS!''MNGR_S_SUB'AS!''MNGR_S_LAB'AS", -
			"NAME","PROGRAM","TITLE")
$	say f$fao("!80*-")
$ NEXT_LIST:
$	LABEL   = f$extract(MNGR_T_LAB,MNGR_S_LAB,RECORD)
$	MODULE  = f$extract(MNGR_T_MOD,MNGR_S_MOD,RECORD)
$	SUBMODULE = f$extract(MNGR_T_SUB,MNGR_S_SUB,RECORD)
$	say f$fao("!''MNGR_S_MOD'AS!''MNGR_S_SUB'AS!''MNGR_S_LAB'AS",MODULE,SUBMODULE,LABEL)
$	read/error=EOF MENU RECORD
$	goto NEXT_LIST
$ EOF0:
$	signal 'P2 I EMPTY "Menu file ''MENU_FILE' is empty"
$ EOF:
$	say f$fao("!80*-")
$	close MENU
$	return
!
$ OPEN_ERROR:
$	STATUS = $STATUS
$	signal 'P2 W OPENERROR "Open error on ''MENU_FILE'" 'STATUS
$	prot 'MENU_FILE
$	exit MNGR__QUIET .or. STATUS
$ GEN_ERROR:
$	STATUS = $STATUS
$	set noon
$	close/nolog MENU
$	prot 'MENU_FILE
$	signal 'P2 W GENERROR "Error in module ''P2'" 'STATUS
$	set on
$	exit MNGR__QUIET .or. STATUS
$ CLOSE_AND_EXIT:
$	close/nolog MENU
$	prot 'MENU_FILE
$	signal 'P2 I CLOSE "Menu file ''MENU_FILE' closed"
$	exit MNGR__SUCCESS
!
$ MNGR$CREATE_PLAY_FDL:
$	subroutine
$	on warning	then goto FDL_ERROR
$	on control_y	then goto FDL_ERROR
!
$	create SYS$SCRATCH:PLAY.FDL
TITLE	"LIBPLAY MENU FILE DEFINITION"

IDENT	" 6-AUG-1992 21:05:08   VAX-11 FDL Editor"

SYSTEM
	SOURCE			"VAX/VMS"

FILE
	NAME			"PLAY.FDL"
	ORGANIZATION		indexed

RECORD
	CARRIAGE_CONTROL	carriage_return
	FORMAT			fixed
	SIZE			80

AREA 0
	ALLOCATION		3
	BEST_TRY_CONTIGUOUS	yes
	BUCKET_SIZE		3
	EXTENSION		3

AREA 1
	ALLOCATION		0
	BEST_TRY_CONTIGUOUS	yes
	BUCKET_SIZE		3
	EXTENSION		3

KEY 0
	CHANGES			no
	DATA_AREA		0
	DATA_FILL		100
	DATA_KEY_COMPRESSION	yes
	DATA_RECORD_COMPRESSION	yes
	DUPLICATES		no
	INDEX_AREA		1
	INDEX_COMPRESSION	yes
	INDEX_FILL		100
	LEVEL1_INDEX_AREA	1
	NAME			"Name"
	PROLOG			3
	SEG0_LENGTH		10
	SEG0_POSITION		0
	TYPE			string
$
$	create/log/fdl=SYS$SCRATCH:PLAY.FDL 'MENU_FILE
$	delete SYS$SCRATCH:PLAY.FDL;
$	exit MNGR__SUCCESS
!
$ FDL_ERROR:
$	STATUS = $STATUS
$	if f$search("SYS$SCRATCH:PLAY.FDL") then delete SYS$SCRATCH:PLAY.FDL;*
$	if f$search(MENU_FILE) then delete 'MENU_FILE;*
$	exit MNGR__QUIET .or. STATUS
$	endsubroutine
!+
NAME:
	LIBPLAY
PURPOSE:
>	Manager for running DCL procedures and EXE executables from a menu
>MKPLAY:
	Create and modify menu files for the LIBPLAY utility
INPUTS: (prompts follow for omitted arguments)
	P1	Name of the menu file with list of procedures/executables
	P2	One of the labels as it would appear on the menu
		(see procedure).
>MKPLAY: (to modify menu files)
	P1	"@"[menu file]
	P2	Modify option
RESTRICTIONS:
>	The LIBSUB.COM file containing the signal and echo procedures should be
	present in the directory indicated by the logical $COM.
	All DCL procedures to be executed should also be located in $COM.
	All executables should be located in $EXE.
	The menu file containing the information for building the module
	should be located in $AUX.
	If a HELP module is included the .HLB file should be located in $LIB.
>MKPLAY:
	The values in index 0 (the module name) cannot be modified
PROCEDURES:
>	The menu file P1 is an indexed file with the following record structure:
	Byte [0,9]	index 0; module name. This will usually be the DCL/EXE
			program name, or the value of an argument passed into
			the command procedure or executable (e.g. the name
			of a statement label in a DCL procedure).
			The module name will be displayed in the menu.
	Byte [10,19]	program name; if the module name is an argument for a 
			command procedure or executable, the program name
			should be given here. If the module name is the same
			as the program name, leave this entry blank.
	Byte [20,79]	Title; one line description of the task performed
>	The module name (index 0) can take several special values:
      - Module names: !,+,-,*
	 ! are ignored (intended for comments);
	 + : the title is interpreted as a message displayed above the menu;
	 - : the title is interpreted as a message displayed before final exit
	 * : will (hopefully) result in clearing the page using CLOCK.EXE
      -	Adding & to the module name:
	at startup the module presented as default is the first one in 
	alphabetical order. If this is no adequate, then a specific module
	can be selected as the startup default by adding the character & to the
	module name.
>	The module name can be input for the program given in the 'program name'
	entry. If the program is a command procedure, the module name is 
	interpreted as a P1 value. If the program is a FORTRAN executable
	the argument can be pulled into the program using the system function
	LIB$GET_FOREIGN
>	The menu as it appears on the screen will contain one line for each
	procedure. Each line consist of the module name and the title string.
>	The display of the menu can be circumvented by supplying the module
	name explicitly as P2 argument in a call to LIBPLAY from the DCL 
	prompt, i.e. @$COM:LIBPLAY <menu file> <module name>.
	The corresponding action is performed and LIBPLAY exits again.
	(NOTE: the indexed menus file were introduced to speed up this form of
	calling LIBPLAY).
>	If the menu file contains CLEANUP as "module name", a generic clean-up
	is performed before final exit. The generic CLEANUP consist of an
	automatic dismount and return to the original working directory.
>	If the menu file contains the module ERASER, the module name is 
	combined with the program name and is executed as a special clean-up on
	exit.
>	CLEANUP and ERASER do not appear on the menu.
>	If module HELP is present, the VAX HELP can be used provided the HELP
	file $LIB:'P1'.HLB exists.
>	When execution of a program ends, and control returns to LIBPLAY then
     - if the clock option is not used, the menu is displayed again
     - if the clock option is used the message "<hit any key to continue>" is
	issued. This message can be skipped (and the menu displayed) if the
	global symbol PLAY_STOP is set to zero in the executed program just
	before exit.
>MKPLAY:
	The following actions are available:
	ADD		Add entries to menu file
	CREATE		Create new menu file
	LIST		List content of menu file
	UPDATE		Update entry in menu file
	DELETE		Delete entry from menu file
MODIFICATION HISTORY:
	SEP-1991, Paul Hick (ARC)
	NOV-1991, Paul Hick (UCSD), introduced MENU_DISPLAY symbol to speed
		up display of menu (still contains a loop. Tried using a single
		f$fao call to do the job, but that doesn't work if the menu
		contains as many as 8-10 items)
	AUG-1992, Paul Hick (UCSD); the menu file is now assumed to be an
		indexed file rather than a sequential ASCII file. The old 
		version is still available under the name LIBMNGR.COM
		The MKPLAY section allows creation and modification of the
		indexed .PLAY files.
	APR-1994, Paul Hick (UCSD); added the option to define the default
		module at startup (by adding "&" to the module name (index 0;
		see PROCEDURE)
!-