! 27 Mar 89
! Name:		q.cmd
! Purpose:	automatic file queueing for TERM
! Usage:	term -z q
!
! 3/8/89 v6.1
! 8/5/88 v6.0F

!
! Queuing directories:
!
switch
case opsys()=0		! VMS
	setvar qdir	"SYS\$SYSROOT:[TERM.QUEUE]"
case opsys()=1		! MSDOS
	setvar qdir	"/usr/term/queue/"
case opsys()=8		! BTOS
	setvar qdir	"[Sys]<Term>queue>"
case opsys()=9		! Mac
	setvar qdir	""
default			! UNIX-like systems
	setvar qdir	"/usr/term/queue/"	! queue dir
endswitch

setvar nodeext	".con"
setvar qext	".###"
setvar nodespec	"*"+nodeext

setvar maxnodes 22		! maximum displayable menu entries
dimstr nodes maxnodes		! array of nodenames

emulate vt100			! so we can use scroll regions

setvar black 0			! standard TERM colors
setvar blue 1
setvar green 2
setvar cyan 3
setvar red 4
setvar magenta 5
setvar brown 6
setvar yellow 14
setvar white 15

color default white,blue
!color reverse magenta,white
cls

proc addnode
	cls
	wclose 3
	wclose 2
	wclose 1
	wopen 3,0,10,3,60,white,magenta
	? "                  A D D    A    N O D E";
	wopen 2,17,10,7,60,white,magenta
	? "     \^E or F1 to save         ESCAPE to not save"
	? "     \^Y to clear a field      DELETE to delete left"
	? "     \^R to restore value      BACKSPACE to delete left"
	? "        Cursor keys select fields, Typing inserts"
	? "         SPACE for next option on rotate fields";
	wopen 1,3,10,14,60,white,magenta
	at clear
	at  0,2 "   Node name: " get synam len 8
	at  1,2 "   Node type: " get sntyp list "UNIX","Xenix","MSDOS","BTOS","VMS","Mac"
	at  2,2 "    Protocol: " get sxprot list "WTERMCRC","TERMCRC"
	at  4,2 "Phone number: " get sphon len 30 
	at  5,2 "   Baud rate: " get sbaud list "1200","600","300","19200","9600","4800","2400"
	at  6,2 "      Parity: " get spar list "NONE","EVEN","ODD","MARK","SPACE"
	at  7,2 "    Logon ID: " get sname len 16
	at  8,2 "    Password: " get spass len 16
	at  8,37 "(or blank if none)"
	at 10,2 "   Is the node variable baud? " get sauto list "NO","YES"
	at read
	setvar retv _retval
	wselect 3
	wclose 3
	wselect 2
	wclose 2
	wselect 1
	wclose 1
	cls
	if retv=1 | synam=''
		at  0,0 ""
		wait 1
		cls
		return
	endif
	setvar synm trim(synam)+nodeext
	if exists(qdir+synm)
		? "The configuration '$(synm)' exists... overwrite? (Y/N) ";
		repeat
			setvar rsp toupper(chrin())
		until rsp='Y' | rsp='N'
		? rsp
		if rsp='N'
			?
			? "Saving to system$(nodeext) instead..."
			? "Remember, rename it or lose it!"
			setvar synm "system$(nodeext)"
		endif
	endif
	?
	?
	? "Writing..."
	fcreate 1,qdir+synm
	setvar sname trim(sname)
	setvar spass trim(spass)
	setvar sphon trim(sphon)
	setvar sbaud trim(sbaud)
	setvar spar trim(spar)
	setvar sxprot trim(sxprot)
	setvar swdl "8"
	if spar != "NONE"
		setvar swdl "7"
	endif

	fwrite 1,'remark This configuration created by q.cmd for system type'
	fwriteln 1," of $(sntyp)"
	fwriteln 1,'baud $(sbaud)'
	fwriteln 1,'parity $(spar)'
	fwriteln 1,'wordlen $(swdl)'
	fwriteln 1,'stopbits 1'
	fwriteln 1,'mode FULL'
	fwriteln 1,'emulate VT100'
	fwriteln 1,'xprot $(sxprot)'
	fwriteln 1,'protocol ASCII'

	switch
	case sntyp="VMS"		! VMS
	case sntyp="MSDOS"		! MSDOS
	case sntyp="BTOS"		! BTOS
	case sntyp="Mac"		! Mac
	default				! Xenix and UNIX systems
	    if sauto="NO"
		! login string for fixed baud line
		fwrite 1,  'login "\^L03\^T05\^C\^X\^X\^X\^X\^X\\b\\b\\b\\b\\b\\b'
		fwrite 1,  '\^D\\r\^F\^Slogin:\^S\^W$(sname)\\r|\^SPassword:\^S'
		fwrite 1,  '\^W$(spass)\\r\^T10|\^S\\\$ \^S\^R00|\^S# \^S\^R0'
		fwriteln 1,'0|\^S% \^S\^R00|\^SNO CARRIER\\r\\n\^S\^R01"'
	    else
		! login string for autobaud line
		fwrite 1,  'login "\^L06\^T05\^B\^C\^X\^X\^X\^X\^X\\b\\b\\b\\b\\b\\b'
		fwrite 1,  '\^D\\r\^F\^Slogin:\^S\^W$(sname)\\r|\^SPassword:\^S'
		fwrite 1,  '\^W$(spass)\\r\^T10|\^S\\\$ \^S\^R00|\^S# \^S\^R0'
		fwriteln 1,'0|\^S% \^S\^R00|\^SNO CARRIER\\r\\n\^S\^R01"'
	    endif
		! logout string
		fwrite 1,  'logout "\^L03\^T05\^C\^X\^X\^X\^X\^X\\b\\b\\b\\b\\b\\'
		fwrite 1,  'b\\rexit\\r\^SNO CARRIER\\r\\n\^S\^R00|\^Slogin'
		fwriteln 1,':\^S\^R00"'
		! startserver string
		fwrite 1,  'startserver "\^L03\^T10\^C\^X\^X\^X\^X\^X\\b\\b\\b\\b'
		fwrite 1,  '\\b\\b\\rterm -x'
		if sxprot="WTERMCRC"
			fwrite 1, '1'		! "-x1" says WTERMCRC
		endif
		fwrite 1,  '\\r\^SOK\\r\\n\^S\^R00|\^Slog'
		fwriteln 1,'in:\^S\^R01|\^SNO CARRIER\\r\\n\^S\^R01"'
		! stopserver string
		fwrite 1,  'stopserver "\^L03\^T05\^C\^X\^X\^X\^X\^X\\r\^S\\\$'
		fwrite 1,  ' \^S\^R00|\^S# \^S\^R00|\^S% \^S\^R00|\^Slogin:'
		fwriteln 1,'\^S\^R00|\^SNO CARRIER\\r\\n\^S\^R00"'
	endswitch

	if sphon!=""
		fwriteln 1,"call $(sphon)"
	else
		fwriteln 1,"call NONE"
	endif
	fclose 1
endproc addnode



proc killnode
	menu 2 close
	menu 2 open "Delete",0,7,white,magenta
	setvar nonode TRUE
	setvar cnt 0
	for i in ($(qdir+nodespec)) do
		if cnt < maxnodes		! don't exceed display
			setvar j midstr(i,len(qdir)+1,80)
			setvar nodes[cnt] i
			menu 2 entry left(j,len(j)-len(nodeext))
			setvar nonode FALSE
		endif
		setvar cnt cnt+1
	endfor
	cls
	wclose 1
	if nonode
		wopen 1,0,28,7,50,white,red
		?
		? "     There are no nodes currently defined"
		?
		? "          ";
		pause
	else
		wopen 1,0,28,7,50,white,magenta
		?
		? " Use the cursor keys to highlight the node"
		? " Hit RETURN to delete the highlighted node"
		? " Hit ESCAPE to return without deleting"
		wselect 0
		setvar men2 menu(2,0)
		if men2!=0			! Not ESCAPE - do kill
*
* Check to see if files are pending & complain
*
*			if [files pending]
*				complain
*			else
				wclose 1
				wopen 1,0,28,5,50,white,red
				?
				? "     Delete this node - are you sure? (Y/N)";
				? " ";
				repeat
					setvar rsp toupper(chrin())
				until rsp='Y' | rsp='N'
				? rsp
				if rsp='Y'
					iferror erase $(nodes[men2-1])
						?
						? "     No priviledges to delete this node\007"
					else
						?
						? "           Node deleted"
					endif
				endif
*			endif
			wselect 0
			at 7,35 ""
			pause
		endif
	endif
	menu 2 close
	wclose 1
endproc killnode



proc listnode
	menu 2 close
	menu 2 open "List",0,7,white,magenta
	setvar nonode TRUE
	setvar cnt 0
	for i in ($(qdir+nodespec)) do
		if cnt < maxnodes		! don't exceed display
			setvar j midstr(i,len(qdir)+1,80)
			setvar nodes[cnt] i
			menu 2 entry left(j,len(j)-len(nodeext))
			setvar nonode FALSE
		endif
		setvar cnt cnt+1
	endfor
	cls
	wclose 1
	if nonode
		wopen 1,0,28,7,50,white,red
		?
		? "     There are no nodes currently defined"
		?
		? "          ";
		pause
	else
		wopen 1,0,28,6,50,white,magenta
		?
		? " Use the cursor keys to increase readability"
		? " Hit RETURN or ESCAPE to return to the menu"
		wselect 0
		setvar men2 menu(2,0)
	endif
	menu 2 close
	wclose 1
endproc listnode



proc queue
	cls
	wclose 3
	wclose 2
	wclose 1
	wopen 3,0,5,3,70,white,magenta
	? "                       Q U E U E    F I L E S";
	wopen 2,17,5,7,70,white,magenta
	? "          \^E or F1 to queue        ESCAPE to not queue"
	? "          \^Y to clear a field      DELETE to delete left"
	? "          \^R to restore value      BACKSPACE to delete left"
	? "             Cursor keys select fields, Typing inserts"
	? "              SPACE for next option on rotate fields";
	wopen 1,3,5,14,70,white,magenta
	at clear
	at  1,2 "    Node name: " get synam len 8
	at  3,2 "    Operation: " get sop list "SEND files to node","GET files from node"
	at  6,2 "List of files: " get slist len 50
	at  7,15 ": " get slist2 len 50
	at  9,2 " To Directory: " get sdir len 50
	at read
	setvar retv _retval
	wselect 3
	wclose 3
	wselect 2
	wclose 2
	wselect 1
	wclose 1
	if retv=1
		at  0,0 ""
		wait 1
		cls
		return
	endif
	setvar slist trim(slist)
	setvar slist2 trim(slist2)
	setvar sdir trim(sdir)
	setvar synm trim(synam)+nodeext
	if !exists(qdir+synm)
*
* Wants a window
*
		cls
		?
		? "    No such node... File(s) not queued"
		?
		? "    ";
		pause
		cls
		return
	endif
	if sdir="" | slist+sdir=""
*
* Wants a window
*
		cls
		?
		? "    Missing file(s) or directory... File(s) not queued"
		?
		? "    ";
		pause
		cls
		return
	endif
	setvar qent uniq(qdir+trim(synam)+qext)
	if qent=""
*
* Wants a window
*
		cls
		?
		? "    Unable to create queue entry... File(s) not queued"
		?
		? "    ";
		pause
		cls
		return
	endif
	iferror fopen 1,qent,'U'
*
* Wants a window
*
		cls
		?
		? "    Unable to open queue entry... File(s) not queued"
		?
		? "    ";
		pause
		cls
		return
	endif
	if left(sop,1)="S"		! send
		fwrite 1,"XFER "
	else				! get
		fwrite 1,"GET "
	endif
	if slist!=""
		fwrite 1,slist
	endif
	if slist!="" & slist2!=""		! both lines have files
		fwrite 1," "			! so space seperate
	endif
	if slist2!=""
		fwrite 1,slist2
	endif
	fwrite 1," "+sdir
	fclose 1
endproc queue

cls

menu 1 close	! etc
menu 1 open "",3,3,white,magenta

menu 1 entry "Add a node","Delete a node","List nodes","Queue files"
menu 1 entry "Quit"
setvar synam ''

repeat
	cls
	at 20,0
	at 21,0
	at 21,0 "Use cursor keys to move around"
	at 22,0
	at 22,0 "Use return key to choose an option"

	at 3,10 "           "
	at 4,10 "           "


	wclose 1
	wopen 1,0,3,3,17,white,magenta
	? "   Q u e u e";
	wselect 0

	setvar men1 menu(1,0)
	switch
	case men1=0			! <ESC> (invalid at top level)
		menu 1 off
	case men1=1			! Add a node
		menu 1 off
		wclose 1
		do @addnode
	case men1=2			! Delete a node
		menu 1 off
		wclose 1
		at 3,10 "Thinking..."
		at 4,10 "please wait"
		do @killnode
	case men1=3			! List nodes
		menu 1 off
		wclose 1
		at 3,10 "Thinking..."
		at 4,10 "please wait"
		do @listnode
	case men1=4			! Queue files for transfer
		menu 1 off
		wclose 1
		at 3,10 "Thinking..."
		at 4,10 "please wait"
		do @queue
	case men1=5			! Quit
	endswitch
until men1>4
wselect 0
at 23,0 ""
quit
