/*REXX*************************************************************** Users: TSO ISPF EDIT users having PLI programs Entry: Used as an EDIT CLIST within ISPF EDIT ===> PLICHK .LABEL1 .LABEL2 Contributed: 1985/09/25 David McRitchie Redone in REXX: 1993/06/02 David McRitchie. Related: QCHK, EDITCHEK, EDITOL, NESTCHK, etc... OPTIONS: TWO LABELS -- WILL DEFAULT TO .ZFIRST AND .ZLAST IF NONE SUPPLIED THIS MACRO CAN BE USED WITHIN A MACRO FOR INSTANCE WITHIN DUADD IT IS INVOKED USING ISREDIT PLICHK .DUADF .DUADL TO RESTRICT USAGE TO SCRIPT ONLY --- NO CHECK FOR "DO" ... "END" ==> PLICHK SCRIPT -- may want to use in combination with "FIXQUOTE" clist To restrict usage to SCRIPT only and only check for quotes use ==> PLICHK SCRIPT QUOTE ............................................... need to obtain starting labels of LABF LABL ............................................... *********************************************************************/ address 'ISREDIT'; 'MACRO (PARMS) NOPROCESS'; note = 'LINE_BEFORE .zfirst = NOTELINE ' Labf=''; Labl=''; Remainder=''; debug='';test=''; SCRIPT='';colbeg='';colend='' i=0;k=0;j=0;quote=''; /* Collect Parameters */ parms = translate(parms) /* not suited for imbedded blanks but will see initial ending quotes*/ do iii = 1 to 10; token = word(parms,iii) if token = '' Then leave tokenx = translate(token); if tokenx = "DEBUG" then do TRACE Intermediate end j = pos(tokenx,' SCRIPT DEBUG QUOTE ') 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 colbeg \= '' then if colend = '' then do zedsmsg = "From/To" zedlmsg = "From/To pair invalid, missing TO column" "line_before .zfirst = NOTELINE" "From/To pair invalid,", "missing TO column" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" Exit 8 end say 'testing remainder --' token '<--' remainder = remainder token end iii if remainder <> "" Then do zedsmsg = Remainder zedlmsg = remainder "-- Parameters unknown to PLICHK" 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 */ /********* END OF GENERALIZED INTERFACE CODE ******************/ "(labfno) = LINENUM" labf "(lablno) = LINENUM" LABL "EXCLUDE ALL" labf labl K = labfno - 1 LOOP1: K = K + 1 IF k > lablno THEN signal LOOP1E IF k = "" THEN say " PASSING BY LINE 8000 NOW" "LABEL" K "= .TLINE" ERR = 0 "SEEK .TLINE .TLINE" colbeg colend """'"" ALL" "(QOT1,QOT2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "'""' ALL" "(QQT1,QQT2) = SEEK_COUNTS" QOTI = qot1 // 2 /* only want the remainder */ QQTI = qqt1 // 2 /* only want the remainder */ err = err + qoti + qqti IF SCRIPT \= "SCRIPT" THEN if err=0 then do "SEEK .TLINE .TLINE 1 '//*'" "(SSA1,SSA2) = SEEK_COUNTS" IF ssa1 \= 0 then signal LOOP1 /* loop1 -- BYPASS all comment cards */ "SEEK .TLINE .TLINE" colbeg colend "'/*' ALL" "(SA1,SA2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "'*/' ALL" "(AS1,AS2) = SEEK_COUNTS" IF SA1 \= AS1 THEN ERR = ERR + 1 END "SEEK .TLINE .TLINE" colbeg colend "':' ALL" "(CN1,CN2) = SEEK_COUNTS" IF cn1 \= 0 then do "SEEK .TLINE .TLINE" colbeg colend "t':q.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':eq.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 IF QUOTE \= "QUOTE" THEN DO "SEEK .TLINE .TLINE" colbeg colend "t':hp0.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':ehp0.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':hp1.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':ehp1.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':hp2.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':ehp2.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':hp3.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':ehp3.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':hp4.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':ehp4.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':hp5.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':ehp5.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':hp6.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':ehp6.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':hp7.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':ehp7.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':hp8.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':ehp8.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':hp9.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':ehp9.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':gt10.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':egt10.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':gb10.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':egb10.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':gt12.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':egt12.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':gt15.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':egt15.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':gt16.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':egt16.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':gt17.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':egt17.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':gt18.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':egt18.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':italic.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':eitalic.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "t':pr12.' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "t':epr12.' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "x'5096984B' ALL" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "x'5083984B' ALL" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 "SEEK .TLINE .TLINE" colbeg colend "", "x'509698984B' all" "(EC1,EC2) = SEEK_COUNTS" "SEEK .TLINE .TLINE" colbeg colend "", "x'508398984B' all" "(EC3,EC4) = SEEK_COUNTS" IF EC1 \= EC3 THEN ERR = ERR + 1 END END IF err \= 0 THEN "RESET .TLINE .TLINE" ELSE "EXCLUDE .TLINE .TLINE ALL" signal LOOP1 LOOP1E: AAA = BBB CCTOT = 0 IF script = "" then do "SEEK .ZFIRST .ZFIRST 'REXX'" IF RC \= 0 THEN DO "SEEK ' DO;' FIRST" IF RC = 0 THEN DO "SEEK ' ' FIRST" IF RC \= 0 THEN DO "SEEK ':' 1 FIRST" IF RC \= 0 THEN "FIND" LABF LABL "' END ' ALL" /*HOPEFULLY ONLY PLI GETS CHECKED FOR an end */ /* that is missing a semi-colon*/ END END END END