|
Back To LeighWeb Mainframe Utilities Page
View the documentation associated with this module
/*********************************************************/
/* ISPF/PDF EDIT MACRO TO WRITE LINES FROM A ISPF */
/* ISPF TABLE INTO THE CURRENT FILE. */
/* THIS MACRO IS USED IN CONJUNCTION WITH THE CUT */
/* CUT MACRO */
/* */
/* SUPPORT */
/* STEVEN SMITH SECURITY PACIFIC AUTOMATION CO OCT 88 */
/* */
/* FOR HELP ON RUNNING THIS MACRO, UNDER EDIT ENTER: */
/* PASTE HELP */
/*********************************************************/
ISREDIT MACRO (PARM1 PARM2 PARM3 PARM4) NOPROCESS
/*** CHECK THE DEBUG SWITCH ***/
ISPEXEC VGET DBGSWTCH PROFILE
IF &DBGSWTCH = ON THEN +
CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS
ELSE +
CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS
/* CONTROL LIST CONLIST SYMLIST
ISPEXEC CONTROL ERRORS RETURN
ISPEXEC VGET (CUTDEF PASTEDEF CUTLIMIT CUTNAME) PROFILE
SET ACTN=&Z
SET CT=&Z
IF &LENGTH(&STR(&PARM1)) = 2 AND +
&SYSINDEX(&STR(.),&STR(&PARM1)) = 0 THEN +
SET CT = &STR(&PARM1)
ELSE +
SELECT (&SYSCAPS(&STR(&PARM1)))
WHEN (B ¦ BE ¦ BEF ¦ BEFO ¦ BEFOR ¦ BEFORE) +
SET BEFAFT = BEFORE
WHEN (A ¦ AF ¦ AFT ¦ AFTE ¦ AFTER ) +
SET BEFAFT = AFTER
WHEN (H ¦ HE ¦ HEL ¦ HELP) +
SET ACTN = HELP
WHEN (P ¦ PR ¦ PRO ¦ PROM ¦ PROMP ¦ PROMPT) +
SET ACTN = PROMPT
WHEN (D ¦ DE ¦ DEF ¦ DEFA ¦ DEFAU ¦ DEFAUL +
DEFAULT ¦ DEFAULTS) +
SET ACTN = DEFAULTS
WHEN (Z ¦ ZE ¦ ZER ¦ ZERO) +
SET ACTN = ZERO
OTHERWISE DO
SET X = &LENGTH(&STR(&PARM1))
IF &X > 1 THEN +
DO
SET POINT = &SUBSTR(1:1,&STR(&PARM1))
SET LABEL = &SUBSTR(2:&X,&STR(&PARM1))
IF &STR(&POINT) ¬= &STR(.) AND +
&DATATYPE(&PARM1) = CHAR THEN +
DO
SET ZEDLMSG = &STR("&PARM1" IS +
NOT A VALID PARAMETER)
ISPEXEC SETMSG MSG(UTLZ001)
EXIT CODE(12)
END
ELSE SET LABEL = &STR(&PARM1)
END
END
END
IF &LENGTH(&STR(&PARM2)) = 2 AND +
&SYSINDEX(&STR(.),&STR(&PARM2)) = 0 THEN +
SET CT = &STR(&PARM2)
ELSE +
SELECT (&SYSCAPS(&STR(&PARM2)))
WHEN (B ¦ BE ¦ BEF ¦ BEFO ¦ BEFOR ¦ BEFORE) +
SET BEFAFT = BEFORE
WHEN (A ¦ AF ¦ AFT ¦ AFTE ¦ AFTER ) +
SET BEFAFT = AFTER
WHEN (H ¦ HE ¦ HEL ¦ HELP) +
SET ACTN = HELP
WHEN (P ¦ PR ¦ PRO ¦ PROM ¦ PROMP ¦ PROMPT) +
SET ACTN = PROMPT
WHEN (D ¦ DE ¦ DEF ¦ DEFA ¦ DEFAU ¦ DEFAUL +
DEFAULT ¦ DEFAULTS) +
SET ACTN = DEFAULTS
WHEN (Z ¦ ZE ¦ ZER ¦ ZERO) +
SET ACTN = ZERO
OTHERWISE DO
SET X = &LENGTH(&STR(&PARM2))
IF &X > 1 THEN +
DO
SET POINT = &SUBSTR(1:1,&STR(&PARM2))
SET LABEL = &SUBSTR(2:&X,&STR(&PARM2))
IF &STR(&POINT) ¬= &STR(.) AND +
&DATATYPE(&PARM2) = CHAR THEN +
DO
SET ZEDLMSG = &STR("&PARM2" IS +
NOT A VALID PARAMETER)
ISPEXEC SETMSG MSG(UTLZ001)
EXIT CODE(12)
END
ELSE SET LABEL = &STR(&PARM2)
END
END
END
IF &LENGTH(&STR(&PARM3)) = 2 AND +
&SYSINDEX(&STR(.),&STR(&PARM3)) = 0 THEN +
SET CT = &STR(&PARM3)
ELSE +
SELECT (&SYSCAPS(&STR(&PARM3)))
WHEN (B ¦ BE ¦ BEF ¦ BEFO ¦ BEFOR ¦ BEFORE) +
SET BEFAFT = BEFORE
WHEN (A ¦ AF ¦ AFT ¦ AFTE ¦ AFTER ) +
SET BEFAFT = AFTER
WHEN (H ¦ HE ¦ HEL ¦ HELP) +
SET ACTN = HELP
WHEN (P ¦ PR ¦ PRO ¦ PROM ¦ PROMP ¦ PROMPT) +
SET ACTN = PROMPT
WHEN (D ¦ DE ¦ DEF ¦ DEFA ¦ DEFAU ¦ DEFAUL +
DEFAULT ¦ DEFAULTS) +
SET ACTN = DEFAULTS
WHEN (Z ¦ ZE ¦ ZER ¦ ZERO) +
SET ACTN = ZERO
OTHERWISE DO
SET X = &LENGTH(&STR(&PARM3))
IF &X > 1 THEN +
DO
SET POINT = &SUBSTR(1:1,&STR(&PARM3))
SET LABEL = &SUBSTR(2:&X,&STR(&PARM3))
IF &STR(&POINT) ¬= &STR(.) AND +
&DATATYPE(&PARM3) = CHAR THEN +
DO
SET ZEDLMSG = &STR("&PARM3" IS +
NOT A VALID PARAMETER)
ISPEXEC SETMSG MSG(UTLZ001)
EXIT CODE(12)
END
ELSE SET LABEL = &STR(&PARM3)
END
END
END
IF &LENGTH(&STR(&PARM4)) = 2 AND +
&SYSINDEX(&STR(.),&STR(&PARM4)) = 0 THEN +
SET CT = &STR(&PARM4)
ELSE +
SELECT (&SYSCAPS(&STR(&PARM4)))
WHEN (B ¦ BE ¦ BEF ¦ BEFO ¦ BEFOR ¦ BEFORE) +
SET BEFAFT = BEFORE
WHEN (A ¦ AF ¦ AFT ¦ AFTE ¦ AFTER ) +
SET BEFAFT = AFTER
WHEN (H ¦ HE ¦ HEL ¦ HELP) +
SET ACTN = HELP
WHEN (P ¦ PR ¦ PRO ¦ PROM ¦ PROMP ¦ PROMPT) +
SET ACTN = PROMPT
WHEN (D ¦ DE ¦ DEF ¦ DEFA ¦ DEFAU ¦ DEFAUL +
DEFAULT ¦ DEFAULTS) +
SET ACTN = DEFAULTS
WHEN (Z ¦ ZE ¦ ZER ¦ ZERO) +
SET ACTN = ZERO
OTHERWISE DO
SET X = &LENGTH(&STR(&PARM4))
IF &X > 1 THEN +
DO
SET POINT = &SUBSTR(1:1,&STR(&PARM4))
SET LABEL = &SUBSTR(2:&X,&STR(&PARM4))
IF &STR(&POINT) ¬= &STR(.) AND +
&DATATYPE(&PARM4) = CHAR THEN +
DO
SET ZEDLMSG = &STR("&PARM4" IS +
NOT A VALID PARAMETER)
ISPEXEC SETMSG MSG(UTLZ001)
EXIT CODE(12)
END
ELSE SET LABEL = &STR(&PARM4)
END
END
END
VERIFY: -
ISPEXEC CONTROL NONDISPL
PROMPT: -
ISPEXEC DISPLAY PANEL(PASTEPRM)
IF &LASTCC=8 THEN EXIT CODE(0)
IF &ACTN = HELP THEN +
DO
/*ISPEXEC BROWSE DATASET('SYS6.DOC.DATA(PASTE)')
ISPEXEC SELECT PGM(ISPTUTOR) PARM(CUTHELP@)
SET ACTN=&Z
GOTO PROMPT
END
IF &ACTN=PROMPT THEN +
DO
SET ACTN=&Z
GOTO PROMPT
END
/* GET DEFAULT MODE */
DEFAULT: -
IF &ACTN=DEFAULTS THEN SET ACTN=&Z
ELSE ISPEXEC CONTROL NONDISPL
ISPEXEC DISPLAY PANEL(PASTEDEF)
IF &LASTCC=8 THEN EXIT CODE(0)
IF &ACTN = &Z THEN SET ACTN=&PASTEDEF
IF &STR(&BEFAFT) = BEFORE OR +
&STR(&BEFAFT) = AFTER THEN +
GOTO AFTER_PROCS
/* PROCESS LINE COMMANDS, CHECK IF A OR B WAS SPECIFIED */
PROCS: -
ISREDIT PROCESS DEST
SET RC = &LASTCC
IF &RC >= 16 THEN EXIT CODE(12)
ELSE +
IF &RC >= 4 THEN +
DO
SET ZEDSMSG = ENTER "A"¦"B" LINE CMD
SET ZEDLMSG = PASTE REQUIRES AN "A" OR "B" LINE COMMAND
ISPEXEC SETMSG MSG(ISRZ001)
EXIT CODE(12)
END
/* CONTROL LIST CONLIST SYMLIST
AFTER_PROCS: -
ISPEXEC CONTROL ERRORS RETURN
/* GET THE NUMBER OF LINES VARIABLE */
SET CUTPST=CUTPST&CT
ISPEXEC TBQUERY &CUTPST ROWNUM(CUTCNT)
IF &LASTCC ¬= 0 THEN DO
ISPEXEC TBCREATE &CUTPST NAMES(CTPT) NOWRITE SHARE
IF &LASTCC = 0 THEN DO
SET ZEDSMSG = USE CUT BEFORE PASTE
SET ZEDLMSG = THE CUTCNT PROFILE VARIABLE WAS NOT FOUND
SET ZEDLMSG = &ZEDLMST &STR(-) USE CUT FIRST
ISPEXEC SETMSG MSG(ISRZ001)
EXIT CODE(12)
END
ELSE DO
ISPEXEC TBOPEN &CUTPST NOWRITE SHARE
IF &LASTCC ¬= 0 THEN DO
EXIT CODE(12)
END
ISPEXEC TBQUERY &CUTPST ROWNUM(CUTCNT)
END
END
IF &CUTCNT <= 0 THEN +
DO
SET ZEDSMSG = USE CUT BEFORE PASTE
SET ZEDLMSG = NO DATA HAS BEEN STORED VIA THE CUT MACRO
ISPEXEC SETMSG MSG(ISRZ001)
EXIT CODE(12)
END
IF &STR(&BEFAFT) > THEN +
IF &DATATYPE(&LABEL) = NUM THEN +
DO
SET ZDEST = &LABEL
ISREDIT CURSOR = &LABEL 9
IF &STR(&BEFAFT) = BEFORE THEN +
DO
ISREDIT FIND PREV P'=' 10
SET BEFAFT = AFTER
END
SET LABEL = &STR(.ZCSR)
END
ELSE +
DO
IF &STR(&BEFAFT) = BEFORE THEN +
DO
ISREDIT FIND FIRST P'=' 10 &LABEL &LABEL
ISREDIT FIND PREV P'=' 10
SET BEFAFT = AFTER
SET LABEL = &STR(.ZCSR)
END
ISREDIT (ZDEST) = LINENUM &LABEL
END
ELSE +
ISREDIT (ZDEST) = LINENUM .ZDEST
SET TRUNCCNT = 0
SET CUTCOUNT = &CUTCNT
/* GET EACH CUT LINE FROM THE TABLE AND ADD IT TO THE FILE */
SET I = &CUTCNT
ISPEXEC TBBOTTOM &CUTPST
DO WHILE &I > 0
IF &STR(&BEFAFT) > THEN +
ISREDIT LINE_&BEFAFT &LABEL = DATALINE (CTPT)
ELSE +
ISREDIT LINE_AFTER &ZDEST = DATALINE (CTPT)
IF &LASTCC = 4 THEN SET TRUNCCNT = &TRUNCCNT + 1
ISPEXEC TBSKIP &CUTPST NUMBER(-1)
SET I = &I - 1
END
/* IF KEEP PARAMETER NOT GIVEN AND NO LINES WERE TRUNCATED, */
/* SET TO NULL ALL VARIABLES STORED IN THE PROFILE. */
IF &ACTN=ZERO THEN +
DO
SET &LCC=0
ISPEXEC TBBOTTOM &CUTPST
DO WHILE &LCC=0
ISPEXEC TBDELETE &CUTPST
SET LCC=&LASTCC
END
END
/* CHECK IF TRUNCATION OCCURRED, IF SO DISPLAY MESSAGE */
IF &TRUNCCNT > 0 THEN +
DO
SET ZEDSMSG = &TRUNCCNT LINES TRUNCATED
SET ZEDLMSG = CURRENT RECORD LENGTH SHORTER THAN ORIGIN
SET ZEDLMSG = &ZEDLMSG &STR(-) &TRUNCCNT OF &CUTCOUNT
SET ZEDLMSG = &STR(&ZEDLMSG) RECORDS WERE TRUNCATED
ISPEXEC SETMSG MSG(ISRZ001)
END
ELSE +
DO
SET ZEDSMSG = &CUTCOUNT LINES PASTED
SET ZEDLMSG = &CUTCOUNT LINES WERE PASTED INTO THE
SET ZEDLMSG = &ZEDLMSG CURRENT FILE
ISPEXEC SETMSG MSG(ISRZ000)
END
SET LINE1 = &ZDEST + 1
ISREDIT CURSOR = &LINE1 0
EXIT
|
|
