Mainframe Utility: LINEUPTO

ISREDIT MACRO (SPLIT)
ISPEXEC CONTROL ERRORS RETURN
/**** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/
ISPEXEC VGET (DBGSWTCH) PROFILE
IF &DBGSWTCH = &STR(ON) THEN +
CONTROL MSG LIST CONLIST SYMLIST NOFLUSH
ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT
IF &SPLIT = HELP THEN GOTO HELPSEC
/**********************************************************************
/* EDIT MACRO : LINEUPTO                                              *
/* AUTHOR     : DAVE LEIGH                                            *
/* DATE       : 6-4-90                                                *
/* FUNCTION   : LINE UP " TO " COBOL WORD IN COBOL PROGRAMS.  FINDS   *
/*              THE " TO " FARTHEST TO THE RIGHT WITHIN EACH PARAGRAPH*
/*              OR SECTION AND ATTEMPTS TO LINE UP ALL THE " TO "     *
/*              WORDS IN THAT SECTION.  ERROR LINES CAN BE FOUND WITH *
/*              THE "L ERR" COMMAND.                                  *
/**********************************************************************

/**********************************************************************
/* WHAT EDIT PROFILE NUMBERING SCHEME IS BEING USED?                  *
/**********************************************************************
ISREDIT (X,Y) = NUMBER
IF &X = ON AND &SYSINDEX(&STR( COBOL),&STR(&Y)) > 0 THEN +
    DO
        SET COL1 = 1
        SET COL2 = 66
    END
ELSE +
    DO
        SET COL1 = 7
        SET COL2 = 72
    END

/**********************************************************************
/* SET UP THE LINES TO PROCESS AND GET TO THE PROCEDURE DIVISION      *
/**********************************************************************
ISREDIT EXCLUDE ALL P'¬' &COL1
ISREDIT EXCLUDE ALL ' GO TO '
ISREDIT EXCLUDE ALL ' DISPLAY '

ISREDIT FIND FIRST ' PROCEDURE ' &COL1 &EVAL(&COL1 + 10 + 3)
IF &LASTCC > 0 THEN +
    DO
        SET ZEDLMSG = &STR(*** COULD NOT FIND A PROCEDURE DIVISION ***)
        ISPEXEC SETMSG MSG(UTLZ001)
        GOTO FINAL
    END

/**********************************************************************
/* HERE WE GO LOOPING THROUGH THE CODE                                *
/**********************************************************************
SET NUMSHIFT = 0
SET LASTFLAG = NO
ISREDIT FIND NEXT P' ª'  &COL1 &EVAL(&COL1 + 2 + 3) NX

DO WHILE &LASTCC = 0 OR &LASTFLAG = YES
    ISREDIT LABEL .ZCSR = .QQX
    ISREDIT SEEK NEXT P'=' &COL1 &EVAL(&COL2 + 1 + 3)
    ISREDIT FIND NEXT P' ª' &COL1 &EVAL(&COL2 + 2 + 3) X
    IF &LASTCC > 0 THEN +
        DO
            ISREDIT FIND FIRST P'=' .ZLAST .ZLAST
            SET LASTFLAG = YES
        END
    ISREDIT LABEL .ZCSR = .QQY
    SET TOCOL = 0
    ISREDIT FIND FIRST ' TO ' NX .QQX .QQY
    DO WHILE &LASTCC = 0
        ISREDIT (NULL,COL) = CURSOR
        ISREDIT FIND PREV P'¬' &EVAL(&COL1 + 5) &COL2 .ZCSR .ZCSR
        IF &LASTCC = 0 THEN +
            DO
                ISREDIT (LN,XCOL) = CURSOR
                SET X = &COL - &XCOL
                IF &X > 1 THEN +
                    DO
                        SET &XCOL = &XCOL + 1
                        SET X = &COL - &XCOL
                        ISREDIT BOUNDS &XCOL &COL2
                        ISREDIT SHIFT < .ZCSR &X
                        ISREDIT BOUNDS &COL1 &COL2
                        SET COL = &XCOL
                    END
                ISREDIT CURSOR = &LN &COL2
            END
        IF &COL > &TOCOL THEN SET TOCOL = &COL
        ISREDIT FIND NEXT ' TO ' NX .QQX .QQY
    END
    IF &TOCOL > 0 THEN +
        DO
            ISREDIT FIND FIRST ' TO ' NX .QQX .QQY
            DO WHILE &LASTCC = 0
                ISREDIT (LN,COL) = CURSOR
                IF &COL < &TOCOL THEN +
                    DO
                        SET X = &TOCOL - &COL
                        ISREDIT BOUNDS = &COL &COL2
                        ISREDIT SHIFT > .ZCSR &X
                        SET NUMSHIFT = &NUMSHIFT + 1
                        IF &EVAL(&NUMSHIFT//10) = 0 THEN +
                            WRITE *** &NUMSHIFT "TO"S PROCESSED
                        ISREDIT BOUNDS = &COL1 &COL2
                    END
                ISREDIT CURSOR = &LN &COL2
                ISREDIT FIND NEXT ' TO ' NX .QQX .QQY
            END
        END
    IF &LASTFLAG = NO THEN ISREDIT FIND FIRST P'=' .QQY .QQY
    ELSE +
        DO
            SET LASTFLAG = NO
            SET LASTCC = 8
        END
END

SET ZEDLMSG = &STR(PROCESSED &NUMSHIFT "TO"S...USE "L ERR" TO FIND +
                   ANY UNSUCCESSFUL ATTEMPTS)
ISPEXEC SETMSG MSG(UTLZ000)

FINAL: +
ISREDIT RESET EXCLUDED
IF &SPLIT = SPLIT THEN %SPLITTO
EXIT

HELPSEC: +                                                              02480000
ISPEXEC SELECT PGM(ISPTUTOR) PARM(UTILH098)                             02490000
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR LINEUPTO UTILITY +            02490000
                   *** NO PROCESSING PERFORMED ***)                     02490000
ISPEXEC SETMSG MSG(UTLZ000)                                             02490000
EXIT
            

 This utility allows the user to type "lineupto" on the command line while
 editing their COBOL program and have their "TO"s in COBOL MOVE statements
 automatically aligned together.  The utility will scan the program and process
 each paragraph/section seperately and attempt to line up each "TO" to the
 rightmost "TO" in that paragraph/section.  Before aligning it moves the "TO"s
 as far left as possible so as to make the most of available space on a given
 line.  Lines which could not be lined up are marked as edit error lines
 (==ERR>).  Specifying parm "split" will automatically split lines in error (see
 SPLITTO)