|
Back To LeighWeb Mainframe Utilities Page
View the documentation associated with this module
ISREDIT MACRO (OPT1,OPT2)
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 &OPT1 = HELP THEN GOTO HELPSEC
/**********************************************************************
/* UTILITY: UNUSED *
/* AUTHOR: DAVID LEIGH *
/* UTILITY: MARK UNUSED DATA ELEMENTS IN THE THE COBOL WORKING *
/* STORAGE SECTION FOR DELETION. *
/**********************************************************************
SET UNBAD = NO
ISPEXEC VPUT UNBAD SHARED
ISREDIT RESET
IF &OPT1 = SPECIFY OR &OPT2 = SPECIFY THEN GOTO SPECSEC
/**********************************************************************
/* IN THIS NEXT SECTION, PROJECT SPECIFIC CODE SHOULD BE INSERTED TO *
/* SPECIFY THE FORMAT OF THE DATASET NAME WHICH CONTAINS THE COMPILE *
/* LISTING. CODE ALSO EXISTS TO ALLOW THE USER TO SPECIFY A DATASET *
/* NAME IF THEIR LISTING IS IN A NON-STANDARD NAME. *
/**********************************************************************
ISREDIT (MBR) = MEMBER
SET DSN = &STR(&SYSUID..COMPILE.LISTING.&MBR)
GOTO GETERROR
/**********************************************************************
/* THE FOLLOWING SECTION OF CODE PERMITS A USER TO SPECIFY THAT THE *
/* DATASET CONTAINING THE COMPILED LISTING IS NOT A STANDARD DATASET *
/* (I.E. NOT FOLLOWING PROJECT CONVENTIONS) AND TO SPECIFY WHICH *
/* DATASET CONTAINS THE COMPILED LISTING. *
/**********************************************************************
SPECSEC: +
WRITENR ENTER FULLY QUALIFIED COMPILE LISTING DATASET NAME ==>
READ DSN
IF &STR(&DSN) = THEN +
DO
SET ZEDLMSG = &STR(*** NO LISTING DATASET NAME ENTERED *** +
PROCESSING TERMINATED ***)
ISPEXEC SETMSG MSG(UTLZ000)
EXIT
END
GETERROR: +
SET ZEDLMSG = &STR(*** EXTRACTING COMPILER MESSAGES FROM "&DSN" ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)
IF &SYSDSN('&STR(&DSN)') = OK THEN +
ISPEXEC EDIT DATASET('&DSN') MACRO(UNUSEDMC) PROFILE(SYSPRINT)
ELSE +
DO
SET ZEDSMSG = &STR(NO LISTING DATASET)
SET ZEDLMSG = &STR(LISTING FILE "&DSN" NOT FOUND. )+
&STR(USE "COMPILE" UTILITY TO CREATE A LISTING )+
&STR(FILE OR USE "SPECIFY" PARM TO BE PROMPTED )+
&STR(FOR A LISTING FILE NAME.)
ISPEXEC SETMSG MSG(UTLZ001W)
EXIT
END
/**********************************************************************
/* RETRIEVE THE STORED DATA ELEMENT NAMES *
/**********************************************************************
ISPEXEC VGET UNNUMELE SHARED
IF &UNNUMELE > 0 THEN +
DO
SET ZEDLMSG = &STR(*** MARKING DATA NAMES IN THE CODE ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)
SYSCALL PROCESS_MESSAGES UNNUMELE
END
/**********************************************************************
/* POSITION THE USER AT THE TOP WITH SOME MESSAGES *
/**********************************************************************
SET KEY =
SELECT (&STR(&OPT1))
WHEN (1 ¦ 01 ¦ F1 ¦ F01 ¦ PF1 ¦ PF01) SET KEY = ZPF01
WHEN (2 ¦ 02 ¦ F2 ¦ F02 ¦ PF2 ¦ PF02) SET KEY = ZPF02
WHEN (3 ¦ 03 ¦ F3 ¦ F03 ¦ PF3 ¦ PF03) SET KEY = ZPF03
WHEN (4 ¦ 04 ¦ F4 ¦ F04 ¦ PF4 ¦ PF04) SET KEY = ZPF04
WHEN (5 ¦ 05 ¦ F5 ¦ F05 ¦ PF5 ¦ PF05) SET KEY = ZPF05
WHEN (6 ¦ 06 ¦ F6 ¦ F06 ¦ PF6 ¦ PF06) SET KEY = ZPF06
WHEN (7 ¦ 07 ¦ F7 ¦ F07 ¦ PF7 ¦ PF07) SET KEY = ZPF07
WHEN (8 ¦ 08 ¦ F8 ¦ F08 ¦ PF8 ¦ PF08) SET KEY = ZPF08
WHEN (9 ¦ 09 ¦ F9 ¦ F09 ¦ PF9 ¦ PF09) SET KEY = ZPF09
WHEN (10 ¦ 10 ¦ F10 ¦ PF10) SET KEY = ZPF10
WHEN (11 ¦ 11 ¦ F11 ¦ PF11) SET KEY = ZPF11
WHEN (12 ¦ 12 ¦ F12 ¦ PF12) SET KEY = ZPF12
WHEN (13 ¦ 13 ¦ F13 ¦ PF13) SET KEY = ZPF13
WHEN (14 ¦ 14 ¦ F14 ¦ PF14) SET KEY = ZPF14
WHEN (15 ¦ 15 ¦ F15 ¦ PF15) SET KEY = ZPF15
WHEN (16 ¦ 16 ¦ F16 ¦ PF16) SET KEY = ZPF16
WHEN (17 ¦ 17 ¦ F17 ¦ PF17) SET KEY = ZPF17
WHEN (18 ¦ 18 ¦ F18 ¦ PF18) SET KEY = ZPF18
WHEN (19 ¦ 19 ¦ F19 ¦ PF19) SET KEY = ZPF19
WHEN (20 ¦ 20 ¦ F20 ¦ PF20) SET KEY = ZPF20
WHEN (21 ¦ 21 ¦ F21 ¦ PF21) SET KEY = ZPF21
WHEN (22 ¦ 22 ¦ F22 ¦ PF22) SET KEY = ZPF22
WHEN (23 ¦ 23 ¦ F23 ¦ PF23) SET KEY = ZPF23
WHEN (24 ¦ 24 ¦ F24 ¦ PF24) SET KEY = ZPF24
END
SELECT (&STR(&OPT2))
WHEN (1 ¦ 01 ¦ F1 ¦ F01 ¦ PF1 ¦ PF01) SET KEY = ZPF01
WHEN (2 ¦ 02 ¦ F2 ¦ F02 ¦ PF2 ¦ PF02) SET KEY = ZPF02
WHEN (3 ¦ 03 ¦ F3 ¦ F03 ¦ PF3 ¦ PF03) SET KEY = ZPF03
WHEN (4 ¦ 04 ¦ F4 ¦ F04 ¦ PF4 ¦ PF04) SET KEY = ZPF04
WHEN (5 ¦ 05 ¦ F5 ¦ F05 ¦ PF5 ¦ PF05) SET KEY = ZPF05
WHEN (6 ¦ 06 ¦ F6 ¦ F06 ¦ PF6 ¦ PF06) SET KEY = ZPF06
WHEN (7 ¦ 07 ¦ F7 ¦ F07 ¦ PF7 ¦ PF07) SET KEY = ZPF07
WHEN (8 ¦ 08 ¦ F8 ¦ F08 ¦ PF8 ¦ PF08) SET KEY = ZPF08
WHEN (9 ¦ 09 ¦ F9 ¦ F09 ¦ PF9 ¦ PF09) SET KEY = ZPF09
WHEN (10 ¦ 10 ¦ F10 ¦ PF10) SET KEY = ZPF10
WHEN (11 ¦ 11 ¦ F11 ¦ PF11) SET KEY = ZPF11
WHEN (12 ¦ 12 ¦ F12 ¦ PF12) SET KEY = ZPF12
WHEN (13 ¦ 13 ¦ F13 ¦ PF13) SET KEY = ZPF13
WHEN (14 ¦ 14 ¦ F14 ¦ PF14) SET KEY = ZPF14
WHEN (15 ¦ 15 ¦ F15 ¦ PF15) SET KEY = ZPF15
WHEN (16 ¦ 16 ¦ F16 ¦ PF16) SET KEY = ZPF16
WHEN (17 ¦ 17 ¦ F17 ¦ PF17) SET KEY = ZPF17
WHEN (18 ¦ 18 ¦ F18 ¦ PF18) SET KEY = ZPF18
WHEN (19 ¦ 19 ¦ F19 ¦ PF19) SET KEY = ZPF19
WHEN (20 ¦ 20 ¦ F20 ¦ PF20) SET KEY = ZPF20
WHEN (21 ¦ 21 ¦ F21 ¦ PF21) SET KEY = ZPF21
WHEN (22 ¦ 22 ¦ F22 ¦ PF22) SET KEY = ZPF22
WHEN (23 ¦ 23 ¦ F23 ¦ PF23) SET KEY = ZPF23
WHEN (24 ¦ 24 ¦ F24 ¦ PF24) SET KEY = ZPF24
END
IF &STR(&KEY) > THEN +
DO
SET ZEDLMSG = &STR(*** PRESS &SUBSTR(2:5,&STR(&KEY)) TO SEE +
THE MARKED LINES ***)
SET &&KEY = &STR(LOCATE NEXT SPECIAL)
ISPEXEC VPUT &KEY PROFILE
END
ELSE +
SET ZEDLMSG = &STR(*** TYPE "L SPE" TO SEE THE MARKED LINES ***)
IF &UNNUMELE = 0 AND &UNNUMWAR = 0 AND &UNNUMERR = 0 AND +
&UNNUMSEV = 0 AND &UNNUMUNA = 0 THEN +
SET ZEDLMSG = &STR(*** NO DATA ELEMENT NAMES WERE SELECTED TO +
MARK ***)
ISREDIT LOCATE .ZLAST
ISREDIT UP MAX
ISREDIT (NUM1,NUM2) = NUMBER
IF &STR(&NUM1) = ON AND &SYSINDEX(&STR(COBOL),&STR(&NUM2)) > 0 AND +
(&UNNUMELE > 0 OR &UNNUMWAR = 0 OR &UNNUMERR = 0 OR +
&UNNUMSEV = 0 OR &UNNUMUNA = 0) THEN +
ISREDIT RIGHT 6
ISPEXEC SETMSG MSG(UTLZ000W)
EXIT
/**********************************************************************
/* PROCESS THE DATA ELEMENT LINES. *
/**********************************************************************
PROCESS_MESSAGES: PROC 1 NUMBER
SYSREF NUMBER
DO &I = 1 TO &NUMBER
SET X = &SUBSTR(&LENGTH(&STR(0000&I))-4:+
&LENGTH(&STR(0000&I)),&STR(0000&I)
ISPEXEC VGET (UN&X.M UN&X.L UN&X.O) SHARED
SYSCALL INSERT_MESSAGE UN&X.M UN&X.L UN&X.O
IF &EVAL(&I//10) = 0 THEN +
DO
SET ZEDLMSG = &STR(*** PROCESSED &I OF +
&NUMBER DATA ELEMENTS ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)
END
END
RETURN
END
/**********************************************************************
/* INSERT A SPECIFIC MESSAGE *
/**********************************************************************
INSERT_MESSAGE: PROC 3 MESSAGE LINE OCCURANCE
SYSREF MESSAGE LINE OCCURANCE
SET PREFIX = &STR(********)
IF &SYSINDEX(&STR('),&SYSNSUB(1,&LINE)) > 0 THEN +
IF &SYSINDEX(&STR("),&SYSNSUB(1,&LINE)) > 0 THEN +
SET NOMARK = YES
ELSE +
SET QT = &STR(")
ELSE +
SET QT = &STR(')
ISREDIT (NUM1,NUM2) = NUMBER
IF &SYSINDEX(&STR(COBOL),&STR(&NUM1)) > 0 OR +
&SYSINDEX(&STR(COBOL),&STR(&NUM2)) > 0 THEN +
SET COL1 = 1
ELSE SET COL1 = 7
ISREDIT (VAR1,VAR2) = BOUNDS
ISREDIT NUMBER OFF
ISREDIT (LRECL) = LRECL
ISREDIT BOUNDS = 1 &LRECL
ISREDIT FIND &QT&STR(&LINE)&QT FIRST &COL1
SET FINDCC = &LASTCC
DO &I = 2 TO &OCCURANCE WHILE &LASTCC = 0 AND &FINDCC = 0
ISREDIT FIND &QT&STR(&LINE)&QT NEXT &COL1
END
IF &NOMARK = YES OR &FINDCC > 0 THEN +
DO
ISPEXEC VGET UNBAD SHARED
IF &UNBAD = NO THEN +
DO
SET UNBAD = YES
ISPEXEC VPUT UNBAD SHARED
SET INSERT = &STR(******* UNABLE TO MARK THE +
FOLLOWING MESSAGES AT THE PROPER +
PROGRAM LINE *******)
ISREDIT LINE_BEFORE .ZFIRST = MSGLINE (INSERT)
END
ISREDIT FIND FIRST P'='
END
DO WHILE &STR(&SYSNSUB(1,&MESSAGE)) >
SET LEN = &LENGTH(&STR(&SYSNSUB(1,&MESSAGE)))
SET X = 63
IF &LEN < &X THEN +
SET X = &LEN
ELSE +
DO WHILE &SYSINDEX(&STR( ),&STR(&SYSNSUB(1,&MESSAGE))) > 0 AND +
&SUBSTR(&X:&X,&STR(&SYSNSUB(1,&MESSAGE))) > &STR( )
SET X = &X - 1
END
SET INSERT = &STR(&PREFIX &SUBSTR(1:&X,&SYSNSUB(1,&MESSAGE)))
ISREDIT LINE_BEFORE .ZCSR = MSGLINE (INSERT)
IF &X = &LEN THEN SET MESSAGE =
ELSE +
DO
SET X = &X + 1
IF &X ª> &LEN THEN +
SET MESSAGE = &SUBSTR(&X:&LEN,+
&STR(&SYSNSUB(1,&MESSAGE)))
END
END
IF &NOMARK = YES OR &FINDCC > 0 THEN +
DO
SET INSERT = &STR(&PREFIX &LINE)
ISPEXEC LINE_BEFORE .ZFIRST = MSGLINE (INSERT)
END
ISREDIT NUMBER = &NUM1 &NUM2
ISREDIT BOUNDS = &VAR1 &VAR2
RETURN
END
HELPSEC: +
ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL)
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR UNUSED UTILITY +
*** NO PROCESSING PERFORMED ***)
ISPEXEC SETMSG MSG(UTLZ000)
EXIT
|
|
