Some of the Doug Nadel's code which I have. I don't see a copyright information in the, so sharing here:
Code: Select all
/* REXX exec to do cursor sensitive data extraction from an ISPF */
/* Screen. */
/* Uses undocumented/Unsupported variables zscreeni & Zscreenc */
/* available in ISPF for OS/390 R2.5 (ISPF4.5). */
/* */
/*------------------------------------------------------------------ */
/* ---> NOTE: ZSCREENI and ZSCREENC may give odd results in some */
/* ---> situations such as command line at the bottom!!!! */
/* ---> If this is a problem, force a call to subroutine */
/* ---> GET_ZSCREEN_VALUES instead of using ISPF's variables. */
/*------------------------------------------------------------------ */
/* */
/* Screen image may translate attr bytes to dsn chars causing */
/* extra characters like '#' to be added to the dsname */
/* */
/* Will not work in popups if invoked with the SUSPEND keyword. */
/* Note that the default command table entry for TSO does have */
/* the SUSPEND keyword. */
/* */
/* Usage: */
/* Name this VCURSOR, set a pfkey to VCURSOR and */
/* create a command table entry: */
/* VCURSOR 0 SELECT CMD(%VCURSOR) */
/* (Or setting pfkey to TSO %VCURSOR will work in most cases) */
/* Then place cursor on dsname and press the pf key. */
/* ZSCREENC may be wrong if initial command doesn't start */
/* with a percent or have MODE(FSCR) on the SELECT statement. */
/* */
/* Author : Doug Nadel April 24, 1999 */
/* Updates: Apr 26, 1999 now views PDS members also. */
/* Aug 18, Allow dsname in parentheses. */
/* Added additional information re MODE(FSCR). */
/* Bypass ZSCREENI and ZSCREENC if needed. */
/* (ISPF version <4.5 but will work in 4.5+) */
/* March 31, 2000 Added basic recognition of GDG names */
/* and view/edit/browse customization */
/* April 3, 2000 Added prompt panel. */
/*------------------------------------------------------------------ */
/* Customization to set service to view edit or browse */
/* or to use prompt panel. */
/*------------------------------------------------------------------ */
service='PROMPT' /* set to VIEW, EDIT, or BROWSE */
/* or PROMPT. */
/*------------------------------------------------------------------ */
Address ispexec
'VGET (ZSCREENI,ZSCREENC,ZENVIR)' /* Extract screen image,
cursor pos and ISPF level */
If substr(zenvir,5,4) <4.5 Then
Call get_zscreen_values
trtable='abcdefghijklmnopqrstuvwxyz' /* Setup valid dsname chars */
trtable=trtable||translate(trtable)||'$#@0123456789.''-{()'
trtable=translate(xrange('00'x,'FF'x),,trtable,' ')
zscreeni=translate(zscreeni,,trtable,' ') /* Remove non-Dsn chars */
If substr(zscreeni,zscreenc+1,1) <> ' ' Then /* Maybe csr on dsn */
Do /* Extract dsn from screen image
and view dataset */
name=word(substr(zscreeni,1+lastpos(' ',zscreeni,zscreenc)),1)
name=translate(strip(substr(name,1,56))) /* Max of 56 char name */
If substr(name,1,1)='(' Then
Parse Var name '('name')'.
Parse Var name dsn '('mem')' /* Is there a member name? */
omem=mem
If mem<>'' Then /* If so, reformat for view
cmd */
Do
gdg=0
name=dsn /* Get dsn */
If substr(name,1,1)='''' Then /* if original name started with
quotes */
name=name'''' /* Fix quotes */
If datatype(mem,'N') = 1 Then /* Gdg? */
Do
Drop otrap.
Call outtrap 'otrap.'
Address tso 'LISTCAT ENT('name')' /* Get real gdg names */
Call outtrap 'OFF'
If otrap.0>(2-2*mem) Then /* If enough lines returned */
Do
a=otrap.0-1+2*mem /* Parse listcat output */
n="'"subword(otrap.a,3,1)"'" /* Get real dsname */
If sysdsn(n)='OK' Then /* Verify that ds exists */
Do /* If real gdg name exists */
name=n /* Use rea name as dsname */
mem='' /* Forget the member name */
omem='' /* Forget the member name */
gdg=1 /* Indicate we forgot member
name */
End
End
End
If gdg=0 Then /* If gdg check failed */
mem='MEMBER('mem')' /* Add member keyword for view*/
End
'CONTROL ERRORS RETURN' /* Return errors to program */
'LMINIT DATAID(VCURSOR) DATASET('name')' /* Alloc w/ Tso naming */
If rc>0 & substr(name,1,1) <> "'" Then /* Alloc w/O tso name */
'LMINIT DATAID(VCURSOR) DATASET('''name''')'
If rc=0 Then
Do
service=translate(service)
If service='PROMPT' Then
Call getservice
If service<>"" Then
service 'DATAID('vcursor')' mem /* View the dataset */
End
Else /* Allocs failed: Set original
message */
'LMINIT DATAID(VCURSOR) DATASET('name')'
If rc>7 Then
'SETMSG MSG(ISRZ002)' /* If error, show messages */
'LMFREE DATAID(&VCURSOR)' /* Free ds if allocated */
End
Else /* Cursor was not on a dsname */
Do /* Give user an error message */
zerrsm = 'Invalid cursor position'
Parse Value '* YES The cursor was not on a data set name.',
With zerrhm zerralrm zerrlm
'SETMSG MSG(ISRZ002)'
End
Exit 0
get_zscreen_values: /* obtain the screen image */
Address ispexec 'VGET (ZSCREENW,ZSCREEND)'
p = ptr(96+ptr(ptr(24+ptr(112+ptr(132+ptr(540))))))
zscreeni=translate(storage(d2x(p),,
zscreenw*zscreend),,xrange('00'x,'3f'x))
zscreenc = c2d(storage(,
d2x(164+ptr(ptr(24+ptr(112+ptr(132+ptr(540)))))),4))
Return
ptr: Return c2d(bitand(storage(d2x(Arg(1)),4),'7FFFFFFF'x))
getservice: Procedure Expose service name omem
'VGET ZSCREEN'
service='EDIT'
dsn=name
Parse Source . . me .
If omem <> "" Then
Do
If substr(dsn,1,1)='''' Then
dsn=substr(dsn,1,length(dsn)-1)'('omem')'''
Else
dsn=dsn'('omem')'
End
Address tso
ddname='$VCSR$'zscreen
'alloc f('ddname') reuse new del dso(po) dir(1) sp(1)' ,
'track recfm(f b) lrecl(80)'
Address ispexec
'LMINIT DATAID(DID) DDNAME('ddname') ENQ(EXCLU)'
'LMOPEN DATAID(&DID) OPTION(OUTPUT)'
Call write ")ATTR"
Call write "+ TYPE(NT)"
Call write "@ TYPE(PT)"
Call write "? TYPE(CH)"
Call write "# TYPE(output) just(asis) caps(off)"
Call write ")BODY WINDOW(60,14)"
Call write " @Cursor Sensitive Action+"
Call write "+%"
Call write "+Dataset:+&DSN"
Call write "+"
Call write "? Select action:"
Call write " _Z% 1. Edit"
Call write " %#VCAXXY +"
Call write " %#VCAXXZ +"
Call write " "
Call write "? Press%END?to cancel this action."
Call write " "
Call write "? To avoid this panel, modify your "me" exec."
Call write ")INIT"
Call write " VGET (VCACTNX) PROFILE"
Call write " .ZVARS = 'VCACTNX'"
Call write " &VCAXXY = ' 2. View'"
Call write " &VCAXXZ = ' 3. Browse'"
Call write ")REINIT"
Call write " REFRESH(*)"
Call write ")PROC"
Call write " IF (.CURSOR = VCAXXY) &VCACTNX = '2' /* allow csr selct*/"
Call write " IF (.CURSOR = VCAXXZ) &VCACTNX = '3'"
Call write " VER (&VCACTNX, NB ,LIST,1,2,3)"
Call write " IF (.MSG NE &Z) &VCACTNX=1"
Call write " VPUT (VCACTNX) PROFILE"
Call write ")END"
'LMMADD DATAID(&DID) MEMBER(FOO)'
'LMFREE DATAID(&DID)'
'LIBDEF ISPPLIB LIBRARY ID('ddname')'
'ADDPOP'
'DISPLAY PANEL(FOO)'
If rc>0 Then service=""
Else If vcactnx=2 Then service='VIEW'
Else If vcactnx=3 Then service='BROWSE'
'REMPOP'
'LIBDEF ISPPLIB'
Address tso
'FREE F('ddname')'
Return
write:
Parse Arg p1
"LMPUT DATAID(&DID) MODE(INVAR) DATALOC(P1) DATALEN(80)"
Return
Code: Select all
/* Rexx - install panel exit in ISFPCU41 to do smart SDSF highlight */
/* */
/* instructions to create customized ISFPCU41 panel for SDSF and */
/* optional Rexx exec (external exec used on ISPF <5.6) */
/* */
/*1 copy this edit macro to a data set allocated to sysproc/sysexec. */
/*2 copy panel ISFPCU41 into a private panel library and edit it. */
/*3 invoke this as a macro */
/*4 IF INSTRUCTED TO DO SO, move the created exec to sysproc/sysexec.*/
/*5 invoke sdsf with the changed panel in ISPPLIB or by using */
/* LIBDEF to point to a PDS containing the changed panel. */
/* */
/* For older ISPF systems, Rexx exec mentioned in step 4 must also */
/* be available when SDSF is started or ISPF will crash!!! */
/* */
/* See the customization sections below to add customized hilight */
/* rules. It is best to change them here and regenerate the panel */
/* and optional clist because if SDSF changes, you can easily */
/* reapply the changes to the new SDSF panel. */
/* */
/*********************************************************************/
Address isredit
Signal on Novalue
'MACRO'
Address ispexec 'VGET (ZENVIR)'
ispf_is_old = substr(zenvir,6,3)<'5.6'
Call insert_attr
'F )INIT 1 FIRST'
Call insert_exec
'F )PROC 1 FIRST'
Call insert_proc
Call insert_comment
Call finalize
Return 1
/*$
/* REXX **************************************************************/
/* Name this Rexx exec SDSFXIT !!! */
/* */
/* Used in conjunction with panel ISFPCU41 to do */
/* highlighting of SDSF data (log, job output, etc) */
/* Author: Doug Nadel (nadel@us.ibm.com) */
/* This code is as-is with no warrenty of any kind */
/*********************************************************************/
Call hello
Signal On Novalue
Call initialize
/* Specify keywords to highlight */
Call add "CPU,20,W" /* JES messages */
Call add "TYPE:,14,W" /* SCLM listing */
Call add "Return Code,15,Y" /* COBOL listing */
Call add "No Statements Flagged in this Assembly,,g" /* Asm listing */
Call add "Top of Data,,b" /* General */
Call add "BOTTOM OF DATA,,b" /* General */
Call add "JES2 JOB STATISTICS,,W" /* JES listing */
/* Calls to 'addp' specify strings that are to be highlighted after */
/* all other highlighting is complete. Use this to force highlights */
/* of specific strings in all cases. For exammple, any reference to */
/* the current user id.' Symantics are the same as for add: */
Call addp userid() || ",,Y" /* General highlighting of userid */
/* Calls to 'addt' specify a string, And an optional color to be */
/* Used to highlight from the start of the string to the end of the */
/* Screen line in the specifiied color. */
Call addt "IKT100,W"
Call addt "J E S 2 ,W"
Call addt "** ASMA,R" /* Asm listing */
Call addt " //,G" /* Part of jcl coloring */
Call addt " //*,T" /* Part of jcl coloring */
Call addt " XX,Y" /* Part of jcl coloring */
Call addt " XX*,B" /* Part of jcl coloring */
Call addt "IEFC653I,P" /* Jcl substitution message */
Call addt "ICH70001I,W" /* Last access */
Call addt "IEF212I,y"
Call addt "IEF272I,y"
Call addt "IEF450I,y"
Call addt "IEF472I,y" /* Abend/Completion code */
Call addt "SYSTEM COMPLETION CODE,y"
Call addt "IEF125I,W" /* Logon */
Call addt "IEF126I,W" /* Logoff */
Call addt "ICH408I,R" /* Racf failures */
Call addt "IEC331I,R" /* Severe catalog errors */
Call addt "IEC332I,R" /* Severe catalog errors */
Call addt "IEC333I,R" /* Severe catalog errors */
Call addt "IEW2008I,Y"
Call addt "IEE600I,Y" /* Reply to xx is; */
Call addt "IGYDS,Y"
/* Calls to 'addn' specify a string, And an optional color to be */
/* Used to highlight from the start of the string to the end of the */
/* Screen line in the specifiied color. All numbers must be zero */
/* In the string to enable number data to be recognized for all */
/* Numbers so that things like timestamps and jobids can be shown. */
Call addn "00.00.00 JOB00000 ,U"
Call addn "COND CODE 0000,Y"
/* Call addn '00.00.00 job00000 -,Y' */
Call addn "NC0000000 ,w,56" /* Commands in syslog */
Call addn "SC ,w,56"
Call addn "==000000==,Y"
Call addn " *00 ,Y"
/* Calls to 'addj' are jcl verbs to be highlighted in red if they */
/* Are found after a // Or xx. */
Call addj "CNTL DLM EXEC JOB SET"
Call addj "COMMAND ELSE IF OUTPUT THEN"
Call addj "DATA ENDCNTL INCLUDE PEND XMIT"
Call addj "DD ENDIF JCLLIB PROC"
/* -------------- end of customization ----------------------------- */
Call Highlight_keywords_preprocessing
Call Highlight_SCLM_and_jobnames
Call Highlight_keywords_to_end_of_line
Call Highlight_number_triggers_to_end_of_line
Call Highlight_JCL
Call Highlight_data_set_names
Call Highlight_keywords_postprocessing
Call Highlight_find_string
Call GoodBye
Highlight_SCLM_and_jobnames:
/* Highlight SCLM listings where first non blank is an asterisk */
/* Also highlight local jobs in da, St, O, H listings */
userid = userid()
ulen = length(userid)
If screenType = 1 & column = 1 Then
Do r = 1 to rows
line = substr(isfbuf,((r - 1) * zscreenw) + 1,zscreenw)
If substr(strip(line),1,1) == "*" Then
Do c = 1 to zscreenw
If substr(line,c,1) == "*" Then
shadow = overlay("R",shadow,(r - 1) * zscreenw + c,1)
Else
shadow = overlay("Y",shadow,(r - 1) * zscreenw + c,1)
End
If substr(line,7,ulen) == userid Then
Do
i = length(strip(substr(line,7,8)))
shadow=overlay("Y",shadow,(r - 1) * zscreenw + 7,ulen,"Y")
shadow=overlay("P",shadow,(r-1)*zscreenw+7+ulen,i-ulen,"P")
End
End
Return
/* Look at the copy, Finding keywords and update shadow accordingly */
/* Highlight keys for key to end of line */
Highlight_keywords_to_end_of_line:
Do a = 1 to targets.0
target = targets.a
wordlen = length(target)
position = pos(target,isfbuf)
Do While position > 0
tlen = zscreenw - (position - 1) // zscreenw
tlen = length(strip(substr(isfbuf,position,tlen),"T"))
shadow = overlay(tcolor.a,shadow,position,tlen,tcolor.a)
position = pos(target,isfbuf,position + 1)
End
End
Return
/* Highlight to end of line for number keys */
Highlight_number_triggers_to_end_of_line:
Do a = 1 to keynums.0
keynum = keynums.a
position = pos(keynum,isfbufzero)
Do While position > 0
position = position + nlen.a
len = zscreenw - (position - 1) // zscreenw
len = length(strip(substr(isfbuf,position,len),"T"))
shadow = overlay(ncolor.a,shadow,position,len,ncolor.a)
position = pos(keynum,isfbufzero,position + 1)
End
End
Return
/* Highlight jcl verbs in // And xx lines */
Highlight_jcl:
Do r = 0 to rows
line = substr(isfbuf,zscreenw * r + 1,zscreenw)
p = pos("//",line)
If p = 0 Then
p = pos("XX",line)
If p > 0 & substr(line,p + 2,1) <> "*" Then
Do
line = substr(isfbuf,zscreenw * r + 1,zscreenw)
Do a = 1 to jclwords.0
jclword = jclwords.a
position = pos(jclword,line,p)
If position > 0 Then
Do
s = zscreenw * r + position
shadow = overlay(jcolor.a,shadow,s,jlen.a,jcolor.a)
Leave a
End
End
End
End
Return
/* Highlight real dsnames in jcl (Dsn= Only) */
Highlight_data_set_names:
Do j = 1 to 2
jclword = word("DSN= DSNAME=",j)
ln = length(jclword)
Do r = 0 to rows
line = substr(isfbuf,zscreenw * r + 1,zscreenw)
position = pos(jclword,line)
If position > 0 & substr(line,position + ln,1) <> "&" Then
Do
c = substr(line,position + ln,1)
Do p = position + ln to zscreenw While c <> " " & c <> ","
s = zscreenw * r + p
shadow = overlay("W",shadow,s,1,"W")
c = substr(line,p + 1,1)
End
End
End
End
Return
/* Highlight keywords before everything else is done */
Highlight_keywords_preprocessing:
Do a = 1 to keywords_pre.0
keyword = keywords_pre.a
wordlen = length(keyword)
position = pos(keyword,isfbufcopy)
Do While position > 0
/* Isfbufcopy=Overlay(' ',Isfbufcopy,Position,Wordlen) */
If position = 1 Then
Do
If substr(isfbufcopy,position + wordlen,1) == " " Then
Do
pcolor = pcolor.a
plen = min(plen.a,zscreenw - (position - 1) // zscreenw)
shadow = overlay(pcolor,shadow,position,plen,pcolor)
End
End
Else
If substr(isfbufcopy,position - 1,1) == " " Then
If substr(isfbufcopy,position + wordlen,1) == " " Then
Do
pcolor = pcolor.a
plen = min(plen.a,zscreenw - (position - 1) // zscreenw)
shadow = overlay(pcolor,shadow,position,plen,pcolor)
End
position = pos(keyword,isfbufcopy,position + 1)
End
End
Return
/* Highlight keywords after everything else is done */
Highlight_keywords_postprocessing:
Do a = 1 to keywords_post.0
keyword = keywords_post.a
wordlen = length(keyword)
position = pos(keyword,isfbufcopy)
Do While position > 0
/* Isfbufcopy=Overlay(' ',Isfbufcopy,Position,Wordlen) */
If position = 1 Then
Do
If substr(isfbufcopy,position + wordlen,1) == " " Then
Do
kcolor = kcolor.a
klen = min(klen.a,zscreenw - (position - 1) // zscreenw)
shadow = overlay(kcolor,shadow,position,klen,kcolor)
End
End
Else
If substr(isfbufcopy,position - 1,1) == " " Then
If substr(isfbufcopy,position + wordlen,1) == " " Then
Do
kcolor = kcolor.a
klen = min(klen.a,zscreenw - (position - 1) // zscreenw)
shadow = overlay(kcolor,shadow,position,klen,kcolor)
End
position = pos(keyword,isfbufcopy,position + 1)
End
End
Return
Highlight_find_string:
len = length(findstr)
If len > 0 Then
Do r = 0 to rows
position = 1
line = translate(substr(isfbuf,zscreenw * r + 1,zscreenw))
Do Until position = 0
position = pos(findstr,line,position)
If position > 0 Then
Do
s = zscreenw * r + position
shadow = overlay("w",shadow,s,len,"w")
position = position + len
End
End
End
Return
setup_find_string:
findstr = findstrq
If length(findstr) > 2 Then
If substr(findstr,1,1) = "*" Then
If substr(findstr,1,1) = substr(findstr,length(findstr))Then
findstr = delstr(delstr(findstr,length(findstr)),1,1)
If length(findstr) > 2 Then
If substr(findstr,1,1) = "'" | substr(findstr,1,1) = '"' Then
If substr(findstr,1,1) = substr(findstr,length(findstr))Then
findstr = delstr(delstr(findstr,length(findstr)),1,1)
Return
hello:
inline = (ISFBUF <> value('isfbuf'))
if inline=0 then Call ISPREXPX 'I'
If "ISFBUF" = value("isfbuf") Then
Do;
Say "Error in SDSF screen panel exit."
Say "Variables passed incorrectly."
Say "Calls to ISPREXPX may be missing."
Call GoodBye
End;
Call setup_find_string
Return
GoodBye:
if inline=0 then Call ISPREXPX 'T'
Return
add:
a = keywords_post.0 + 1
keywords_post.0 = a
Parse value Arg(1) With keywords_post.a "," klen.a "," kcolor.a
keywords_post.a = translate(keywords_post.a)
If klen.a = "" Then
klen.a = length(keywords_post.a)
If kcolor.a = "" Then
kcolor.a = default_highlight_color
Return
addp:
a = keywords_pre.0 + 1
keywords_pre.0 = a
Parse value Arg(1) With keywords_pre.a "," plen.a "," pcolor.a
keywords_pre.a = translate(keywords_pre.a)
If plen.a = "" Then
plen.a = length(keywords_pre.a)
If pcolor.a = "" Then
pcolor.a = default_highlight_color
Return
addt:
a = targets.0 + 1
targets.0 = a
Parse value Arg(1) With targets.a "," tcolor.a
targets.a = translate(targets.a)
If tlen.a = "" Then
tlen.a = length(targets.a)
If tcolor.a = "" Then
tcolor.a = default_highlight_color
Return
addn:
a = keynums.0 + 1
keynums.0 = a
Parse value Arg(1) With keynums.a "," ncolor.a "," nlen.a
keynums.a = translate(keynums.a)
If nlen.a == "" Then
nlen.a = 0
If ncolor.a == "" Then
ncolor.a = default_highlight_color
Return
addj:
v = strip(space(Arg(1)))
Do While v <> ""
a = jclwords.0 + 1
jclwords.0 = a
Parse Var v jclwords.a v
jclwords.a = " "jclwords.a" "
jlen.a = length(jclwords.a)
End
Return
initialize:
shadow = copies(" ",length(shadow))
screenType = 0
Parse Var isfln1 . display .
If display == "STATUS" | display == "OUTPUT" | display == "DA" | ,
display == "HELD" | display == "INPUT" Then
screenType = 1
If display == "SYSLOG" Then
screenType = 2
If screenType = 0 Then
Call GoodBye
default_highlight_color = "R"
Parse value 0 With keywords_pre.0 pcolor. plen.
Parse value 0 With keywords_post.0 kcolor. klen.
Parse value "0 R" With jclwords.0 jcolor. jlen.
Parse value 0 With targets.0 tcolor. tlen.
Parse value 0 With keynums.0 ncolor. nlen.
/* Make a copy of isfbuf with only alphanumerics. This will be used */
/* As the reference string for finding keyword. */
/* Set up translate table of valid keyword characters */
trtable = "ABCDEFGHIJKLMNOPQRSTUVWXYZ$#@0123456789_:*/"
trtable = translate(xrange("00"x,"FF"x),,trtable," ")
isfbufcopy = translate(isfbuf)
isfbufcopy = translate(isfbufcopy,,trtable," ")/* Remove non-kwd chars*/
/* Make a copy of isfbuf with only dsname characters incl parens */
/* And quotes */
trtable = "ABCDEFGHIJKLMNOPQRSTUVWXYZ$#@0123456789@$#_()"""
trtable = translate(xrange("00"x,"FF"x),,trtable," ")
isfbufdsns = translate(isfbuf)
isfbufdsns = translate(isfbufdsns,,trtable," ")/* Remove non-kwd chars*/
isfbufzero = translate(isfbuf,"0","123456789","0")
rows = ((length(isfbuf) + zscreenw - 1) % zscreenw )
column = 1
Parse Var isfln1 . "COLUMNS" column .
Parse Var column column "-" .
If column = "" | datatype(column,"N") = 0 Then
column = 1
Return
$*/
insert_attr : Procedure
'F )ATTR 1 first'
'line_after .zcsr = " y TYPE(CHAR) COLOR(YELLOW) hilite(REVERSE)"'
'line_after .zcsr = " w TYPE(CHAR) COLOR(WHITE) hilite(REVERSE)"'
'line_after .zcsr = " t TYPE(CHAR) COLOR(TURQ) hilite(REVERSE)"'
'line_after .zcsr = " r TYPE(CHAR) COLOR(RED) hilite(REVERSE)"'
'line_after .zcsr = " p TYPE(CHAR) COLOR(PINK) hilite(REVERSE)"'
'line_after .zcsr = " g TYPE(CHAR) COLOR(GREEN) hilite(REVERSE)"'
'line_after .zcsr = " b TYPE(CHAR) COLOR(BLUE) hilite(REVERSE)"'
'line_after .zcsr = " Y TYPE(CHAR) COLOR(YELLOW) "'
'line_after .zcsr = " W TYPE(CHAR) COLOR(WHITE) "'
'line_after .zcsr = " T TYPE(CHAR) COLOR(TURQ) "'
'line_after .zcsr = " R TYPE(CHAR) COLOR(RED) "'
'line_after .zcsr = " P TYPE(CHAR) COLOR(PINK) "'
'line_after .zcsr = " G TYPE(CHAR) COLOR(GREEN) "'
'line_after .zcsr = " B TYPE(CHAR) COLOR(BLUE) "'
'c "#ISFBUF -------" "#ISFBUF,SHADOW " first'
Return
insert_exec : Procedure Expose ispf_is_old
'F ) 1'
line="&CMD=TRUNC(&LASTISFC,' ')"
'LINE_BEFORE .zcsr = (LINE)'
line="IF (&CMD = 'F','FIND')"
'LINE_BEFORE .zcsr = (LINE)'
line=" IF (.TRAIL NE &Z)"
'LINE_BEFORE .zcsr = (LINE)'
line=" &FINDSTRQ = .TRAIL"
'LINE_BEFORE .zcsr = (LINE)'
line=" &FINDSTRQ = '*&FINDSTRQ.*'"
'LINE_BEFORE .zcsr = (LINE)'
line="IF (&CMD = 'RES','RESET')"
'LINE_BEFORE .zcsr = (LINE)'
line=" &FINDSTRQ = &Z"
'LINE_BEFORE .zcsr = (LINE)'
line="&SHADOW=&ISFBUF"
'LINE_BEFORE .zcsr = (LINE)'
If ispf_is_old Then
Do
line='PANEXIT((ISFBUF,SHADOW,ZSCREENW,ISFLN1,FINDSTRQ,LASTISFC)'
line=LINE||',REXX,%SDSFXIT)'
'LINE_BEFORE .zcsr = (LINE)'
End
Else
Do
LINE="*REXX(ISFBUF,SHADOW,ZSCREENW,ISFLN1,FINDSTRQ,LASTISFC)"
'LINE_BEFORE .zcsr = (LINE)'
lineno=1
Do Until substr(sourceline(lineno),1,3) = '/*$'
lineno = lineno + 1
End
Do Until line ='$*/'
lineno = lineno + 1
line= strip(sourceline(lineno),'T')
If line <> '$*/' Then
'LINE_BEFORE .zcsr = (LINE)'
End
line='*ENDREXX'
'LINE_BEFORE .ZCSR = (LINE)'
End
Return
insert_proc: procedure
LINE=" &ISFCMD = &Z"
'LINE_AFTER .zcsr = (LINE)'
LINE="IF (&ISFCMD = 'RES','RESET')"
'LINE_AFTER .zcsr = (LINE)'
LINE="&LASTISFC = &ISFCMD"
'LINE_AFTER .zcsr = (LINE)'
RETURN
insert_comment: Procedure Expose ispf_is_old
'label 2 = .cmt'
Call add "*"
Call add " "
Call add " Panel modified to highlight SDSF data using"
Call add " a rexx panel exit."
Call add " "
If ispf_is_old Then
Do
Call add copies(" ",47)
Call add " "left("Requires external Rexx exec SDSFXIT",46)
Call add " "
End
Call add "*"
Call add " "
Call add " Author of hilighting exit: Doug Nadel (nadel@us.ibm.com)"
Call add " Highlighting modifications are supplied ""as-is"" and "
Call add " have no warranty of any kind."
Call add " "
Call add "*"
Return
add: Procedure
line = Arg(1)
If line = '*' Then line = copies("*",65)
line='/*'left(line,65)'*/'
"line_before .cmt = (line)"
Return
finalize : Procedure Expose ispf_is_old
Say "This panel has been changed to add panel exit logic."
If ispf_is_old Then
Do
'F )END 1'
'DEL ALL .ZCSR .ZLAST'
line = ')END'
'line_after .zlast = (line)'
lineno=1
Do Until substr(sourceline(lineno),1,3) = '/*$'
lineno = lineno + 1
End
Do Until line ='$*/'
lineno = lineno + 1
line= strip(sourceline(lineno),'T')
If line <> '$*/' Then
'LINE_AFTER .zlast = (LINE)'
End
Say " "
Say "Move all of the lines after the )END statement"
Say "to a SYSEXEC or SYSPROC data set before starting"
Say "SDSF."
'F )END first 1'
End
Else
Do
'F P"=" first'
End
Return