Return to Mainframe Utilities Page
Module
PROC 0 HELP DSN() EDIT
CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /* STANDARD INITIAL */
ERROR DO /* PROCESSING : */
SET MODE = CLIST /* 1. INVOCATION */
RETURN /* MODE ? */
END /* */
ISREDIT MACRO (HELP) /* */
ERROR OFF /* */
ISPEXEC CONTROL ERRORS RETURN /* LOGGING */
ISPEXEC VGET (DBGSWTCH) PROFILE /* 3. DEBUG MESSAGES*/
IF &DBGSWTCH = &STR(ON) THEN /* BASED ON */ +
CONTROL MSG LIST CONLIST SYMLIST NOFLUSH /* "DBGSWTCH" */
ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /* VARIABLE. */
IF &HELP = HELP THEN GOTO HELPSEC /* 4. DISPLAY HELP */
/**********************************************************************/
/* UTILITY NAME : COMPONEN */
/* AUTHOR : DAVE LEIGH */
/* DESCRIPTION : EXTRACT WHAT COMPONENTS ARE A PART OF A GIVEN CLIST */
/* AND PLACE THE RESULTS IN A FILE. */
/**********************************************************************/
/**********************************************************************
/* IF CALLED AS A CLIST, THEN START THE EDITING PROCESS. *
/**********************************************************************
IF &MODE = CLIST THEN +
IF &STR(&DSN) = THEN +
DO
SET ZEDLMSG = &STR(NO CLIST DATASET NAME SPECIFIED. +
NO PROCESSING PERFORMED)
ISPEXEC SETMSG MSG(UTLZ001)
EXIT
END
ELSE +
DO
SET CMPLVL = 0
IF &EDIT = EDIT THEN SET CMPEDIT = YES
ISPEXEC VPUT (CMPLVL CMPEDIT) SHARED
ISPEXEC EDIT DATASET('&DSN') MACRO(COMPONEN)
EXIT
END
ELSE +
DO
IF &HELP = EDIT THEN +
SET CMPEDIT = YES
ELSE SET CMPEDIT = NO
ISPEXEC VGET CMPTYPE SHARED
IF &CMPTYPE = THEN +
SET CMPTYPE = CLIST
ISPEXEC VPUT (CMPEDIT CMPTYPE) SHARED
ISREDIT (MBR) = MEMBER
ISREDIT (DSN) = DATASET
IF &MBR > THEN SET DSN = &STR(&DSN(&MBR))
SET ZEDLMSG = &STR(GATHERING COMPONENTS IN "&DSN")
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000)
END
/**********************************************************************
/* IF THE NESTING LEVEL IS 0 THEN DO SOME INITIALIZATION *
/**********************************************************************
ISPEXEC VGET (CMPEDIT CMPLVL CMPDSN CMPTYPE) SHARED
IF &STR(&CMPLVL) < 1 THEN SET &CMPLVL = 0
IF &STR(&CMPLVL) = 0 THEN +
DO
SET CMPTYPE = CLIST
IF &STR(&MBR) > THEN +
SET CMPDSN = &STR(&SYSPREF..TEMP.COMPONEN.&MBR)
ELSE +
DO &I = &LENGTH(&STR(&DSN)) TO 1 BY -1
IF &SUBSTR(&I:&I,&STR(&DSN)) = &STR(.) THEN +
DO
SET I = &I + 1
SET CMPDSN = &STR(&SYSPREF..TEMP.+
COMPONEN.+
&SUBSTR(&I,&LENGTH(&STR(&DSN)),+
&STR(&DSN))
SET I = 0
END
END
DO &I = &LENGTH(&STR(&CMPDSN)) TO 1 BY -1
IF &SUBSTR(&I:&I,&STR(&CMPDSN)) = &STR(.) THEN +
DO
SET I = &I + 1
SET CMPMBR = &SUBSTR(&I:&LENGTH(&STR(&CMPDSN)),+
&STR(&CMPDSN))
SET I = 0
END
END
SET ISPPLIB =
SET ISPMLIB =
SET ISPTLIB =
SET ISPSLIB =
SET ISPLLIB =
SET ISPCLIB =
ISPEXEC VPUT (CMPLVL ISPPLIB ISPMLIB ISPTLIB ISPSLIB +
ISPLLIB ISPCLIB CMPDSN TYPE CMPMBR) SHARED
DELETE '&CMPDSN'
FREE DD(CMPDD)
ALLOC DD(CMPDD) DSN('&CMPDSN') +
NEW CATALOG +
UNIT(SYSDA) VOLUME(WRK$$$) +
SPACE(5,5) TRACKS RELEASE +
RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS)
OPENFILE CMPDD OUTPUT
SET CMPDD = &STR(<&SUBSTR(1:8,&STR(&CMPMBR ))> +
ISPCLIB: &CMPMBR)
PUTFILE CMPDD
CLOSFILE CMPDD
END
/**********************************************************************
/* VGET SOME VARIABLE AND SET SOME VARIABLES. *
/**********************************************************************
SET VARVALUE = &STR(***VARIABLE***)
ISPEXEC VGET (CMPLVL ISPPLIB ISPMLIB ISPTLIB ISPSLIB +
ISPLLIB ISPCLIB CMPDSN TYPE CMPMBR) SHARED
DO &I = 1 TO &CMPLVL BY 1
SET PFX = &STR(&PFX )
END
SET PFX = &STR(<&SUBSTR(1:8,&STR(&CMPMBR ))> &PFX)
SET CMPLVL = &CMPLVL + 1
ISPEXEC VPUT CMPLVL SHARED
FREE DD(CMPDD)
ALLOC DD(CMPDD) DSN('&CMPDSN') MOD
OPENFILE CMPDD OUTPUT
SET LP = &STR((
SET RP = &STR())
/**********************************************************************
/* PROCESS DIFFERENTLY IF A CLIST, PANEL, OR SKELETON *
/**********************************************************************
SELECT (&CMPTYPE)
WHEN (CLIST) GOTO CLIST_SECTION
WHEN (PANEL) GOTO PANEL_SECTION
WHEN (SKELETON) GOTO SKELETON_SECTION
OTHERWISE EXIT CODE(20)
END
/**********************************************************************
/* ACTUALLY PARSE THE CLIST NOW AND PUT THE INFO TO THE OUTPUT DATASET*
/**********************************************************************
CLIST_SECTION: +
ISREDIT (LRECL) = LRECL
ISREDIT BOUNDS = 1 &LRECL
ISREDIT EXCLUDE ALL
ISREDIT FIND ALL 'EXEC '
ISREDIT FIND ALL '%'
ISREDIT FIND ALL ' MACRO('
ISREDIT EXCLUDE ALL "/" 1
ISREDIT EXCLUDE ALL 'REXX EXEC'
ISREDIT EXCLUDE ALL 'EXEC PGM='
ISREDIT EXCLUDE ALL 'ISPEXEC CONTROL '
ISREDIT EXCLUDE ALL 'ISPEXEC LIBDEF '
ISREDIT EXCLUDE ALL 'ISPEXEC BROWSE '
ISREDIT EXCLUDE ALL 'ISPEXEC LM'
ISREDIT EXCLUDE ALL 'ISPEXEC VPUT '
ISREDIT EXCLUDE ALL 'ISPEXEC VGET '
ISREDIT EXCLUDE ALL 'WRITE ' 1
ISREDIT EXCLUDE ALL '(%)'
ISREDIT FIND FIRST P'=' 1 NX
DO WHILE &LASTCC = 0
SET PANELTOO = NO
ISREDIT FIND FIRST 'ISPEXEC ' .ZCSR .ZCSR
IF &LASTCC = 0 THEN DO
ISREDIT FIND NEXT ' SELECT ' .ZCSR .ZCSR
IF &LASTCC = 0 THEN DO
ISREDIT LABEL .ZCSR = .CURR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT (NULL,COL1) = CURSOR
ISREDIT FIND NEXT '(' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (TYPE) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (TYPE)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT (TYPE) = LINE .ZCSR
ISREDIT DELETE .ZCSR
SET TYPE = &TYPE
SELECT (&TYPE)
WHEN (PANEL) DO
PANEL_TOO: SET COL1 = &COL2 + 2
ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR
ISREDIT FIND NEXT ')' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (XPANEL) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (XPANEL)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET XPANEL = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (XPANEL) = LINE .ZCSR
SET XPANEL = &XPANEL
IF &LENGTH(&STR(&XPANEL)) = 0 THEN +
SET XPANEL = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
ISPEXEC VGET ISPPLIB SHARED
IF &SYSINDEX(&STR( &XPANEL ),+
&STR(&ISPPLIB)) = 0 AND +
&STR(&XPANEL) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPPLIB = &STR(&ISPPLIB &XPANEL )
SET CMPDD = &STR(&PFX.ISPPLIB: &XPANEL)
PUTFILE CMPDD
ISPEXEC VPUT ISPPLIB SHARED
ISPEXEC SELECT +
CMD(%FINDMOD &XPANEL ISPPLIB BATCH)
IF &LASTCC = 0 THEN +
DO
ISPEXEC VGET DSN SHARED
CLOSFILE CMPDD
SET CMPTYPE = PANEL
ISPEXEC VPUT CMPTYPE SHARED
ISPEXEC EDIT DATASET('&DSN') +
MACRO(COMPONEN)
SET CMPTYPE = CLIST
ISPEXEC VPUT CMPTYPE SHARED
FREE DD(CMPDD)
ALLOC DD(CMPDD) DSN('&CMPDSN') MOD
OPENFILE CMPDD OUTPUT
END
END
IF &PANELTOO = YES THEN GOTO PANEL_TOO_GOBACK
END
WHEN (PGM) DO
SET COL1 = &COL2 + 2
ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR
ISREDIT FIND NEXT ')' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (XPGM) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (XPGM)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET XPGM = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (XPGM) = LINE .ZCSR
SET XPGM = &XPGM
IF &LENGTH(&STR(&XPGM)) = 0 THEN +
SET XPGM = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
ISPEXEC VGET ISPLLIB SHARED
IF &SYSINDEX(&STR( &XPGM ),+
&STR(&ISPLLIB)) = 0 AND +
&STR(&XPGM) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPLLIB = &STR(&ISPLLIB &XPGM )
SET CMPDD = &STR(&PFX.ISPLLIB: &XPGM)
PUTFILE CMPDD
ISPEXEC VPUT ISPLLIB SHARED
END
END
WHEN (CMD) DO
SET COL1 = &COL2 + 2
ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR
ISREDIT FIND NEXT ')' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT (NULL,COL2X) = CURSOR
IF &COL2X < &COL2 THEN SET COL2 = &COL2X
SET COL2 = &COL2 - 1
ISREDIT (XCMD) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (XCMD)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET XCMD = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (XCMD) = LINE .ZCSR
SET XCMD = &XCMD
IF &LENGTH(&STR(&XCMD)) = 0 THEN +
SET XCMD = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
IF &SUBSTR(1:1,&STR(&XCMD)) = &STR(%) THEN +
SET XCMD = &SUBSTR(2:&LENGTH(&STR(&XCMD)),+
&STR(&XCMD))
ISPEXEC VGET ISPCLIB SHARED
IF &SYSINDEX(&STR( &XCMD ),+
&STR(&ISPCLIB)) = 0 AND +
&STR(&XCMD) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPCLIB = &STR(&ISPCLIB &XCMD )
SET CMPDD = &STR(&PFX.ISPCLIB: &XCMD)
PUTFILE CMPDD
ISPEXEC VPUT ISPCLIB SHARED
ISPEXEC SELECT +
CMD(%FINDMOD &XCMD SYSPROC BATCH)
IF &LASTCC = 0 THEN +
DO
ISPEXEC VGET DSN SHARED
CLOSFILE CMPDD
ISPEXEC EDIT DATASET('&DSN') +
MACRO(COMPONEN)
FREE DD(CMPDD)
ALLOC DD(CMPDD) DSN('&CMPDSN') MOD
OPENFILE CMPDD OUTPUT
END
END
END
OTHERWISE
END
END
ELSE DO
ISREDIT FIND NEXT ' DISPLAY ' .ZCSR .ZCSR
IF &LASTCC = 0 THEN DO
ISREDIT LABEL .ZCSR = .CURR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT (NULL,COL1) = CURSOR
ISREDIT FIND NEXT '(' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (TYPE) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (TYPE)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT (TYPE) = LINE .ZCSR
ISREDIT DELETE .ZCSR
SET TYPE = &TYPE
SELECT (&TYPE)
WHEN (PANEL) DO
SET COL1 = &COL2 + 2
ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR
ISREDIT FIND NEXT ')' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (XPANEL) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (XPANEL)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET XPANEL = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (XPANEL) = LINE .ZCSR
SET XPANEL = &XPANEL
IF &LENGTH(&STR(&XPANEL)) = 0 THEN +
SET XPANEL = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
ISPEXEC VGET ISPPLIB SHARED
IF &SYSINDEX(&STR( &XPANEL ),+
&STR(&ISPPLIB)) = 0 AND +
&STR(&XPANEL) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPPLIB = &STR(&ISPPLIB &XPANEL )
SET CMPDD = &STR(&PFX.ISPPLIB: &XPANEL)
PUTFILE CMPDD
ISPEXEC VPUT ISPPLIB SHARED
ISPEXEC SELECT +
CMD(%FINDMOD &XPANEL ISPPLIB BATCH)
IF &LASTCC = 0 THEN +
DO
ISPEXEC VGET DSN SHARED
CLOSFILE CMPDD
SET CMPTYPE = PANEL
ISPEXEC VPUT CMPTYPE SHARED
ISPEXEC EDIT DATASET('&DSN') +
MACRO(COMPONEN)
SET CMPTYPE = CLIST
ISPEXEC VPUT CMPTYPE SHARED
FREE DD(CMPDD)
ALLOC DD(CMPDD) DSN('&CMPDSN') +
MOD
OPENFILE CMPDD OUTPUT
END
END
END
WHEN (MSG) DO
SET COL1 = &COL2 + 2
ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR
ISREDIT FIND NEXT ')' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (XMSG) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (XMSG)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET XMSG = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (XMSG) = LINE .ZCSR
SET XMSG = &XMSG
IF &LENGTH(&STR(&XMSG)) = 0 THEN +
SET XMSG = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
ISPEXEC VGET ISPMLIB SHARED
IF &SYSINDEX(&STR( &XMSG ),+
&STR(&ISPMLIB)) = 0 AND +
&STR(&XMSG) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPMLIB = &STR(&ISPMLIB &XMSG )
SET CMPDD = &STR(&PFX.ISPMLIB: &XMSG)
PUTFILE CMPDD
ISPEXEC VPUT ISPMLIB SHARED
END
END
OTHERWISE
END
END
ELSE DO
ISREDIT FIND NEXT ' SETMSG ' .ZCSR .ZCSR
IF &LASTCC = 0 THEN DO
ISREDIT LABEL .ZCSR = .CURR
ISREDIT FIND NEXT '(' .ZCSR .ZCSR
ISREDIT (NULL,COL1) = CURSOR
SET COL1 = &COL1 + 1
ISREDIT FIND NEXT ')' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (XMSG) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (XMSG)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET XMSG = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (XMSG) = LINE .ZCSR
SET XMSG = &XMSG
IF &LENGTH(&STR(&XMSG)) = 0 THEN +
SET XMSG = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
ISPEXEC VGET ISPMLIB SHARED
IF &SYSINDEX(&STR( &XMSG ),+
&STR(&ISPMLIB)) = 0 AND +
&STR(&XMSG) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPMLIB = &STR(&ISPMLIB &XMSG )
SET CMPDD = &STR(&PFX.ISPMLIB: &XMSG)
PUTFILE CMPDD
ISPEXEC VPUT ISPMLIB SHARED
END
END
ELSE DO
ISREDIT FIND NEXT ' MACRO(' .ZCSR .ZCSR
IF &LASTCC = 0 THEN DO
ISREDIT LABEL .ZCSR = .CURR
ISREDIT FIND NEXT '(' .ZCSR .ZCSR
ISREDIT (NULL,COL1) = CURSOR
SET COL1 = &COL1 + 1
ISREDIT FIND NEXT ')' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (XCMD) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (XCMD)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET XCMD = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (XCMD) = LINE .ZCSR
SET XCMD = &XCMD
IF &LENGTH(&STR(&XCMD)) = 0 THEN +
SET XCMD = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
ISPEXEC VGET ISPCLIB SHARED
IF &SYSINDEX(&STR( &XCMD ),+
&STR(&ISPCLIB)) = 0 AND +
&STR(&XCMD) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPCLIB = &STR(&ISPCLIB &XCMD )
SET CMPDD = &STR(&PFX.ISPCLIB: &XCMD)
PUTFILE CMPDD
ISPEXEC VPUT ISPCLIB SHARED
ISPEXEC SELECT +
CMD(%FINDMOD &XCMD SYSPROC BATCH)
IF &LASTCC = 0 THEN +
DO
ISPEXEC VGET DSN SHARED
CLOSFILE CMPDD
ISPEXEC EDIT DATASET('&DSN') +
MACRO(COMPONEN)
FREE DD(CMPDD)
ALLOC DD(CMPDD) DSN('&CMPDSN') MOD
OPENFILE CMPDD OUTPUT
END
END
END
ELSE DO
ISREDIT FIND NEXT ' FTINCL ' .ZCSR .ZCSR
IF &LASTCC = 0 THEN DO
ISREDIT LABEL .ZCSR = .CURR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT (NULL,COL1) = CURSOR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (SKELETON) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (SKELETON)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET SKELETON = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (SKELETON) = LINE .ZCSR
SET SKELETON = &SKELETON
IF &LENGTH(&STR(&SKELETON)) = 0 THEN +
SET SKELETON = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
ISPEXEC VGET ISPSLIB SHARED
IF &SYSINDEX(&STR( &SKELETON ),+
&STR(&ISPSLIB)) = 0 AND +
&STR(&SKELETON) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPSLIB = &STR(&ISPSLIB &SKELETON )
SET CMPDD = &STR(&PFX.ISPSLIB: &SKELETON)
PUTFILE CMPDD
ISPEXEC VPUT ISPSLIB SHARED
ISPEXEC SELECT +
CMD(%FINDMOD &SKELETON ISPSLIB BATCH)
IF &LASTCC = 0 THEN +
DO
ISPEXEC VGET DSN SHARED
CLOSFILE CMPDD
SET CMPTYPE = SKELETON
ISPEXEC VPUT CMPTYPE SHARED
ISPEXEC EDIT DATASET('&DSN') +
MACRO(COMPONEN)
SET CMPTYPE = CLIST
ISPEXEC VPUT CMPTYPE SHARED
FREE DD(CMPDD)
ALLOC DD(CMPDD) DSN('&CMPDSN') MOD
OPENFILE CMPDD OUTPUT
END
END
END
ELSE DO
ISREDIT FIND NEXT ' TB' .ZCSR .ZCSR
IF &LASTCC = 0 THEN DO
ISREDIT FIND ' PANEL(' .ZCSR .ZCSR
IF &LASTCC = 0 THEN SET PANELTOO = YES
ELSE SET PANELTOO = NO
ISREDIT LABEL .ZCSR = .CURR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT (NULL,COL1) = CURSOR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT FIND PREV P'¬' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
ISREDIT (XTABLE) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (XTABLE)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET XTABLE = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (XTABLE) = LINE .ZCSR
SET XTABLE = &XTABLE
IF &LENGTH(&STR(&XTABLE)) = 0 THEN +
SET XTABLE = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
ISPEXEC VGET ISPTLIB SHARED
IF &SYSINDEX(&STR( &XTABLE ),+
&STR(&ISPTLIB)) = 0 AND +
&STR(&XTABLE) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPTLIB = &STR(&ISPTLIB &XTABLE )
SET CMPDD = &STR(&PFX.ISPTLIB: &XTABLE)
PUTFILE CMPDD
ISPEXEC VPUT ISPTLIB SHARED
END
IF &PANELTOO = YES THEN +
DO
ISREDIT FIND FIRST ' PANEL(' .CURR .CURR
ISREDIT FIND NEXT '(' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
GOTO PANEL_TOO
PANEL_TOO_GOBACK: SET PANELTOO = NO
END
END
END
END
END
END
END
END
ELSE DO
ISREDIT FIND FIRST 'EXEC ' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
DO
ISREDIT LABEL .ZCSR = .CURR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT (NULL,COL1) = CURSOR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT FIND FIRST "'" &COL1 &COL1 .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
DO
SET EVALUATE = NO
SET COL1 = &COL1 + 1
SET COL2 = &COL2 - 1
END
ELSE SET EVALUATE = YES
ISREDIT (CMD) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (CMD)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET CMD = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (CMD) = LINE .ZCSR
SET CMD = &CMD
IF &LENGTH(&STR(&CMD)) = 0 THEN +
SET CMD = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
IF &LENGTH(&STR(&CMD)) = 0 THEN +
SET CMD = &STR(&VARVALUE)
IF &EVALUATE = YES AND &STR(&CMD) ¬= &STR(&VARVALUE) THEN +
DO
SET A = &SYSINDEX(&STR(&LP),&STR(&CMD))
SET B = &SYSINDEX(&STR(CLIST),&STR(&CMD))
IF &B = 0 THEN +
IF &A > 0 THEN +
SET CMD = &STR(&SYSPREF..)+
&SUBSTR(1:&A-1,&STR(&CMD))+
&STR(.CLIST)+
&SUBSTR(&A:&LENGTH(&STR(&CMD))+
&STR(&CMD))
ELSE +
SET CMD = &STR(&SYSPREF..&CMD..CLIST)
ELSE SET CMD = &STR(&SYSPREF..&CMD)
END
ISPEXEC VGET ISPCLIB SHARED
IF &SYSINDEX(&STR( &CMD ),+
&STR(&ISPCLIB)) = 0 AND +
&STR(&CMD) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPCLIB = &STR(&ISPCLIB &CMD )
SET CMPDD = &STR(&PFX.ISPCLIB: &CMD)
PUTFILE CMPDD
ISPEXEC VPUT ISPCLIB SHARED
CLOSFILE CMPDD
ISPEXEC EDIT DATASET('&CMD') +
MACRO(COMPONEN)
FREE DD(CMPDD)
ALLOC DD(CMPDD) DSN('&CMPDSN') MOD
OPENFILE CMPDD OUTPUT
END
END
ELSE DO
ISREDIT FIND FIRST 'EX ' .ZCSR .ZCSR
IF &LASTCC = 0 THEN DO
ISREDIT LABEL .ZCSR = .CURR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT (NULL,COL1) = CURSOR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT FIND FIRST "'" &COL1 &COL1 .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
DO
SET EVALUATE = NO
SET COL1 = &COL1 + 1
SET COL2 = &COL2 - 1
END
ELSE SET EVALUATE = YES
ISREDIT (CMD) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (CMD)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET CMD = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (CMD) = LINE .ZCSR
SET CMD = &CMD
IF &LENGTH(&STR(&CMD)) = 0 THEN +
SET CMD = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
IF &LENGTH(&STR(&CMD)) = 0 THEN +
SET CMD = &STR(&VARVALUE)
IF &EVALUATE = YES AND &STR(&CMD) ¬= &STR(&VARVALUE) THEN +
DO
SET A = &SYSINDEX(&STR(&LP),&STR(&CMD))
SET B = &SYSINDEX(&STR(CLIST),&STR(&CMD))
IF &B = 0 THEN +
IF &A > 0 THEN +
SET CMD = &STR(&SYSPREF..)+
&SUBSTR(1:&A-1,&STR(&CMD))+
&STR(.CLIST)+
&SUBSTR(&A:&LENGTH(&STR(&CMD))+
&STR(&CMD))
ELSE +
SET CMD = &STR(&SYSPREF..&CMD..CLIST)
ELSE SET CMD = &STR(&SYSPREF..&CMD)
END
ISPEXEC VGET ISPCLIB SHARED
IF &SYSINDEX(&STR( &CMD ),+
&STR(&ISPCLIB)) = 0 AND +
&STR(&CMD) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPCLIB = &STR(&ISPCLIB &CMD )
SET CMPDD = &STR(&PFX.ISPCLIB: &CMD)
PUTFILE CMPDD
ISPEXEC VPUT ISPCLIB SHARED
CLOSFILE CMPDD
ISPEXEC EDIT DATASET('&CMD') +
MACRO(COMPONEN)
FREE DD(CMPDD)
ALLOC DD(CMPDD) DSN('&CMPDSN') MOD
OPENFILE CMPDD OUTPUT
END
END
ELSE DO
ISREDIT FIND FIRST '%' .ZCSR .ZCSR
IF &LASTCC = 0 THEN DO
ISREDIT LABEL .ZCSR = .CURR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT (NULL,COL1) = CURSOR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (CMD) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (CMD)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET CMD = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (CMD) = LINE .ZCSR
SET CMD = &CMD
IF &LENGTH(&STR(&CMD)) = 0 THEN +
SET CMD = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
ISPEXEC VGET ISPCLIB SHARED
IF &SYSINDEX(&STR( &CMD ),+
&STR(&ISPCLIB)) = 0 AND +
&STR(&CMD) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPCLIB = &STR(&ISPCLIB &CMD )
SET CMPDD = &STR(&PFX.ISPCLIB: &CMD)
PUTFILE CMPDD
ISPEXEC VPUT ISPCLIB SHARED
ISPEXEC SELECT +
CMD(%FINDMOD &CMD SYSPROC BATCH)
IF &LASTCC = 0 THEN +
DO
ISPEXEC VGET DSN SHARED
CLOSFILE CMPDD
ISPEXEC EDIT DATASET('&DSN') +
MACRO(COMPONEN)
FREE DD(CMPDD)
ALLOC DD(CMPDD) DSN('&CMPDSN') MOD
OPENFILE CMPDD OUTPUT
END
END
END
END
END
END
ISREDIT FIND NEXT P'=' 1 NX
END
GOTO FINISH
/**********************************************************************
/* PARSE A PANEL FOR MESSAGES *
/**********************************************************************
PANEL_SECTION: +
ISREDIT (LRECL) = LRECL
ISREDIT BOUNDS = 1 &LRECL
ISREDIT EXCLUDE ALL
ISREDIT FIND ALL ' MSG='
ISREDIT FIND ALL ',MSG='
ISREDIT EXCLUDE ALL '/' 1
ISREDIT EXCLUDE ALL ')' 1
ISREDIT FIND FIRST P'=' 1 NX
DO WHILE &LASTCC = 0
ISREDIT FIND FIRST 'MSG=' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
DO
ISREDIT LABEL .ZCSR = .CURR
ISREDIT FIND NEXT '=' .ZCSR .ZCSR
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT (NULL,COL1) = CURSOR
ISREDIT FIND NEXT ')' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (MSG) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (MSG)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET MSG = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (MSG) = LINE .ZCSR
SET MSG = &MSG
IF &LENGTH(&STR(&MSG)) = 0 THEN +
SET MSG = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
ISPEXEC VGET ISPMLIB SHARED
IF &SYSINDEX(&STR(&MSG ),+
&STR(&ISPMLIB)) = 0 AND +
&STR(&MSG) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPMLIB = &STR(&ISPMLIB &MSG )
SET CMPDD = &STR(&PFX.ISPMLIB: &MSG)
PUTFILE CMPDD
ISPEXEC VPUT ISPMLIB SHARED
END
IF &STR(&MSG) = &STR(&VARVALUE) THEN +
DO
SET ISPMLIB = &STR(&ISPMLIB &MSG )
SET CMPDD = &STR(&PFX.ISPMLIB: &MSG)
PUTFILE CMPDD
END
END
ISREDIT FIND LAST P'=' .ZCSR .ZCSR
ISREDIT FIND NEXT P'=' 1 NX
END
GOTO FINISH
/**********************************************************************
/* PARSE A SKELETON FOR IMBEDDED MEMBERS *
/**********************************************************************
SKELETON_SECTION: +
ISREDIT (LRECL) = LRECL
ISREDIT BOUNDS = 1 &LRECL
ISREDIT EXCLUDE ALL
ISREDIT FIND ALL ')IM ' 1
ISREDIT FIND FIRST P'=' 1 NX
DO WHILE &LASTCC = 0
ISREDIT FIND FIRST P'¬' 5 &LRECL .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
DO
ISREDIT (NULL,COL1) = CURSOR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT (NULL,COL2) = CURSOR
SET COL2 = &COL2 - 1
ISREDIT (SKELETON) = LINE .ZCSR
ISREDIT LINE_BEFORE .ZCSR = (SKELETON)
ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR
ISREDIT FIND PREV P'=' 1
ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) +
ALL .ZCSR .ZCSR
ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL +
ALL .ZCSR .ZCSR
ISREDIT FIND FIRST '&&' .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
SET SKELETON = &STR(&VARVALUE)
ELSE +
DO
ISREDIT (SKELETON) = LINE .ZCSR
SET SKELETON = &SKELETON
IF &STR(&SKELETON) = THEN +
SET SKELETON = &STR(&VARVALUE)
END
ISREDIT DELETE .ZCSR
ISPEXEC VGET ISPSLIB SHARED
IF &SYSINDEX(&STR( &SKELETON ),+
&STR(&ISPMLIB)) = 0 AND +
&STR(&SKELETON) ¬= &STR(&VARVALUE) THEN +
DO
SET ISPMLIB = &STR(&ISPSLIB &SKELETON )
SET CMPDD = &STR(&PFX.ISPSLIB: &SKELETON)
PUTFILE CMPDD
ISPEXEC VPUT ISPSLIB SHARED
ISPEXEC SELECT +
CMD(%FINDMOD &SKELETON ISPSLIB BATCH)
IF &LASTCC = 0 THEN +
DO
ISPEXEC VGET DSN SHARED
CLOSFILE CMPDD
ISPEXEC EDIT DATASET('&DSN') +
MACRO(COMPONEN)
FREE DD(CMPDD)
ALLOC DD(CMPDD) DSN('&CMPDSN') MOD
OPENFILE CMPDD OUTPUT
END
END
IF &STR(&SKELETON) = &STR(&VARVALUE) THEN +
DO
SET ISPMLIB = &STR(&ISPSLIB &SKELETON )
SET CMPDD = &STR(&PFX.ISPSLIB: &SKELETON)
PUTFILE CMPDD
END
END
ISREDIT FIND LAST P'=' .ZCSR .ZCSR
ISREDIT FIND NEXT P'=' 1 NX
END
GOTO FINISH
/**********************************************************************
/* RETURN TO THE PREVIOUS LEVEL OR GET OUT ALL TOGETHER. *
/**********************************************************************
FINISH: +
IF &CMPLVL < 2 THEN +
DO
CLOSFILE CMPDD
FREE DD(CMPDD)
IF &CMPEDIT = YES THEN +
ISPEXEC EDIT DATASET('&CMPDSN')
SET CMPLVL =
SET CMPDSN =
SET CMPTYPE =
SET DSN =
ISPEXEC VPUT (CMPTYPE CMPLVL CMPDSN DSN) SHARED
END
SET CMPLVL = &CMPLVL - 1
ISPEXEC VPUT CMPLVL SHARED
ISREDIT CANCEL
EXIT
HELPSEC: + 02480000
ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR XXXXXXXX UTILITY + 02490000
*** NO PROCESSING PERFORMED ***) 02490000
ISPEXEC SETMSG MSG(UTLZ000) 02490000
EXIT
Documentation
The COMPONEN edit macro is a utility which parses a CLIST to determine all of
it's "called" components (e.g. PANELS, MESSAGES, TABLES, PROGRAMS, CLISTS,
SKELETONS, etc.). The results are then placed in a file and you are taken into
an edit on that file.
Simply type COMPONEN on the command line of a CLIST you are editing and press
ENTER and "off you go".
0 Comments