C C COPYRIGHT (C) 1983 GLENN EVERHART C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY. 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 COMMON/IOLVL/IOLVL 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.27)GOTO 1000 IF(LINE(1).EQ.37)GOTO 7000 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 DO 1 N=1,NMX LL=LINE(N) IF(LL.GT.96.AND.LL.LE.123)LL=LL-32 LINE(N)=LL 1 CONTINUE 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)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' GOTO 2000 10 CONTINUE C HANDLE AUX KEYPAD KEYS AS INDIRECTS (FOR NOW) C MAP ENTER KEY INTO AUX KEYPAD RANGE 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. 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 IVL=0 C BUILD WITH /DEBUG OPTION TO INCLUDE "DK:" IN STRING D LINE(2)='D' D LINE(3)='K' D LINE(4)=':' D IVL=3 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 IVL=0 C BUILD WITH /DEBUG OPTION TO INCLUDE "DK:" IN STRING D LINE(2)='D' D LINE(3)='K' D LINE(4)=':' D IVL=3 LINE(2+IVL)='K' LINE(3+IVL)='Y' 2600 CONTINUE LINE(4+IVL)=LC 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 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 DO 7004 LL=I1,II2 II=II+1 7004 LINBUF(II)=LINE(LL) 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) RETURN END