C COMMAND-LINE MUNGER FOR PORTACALC
C COPYRIGHT (C) 1983 GLENN EVERHART
c all rights reserved
C SUBROUTINE CMDMUN(LINE)
C   MUNGES UP COMMAND LINES PASSED IN ARGUMENT TO ALLOW
C  SPECIAL KEYS TO BE RECOGNIZED.
C  DEFAULT VERSION JUST RETURNS
C THIS VERSION (FOR VAX) ASSUMES ESCAPE SEQUENCES ARESENT TO
C THE PROGRAM AND HANDLES ANSI ARROW KEYS AND PF2 KEY.
C NOTE: A FEW LITTLE EXTRAS CAN BE TRIED.
C IF THE COMMAND BEGINS WITH CHARACTER % WE WILL PARSE IT AS
C FOLLOWS:
C  1. UP TO NEXT % SIGN, THE CHARACTERS WILL BE ECHOED TO TERMINAL
C	UNALTERED (USE FOR SENDING OUT ESCAPE SEQUENCES, E.G. TO
C	CHANGE WIDTH OF TERMINAL)
C  2. COMMAND UP TO NEXT % SIGN WILL BE TAKEN AS A LITERAL TO LEAVE
C       INSIDE COMMAND LINE PASSED BACK
C  3. IF ? APPEARS AFTERWARDS, TERMINAL WILL BE READ AND RESULTING
C       TEXT APPENDED TO 2ND GROUP WHEN PASSED BACK. IF RESULTING
C	READ-IN TEXT BEGINS WITH A \ CHARACTER OR ANY CONTROL CHARACTER
C	(E.G. ESCAPE) THE COMMAND TERMINATES; OTHERWISE, IF READ-IN
C	OCCURRED, THE INPUT COMMAND FILE (IF ONE EXISTS) WILL BE
C	REWOUND. NOTE THIS REWIND OPERATION OCCURS ONLY IF THE ? WAS
C	SEEN.
C 	ALSO IF A \ REPLACES THE ?, NO REWIND OCCURS.
C	IF A & IS SEEN, CLOSE FILE IMMEDIATELY PRIOR TO EXIT TO
C GET OUT OF THE WAY FOR W OR PPN/GP COMMANDS.
	SUBROUTINE CMDMUN(LINE)
	LOGICAL*1 LINE(120),LC,LINBUF(120)
	INTEGER*2 IOLVL,IGOLD
	COMMON/IOLVL/IOLVL,IGOLD
D	ITERT=0
D6501	CONTINUE
D	ITERT=ITERT+1
D	IF(ITERT.GT.10)RETURN
C ITERT ALLOWS REPROCESS OF COMMANDS FROM FILES FOR MACROS
C DEPTH OF UP TO 10 PASSES...
C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
	LI=1
C ALLOW ARROWS OR OTHER SIMILAR KEYS TO BE RECOGNIZED
	LL=LINE(LI)
	IF(LL.EQ.33.OR.LL.EQ.27)GOTO 1000
	IF(LINE(1).EQ.37)GOTO 7000
	IF(LINE(1).EQ.'^')IGOLD=IGOLD+1
	IF(LINE(1).EQ.'^')GOTO 7223
C IF WE SEE [, COULB BE THAT ESC GOT EATEN BY VMS...
	IF(LINE(LI).EQ.'[')GOTO 1000
C CONVERT LOWER TO UPPER CASE
	NMX=120
	DO 41 N=1,120
C CHECK FOR DOUBLE QUOTE (34 DECIMAL). LEAVE L.C. IF SO
	NNN=LINE(N)
	IF(NNN.EQ.34)NMX=2
C IF WE SEE " CHARACTER THEN ONLY CONVERT 1ST 2 CHARACTERS TO U.C.
41	CONTINUE
	JFED=0
	DO 1 N=1,NMX
	LL=LINE(N)
	IF(LL.GT.96.AND.LL.LT.123)LL=LL-32
	LINE(N)=LL
C IF WE SEE A __ (2 SUCCESSIVE UNDERSCORES) IN THE TEXT, CALL
C FRMEDT TO EDIT ANY {V1 FORMS WE SEE INTO THE TEXT IN THE
C FORMULAS POINTED TO. USEFUL FOR MACROS.
	IF(LINE(N).EQ.'_'.AND.LINE(N+1).EQ.'_')JFED=N
1	CONTINUE
	IF(JFED.EQ.0)GOTO 520
C MOVE TEXT DOWN OVER THE __ CHARACTERS
	DO 521 N=JFED,120
	LINE(N)=LINE(N+2)
521	CONTINUE
	LINE(119)=0
	LINE(120)=0
	KK=110
	CALL FRMEDT(LINE,KK)
520	CONTINUE
C	IF(LINE(1).NE.'M')RETURN
	IF(LINE(1).NE.'M')GOTO 2000
	LI=2
	GOTO 1000
1000	CONTINUE
C HANDLE ESCAPE SEQUENCES
C ENCODE VT100 SEQUENCES HERE. MUST MODIFY FOR OTHERS.
C IF VMS PASSES 2 ESCS, PASS 1ST, TEST SECOND.
	LL=LINE(LI+1)
	IF(LL.EQ.27.or.ll.eq.33)LI=LI+1
	LC=LINE(LI+1)
	IF(LC.EQ.'['.OR.LC.EQ.'O'.OR.LC.EQ.'?')LC=LINE(LI+2)
	IF(LC.NE.'Q')GOTO 10
C MAKE PF2 MEAN HELP, JUST LIKE EDT
	LINE(LI)=72
C 72 = ASCII FOR 'H'
C ALLOW IGOLD>0 TO MEAN SCREEN HELPS STARTING AT 9.
	IGG=IGOLD+8
	IF(IGOLD.LE.0)GOTO 844
	LINE(LI+1)=48+(IGG/10)
	LINE(LI+2)=48+(MOD(IGG,10))
844	CONTINUE
C	RETURN
C HELP ERASES SCREEN SO MAKE IT RESET GOLD LEVEL TOO.
	GOTO 2000
10	CONTINUE
C HANDLE AUX KEYPAD KEYS AS INDIRECTS (FOR NOW)
C MAP ENTER KEY INTO AUX KEYPAD RANGE
C AUX KEYPAD ESC SEQS ARE <ESC>[O<LETTER>
C WHERE <LETTER> IS A GIVEN.
C  FOR VT200, THERE ARE CODES OF FORM <ESC>[NN~
C WHICH NEED TO GET DECODED TOO. ENCODE AS KYA.CMD THRU
C KY?.CMD.
C IF WE HAD $[NN~ FORM THEN LC IS LINE(LI+1)
	LCC=LINE(LI+3)
	LL=LC
	LL=LL-48
	IF(LL.LT.0.OR.LL.GT.9)GOTO 1630
	IF(LINE(LI+3).EQ.'~')GOTO 1632
	LLL=LCC-48
	IF(LLL.LT.0.OR.LLL.GT.9)GOTO 1630
	LL=LL*10+LLL
1632	CONTINUE
C LL IS NOW CODE TO ADD.
	IF(LL.LE.0)GOTO 1630
	IF(LL.GT.15)LL=LL+4
C ADJUST SO KYP, KYQ, KYR, AND KYS REMAIN AS BEFORE
C AND JUST SHOVE ALL ELSE UP.
C NOTE: GET KZ<LETT>.CMD IF CODE > 26
	LC=LL+64
C GO MAKE A 'KY<LETTER>.CMD' OUT OF CODE.
C IF CODE IS OUT OF RANGE, FORGET IT.
	GOTO 2100
1630	CONTINUE
	IF(LC.EQ.'M')LC='o'
	IF(LC.GE.'l'.AND.LC.LE.'y')GOTO 2650
	IF(LC.GE.'P'.AND.LC.LE.'S')GOTO 2100
C HANDLE INDIRECT CALLS AT 2100 FOR PF1 THRU PF4 IF AANY
	LL=LC
	LL=LL-65
C SUBTRACT ASCII A
	IF (LL.LT.0.OR.LL.GT.3)GOTO 2000
	LK=LL
	IF(LL.EQ.3)LK=2
	IF(LL.EQ.2)LK=3
	LK=LK+49
C ADJUST FOR ASCII VALUE
	LINE(LI)=LK
C STASH NEW CELL IN.
	RETURN
C CURSOR MOTION WILL NOT RESET GOLD LEVEL... CAN'T ERASE SCREEN
C INDICATOR.
C	GOTO 2000
2650	CONTINUE
	LL=LC
	LL=LL-'l'+'A'
C MAPPING IS:
C  KEY	CHAR	AKx.CMD  x=
C  0	p	E
c  1    q	F
C  2	r	G
c  3	s	H
c  4    t       I
c  5	u	J
c  6	v	K
c  7	w	L
c  8	x	M
c  9	y	N
c  ,	l	A
c  -	m	B
c  .	n	C
c ENTER o	D
	LC=LL
	LINE(1)=64
C 64 IS ASCII @ CHARACTER
C	IVL=0
C BUILD WITH /DEBUG OPTION TO INCLUDE "DK:" IN STRING
	LINE(2)='['
	LINE(3)='D'
	LINE(4)='K'
	LINE(5)=']'
	IVL=4
	LINE(2+IVL)='A'
	LINE(3+IVL)='K'
	GOTO 2600
2100	CONTINUE
C GENERATE INDIRECT FILE CALLS FROM PF1, PF3, PF4 KEYS IF ANY
C (THESE GIVE LETTERS P, R, OR S)
	LINE(1)=64
C	IVL=0
C BUILD WITH /DEBUG OPTION TO INCLUDE "DK:" IN STRING
	LINE(2)='['
	LINE(3)='D'
	LINE(4)='K'
	LINE(5)=']'
	IVL=4
	LINE(2+IVL)='K'
	LINE(3+IVL)='Y'
	IF(LC.LE.90)GOTO 2600
C LC OVER VALUE FOR 'Z' SO BUMP IT DOWN AGAIN.
	LINE(3+IVL)='Z'
	LC=LC-26
2600	CONTINUE
	LINE(4+IVL)=LC
	IF(IGOLD.LE.0)GOTO 7202
C GOLD ADDS EXTRA A,B,C,D,E,... ETC. AFTER FILENAME
	LINE(5+IVL)=64+IGOLD
	IVL=IVL+1
C ADD EXTRA LETTER FOR GOLDED COMMANDS
7202	CONTINUE
	LINE(5+IVL)='.'
	LINE(6+IVL)='C'
	LINE(7+IVL)='M'
	LINE(8+IVL)='D'
	LINE(9+IVL)=0
C GENERATE @KYP, @KYR, OR @KYS COMMAND ON PF1, PF3, PF4
2000	CONTINUE
	IGOLD=0
	RETURN
7000	CONTINUE
C PROCESS %%% FORMS
	I1=INDEX(LINE(2),37)
C IF I1 IS 1, THEN WE JUST HAVE %% AND THERE'S NOTHING TO DUMP TO
C THE SCREEN. OTHERWISE DUMP IT OUT HERE..
	I1=I1+1
	IF(I1.LE.2.OR.I1.GT.80)GOTO 7002
	II1=I1-1
	WRITE(6,7001)(LINE(II),II=2,II1)
7001	FORMAT(80A1,60A1)
7002	CONTINUE
	IF(I1.GT.80)RETURN
C COPY WHATEVER NEEDS TO BE COPIED TO LINBUF
	DO 7003 II=1,80
7003	LINBUF(II)=0
	I2=INDEX(LINE(I1+1),37)
	IF(I2.GT.80)RETURN
	I2=I2+I1
	I1=I1+1
	II2=I2-1
	II=0
	IF(I1.GT.II2)GOTO 7540
	DO 7004 LL=I1,II2
	II=II+1
7004	LINBUF(II)=LINE(LL)
7540	CONTINUE
	IF(I2.GT.80)RETURN
C IF LINE(I2+1) HAS & THEN CLOSE FILE RIGHT HERE AND BUG OFF
	IF(LINE(I2+1).NE.'&')GOTO 8005
	CLOSE (UNIT=IOLVL)
	IOLVL=5
	LINE(I2+1)='\'
8005	CONTINUE
C SEE IF LINE(I2+1) CONTAINS A ?
	IF(LINE(I2+1).NE.'?'.AND.LINE(I2+1).NE.'\')GOTO 7005
C HAVE TO READ IN USER'S LINE HERE... READ OFF UNIT 5 ALWAYS...
	LX=II+1
	READ(5,7001,END=7035,ERR=7035)(LINBUF(II),II=LX,120)
C NOW SEE IF LINBUF(LX) IS EITHER A \ CHAR OR ANY CONTROL CHARACTER
	LC=LINBUF(LX)
	IF(LINE(I2+1).EQ.'\')GOTO 7005
	IF(IOLVL.EQ.5)GOTO 7005
C IF WE SEE ANYTHING EXCEPT A CONTROL CHAR OR \, REWIND THE FILE...
C THIS ALLOWS US TO HAVE A SORT OF "ENTER MODE" AND A "COMMAND MODE"
C A LA SUPERCALC ETC.
	IF(LC.NE.'\'.AND.LC.GT.32)REWIND IOLVL
C COMMENT OUT ANY TERMINAL COMMAND
	IF(LC.EQ.'\'.OR.LC.LE.32)LINBUF(1)='*'
	GOTO 7005
7035	CONTINUE
C RECOVER AFTER CTL-Z ON EXPECTED INPUT.
	REWIND 5
	LINBUF(1)='*'
	CLOSE (UNIT=IOLVL)
	IOLVL=5
7005	CONTINUE
	DO 7006 II=1,120
7006	LINE(II)=LINBUF(II)
	KKK=110
	IF(JFED.GT.0)CALL FRMEDT(LINE,KKK)
D	GOTO 6501
C REMOVE 6502 RETURN IF YOU ALWAYS COMPILE WITH D LINES USED...
6502	RETURN
C RETURN AFTER BUMPING IGOLD. COMMENT OUT CMD
7223	CONTINUE
	LINE(1)='*'
	RETURN
	END