/*********************************************************************/ /* PINX Author: David McRitchie, created 1986/05/10 IS03 */ /* at "The REXX Macros Toolbox", DMcRitchie@hotmail.com */ /* Updated 1989/01/30 22:03 IS03 */ /*********************************************************************/ /* TITLE: PINX, CREATE ".PI" FROM NX LINES */ /* USERS: TSO ISPF EDIT USERS | SCRIPT USERS */ /* .ADDRA .ADDRB COPY THE CONTENT OF .ADDRC .ADDRD */ /* CONTRIBUTED: 1986/05/10 DAVID MCRITCHIE */ /* */ /* EXAMPLE: PINX .A .B */ /* */ /* DOCUMENTED: IS03.SHARE.TEXT(PINX) */ /* IS03.CLISTHLP.HELP(PINX) */ /* */ /* OPTIONS: */ /* LPTR-DEST-RANGE | ENTIRE (REQUIRED) LINE POINTER RANGE */ /* LPTR-SOURCE-PAIR | MEMBERNAME MATERIAL TO BE COPIED */ /* NX | X (OPTIONAL) PROCESS ALL, OR NON-EXCLUDED, OR EXCLUDED */ /* lines APPLIES TO THE LPTR-DEST-RANGE ONLY */ /* */ /*********************************************************************/ CONTROL ASIS ISREDIT MACRO PROCESS (TOK1,TOK2,K2,TOK3,TOK4,TOK5,TOK6,TOK7,+ TOK8,TOK9,TOK10,+ TOK11,TOK12,TOK13,TOK14,TOK15,TOK16,TOK17,TOK18,TOK19,+ TOK20,TOK21,TOK22,TOK23,TOK24,TOK25,TOK26,TOK27,TOK28,+ TOK29,TOK30,TOK31,TOK32,TOK33,TOK34,TOK35,TOK36,TOK37,+ TOK38,TOK39,TOK40,TOK41,TOK42,TOK43,TOK44,TOK45,TOK46) SET RP = &STR()) SET I = 0 /********* SET I = 1 DO WHILE &I <= 48 SET TOKEN = &&TOK&I SET TOKEN = &STR(&SYSCAPS(&TOKEN)) IF &STR(&TOKEN) = RERUN THEN SET RERUN = RERUN IF &STR(&TOKEN) = DONE THEN SET DONED = DONE IF &STR(&TOKEN) = HOLD THEN SET HOLD = HOLD IF DEBUG = &DEBUG | DEBUG = &TOKEN THEN + WRITE &I TOK&&I=&&TOK&I TOKEN=&TOKEN IF &STR(&TOKEN) = &STR() THEN GOTO END_TOK IF &SUBSTR(1,&TOKEN) = &STR(.) THEN DO IF &LABF. = &STR() THEN DO SET LABF = &STR(&TOKEN) GOTO NXT_TOK END IF &STR(&LABL) = &STR() THEN DO SET LABL = &STR(&TOKEN) GOTO NXT_TOK END SET &ZEDSMSG = &STR(LABEL &STR(&TOKEN)) SET &ZEDLMSG = &STR(EXACTLY 2 LABELS + REQUIRED FOUND "&LABF", "&LABL" AND "&STR(&TOKEN)") ISPEXEC SETMSG MSG(ISRZ000) EXIT CODE(12) END SET REMAIN = &STR(&REMAIN &STR(&TOKEN)) NXT_TOK: - SET I = &I + 1 END END_TOK: SET I = &I /*********************************************************************/ /*********************************************************************/ IF &LABF. = &STR() THEN DO SET LABF = .ZFIRST SET LABL = .ZLAST END IF &LABL. = &STR() THEN DO SET &ZEDSMSG = MISSING LABEL(S) SET &ZEDLMSG = &STR(&ZEDSMSG -- TWO + LABELS AND MEMBER, OR 4 LABELS ARE REQUIRED) ISPEXEC SETMSG MSG(ISRZ000) EXIT CODE(12) END ISREDIT (#LABF) = LINENUM &LABF. IF &LASTCC ^= 0 THEN DO SET &ZEDSMSG = &STR(&LABF. LABEL) SET &ZEDLMSG = &STR(&ZEDSMSG DOES NOT EXIST) ISPEXEC SETMSG MSG(ISRZ000) EXIT CODE(12) END ISREDIT (#LABL) = LINENUM &LABL. IF &LASTCC ^= 0 THEN DO SET &ZEDSMSG = &STR(&LABL. LABEL) SET &ZEDLMSG = &STR(&ZEDSMSG DOES NOT EXIST) ISPEXEC SETMSG MSG(ISRZ000) EXIT CODE(12) END IF &STR(&REPRO) ^= &STR() THEN GOTO JJJ /*********** END OF LABEL REQUIREMENTS **********************/ /*********** CODE FOR LINE SHIFT COMMANDS ***************/ /*********** CODE FOR LINE SHIFT COMMANDS ***************/ /*********** CODE FOR LINE SHIFT COMMANDS ***************/ ISREDIT SEEK X'49' &LABF. &LABL. FIRST IF &LASTCC = 0 THEN GOTO CHKDEST ISREDIT SEEK X'48' &LABF. &LABL. FIRST IF &LASTCC = 0 THEN GOTO CHKDEST ISREDIT SEEK X'47' &LABF. &LABL. FIRST IF &LASTCC = 0 THEN GOTO CHKDEST ISREDIT SEEK X'46' &LABF. &LABL. FIRST IF &LASTCC = 0 THEN GOTO CHKDEST ISREDIT SEEK X'45' &LABF. &LABL. FIRST IF &LASTCC = 0 THEN GOTO CHKDEST GOTO DESTOK CHKDEST: WRITE WARNING X'45'-X'49' FOUND IN DATA IF &STR(&RERUN) = RERUN THEN DO WRITE RERUN WAS REQUESTED -- WILL CONTINUE END ELSE DO WRITE A RERUN IS DONE ===> PINX .LABF .LABL RERUN WRITE RERUN NOT REQUESTED -- ABORTING SET &ZEDSMSG = &STR(NOT A RERUN) SET &ZEDLMSG = &STR(TO RERUN INCLUDE "RERUN" ON PINX COMMAND) ISPEXEC SETMSG MSG(ISRZ000) EXIT CODE(12) END /*************** PERMITTED TO CONTINUE *********************/ DESTOK: - IF &STR(&DONED) = DONE THEN GOTO DONE ISREDIT SEEK &LABF. &LABL. ' ' NX FIRST ISREDIT (I) = LINENUM .ZCSR ISREDIT (LN1) = LINE .ZCSR WRITE &I -- &LN1. ISREDIT CHANGE all nx &LABF. &LABL. '&&' X'49' ISREDIT CHANGE all nx &LABF. &LABL. "'" X'48' ISREDIT CHANGE all nx &LABF. &LABL. '"' X'47' BACK: - ISREDIT (LN1) = LINE .ZCSR IF &STR(&SYSCAPS(&SUBSTR(1:4,&STR(&LN1)))) = + &STR(.PI ) THEN GOTO NXT IF &STR(&SYSCAPS(&SUBSTR(1:8,&STR(&LN1)))) = + &STR(.*--.PI ) THEN GOTO NXT SET LN3 = &STR(.PI º&STR(&LN1.)) SET LN1 = &STR(.*--.PI º&STR(&LN1.)) ISREDIT (LN2) = LINE &EVAL(&I + 1) /* IF &STR(&SYSCAPS(&STR(&LN1))) = &STR(+ &SYSCAPS(&STR(&LN2))) THEN GOTO NXT /* IF &STR(&SYSCAPS(&STR(&LN2))) = &STR(+ &SYSCAPS(&STR(&LN3))) THEN GOTO NXT ISREDIT SEEK FIRST .ZCSR .ZCSR '"' IF &LASTCC = 0 THEN ISREDIT LINE_AFTER .ZCSR = "&NRSTR(&LN1.)" ELSE ISREDIT LINE_AFTER .ZCSR = '&NRSTR(&LN1.)' SET I = &I + 1 NXT: - ISREDIT (LAST) = LINENUM &LABL. SET I = &I + 1 IF &EVAL(1000000 + &I ) >= &EVAL(1000000 + &LAST) + THEN GOTO DONE ISREDIT LABEL &I = .PTR ISREDIT SEEK .PTR &LABL. ' ' NX FIRST IF &LASTCC ^= 0 THEN GOTO DONE ISREDIT (XSTATUS) = XSTATUS &I ISREDIT (I) = LINENUM .ZCSR IF &LASTCC = 0 THEN GOTO BACK DONE: - ISREDIT CHANGE all nx 'º&&&&rbl.' ' ' ISREDIT CHANGE all nx &LABF. &LABL. X'49' '&&' ISREDIT CHANGE all nx &LABF. &LABL. X'48' "'" ISREDIT CHANGE all nx &LABF. &LABL. X'47' '"' IF &STR(&HOLD) = HOLD THEN EXIT CODE(0) ISREDIT X ALL &LABF. &LABL. ISREDIT F ALL &LABF. &LABL. 1 '.*--.PI ' ISREDIT CHANGE all nx &LABF. &LABL. ':P ' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':P.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':LI.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':GB12.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':GP12.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':GT12.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':GT15.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':HP0.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':HP1.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':HP2.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':HP3.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':EGB12.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':EGP12.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':EGT12.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':EGT15.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':EHP0.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':EHP1.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':EHP2.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. ':EHP3.' 'º' ISREDIT CHANGE all nx &LABF. &LABL. "^" "º" ISREDIT CHANGE all nx &LABF. &LABL. ";" "º" ISREDIT CHANGE all nx &LABF. &LABL. ".sk 0" "º" ISREDIT CHANGE all nx &LABF. &LABL. ".sk 1" "º" ISREDIT CHANGE all nx &LABF. &LABL. ".sp 0" "º" ISREDIT CHANGE all nx &LABF. &LABL. ".sp 1" "º" ISREDIT CHANGE all nx &LABF. &LABL. " - " "º" ISREDIT CHANGE all nx &LABF. &LABL. ":HDREFID REFID='" "º" ISREDIT CHANGE all nx &LABF. &LABL. "'." "º" ISREDIT CHANGE all nx &LABF. &LABL. "' " "º" ISREDIT CHANGE all nx &LABF. &LABL. " '" "º" ISREDIT CHANGE all nx &LABF. &LABL. '" ' "º" ISREDIT CHANGE all nx &LABF. &LABL. ' "' "º" ISREDIT CHANGE all nx &LABF. &LABL. ':H3.' '' ISREDIT CHANGE all nx &LABF. &LABL. ':H2.' '' ISREDIT CHANGE all nx &LABF. &LABL. ':H1.' '' ISREDIT CHANGE all nx &LABF. &LABL. ':H0.' '' ISREDIT CHANGE all nx &LABF. &LABL. ":H3 ID='" "º" ISREDIT CHANGE all nx &LABF. &LABL. ":H2 ID='" "º" ISREDIT CHANGE all nx &LABF. &LABL. ":H1 ID='" "º" ISREDIT CHANGE all nx &LABF. &LABL. ":H0 ID='" "º" ISREDIT CHANGE all nx &LABF. &LABL. "ºººº" "º" ISREDIT CHANGE all nx &LABF. &LABL. "ºº" "º" ISREDIT CHANGE all nx &LABF. &LABL. "ºº" "º" ISREDIT F all nx &LABF. &LABL. ':H' ISREDIT F all nx &LABF. &LABL. '.PI ' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'40' X'46' ISREDIT CHANGE all nx &LABF. &LABL. + 1 70 X'46464646464646464646464646464646' X'46' ISREDIT CHANGE all nx &LABF. &LABL. + 1 70 X'4646464646464646' X'46' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'464646' X'46' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'4646' X'46' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'4646' X'46' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'4646' X'46' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'4646' X'46' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'4646' X'46' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'4646' X'46' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'4646' X'46' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'6A46' X'6A' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'466A' X'6A' ISREDIT CHANGE all nx &LABF. &LABL. 1 70 X'46' X'40' ISREDIT CHANGE all nx '/' 'º' ISREDIT CHANGE all nx '.*--.piº' '.pi º' ISREDIT CHANGE all nx '.*--.pi º' '.pi º' ISREDIT CHANGE all nx '&&&&gml. ' 'º' ISREDIT CHANGE all nx '&&&&gml.' 'º' ISREDIT CHANGE all nx ': ' 'º' /* ISREDIT CHANGE all nx ':' 'º' ISREDIT CHANGE all nx ' alarm ' 'ºalarm ' ISREDIT CHANGE all nx 'ºalarm ' 'ºalarmº' ISREDIT CHANGE all nx 'ºdetection + circuit ' 'ºdetectionºcircuit ' ISREDIT CHANGE all nx 'º3084 ' '3084º' ISREDIT CHANGE all nx 'º4361 ' '4361º' ISREDIT CHANGE all nx ' &&&& ' 'and ' ISREDIT CHANGE all nx '&&&&rbl.' ' ' ISREDIT CHANGE all nx &LABF. &LABL. "ºº" "º" ISREDIT CHANGE all nx &LABF. &LABL. "ºº" "º" ISREDIT RESET &LABF. &LABL. CHANGE DONE2: ISREDIT FIND FIRST NX &LABF. &LABL. ".PI º " IF &LASTCC. EQ 0 THEN DO ISREDIT DELETE .ZCSR .ZCSR GOTO DONE2 END