/* Rexx - rexxfmt - an ispf macro to format a rexx exec */ /* */ /* ====> Please read this prolog. It contains many caveats. */ /* */ /* Depends on having a wide area to edit. */ /* Vb data sets. Never tested with fb data sets */ /* Works by creating ttetmptt.Clist with a copy */ /* Of the data preceded by a "Trace s" Statement. */ /* That copy is run and the output is trapped and */ /* Altered. */ /* */ /* ====> The rexx processor does some bizarre */ /* ====> Formatting things so any exec formatted with */ /* ====> This should be tested very carefully. */ /* */ /* Since the rexx processor doesn't correctly */ /* Concatenate multi-line statements, An attempt */ /* Is made to split lines at their original */ /* Split positions (Lines with continuation commas */ /* Only - not multi-line quoted strings). */ /* */ /* Line comments are formatted starting in column 40 and */ /* Wrapping within the 40-71 column range. To change the */ /* Starting column change the variable comment_Start or */ /* Specify the column number as a parameter on the macro. */ /* */ /*-------------------------------------------------------------------*/ /* Sorry... I can't support a wide variety of comment */ /* Styles. You can shift line comments left all the way */ /* By using a low number (Like 3) As an operand. */ /*-------------------------------------------------------------------*/ /* Note: This exec works looks better with the recase program */ /* Macro available in a load library. Recase is available */ /* As assembler source from */ /* Ftp://Www.Mindspring.Com/Pub/Users/Somebody/Recase.Txt */ /* But this exec will work ok without it too. */ /*-------------------------------------------------------------------*/ /* */ /* Known restrictions: */ /* */ /* 1) Lines with a split (Ending in a comma) May */ /* Be joined incorrectly. This exec changes all " ," Characters */ /* Not in quotes or comments to "," Except that trailing */ /* Commas have a space added before them. */ /* */ /* 2) Comments that are greater than 72 characters wide */ /* Will will be reformatted. */ /* */ /* 3) Split lines that, When joined, Are wider than */ /* The data being edited will stop the formatting */ /* Process. */ /* */ /* 4) Continued lines of the form */ /* */ /* Rexrexxrexx, /+Comment comment +/ */ /* More rexx, /+ More comments +/ */ /* More rexx /+ More comments +/ */ /* */ /* May be completely mangled. */ /* */ /* 5) Comments with long strings of nonblanks may cause problems. */ /* */ /*-------------------------------------------------------------------*/ /* Author: Doug nadel nadel@us.Ibm.Com */ /* */ /* Version: 1.01 january 24, 2000 */ /* Version: 1.02 january 25, 2000 */ /* - end macro if comments or strings too long. */ /* - change temp name to remove dollar sign. */ /* - allow to work with profile noprefix */ /* - use <> For not equals. */ /* Version: 1.03 january 25, 2000 */ /* - hopefully better handling of multiline */ /* Comments. */ /* Version: 1.04 january 30, 2000 */ /* - hopefully better handling of multiline */ /* Comments. */ /* - much faster and robust resplitting of split lines. */ /* Version: 1.06 february 3, 2000 */ /* - format select/When so that if te when clause and */ /* Statement fit on one line, They are compacted. */ /* Disable this by setting */ /* Reformat_Select_Statements = 0 */ /* - fixed some more line resplitting problems. */ /* - speed up preserving characters phase. */ /* - fixed not formatting last line. */ /* */ /* * This is a work in progress. Use it with care * */ /* *** This is a work in progress. Use it with care *** */ /* ***** This is a work in progress. Use it with care ***** */ /* *** This is a work in progress. Use it with care *** */ /* * This is a work in progress. Use it with care * */ /* */ /*********************************************************************/ Address isredit quiet = 0 /* Set to non-zero to avoid Seeing progress messages. */ reformat_Select_statements = 1 /* Set to zero to not join when Stmts */ comment_start = 40 /* Left coulmn for line Comments */ "MACRO (QUIT)" If datatype(quit,"N") = 1 Then Do comment_start = max(5,min(quit,60)) quit = "" End "(US) = USER_STATE" "BOUNDS" /* Reset bounds */ "(FD) = DISPLAY_LINES" "(NUM) = NUMBER" If number = "ON" Then "UNNUM" "(DW) = DATA_WIDTH" 'F "79"X FIRST' If rc <> 0 Then 'F "78"X FIRST' If rc <> 0 Then 'F "77"X FIRST' If rc <> 0 Then 'F "76"X FIRST' If rc = 0 Then Do Parse Source . . me . Parse value, "YES * Format Canceled$The data contains X'76', X'77',", "X'78', or X'79' characters. The "me" macro uses these", "characters during the formatting process", With zerralrm zerrhm zerrsm "$"zerrlm Address ispexec "SETMSG MSG(ISRZ002)" "USER_STATE = (US)" Exit 12 End Do queued() Pull End If sysvar(syspref) <> "" Then If sysvar(syspref) <> userid() Then tempds = "'"sysvar(syspref)"."userid()".TTETMPTT.CLIST'" Else tempds = "'"sysvar(syspref)".TTETMPTT.CLIST'" Else tempds = "'"userid()".TTETMPTT.CLIST'" Address tso "ALLOC F($ABCX) REUSE NEW DEL UNIT(SYSALLDA) ", "DSO(PS) LRECL(600) RECF(V B) DA("tempds")" "(LAST) = LINENUM .ZL" Queue "/* REXX */ TRACE S" Call preserve_chars Do a = 1 to last "(LINE) = LINE "a line = space(line) Queue " "strip(line,"T") End Queue " Nop" /* Add extra line because there Were problems formattingthe Last line */ Address tso "EXECIO "queued()" DISKW $ABCX (FINIS" q = outtrap(trap.,,concat ) If quiet = 0 Then Say "Running REXX through REXX processor with TRACE S in effect..." Address tso "EX "tempds q = outtrap(off) Address tso "FREE F($ABCX)" Do a = 2 to trap.0 - 1 If substr(trap.a,8,3) = "*-*" Then Do stline = strip(line,,"79"x) If length(line) > dw & substr(stline,1,2) <> "/*", & substr(reverse(stline),1,2) <> "/*" Then Do line = space(line) If length(line) <= dw Then Leave Parse Source . . me . Parse value, "YES * $Macro failed because after running the exec", "through the REXX processor, one or more lines was longer", "than the data width of "dw + 0".", With zerralrm zerrhm zerrsm "$"zerrlm zerrlm = me":"zerrlm, "This may be due to comments or quoted", "strings that span lines." Address ispexec "SETMSG MSG(ISRZ002)" "C '79'X '40'x ALL" "C '78'X '7F'x ALL" "C '77'X '7D'x ALL" "RESET CHG" "USER_STATE = (US)" Exit 12 End line = substr(trap.a,12) End Else line = strip(line,"T")strip(trap.a) End "RESET" "DEL ALL NX" "LINE_AFTER 0 = (ZTIME)" line = "" Do a = 2 to trap.0 - 1 If substr(trap.a,8,3) = "*-*" Then Do stline = strip(strip(line,,"79"x)) If line <> "" Then If length(line) > dw, |(length(line) > 72 & substr(stline,1,2) = "/*" & , substr(reverse(stline),1,2) = "/*") Then Do While line <> "" Parse Var line linex " " line linex = space(translate(linex," ","79"x)) Do 200 Until linex = "" If length(linex) < 73 Then loc = length(linex) + 1 Else loc = lastpos(" ",substr(linex,1,72)) If loc < 2 Then If pos("*/",linex) > 0 Then loc = min(72,pos("*/",linex)) Else loc = 72 Interpret "parse var linex part1 "loc" linex" "LINE_BEFORE .ZL = (PART1)" End End Else "LINE_BEFORE .ZL = (LINE)" line = substr(trap.a,12) End Else line = strip(line,"T")strip(trap.a) End If line <> "" Then "LINE_BEFORE .ZL = (LINE)" "DELETE ALL .ZL .ZL" Drop trap. If abbrev("QUIT",translate(quit),1) = 1 Then Do "USER_STATE = (US)" Exit 1 End Address ispexec "CONTROL ERRORS RETURN" "!RECASE" /* Program to re-case rexx Keywords - optional! */ "DEFINE RECASE RESET" Address ispexec "CONTROL ERRORS CANCEL" "RESET" "(LAST) = LINENUM .ZL" Do a = 1 to last - 1 "(LINE1) = LINE "a + 0 "(LINE2) = LINE "a + 1 line1 = strip(line1,"T") line2 = strip(line2) If translate(subword(line2,1,1)) = "THEN" Then If length(line1) + 1 + length(line2) <= dw Then Do line1 = line1" "line2 "LINE "a" = (LINE1)" "LINE "a + 1"= (Z)" "XSTATUS "a + 1"= X" End End "DEL ALL X" "(LAST) = LINENUM .ZL" Do a = 1 to last "(LINE1) = LINE "a + 0 c = verify(line1," ") If c > 1 Then Do c = c - 1 "LABEL "a" = .A" 'C "'copies(" ",c)'" "'copies(" ",c * 2)'" 1 .A .A ALL' End End "RESET" Call break_comma_lines "C '79'X '40'x ALL" "C '78'X '7F'x ALL" "C '77'X '7D'x ALL" Call align_comment_close If reformat_Select_statements = 1 Then Call reformat_Select_statements_proc rc = 0 If dw > 72 Then 'F FIRST P"^" 73 'dw If rc = 0 Then Do Parse value, "YES * Long Line$One or more lines extend past column 72", With zerralrm zerrhm zerrsm "$"zerrlm Address ispexec "SETMSG MSG(ISRZ002)" Return 0 End "USER_STATE = (US)" "LOCATE "fd Return 1 break_comma_lines: Procedure Expose quiet /* Break lines that have a comma in them that were joined incorrectly By running the exec through the rexx processor */ If quiet = 0 Then Say "Splitting lines that were incorrectly joined by REXX..." "(LAST) = linenum .zl" lineno = 1 Do Until lineno > last "(LINE) = line" lineno line = strip(line,"T") If 0 < length(line) Then Do split = pos(" ,",line) If split > 0 Then Do "LABEL "lineno" = .RF 0" "C ' ,' ',' FIRST .RF .RF" "TSPLIT .RF "split + 1 "(LINE1) = line "lineno + 1 If p = 0 Then p = verify(line," ") line1 = copies(" ",p + 1)strip(line1) "LINE" lineno + 1 " = (LINE1)" last = last + 1 /* Since new line was added */ End Else p = 0 End "(LAST) = linenum .zl" lineno = lineno + 1 End "RESET LABEL" Return align_comment_close: Procedure Expose quiet comment_start If quiet = 0 Then Say "Aligning comment close characters..." cs = comment_start "(LAST) = linenum .zl" a = 1 Do While a < last "(LINE) = line" a line = strip(line,"T") If length(line) > 1 Then If substr(line,length(line) - 1,2) = "*/" Then Do sline = strip(line) If substr(sline,1,2) <> "/*" Then If lastpos("/*",line) > 0 Then Do line1 = reverse(line) Parse Var line1 comment "*/" line1/* Remove comment */ comment = translate(comment," ","79"x) comment = space(reverse(delstr(comment,1,2))) line1 = strip(reverse(line1),"T") If 67 > length(comment) + max(cs - 1,length(line1)) Then Do comment = "/* "comment l = 69 - length(comment) line = substr(line1,1,max(min(l,cs - 2),length(line1))) If length(line || comment) < 69 Then line = line comment Else line = line || comment line = left(line,max(69,length(line)))"*/" End Else Do lines_written = 0 line = substr(line1,1,max(length(line1),cs - 1))"/*" "LABEL "a + 1" = .NEXT" comment = comment"*/" Do Until comment = "" Parse Var comment w rest If length(w) > 69 - cs Then Interpret "parse var comment w "70 - cs" rest" comment = rest If length(line w) > 71 Then Do If lines_written = 0 Then Do "LINE "a" = (LINE)" "LINE_BEFORE .NEXT = (Z)" End Else "LINE_BEFORE .NEXT = (LINE)" a = a + 1 line = copies(" ",cs + 1) End line = line w If comment = "" Then Do line = substr(line,1,length(line) - 2) line = substr(line,1,69)"*/" End End End End Else Nop Else line = left(substr(line,1,length(line) - 2),69)"*/" "LINE "a" = (LINE)" "(LAST) = linenum .zl" last = last + 0 End a = a + 1 End Return preserve_chars: Procedure Expose quiet If quiet = 0 Then Say "Preserving special characters in strings and comments..." /* In comments: ' = X77 */ /* In comments: " = X78 */ /* In strings : ' ' = X79 */ "(LAST) = LINENUM .ZL" "RESET" /* Type defines where we are in code: */ /* 00=Single quote, 01=Double quote, 02=Open code ,03+=Comment */ /* Comments can be nested up to about 253 levels */ type = "02"x /* Open code */ Address ispexec "CONTROL ERRORS RETURN" "!REXXFM" /* Optional assembler version of This subroutine - much Faster */ pgmmacrc = rc "DEFINE REXXFM RESET" Address ispexec "CONTROL ERRORS CANCEL" If pgmmacrc > 0 Then Do Do a = 1 to last "(SLINE) = LINE" a sline = strip(sline,"T") linelen = length(sline) line = "" Do b = 1 to linelen Parse Var sline chr 2 sline nextchar = chr If chr = " " & type <> "02"x Then nextchar = "79"x Else Select When(type = "00"x ) Then /* In single quote */ If chr = "'" Then type = "02"x Else If chr = " " Then nextchar = "79"x When(type = "01"x ) Then /* In double quote */ If chr = '"' Then type = "02"x Else If chr = " " Then nextchar = "79"x When(type > "02"x ) Then/* In comment (May be nested) */ If chr = "/" Then If substr(sline,1,1) = "*" Then Do type = d2c(c2d(type) + 1) Parse Var sline . 2 sline b = b + 1 nextchar = "/*" End Else Nop Else If chr = '"' Then nextchar = "78"x Else If chr = "'" Then nextchar = "77"x Else If chr = "*" Then If substr(sline,1,1) = "/" Then Do type = d2c(c2d(type) - 1) Parse Var sline . 2 sline b = b + 1 nextchar = "*/" End Otherwise /* Not quotes or comments */ If chr = "/" Then If substr(sline,1,1) = "*" Then Do type = d2c(c2d(type) + 1) Parse Var sline . 2 sline b = b + 1 nextchar = "/*" End Else Nop Else If chr = "'" Then type = "00"x Else If chr = '"' Then type = "01"x End line = line || nextchar End "LINE "a"= (LINE)" End "C '40'X '76'X ALL" Do Until rc > 0 "C '766B'X ',' ALL" End "(DW) = DATA_WIDTH" Do dw Until rc > 0 "C '6B76'X ',' ALL" End "C '76'X '40'X ALL" "C ', ' ' ,' ALL" "RESET" End Return reformat_Select_statements_proc: Procedure Address isredit "(LAST) = linenum .zl" If last > 2 Then Do "RESET" Do a = 1 to last - 2 "(LINE) = line "a "(LINE2) = LINE "a + 1 "(LINE3) = LINE "a + 2 line3 = subword(translate(line3),1,1) line = strip(line,"T") If substr(translate(subword(line,1,1)),1,4) = "WHEN", & (substr(line3,1,4) = "WHEN", | substr(line3,1,9) = "OTHERWISE") Then If length( line) + length(strip(line2)) < 72 Then If substr(line,length(line) - 1,2) <> "*/" Then Do line = line strip(line2) "LINE "a" = (LINE)" "LINE "a + 1" = (Z)" "XSTATUS "a + 1" = X" End End "DEL ALL X" End Return