Return to Mainframe Utilities Page
Module
ISREDIT MACRO (PARM OLDNAME)
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
/*****************************************************************/
/* EDIT MACRO "LABLPROF" - SET/INSERT LABELS FOR A SPECIFIC FILE */
/* WHICH ARE STORED IN AN ISPF PROFILE VARIABLE OF THE SAME NAME.*/
/* DAVID LEIGH - 4-11-90 */
/*****************************************************************/
ISREDIT (SLN,SCL) = CURSOR
ISREDIT (MBR) = MEMBER
ISREDIT (DSN) = DATASET
IF &SYSINDEX(&STR(&SYSUID..PANVALET.),&STR(&DSN)) = 1 THEN +
DO
ISPEXEC VGET PMBR
SET MBR = &PMBR
END
IF &STR(&MBR) = THEN +
DO
SET MBR = &STR(&DSN)
DO WHILE &SYSINDEX(&STR(.),&STR(&MBR)) > 0
SET A = &SYSINDEX(&STR(.),&STR(&MBR))
SET B = &LENGTH(&STR(&MBR))
SET A = &A + 1
SET MBR = &SUBSTR(&A:&B,&STR(&MBR))
END
END
SET ZEDLMSG = &STR(*** VALID PARAMETERS ARE: +
HELP, SET, SHOW, RENAME HILITE ***)
SELECT &STR(&PARM)
WHEN (HELP) GOTO HELPSEC
WHEN (HILITE) GOTO HILISEC
WHEN (SET) GOTO SETSEC
WHEN (SHOW) GOTO SHOWSEC
WHEN (RENAME) GOTO RENAMESEC
WHEN (COPY) GOTO COPYSEC
WHEN () GOTO INSLABEL
OTHERWISE ISPEXEC SETMSG MSG(UTLZ001)
END
EXIT
/*****************************************************************/
/* SET THE VARIABLE TO A NEW VALUE */
/*****************************************************************/
SETSEC: +
ISREDIT (B1,B2) = BOUNDS
ISREDIT LOCATE FIRST LABEL
SET SAVECC = &LASTCC
SET X = 0
DO WHILE &SAVECC = 0
SET X = &X + 1
ISREDIT (FLINE,NULL) = DISPLAY_LINES
ISREDIT (LBL,NULL) = LABEL &FLINE
SET LBL = &LBL
SET SAVELBL = &STR(&SAVELBL &LBL)
ISREDIT (DLINE) = LINE &LBL
SET DLINE = &SUBSTR(&B1:&B2,&NRSTR(&DLINE))
ISREDIT (LN,CL) = CURSOR
SET TEMP = &NRSTR(&TEMP)+
&STR(ISREDITLABEL=&LBL)&NRSTR(ISREDITLINE=&DLINE)
IF &SYSINDEX(&STR('),&NRSTR(&DLINE)) > 0 THEN SET QTS = &STR(")
ELSE SET QTS = &STR(')
ISREDIT SEEK ALL &QTS&NRSTR(&DLINE)&QTS
ISREDIT (NULL,SCOUNT) = SEEK_COUNTS
IF &SCOUNT > 1 THEN +
DO
ISREDIT SEEK FIRST &QTS&NRSTR(&DLINE)&QTS
SET FINDCC = &LASTCC
ISREDIT (XLN,CL) = CURSOR
SET A = 1
DO WHILE &FINDCC = 0 AND &XLN < &LN
ISREDIT SEEK NEXT &QTS&NRSTR(&DLINE)&QTS
SET FINDCC = &LASTCC
ISREDIT (XLN,CL) = CURSOR
IF &FINDCC = 0 THEN SET A = &A + 1
END
SET TEMP = &NRSTR(&TEMP)&STR(ISREDITOCCURANCE=&A)
END
ISREDIT CURSOR = &LN 1
ISREDIT LOCATE NEXT LABEL
SET SAVECC = &LASTCC
END
SET SAVELBL = &SAVELBL
IF &NRSTR(&TEMP) > THEN +
DO
SET &&MBR = &NRSTR(&TEMP)
ISPEXEC VPUT &MBR PROFILE
SET ZEDLMSG = &STR(LABEL PROFILE = &SAVELBL)
ISPEXEC SETMSG MSG(UTLZ000W)
END
ELSE +
DO
SET ZEDLMSG = &STR(*** NO LABELS FOUND. NO "LABEL PROFILE" +
WAS STORED ***)
ISPEXEC SETMSG MSG(UTLZ001)
END
ISREDIT CURSOR = &SLN &SCL
EXIT
/*****************************************************************/
/* GET THE VARIABLE AND APPLY LABEL VALUES TO THE FILE. */
/*****************************************************************/
INSLABEL: +
ISPEXEC VGET &MBR PROFILE
SET TEMP = &STR(&&&MBR)
IF &STR(&TEMP) = THEN +
DO
SET ZEDLMSG = &STR(*** NO LABEL PROFILE STORED FOR "&MBR." +
"LABLPROF SET" WILL STORE THEM ***)
ISPEXEC SETMSG MSG(UTLZ000)
EXIT
END
SET TLEN = &LENGTH(&STR(&TEMP))
SET LABCOUNT = 0
SET BADCOUNT = 0
SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))
DO WHILE &TLEN > 0 AND &NEXTCHAR > 0
SET LPOS = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP)) + 13
SET DPOS = &SYSINDEX(&STR(ISREDITLINE=),&STR(&TEMP)) + 12
SET LBL = &SUBSTR(&LPOS:&EVAL(&DPOS-13),&STR(&TEMP))
SET DLINE = &SUBSTR(&DPOS:&TLEN,&STR(&TEMP))
SET DLEN = &LENGTH(&NRSTR(&DLINE))
SET Z = &SYSINDEX(&STR(ISREDITOCCURANCE=),&NRSTR(&DLINE))
SET Y = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE))
IF &Y = 0 THEN SET Y = &DLEN + 1
IF &Z < &Y AND &Z > 0 THEN +
DO
SET OPOS = &Z + 17
SET X = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE)) - 1
IF &X < 1 THEN SET X = &DLEN
SET OCCR = &SUBSTR(&OPOS:&X,&NRSTR(&DLINE))
SET OCCR = &OCCR
SET DLINE = &SUBSTR(1:&EVAL(&Z - 1),&NRSTR(&DLINE))
SET DLEN = &LENGTH(&NRSTR(&DLINE)
SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
SET X = &X + &DLEN - 1
IF &X < &TLEN THEN +
DO
SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
SET TLEN = &LENGTH(&STR(&TEMP))
END
ELSE SET TLEN = 0
END
ELSE +
DO
SET OCCR = 1
SET DLINE = &SUBSTR(1:&EVAL(&Y - 1),&NRSTR(&DLINE))
SET DLEN = &LENGTH(&NRSTR(&DLINE)
SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
SET X = &X + &DLEN - 1
IF &X < &TLEN THEN +
DO
SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
SET TLEN = &LENGTH(&STR(&TEMP))
END
ELSE SET TLEN = 0
END
ISREDIT FIND FIRST '&NRSTR(&DLINE)'
SET SAVECC = &LASTCC
SET X = 1
DO WHILE &X < &OCCR
ISREDIT RFIND
SET SAVECC = &LASTCC
SET X = &X + 1
END
IF &SAVECC = 0 THEN +
DO
SET LABCOUNT = &LABCOUNT + 1
ISREDIT LABEL .ZCSR = &LBL 0
ISREDIT FIND ALL P'=' .ZCSR .ZCSR
END
ELSE SET BADCOUNT = &BADCOUNT + 1
SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))
END
IF &BADCOUNT = 0 THEN +
DO
SET ZEDLMSG = &STR(*** SUCCESSFULLY LABELED &MBR +
LINES (&LABCOUNT OF THEM) ***)
ISPEXEC SETMSG MSG(UTLZ000)
END
ELSE +
DO
SET TCOUNT = &BADCOUNT + &LABCOUNT
SET ZEDLMSG = &STR(* ONLY &LABCOUNT OF &TCOUNT LINES LABELED +
("LABLPROF SET" TO RESET LABEL PROFILE) *)
ISPEXEC SETMSG MSG(UTLZ001)
END
ISREDIT CURSOR = &SLN &SCL
EXIT
/*****************************************************************/
/* INSERT MESSAGE LINES WHICH SHOW WHAT LABELS ARE IN THE PROFILE*/
/*****************************************************************/
SHOWSEC: +
ISREDIT SEEK NEXT P'=' 1
ISREDIT SEEK NEXT P'=' 1
ISPEXEC VGET &MBR PROFILE
SET TEMP = &STR(&&&MBR)
IF &STR(&TEMP) = THEN +
DO
SET ZEDLMSG = &STR(*** NO LABEL PROFILE STORED FOR "&MBR." +
"LABLPROF SET" WILL STORE THEM ***)
ISPEXEC SETMSG MSG(UTLZ000)
EXIT
END
SET TLEN = &LENGTH(&STR(&TEMP))
SET LABCOUNT = 0
SET BADCOUNT = 0
SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))
DO WHILE &TLEN > 0 AND &NEXTCHAR > 0
SET LPOS = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP)) + 13
SET DPOS = &SYSINDEX(&STR(ISREDITLINE=),&STR(&TEMP)) + 12
SET LBL = &SUBSTR(&LPOS:&EVAL(&DPOS-13),&STR(&TEMP))
SET DLINE = &SUBSTR(&DPOS:&TLEN,&STR(&TEMP))
SET DLEN = &LENGTH(&NRSTR(&DLINE))
SET Z = &SYSINDEX(&STR(ISREDITOCCURANCE=),&NRSTR(&DLINE))
SET Y = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE))
IF &Y = 0 THEN SET Y = &DLEN + 1
IF &Z < &Y AND &Z > 0 THEN +
DO
SET OPOS = &Z + 17
SET X = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE)) - 1
IF &X < 1 THEN SET X = &DLEN
SET OCCR = &SUBSTR(&OPOS:&X,&NRSTR(&DLINE))
SET OCCR = &OCCR
SET DLINE = &SUBSTR(1:&EVAL(&Z - 1),&NRSTR(&DLINE))
SET DLEN = &LENGTH(&NRSTR(&DLINE)
SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
SET X = &X + &DLEN - 1
IF &X < &TLEN THEN +
DO
SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
SET TLEN = &LENGTH(&STR(&TEMP))
END
ELSE SET TLEN = 0
END
ELSE +
DO
SET OCCR = 1
SET DLINE = &SUBSTR(1:&EVAL(&Y - 1),&NRSTR(&DLINE))
SET DLEN = &LENGTH(&NRSTR(&DLINE)
SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
SET X = &X + &DLEN - 1
IF &X < &TLEN THEN +
DO
SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
SET TLEN = &LENGTH(&STR(&TEMP))
END
ELSE SET TLEN = 0
END
SET MSG = &STR(&SUBSTR(1:8,&STR(&LBL ))&SYSNSUB(1,&DLINE))
ISREDIT LINE_BEFORE .ZCSR = MSGLINE (MSG)
SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))
END
ISREDIT CURSOR = &SLN &SCL
EXIT
/*****************************************************************/
/* HILIGHT EACH LINE WHICH HAS AN EDIT LABEL FROM THE PROFILE */
/* ***** HAVE NOT GOTTEN THIS TO WORK YET! ********************* */
/*****************************************************************/
HILISEC: +
ISREDIT SEEK NEXT P'=' 1
ISREDIT SEEK NEXT P'=' 1
ISPEXEC VGET &MBR PROFILE
SET TEMP = &STR(&&&MBR)
IF &STR(&TEMP) = THEN +
DO
SET ZEDLMSG = &STR(*** NO LABEL PROFILE STORED FOR "&MBR." +
"LABLPROF SET" WILL STORE THEM ***)
ISPEXEC SETMSG MSG(UTLZ000)
EXIT
END
SET TLEN = &LENGTH(&STR(&TEMP))
SET LABCOUNT = 0
SET BADCOUNT = 0
SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))
DO WHILE &TLEN > 0 AND &NEXTCHAR > 0
SET LPOS = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP)) + 13
SET DPOS = &SYSINDEX(&STR(ISREDITLINE=),&STR(&TEMP)) + 12
SET LBL = &SUBSTR(&LPOS:&EVAL(&DPOS-13),&STR(&TEMP))
SET DLINE = &SUBSTR(&DPOS:&TLEN,&STR(&TEMP))
SET DLEN = &LENGTH(&NRSTR(&DLINE))
SET Z = &SYSINDEX(&STR(ISREDITOCCURANCE=),&NRSTR(&DLINE))
SET Y = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE))
IF &Y = 0 THEN SET Y = &DLEN + 1
IF &Z < &Y AND &Z > 0 THEN +
DO
SET OPOS = &Z + 17
SET X = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE)) - 1
IF &X < 1 THEN SET X = &DLEN
SET OCCR = &SUBSTR(&OPOS:&X,&NRSTR(&DLINE))
SET OCCR = &OCCR
SET DLINE = &SUBSTR(1:&EVAL(&Z - 1),&NRSTR(&DLINE))
SET DLEN = &LENGTH(&NRSTR(&DLINE)
SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
SET X = &X + &DLEN - 1
IF &X < &TLEN THEN +
DO
SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
SET TLEN = &LENGTH(&STR(&TEMP))
END
ELSE SET TLEN = 0
END
ELSE +
DO
SET OCCR = 1
SET DLINE = &SUBSTR(1:&EVAL(&Y - 1),&NRSTR(&DLINE))
SET DLEN = &LENGTH(&NRSTR(&DLINE)
SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
SET X = &X + &DLEN - 1
IF &X < &TLEN THEN +
DO
SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
SET TLEN = &LENGTH(&STR(&TEMP))
END
ELSE SET TLEN = 0
END
ISREDIT FIND ALL P'@' &STR(&LBL) &STR(&LBL)
SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))
END
ISREDIT CURSOR = &SLN &SCL
EXIT
/*****************************************************************/
/* RENAME ANOTHER PROFILE TO THIS MEMBER NAME */
/*****************************************************************/
RENAMESEC: +
IF &STR(&OLDNAME) = THEN +
DO
SET ZEDLMSG = &STR(*** THE "RENAME FROM" MEMBER NAME MUST +
BE SPECIFIED ***)
ISPEXEC SETMSG MSG(UTLZ001)
EXIT CODE(12)
END
ISPEXEC VGET &OLDNAME PROFILE
IF &LASTCC = 8 THEN +
DO
SET ZEDLMSG = &STR(*** LABEL PROFILE "&OLDNAME" DOES NOT +
EXIST TO RENAME. USE "LABLPROF SET" ***)
ISPEXEC SETMSG MSG(UTLZ001W)
EXIT
END
SET &MBR = &STR(&&&OLDNAME)
ISPEXEC VPUT &MBR PROFILE
ISPEXEC VERASE &OLDNAME PROFILE
ISREDIT CURSOR = &SLN &SCL
SET ZEDLMSG = &STR(*** LABEL PROFILE "&OLDNAME" RENAMED TO "&MBR" ***)
ISPEXEC SETMSG MSG(UTLZ00W)
EXIT
/*****************************************************************/
/* COPY ANOTHER PROFILE TO THIS MEMBER NAME */
/*****************************************************************/
COPYSEC: +
IF &STR(&OLDNAME) = THEN +
DO
SET ZEDLMSG = &STR(*** THE "COPY FROM" MEMBER NAME MUST +
BE SPECIFIED ***)
ISPEXEC SETMSG MSG(UTLZ001)
EXIT CODE(12)
END
ISPEXEC VGET &OLDNAME PROFILE
IF &LASTCC = 8 THEN +
DO
SET ZEDLMSG = &STR(*** LABEL PROFILE "&OLDNAME" DOES NOT +
EXIST TO COPY. USE "LABLPROF SET" ***)
ISPEXEC SETMSG MSG(UTLZ001W)
EXIT
END
SET &MBR = &STR(&&&OLDNAME)
ISPEXEC VPUT &MBR PROFILE
ISREDIT CURSOR = &SLN &SCL
SET ZEDLMSG = &STR(*** LABEL PROFILE "&OLDNAME" COPIED TO "&MBR" ***)
ISPEXEC SETMSG MSG(UTLZ00W)
EXIT
HELPSEC: + 02480000
ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR LABLPROF UTILITY + 02490000
*** NO PROCESSING PERFORMED ***) 02490000
ISPEXEC SETMSG MSG(UTLZ000) 02490000
EXIT
Documentation
This utility allows the user to set a series of labels in an edit session (via
typing ".xxxxx" where xxxxx is a label name on an edit line number and pressing
ENTER) and save them in a "label profile" specific to that member. When they
return to that member, they are able to reset all of their labels to the values
in the "label profile". To set a label profile, set the labels in the edit
session and then type LABLPROF SET on the command line and press ENTER. To
label lines in a file from the saved "label profile" type LABLPROF and press
ENTER (while in an edit session of the specific file).
To see what lines are currently associated with which labels in the edit
profile, type LABLPROF SHOW and press ENTER. Message lines will be inserted
which show you the name of the label (e.g. ".A") and the text on that line.
When you rename a member, the label profile for that member is not
automatically renamed. You can rename the label profile by executing the
LABLPROF edit macro and specifying the keyword RENAME and the OLD NAME that
you're renaming from. So, if you renamed member "A" to "B", while editing "B",
you would type LABLPROF RENAME A and press enter, and the "A" label profile
would be renamed to "B".
Similar to the RENAME function is the COPY function. In the previous example,
if you had created member "B" as a COPY of member "A", you could copy the label
profile by typing LABLPROF COPY A while editing member "B".
0 Comments