/* REXX *************************************************************** EDITPR AUTHOR: DAVID MCRITCHIE, CREATED 1989/02/11 * "The REXX Macros Toolbox" * UPDATED 1990/10/19 16:11 IS03 * UPDATED 1992/04/21 IS03 RESET P3 (ERRORS) IF P1 P2 MATCH * UPDATED 1992/05/30 IS03 SINGLE QUOTED STRINGS, OPTIONAL * UPDATED 1997/04/01 IS03 SPF/PC 4.0.A UNKNOWN CHANGE FOR ********************************************************************* TITLE: EDITPR -- CHECK FOR MATCHED PAIR COMBINATION * USERS: TSO ISPF EDIT USERS | SCRIPT USERS * * EXAMPLE: EDITPR :GT12. :EGT12. * EDITPR '.KP ON' '.KP OFF' * EDITPR .ZF .ZL .STRING1 .STRING2 (LABELS FIRST HERE)* * OPTIONS: * LABEL-PAIR * COL-PAIR * NX * WORD * * ANY OTHER OPERANDS CAN BE ADDED AFTER THE EDIT PAIR HAS * BEEN INCLUDED. IF EITHER OF THE EDIT PAIR LOOKS LIKE * A LABEL YOU MUST FIRST INCLUDE ACTUAL LABELS AT THE * BEGINNING SUCH AS THE DEFAULTED .ZF .ZL COMBINATION. * ****************************************************************/ /*********************************************************************/ /*INITIALIZE INIT */ ADDRESS 'ISREDIT'; 'MACRO (PARMS) NOPROCESS'; NOTE = 'LINE_BEFORE .ZFIRST = NOTELINE ' LABF=''; LABL=''; REMAINDER=''; SEPSTR='';FROMCOL='';TOCOL='';FORCOL='';FLAGS=0; DEBUG='';TEST='';X='';NX='';WORD='';PAIR1='';PAIR2=''; PARMS = TRANSLATE(PARMS) /* COLLECT PARAMETERS */ IF PARMS = '' THEN DO; /* test */ ZEDSMSG = '' ZEDLMSG = "EDITPR MISSING OPERANDS SUCH AS", "'' -or-- :gt12. :egt12." /*ADDRESS*/ "ISPEXEC" "SETMSG MSG(ISRZ000)" EXIT 8 END /* NOT SUITED FOR IMBEDDED BLANKS BUT WILL SEE INITIAL ENDING QUOTES*/ parms = translate(parms) Parse var parms parms "'" pair1 "'" right parms = parms right Parse var parms parms "'" pair2 "'" right parms = parms||right DO III = 1 TO 10; TOKEN = WORD(PARMS,III) IF TOKEN = '' THEN LEAVE TOKENX = TRANSLATE(TOKEN); IF TOKENX = "DEBUG" THEN TRACE INTERMEDIATE J = POS(TOKENX,' X NX WORD DEBUG TEST ') IF J <> 0 THEN DO; STRING = TOKEN ' = '''TOKEN''''; INTERPRET STRING; ITERATE III; END; IF SUBSTR(TOKEN,1,1) = '.' THEN DO IF LABF = '' THEN LABF = TOKEN ELSE IF LABL = '' THEN LABL = TOKEN ELSE DO ZEDSMSG = '.LABEL RC=8' ZEDLMSG = 'TOO MANY LABELS --' LABF LABL TOKEN /*ADDRESS*/ "ISPEXEC" "SETMSG MSG(ISRZ000)" EXIT 8 END ITERATE III END IF PAIR1 = '' THEN DO;PAIR1 = TOKEN; ITERATE III; END; IF PAIR2 = '' THEN DO;PAIR2 = TOKEN; ITERATE III; END; /* will be able to enclose in single quotes but not double*/ IF SUBSTR(TOKEN,1,1) = "'" THEN DO /* "'"*/ SEPSTR = SUBSTR(TOKEN,2,VALUE(LENGTH(TOKEN)-2)) ITERATE III END ELSE DO; IF SUBSTR(TOKEN,1,1) = '"' THEN DO /* '"'*/ SEPSTR = SUBSTR(TOKEN,2,VALUE(LENGTH(TOKEN)-2)) ITERATE III END END SAY 'TESTING REMAINDER --' TOKEN '<--' REMAINDER = REMAINDER TOKEN END III IF REMAINDER <> "" THEN DO ZEDSMSG = REMAINDER ZEDLMSG = REMAINDER "-- PARAMETERS UNKNOWN TO TESTXXXX" /*ADDRESS*/ "ISPEXEC" "SETMSG MSG(ISRZ000)" EXIT 8 END /* PROCESS ADDITIONAL LABEL / RANGE RELATIONSHIPS */ IF LABL = '' THEN DO "PROCESS RANGE C" IF RC = 0 THEN DO "LABEL .ZFRANGE = .LABF 1" "LABEL .ZLRANGE = .LABL 1" LABF = ".LABF" LABL = ".LABL" END END IF LABL = '' THEN DO; LABF='.ZFIRST'; LABL='.ZLAST'; END; "(LABFNO) = LINENUM" LABF "(LABLNO) = LINENUM" LABL /****** ALL PARAMETERS HAVE BEEN RECEIVED -- PROCESS RELATIONSHIPS */ /************************** CODE FOR EDITPR COMMANDS ***************/ /************************** CODE FOR EDITPR COMMANDS ***************/ /************************** CODE FOR EDITPR COMMANDS ***************/ IF SUBSTR(PAIR1,1,1) = ":" & SUBSTR(PAIR2,1,1) = ":" THEN TAG = "TAG"; ELSE TAG = "" P1 = 0 P2 = 0 P3 = 0 PAIR1X = "'"PAIR1"'" PAIR2X = "'"PAIR2"'" "(VAR013,VAR014) = CURSOR" "FIND FIRST" LABF LABL PAIR1X IF RC \= 0 THEN DO "FIND FIRST" LABF LABL PAIR2X IF RC \= 0 THEN DO ZEDSMSG = "NOT FOUND" ZEDLMSG = "NEITHER" PAIR1X "NOR" PAIR2X "FOUND WITHIN", "DATA" LABF LABL NOTEX = "*ERROR**" ZEDLMSG "LINE_BEFORE .ZCSR = NOTELINE (NOTEX)" /*ADDRESS*/ "ISPEXEC" "SETMSG MSG(ISRZ000)" NOTEX = "NO" PAIR1X PAIR2X "PAIRS FOUND" "LINE_AFTER" VAR013 " = NOTELINE (NOTEX)" EXIT 8 END END "LOC" LABF "CURSOR =" LABF "0" /* NEXT LINE ASSUME YOU HAVE MATCHED ON :_EGT12. */ /*ISREDIT F PREV P'='*/ LOOPF: IF P1 \= P2 THEN DO P3 = P3 + 1 IF P3 > 10 THEN DO ZEDSMSG = "TOO MANY ERRORS" ZEDLMSG = "ERROR COUNT LOOP EXCEEDS 10" "LINE_BEFORE .ZCSR = NOTELINE ""*ERROR**" ZEDLMSG"""" /*ADDRESS*/ "ISPEXEC" "SETMSG MSG(ISRZ000)" FLAGS = FLAGS + 1 EXIT 8 END END "(CUR01,CUR02) = CURSOR" "FIND NEXT" NX WORD PAIR1X IF RC = 0 THEN DO "(CUR11,CUR12) = CURSOR" VALF = CUR11 * 1000 + CUR12 END ELSE VALF = 999999999 "CURSOR =" CUR01 CUR02 "FIND NEXT" NX WORD PAIR2X IF RC = 0 THEN DO "(CUR21,CUR22) = CURSOR" VALLST = CUR21 * 1000 + CUR22 END ELSE VALLST = 999999999 IF VALF = VALLST THEN SIGNAL ENDED IF VALF = 999999999 THEN DO P2 = P2 + 1 NOTEX = P1"-"P2" FOUND", "UNMATCHED" PAIR2X WORD TAG CUR21 CUR22 "LAST", PAIR1X CUR01 CUR02 "LINE_AFTER .ZCSR = NOTELINE (NOTEX)" "LABEL .ZCSR = .ERROR 0" FLAGS = FLAGS + 1 IF P1 = P2 THEN P3 = 0 EXIT 4 END IF VALLST = 999999999 THEN DO P1 = P1 + 1 P3 = P3 + 1 NOTEX = P1"-"P2" FOUND", "UNMATCHED" PAIR1X WORD TAG CUR01 CUR02 "LAST" PAIR2X "LINE_AFTER .ZCSR = NOTELINE (NOTEX)" FLAGS = FLAGS + 1 IF P1 = P2 THEN P3 = 0 "LABEL .ZCSR = .ERROR 0" SIGNAL FINISH END IF VALF < VALLST THEN DO "CURSOR =" CUR11 CUR12 "FIND NEXT" NX WORD PAIR1X IF RC = 0 THEN DO "(CUR31,CUR32) = CURSOR" VALCHK = CUR31 * 1000 + CUR32 IF VALCHK > VALLST THEN DO P1 = P1 + 1 P2 = P2 + 1 "CURSOR =" CUR21 CUR22 CUR21 = CUR21 + 0 CUR22 = CUR22 + 0 SIGNAL LOOPF END NOTEX = , VALUE(P1+2)"-"P2, "BEGIN" PAIR1X TAG CUR31"."CUR32, "REPEAT OF" CUR11"."CUR12, "CHECK FOR MISSING" PAIR2X TAG "LINE_AFTER" CUR31 "= NOTELINE (NOTEX)" NOTEX = VALUE(P1+1)"-"P2, "BEGIN" PAIR1X TAG "ABOVE ON" CUR11"."CUR12 "IS MISSING", "AN ENDING" PAIR2X TAG "LINE_AFTER" CUR11 "= NOTELINE (NOTEX)" P1 = P1 + 1 FLAGS = FLAGS + 1 "CURSOR =" CUR11 CUR12 SIGNAL LOOPF END P1 = P1 + 1 P2 = P2 + 1 "CURSOR =" CUR21 CUR22 SIGNAL LOOPF END P2 = P2 + 1 FLAGS = FLAGS + 1 NOTEX = P1"-"P2" UNMATCHED END" WORD PAIR2X TAG "ABOVE ON", CUR21 CUR22 "LINE_AFTER" CUR21 "= NOTELINE (NOTEX)" "CURSOR =" CUR21 CUR22 IF P1 = P2 THEN P3 = 0 SIGNAL LOOPF ENDED: IF P1 = P2 THEN DO /* CORRECTED FORM P1=P3*/ NOTEX = P1"-"P2" MATCHED," P1 PAIR1X TAG, " VS" P2 PAIR2X TAG "LINE_AFTER .ZCSR = NOTELINE (NOTEX)" "CURSOR =" VAR013 VAR014 IF FLAGS \= 0 THEN EXIT 4 EXIT 1 END FINISH: NOTEX = P1"-"P2" UNMATCHED" WORD", " P1 PAIR1X TAG WORD, " VS" P2 PAIR2X TAG "LINE_AFTER .ZCSR = NOTELINE (NOTEX)" EXIT 4