Make CL source code interpretation and maintenance easier with this utility.
Brief: Indenting CL code is cumbersome, especially if you (like most of us) use the command prompter. Learn how REXX gives this new utility the power to increase the readability of your CL source code and facilitate program maintenance.
Every once in a while, I have an idea for a neat utility. When the idea hits me, I write it down immediately, even if it's 3 o'clock in the morning. Living within a mile of the office has its advantages, one of which is that I can come in anytime (even at 3 a.m.) to try something out. This is precisely what happened this time.
CL is a free-format language, as you must be aware. Most programmers use the command prompter while entering the source code in SEU, meaning that all command names begin at column 14 and the first parameter's keyword is always placed on column 25. This has the advantage of providing a consistent format that everyone can quickly become familiar with.
The Problem
But wait-what happens when you code some statements within a DO/ENDDO pair? Because CL is a free-format language, it would be nice to be able to write these statements in indented form; that would make the beginning and the end of a DO group rather obvious and, therefore, the program would be far easier to read.
Unfortunately, the command prompter has no way of knowing that the command you're prompting for is being coded within a DO group. This means that CL programs written with the help of the command prompter are never indented. One must push the statements to the right by inserting spaces, which is always cumbersome, especially when there's not enough room at the right end to insert all the necessary spaces.
Looking for the Solution
So what's the solution? The straightforward approach is to write a program that will take a CL source member, indent the statements as needed, and write it back. If you have the December 1991 issue of MC, you'll remember Robin Klima's utility to indent RPG/400 source, the Indent RPG Source (INDRPGSRC) command. INDRPGSRC can be handled by an RPG program because it processes RPG source, which is columnar in nature; this means that the processing program has no trouble finding IFs, ENDs and so on.
Processing CL source (or the source of any free-format language) is a bit more complicated. Consider that a single CL statement can span several lines; that alone is different from RPG statements. Also, the IFs, DOs and ENDDOs can be anywhere within the line. Scanning free-format code with an RPG program would be difficult and the resulting program would be complicated since RPG's string handling capabilities are limited, even considering the new CAT, SCAN, SUBST and XLATE operations.
Since I like PL/I, I thought about developing the CL indenting utility in that language; but even PL/I's string handling functions are insufficient to tackle the task at hand. Besides, few subscribers would be able to use it since PL/I is not all that popular.
REXX, Of Course!
Then, at 2:30 in the morning one Friday, it hit me-I could use REXX instead of PL/I. REXX has powerful string handling functions and, what's best, everyone has REXX!
The result (after much hunt and peck, testing, cursing and debugging) is the Indent CL Source (INDCLSRC) command, which is listed in 1. It runs CL program CL001CL (2), CL program CL001CLA (3) and REXX program CL001RX (4). To give you an idea of what INDCLSRC can do for you, both CL programs included in this article are indented.
The result (after much hunt and peck, testing, cursing and debugging) is the Indent CL Source (INDCLSRC) command, which is listed in Figure 1. It runs CL program CL001CL (Figure 2), CL program CL001CLA (Figure 3) and REXX program CL001RX (Figure 4). To give you an idea of what INDCLSRC can do for you, both CL programs included in this article are indented.
INDCLSRC lets you control on what column you want to begin writing the statements (the default is column 3), how many columns to indent per DO group level (default is 3) and how many columns to indent all continuation lines (again, the default is 3).
INDCLSRC has two other features: you can order it to translate to upper or lowercase the entire source member (except quoted strings, of course), and you can save the original CL source code before indenting if you feel safer that way. You should try the lowercase option to see if you like it better than uppercase. If you've done any programming in languages other than CL and RPG, you may be used to lowercase code.
The main point to remember is that INDCLSRC indents the actual source member. Normally, it does not print an indented version, but actually changes the source code itself. Don't worry; the CL compiler will accept it after INDCLSRC has done its work, even if you requested translation to lowercase. Alternatively, you can request an indented listing-in this case, INDCLSRC does not update the original source member.
The INDCLSRC Command
The Indent CL Source (INDCLSRC) command has nine parameters:
Source member (SRCMBR): enter the name of the member you want to indent. You can also enter *ALL if you want to indent all CL source members of an entire source file. When *ALL is used, the program automatically skips all members that have a source type other than CL, CLP or CLP38.
Source file (SRCFILE): enter the qualified name of the source file being processed. It defaults to QCLSRC in *LIBL.
Convert case (CVTCASE): indicate what case conversion you want to perform. It defaults to *NONE (no case conversion). Other values are *LOWER (convert to lowercase) and *UPPER (convert to uppercase). Quoted strings and comments are never converted.
Indent remarks (INDRMKS): indent, or leave alone, all comments in the program. It defaults to *YES. If you choose *NO, remarks are not indented provided that each line begins with /*.
Output (OUTPUT): indicate where to send the output (replace the source member (*SRCMBR) or print (*PRINT)). The default is *SRCMBR.
Save old source (SAVOLDSRC): indicate whether to copy the source member to file B4INDCLSRC before replacing the source member. This parameter only appears if the OUTPUT parameter value is *SRCMBR. It defaults to *NO. If you select *YES, the member is copied to that file in the same library, using the same member name(s).
Beginning column (BGNCOL): indicate on what column to begin writing unindented statements (those found outside all DO/ENDDO groups). It defaults to 3, but any value between 1 and 14 can be entered.
Indent columns (INDCOL): tell the system how many columns to indent each nested level of DO/ENDDO. It defaults to 3. Any value between 1 and 5 can be entered.
Indent continuation (INDCONT): specify how many columns to indent continuation lines, relative to the indentation of the first line of the statement. It defaults to 3. Any value between 1 and 5 can be selected.
How Does It Work?
Explaining each and every statement in the REXX program is out of the question due to space limitations, but I'll explain the basic concepts behind the program. If you want to learn more about REXX, see the list of reference material given at the end of this article.
REXX constructs are a lot like PL/I's. Comments are coded as in CL. Blank lines are allowed, and assigning values to variables is done with the equal sign (=). You can execute any CL command directly by simply enclosing the entire command string in quotes.
REXX has three built-in "files" to communicate with the outside world: STDIN (input), STDOUT (output) and STDERR (error messages). Though not actually files, they're so similar to files that there's no harm in calling them that. Under normal circumstances, all three communicate with the user through the Extended Program Model (EPM) session manager. This means that STDIN receives what you type at the keyboard and both STDOUT and STDERR go to the screen.
But we need to be able to read and write source file members, which is not the normal use for the built-in files. Fortunately, we can run the OVRDBF command from within the REXX program to override them to something different.
CL001RX is broken down into a mainline routine and several subroutines. Each module (mainline or subroutine) begins with a tag (a name followed by a colon) and ends in a RETURN statement. The initial tag is not required for the mainline, but I like using the program's name as a tag for consistency. The subroutines are executed with the CALL statement, which works just like RPG's EXSR operation.
The Mainline Routine
The mainline uses a PARSE ARG statement to break the input parameter string into separate words, each word being a different parameter. REXX programs can only receive one parameter, which is always a character string. If you need to pass more than one parameter to a REXX program, you must concatenate the values of all the parameters and pass the resulting string as I've done. CL001RX breaks up the parameter string into SRCFLIB (source file library), SRCF (source file), SRCMBR (source member), CVTCASE (convert case), INDRMKS (indent remarks), BGNCOL (beginning column number), INDCOL (indent columns) and INDCONT (indent continuation lines).
Then I coded two statements to override the STDIN and STDOUT files. In the first one I had to override STDIN to the appropriate library, file and member; therefore, I had to build the statement from several literal strings and variables.
Using a technique known as abuttal, the variables (srcflib, srcf, and srcmbr) are concatenated to the literal strings by simply joining (abutting) them together:
'ovrdbf file(stdin) tofile(' srcflib'/'srcf') mbr('srcmbr')'
The resulting CL command is:
ovrdbffile(stdin) + tofile(lll/fff) mbr(mmm)
Where lll, fff and mmm are the contents of variables srcflib, srcf and srcmbr respectively.
The two OVRDBF commands redirect STDIN to the original source member and STDOUT to member WORKMBR in QTEMP/QCLSRC which was prepared by CL001CL.
After initializing a few variables, we enter an infinite loop (DO FOREVER) which reads a record in the source member with the PARSE PULL statement, receiving the entire record into variable SOURCE-RECORD. This process is repeated until no more records are found.
If SOURCE-RECORD contains all blanks beginning at position 13 (the usable portion of the source record), we write the source record immediately with the SAY statement. Else, CL001RX calls subroutine PROCESS-RECORD.
Processing Each Record
Subroutine PROCESS-RECORD does several things:
Extracts the tag in the CL statement, if one is found, and writes it in a separate line with a continuation sign (+). To determine if there's a tag, PARSE VAR splits SOURCE-DATA in two at the first blank found. TAG receives the first "word" and STATEMENT receives the rest. The built-in REXX function RIGHT then extracts one byte from the right-hand end of TAG and compares it to a colon. Notice the use of the || operator to concatenate strings, and the TRANSLATE function to convert from uppercase to lowercase or vice versa.
Writes the comment as is if INDRMKS(*NO) was specified.
Builds the entire command string by calling subroutine BUILD-COMMAND-STRING.
Converts the entire command string to uppercase or lowercase (except quoted strings) if you requested this conversion.
Formats DCL statements differently to ensure that the VAR, TYPE and LEN parameters are vertically aligned. This is done by calling subroutine FORMAT-DCL.
Finally, it writes the command string by calling subroutine WRITE.
Building the Command String
SubroutineBUILD-COMMAND-
STRING first eliminates the repeated spaces found between the command name and the first parameter's keyword, assigning the result to variable INPUT. Notice the use of the STRIP function to remove leading and trailing blanks.
Next, it enters a DO WHILE which reads subsequent records from the source member for as long as INPUT ends in a continuation symbol (either a plus or a minus sign). In the DO WHILE, the symbol | is used for or and & is used for and. These symbols are the REXX equivalents of *OR and *AND in CL.
Function LEFT extracts the specified number of bytes from the left-hand side of a string, and LENGTH calculates the length of a string.
BUILD-COMMAND-STRING uses variations of the STRIP function, with a second parameter to indicate which blanks to remove; 'B' removes both leading and trailing blanks, 'L' removes leading blanks only and 'T' removes trailing blanks only.
Formatting DCL Statements
Subroutine FORMAT-DCL breaks INPUT into several components. Decimal variables are treated differently because (a) the LEN parameter of a DCL command can omit the decimal portion, and (b) if LEN includes the decimal portion as in LEN(5 0), it would be broken down by the PARSE VAR into two variables (splitting the string at the space between the 5 and the 0).
At the end of the subroutine, INPUT is rebuilt. The LEFT function is used to pad the components with blanks at the right-hand side of the string, since it attempts to extract more characters than are available-for example, LEFT(VAR,17) requests a 17-character field; if VAR contains less than 17, whatever characters VAR contain are left-adjusted, padding the right end with blanks.
Writing the Statements
Subroutine WRITE actually writes INPUT to the work source member. First it determines if the current level is less than or equal to 10 (10 levels is the maximum levels the CL compiler will accept). It then determines how many characters are available for writing, considering the beginning column number (BGNCOL), the number of columns to indent per level (INDCOL) and the number of levels (LEVEL). It builds a string of blanks in INDENT with as many blanks as necessary to indent the statement properly, using the COPIES function to repeat a blank space a certain number of times.
Before writing anything, it calls
CALCULATE-NEXT-LEVEL to do precisely that: calculate the next level
number if the current statement happens to have a DO or ENDDO somewhere.
Then it enters a DO UNTIL loop which writes as much as possible (70 characters) to each line, breaking INPUT if it doesn't fit in its entirety. Finding a good breaking point is a crucial task delegated to subroutine BREAK-INPUT.
Calculating the Next Level
SubroutineCALCULATE-NEXT-LE-
VEL finds out if the current line contains a comment and if so, where. It also finds out if the current line contains a THEN(DO), CMD(DO), EXEC(DO) or ENDDO and if so, where. Function POS finds any of these strings within INPUT.
If any form of DO is found before the comment begins, NEXT-LEVEL is increased by 1. If ENDDO is found before the comment begins, NEXT-LEVEL is decreased by 1. Otherwise, NEXT-LEVEL is set equal to LEVEL.
Breaking the Input String
Subroutine BREAK-INPUT takes a rather brute-force approach to find a convenient breaking point for the INPUT string: it finds the last blank space at or before the point where the line must end if it is to be continued (MAXLENGTH minus 2, to be able to insert a '+' at the end). The rest of the subroutine allows for special cases where there's no breaking point (no space is found) or we must use a minus sign instead of plus sign.
Built-in REXX function LASTPOS searches INPUT backwards, starting the search for a blank space at byte number WORK-MAXLENGTH-2.
Converting to Uppercase or Lowercase
Finally, subroutine CONVERT-CASE converts every letter of the alphabet found in INPUT to upper- or lowercase, provided that it's not within quotes. This preserves quoted strings as the programmer coded them.
First, POS is used to find a single quote character within INPUT. If none is found (the position is 0), the entire INPUT string is converted to the desired case with the TRANSLATE function.
Else, we enter a DO UNTIL loop which will repeat processing until no more single quotes are encountered. The code inside the loop finds two single quotes, converts to the desired case everything before the first one, concatenates the portion within the single quotes without conversion and repeats the process. It's actually rather simple.
Programmer Friendly
INDCLSRC makes CL more programmer-friendly, and it will spoil you when you become accustomed to it. I know that from personal experience. Recently I submitted to batch several jobs to indent all members in several of our source files, using CVTCASE(*LOWER) because we favor lowercase for our internal use. Now we cannot stand the sight of a "normal" CL program!
An added bonus of INDCLSRC is that it reports to you mismatched DOs and ENDDOs. If the program has too many ENDDOs at some point, it will tell you. If the source code ends without closing a DO group, it will tell you. In both cases it does so by inserting a line having >>>---> in columns 1-7, followed by a message.
INDCLSRC has a few requirements and limitations:
The original code must use keywords in DCLs, IFs, ELSEs and MONMSGs.
Comments embedded between command parameters may confuse INDCLSRC.
INDCLSRC has a lot of code, but it's well worth the effort. You can download it from OpenBBS, and I urge you to take it for a test drive.
Further Reading
Pelkie, Craig. "A Look at REXX," MC (November 1991): 18-24.
Pelkie, Craig. "A REXXample," MC (July 1991): 34-38.
REXX Programmer's Guide, (SC24-5553-00)
REXX Reference Guide, (SC24- 5552-00)
Using REXX to Indent CL Source
Figure 1 Command INDCLSRC
INDCLSRC: CMD PROMPT('Indent CL Source') PARM KWD(SRCMBR) TYPE(*NAME) LEN(10) + SPCVAL((*ALL)) MIN(1) EXPR(*YES) + PROMPT('Source member') PARM KWD(SRCFILE) TYPE(Q1) PROMPT('Source file') PARM KWD(CVTCASE) TYPE(*CHAR) LEN(6) RSTD(*YES) + DFT(*NONE) VALUES(*UPPER *LOWER *NONE) + EXPR(*YES) PROMPT('Convert case') PARM KWD(INDRMKS) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*YES) VALUES(*YES *NO) EXPR(*YES) + PROMPT('Indent remarks') PARM KWD(OUTPUT) TYPE(*CHAR) LEN(7) RSTD(*YES) + DFT(*SRCMBR) VALUES(*SRCMBR *PRINT) + EXPR(*YES) PROMPT('Output') PARM KWD(SAVOLDSRC) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*NO) VALUES(*YES *NO) EXPR(*YES) + PMTCTL(PC1) PROMPT('Save old source member') PARM KWD(BGNCOL) TYPE(*DEC) LEN(2 0) DFT(3) + RANGE(1 14) PMTCTL(*PMTRQS) + PROMPT('Beginning column') PARM KWD(INDCOL) TYPE(*DEC) LEN(1 0) DFT(3) + RANGE(1 5) PMTCTL(*PMTRQS) PROMPT('Indent + columns per level') PARM KWD(INDCONT) TYPE(*DEC) LEN(1 0) DFT(3) + RANGE(1 5) PMTCTL(*PMTRQS) PROMPT('Indent + continuation lines') Q1: QUAL TYPE(*NAME) LEN(10) DFT(QCLSRC) EXPR(*YES) QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL) (*CURLIB)) EXPR(*YES) + PROMPT('Library') PC1: PMTCTL CTL(OUTPUT) COND((*EQ *SRCMBR))
Using REXX to Indent CL Source
Figure 2 CL program CL001CL
CL001CL: + PGM PARM(&SRCMBR &QSRCF &CVTCASE &INDRMKS &OUTPUT &SAVOLDSRC + &BGNCOL &INDCOL &INDCONT) DCL VAR(&BGNCOL) TYPE(*DEC) LEN(2 0) DCL VAR(&CVTCASE) TYPE(*CHAR) LEN(6) DCL VAR(&INDCOL) TYPE(*DEC) LEN(1 0) DCL VAR(&INDCONT) TYPE(*DEC) LEN(1 0) DCL VAR(&INDRMKS) TYPE(*CHAR) LEN(4) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(80) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&OUTPUT) TYPE(*CHAR) LEN(7) DCL VAR(&QSRCF) TYPE(*CHAR) LEN(20) DCL VAR(&RTNLIB) TYPE(*CHAR) LEN(10) DCL VAR(&SAVOLDSRC) TYPE(*CHAR) LEN(4) DCL VAR(&SRCF) TYPE(*CHAR) LEN(10) DCL VAR(&SRCFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&SRCMBR) TYPE(*CHAR) LEN(10) DCL VAR(&SRCTYPE) TYPE(*CHAR) LEN(10) /* Break qualified name */ CHGVAR VAR(&SRCF) VALUE(%SST(&QSRCF 1 10)) CHGVAR VAR(&SRCFLIB) VALUE(%SST(&QSRCF 11 10)) /* If not *ALL, process member immediately */ IF COND(&SRCMBR *NE '*ALL') THEN(DO) RTVMBRD FILE(&SRCFLIB/&SRCF) MBR(&SRCMBR) SRCTYPE(&SRCTYPE) IF COND(&SRCTYPE *NE 'CL' *AND &SRCTYPE *NE 'CLP' *AND + &SRCTYPE *NE 'CLP38') THEN(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Member' + *BCAT &SRCMBR *BCAT 'is not a CL source member') + MSGTYPE(*ESCAPE) RETURN ENDDO ELSE CMD(DO) CALL PGM(CL001CLA) PARM(&SRCMBR &SRCF &SRCFLIB &CVTCASE + &INDRMKS &OUTPUT &SAVOLDSRC &BGNCOL &INDCOL &INDCONT) MONMSG MSGID(CPF0000) EXEC(DO) RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) MSGFLIB(&MSGFLIB) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) RETURN ENDDO ENDDO ENDDO /* Otherwise, process multiple members */ ELSE CMD(DO) RTVMBRD FILE(&SRCFLIB/&SRCF) MBR(*FIRSTMBR) RTNMBR(&SRCMBR) + SRCTYPE(&SRCTYPE) MONMSG MSGID(CPF0000) EXEC(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Source + file' *BCAT &SRCF *BCAT 'in' *BCAT &SRCFLIB *BCAT 'has + no members') MSGTYPE(*ESCAPE) RETURN ENDDO LOOP: + IF COND(&SRCTYPE *EQ 'CLP' *OR &SRCTYPE *EQ 'CLP38' *OR + &SRCTYPE *EQ 'CL') THEN(DO) CALL PGM(CL001CLA) PARM(&SRCMBR &SRCF &SRCFLIB &CVTCASE + &INDRMKS &OUTPUT &SAVOLDSRC &BGNCOL &INDCOL &INDCONT) MONMSG MSGID(CPF0000) EXEC(DO) RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) MSGFLIB(&MSGFLIB) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*DIAG) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&SRCTYPE + *BCAT 'member' *BCAT &SRCMBR *BCAT 'not processed') + MSGTYPE(*DIAG) GOTO CMDLBL(NEXT) ENDDO SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Member' + *BCAT &SRCMBR *BCAT 'indented successfully') + MSGTYPE(*INFO) ENDDO ELSE CMD(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&SRCTYPE + *BCAT 'member' *BCAT &SRCMBR *BCAT 'skipped') + MSGTYPE(*INFO) ENDDO NEXT: + RTVMBRD FILE(&SRCFLIB/&SRCF) MBR(&SRCMBR *NEXT) + RTNMBR(&SRCMBR) SRCTYPE(&SRCTYPE) MONMSG MSGID(CPF0000) EXEC(RETURN) GOTO CMDLBL(LOOP) ENDDO ENDPGM
Using REXX to Indent CL Source
Figure 3 CL program CL001CLA
CL001CLA: + PGM PARM(&SRCMBR &SRCF &SRCFLIB &CVTCASE &INDRMKS &OUTPUT + &SAVOLDSRC &BGNCOL &INDCOL &INDCONT) DCL VAR(&BGNCOL) TYPE(*DEC) LEN(2 0) DCL VAR(&BGNCOL_C) TYPE(*CHAR) LEN(2) DCL VAR(&CVTCASE) TYPE(*CHAR) LEN(6) DCL VAR(&INDCOL) TYPE(*DEC) LEN(1 0) DCL VAR(&INDCOL_C) TYPE(*CHAR) LEN(1) DCL VAR(&INDCONT) TYPE(*DEC) LEN(1 0) DCL VAR(&INDCONT_C) TYPE(*CHAR) LEN(1) DCL VAR(&INDRMKS) TYPE(*CHAR) LEN(4) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(80) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&OUTPUT) TYPE(*CHAR) LEN(7) DCL VAR(&RTNLIB) TYPE(*CHAR) LEN(10) DCL VAR(&SAVOLDSRC) TYPE(*CHAR) LEN(4) DCL VAR(&SRCF) TYPE(*CHAR) LEN(10) DCL VAR(&SRCFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&SRCMBR) TYPE(*CHAR) LEN(10) MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(SNDERRMSG)) /* Allocate source member */ ALCOBJ OBJ((&SRCFLIB/&SRCF *FILE *EXCL &SRCMBR)) WAIT(0) /* Send status message */ SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Indenting member' + *BCAT &SRCMBR *TCAT '; please wait') TOPGMQ(*EXT) + MSGTYPE(*STATUS) CHGJOB STSMSG(*NONE) /* Save original source member, if requested */ IF COND(&OUTPUT *EQ '*SRCMBR' *AND &SAVOLDSRC *EQ '*YES') THEN(DO) CRTSRCPF FILE(&SRCFLIB/B4INDCLSRC) RCDLEN(92) TEXT('CL source + saved before running INDCLSRC') MONMSG MSGID(CPF0000) CPYSRCF FROMFILE(&SRCFLIB/&SRCF) TOFILE(&SRCFLIB/B4INDCLSRC) + FROMMBR(&SRCMBR) TOMBR(*FROMMBR) MBROPT(*REPLACE) ENDDO /* Create work member in QTEMP/QCLSRC */ CRTSRCPF FILE(QTEMP/QCLSRC) RCDLEN(92) MONMSG MSGID(CPF0000) ADDPFM FILE(QTEMP/QCLSRC) MBR(WORKMBR) MONMSG MSGID(CPF0000) CLRPFM FILE(QTEMP/QCLSRC) MBR(WORKMBR) /* Indent CL source and replace original member */ CHGVAR VAR(&BGNCOL_C) VALUE(&BGNCOL) CHGVAR VAR(&INDCOL_C) VALUE(&INDCOL) CHGVAR VAR(&INDCONT_C) VALUE(&INDCONT) RTVOBJD OBJ(CL001CL) OBJTYPE(*PGM) RTNLIB(&RTNLIB) STRREXPRC SRCMBR(CL001RX) SRCFILE(&RTNLIB/QREXSRC) PARM(&SRCFLIB + *BCAT &SRCF *BCAT &SRCMBR *BCAT &CVTCASE *BCAT &INDRMKS *BCAT + &BGNCOL_C *BCAT &INDCOL_C *BCAT &INDCONT_C) IF COND(&OUTPUT *EQ '*SRCMBR') THEN(DO) CPYSRCF FROMFILE(QTEMP/QCLSRC) TOFILE(&SRCFLIB/&SRCF) + FROMMBR(WORKMBR) TOMBR(&SRCMBR) MBROPT(*REPLACE) + SRCOPT(*SEQNBR) SRCSEQ(1.00 1.00) ENDDO ELSE CMD(DO) OVRPRTF FILE(QSYSPRT) PRTTXT('Member =' *BCAT &SRCMBR) CPYSRCF FROMFILE(QTEMP/QCLSRC) TOFILE(*PRINT) FROMMBR(WORKMBR) DLTOVR FILE(QSYSPRT) ENDDO DLCOBJ OBJ((&SRCFLIB/&SRCF *FILE *EXCL &SRCMBR)) GOTO CMDLBL(ENDPGM) /* Send error message */ SNDERRMSG: + DLCOBJ OBJ((&SRCFLIB/&SRCF *FILE *EXCL &SRCMBR)) RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) + MSGFLIB(&MSGFLIB) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) MSGDTA(&MSGDTA) + MSGTYPE(*ESCAPE) ENDPGM: + CHGJOB STSMSG(*USRPRF) ENDPGM
Using REXX to Indent CL Source
Figure 4 REXX program CL001RX
mainline: parse arg srcflib srcf srcmbr cvtcase indrmks bgncol indcol indcont 'ovrdbf file(stdin) tofile('srcflib'/'srcf') mbr('srcmbr')' 'ovrdbf file(stdout) tofile(qtemp/qclsrc) mbr(workmbr)' level = 1 lowercase = 'abcdefghijklmnopqrstuvwxyz' uppercase = translate(lowercase) select when cvtcase = '*UPPER' then do from_case = lowercase to_case = uppercase end when cvtcase = '*LOWER' then do from_case = uppercase to_case = lowercase end otherwise nop end do forever parse pull source_record if source_record = '' then leave if substr(source_record,13,80) = '' then say source_record else call process_record end if level > 1 then do missing_enddo = level - 1 say sequence || date || '>>>---> ' || missing_enddo , || ' missing ENDDOs detected' end return /*******************************************************************/ process_record: sequence = substr(source_record,1,6) date = substr(source_record,7,6) source_data = substr(source_record,13,80) /* write a separate record for CL tags */ parse var source_data tag statement if right(tag,1) = ':' then do if cvtcase = '*NONE' then say sequence || date || tag || ' +' else say sequence || date || , translate(tag,to_case,from_case) || ' +' if left(statement,1) = '+' then return else source_data = statement end /* write comments as-is if indrmks = '*NO' */ if left(strip(source_data),2) = '/*' & indrmks = '*NO' then do say sequence || date || source_data return end /* build entire command string */ call build_command_string /* convert input case if so requested */ if cvtcase <> '*NONE' & left(strip(input),2) <> '/*' then call convert_case /* format DCLs to align parameters vertically */ if translate(word(input,1)) = 'DCL' then call format_dcl /* write command string */ call write return /*******************************************************************/ build_command_string: /* eliminate repeated blanks between command and parameters */ parse var source_data command parameters input = strip(command) || ' ' || strip(parameters) /* continue with next records if necessary */ do while right(input,1) = '+' | right(input,1) = '-' save_continuation = right(input,1) input = left(input,length(input)-1) parse pull source_record source_data = substr(source_record,13,80) if save_continuation = '+' then input = input || strip(source_data,'b') else input = input || strip(source_data,'t') end return /*******************************************************************/ format_dcl: parse var input dcl var type varlen other_parameters if translate(left(varlen,4)) <> 'LEN(' then do other_parameters = varlen || ' ' || other_parameters varlen = '' end if translate(type) = 'TYPE(*DEC)' then do parse var other_parameters decimals other_parameters2 if substr(decimals,2,1) = ')' then do varlen = varlen || ' ' || decimals other_parameters = other_parameters2 end end input = dcl || ' ' || left(var,17) || left(type,12) || , left(varlen,11) || strip(other_parameters) return /*******************************************************************/ write: /* indent only the first 10 levels */ if level < 1 then do say sequence || date || '>>>---> Superfluous ENDDO found' level = 1 end if level <= 10 then indent = copies(' ',indcol*(level-1)+bgncol) else indent = copies(' ',indcol*9+bgncol) /* calculate maximum statement length */ maxlength = 70 - length(indent) call calculate_next_level last_break_symbol = '' write_indented = 'Y' continued = 'N' /* write as much as possible within the maximum length calculated */ do until length(input) = 0 /* if entire statement fits, write it out immediately */ if continued = 'Y' & length(input) <= maxlength - indcont | , continued = 'N' & length(input) <= maxlength then do if translate(word(input,1)) = 'ENDDO' & , length(indent)-indcol > 0 then indent = left(indent,length(indent)-indcol) if last_break_symbol = '-' then write_indented = 'N' if write_indented = 'Y' then do if continued = 'N' then say sequence || date || indent || input else say sequence || date || indent || , copies(' ',indcont) || input end else say sequence || date || input level = next_level input = '' end /* if too long, write as many words as will fit */ else do call break_input if write_indented = 'Y' then do if continued = 'N' then say sequence || date || indent || output else say sequence || date || indent || , copies(' ',indcont) || output if input <> ' ' then continued = 'Y' end else say sequence || date || output end end return /*******************************************************************/ calculate_next_level: /* comment lines do not affect indentation level */ if left(input,2) = '/*' then next_level = level /* determine if DO or ENDDO were processed */ else do comment_starts = pos('/*',input) if comment_starts = 0 then comment_starts = 9999 then_do_starts = pos('THEN(DO)',translate(input)) cmd_do_starts = pos('CMD(DO)',translate(input)) exec_do_starts = pos('EXEC(DO)',translate(input)) enddo_starts = pos('ENDDO',translate(input)) select when then_do_starts > 0 & , then_do_starts < comment_starts | , cmd_do_starts > 0 & , cmd_do_starts < comment_starts | , exec_do_starts > 0 & , exec_do_starts < comment_starts then next_level = level + 1 when enddo_starts > 0 & , enddo_starts < comment_starts then next_level = level - 1 otherwise next_level = level end end if level < 1 then level = 1 return /*******************************************************************/ break_input: work_maxlength = maxlength if last_break_symbol = '-' then do work_maxlength = 70 write_indented = 'N' end else write_indented = 'Y' if continued = 'Y' then work_maxlength = work_maxlength - indcont break_position = lastpos(' ',input,work_maxlength-2) if break_position > 0 then do if substr(input,break_position+1,1) = ' ' then do break_symbol = '-' output = left(input,break_position) end else do break_symbol = ' +' output = left(input,break_position-1) end input = substr(input,break_position+1) end else do output = left(input,work_maxlength-2) input = substr(input,work_maxlength-1) break_symbol = '+' end output = output || break_symbol last_break_symbol = break_symbol return /*******************************************************************/ convert_case: beginning_quote = pos("'",input,1) if beginning_quote = 0 then input = translate(input,to_case,from_case) else do input_accum = '' do until beginning_quote = 0 beginning_quote = pos("'",input,1) ending_quote = pos("'",input,beginning_quote+1) if beginning_quote > 0 & ending_quote > 0 then do left_portion = left(input,beginning_quote-1) middle_portion = substr(input,beginning_quote,, ending_quote-beginning_quote+1) right_portion = substr(input,ending_quote+1) input_accum = input_accum || , translate(left_portion,to_case,from_case) || , middle_portion input = right_portion end end input = input_accum || translate(input,to_case,from_case) end return
LATEST COMMENTS
MC Press Online