Back To LeighWeb Mainframe Utilities Page

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