Doug Nadel' s REXX code.
Moderator: mickeydusaor
Doug Nadel' s REXX code.
Hi,
I used to have may of the Doug Nadel's REXX with me but it seems his website if no working now. And I don't have the backup of those REXXs in my new company, does anyone of you have them with you?
I used to have may of the Doug Nadel's REXX with me but it seems his website if no working now. And I don't have the backup of those REXXs in my new company, does anyone of you have them with you?
-
- Global Moderator
- Posts: 838
- Joined: Wed Sep 11, 2013 3:57 pm
Re: Doug Nadel's REXX code.
cheers
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
Re:Doug Nadel's REXX code.
Thanks Enrico but the site shows this:
The MVS related content on this site is unavailable.
I have retired from IBM and much of the MVS related content on this site was developed as part of my tenure there. It was published here with the permission of IBM during my employment. I was diligent about assigning copyright to IBM and I intend to respect that same copyright.
I would be happy to answer questions on MVS, ISPF, Rexx, etc, but will no longer be distributing any software that was created before my departure from IBM.
Note also that I no longer have any access to a mainframe or any z/OS installations so I can not test, try, prototype or verify any answers I give. Nonetheless, questions are welcome.
‐ Doug Nadel
-
- Global Moderator
- Posts: 838
- Joined: Wed Sep 11, 2013 3:57 pm
Re: Doug Nadel's REXX code.
what is that You do not understand in the notice that Doug put up
and learn to spell properly people's names
Doug Nadel
I do not think that Doug is related in any way to the tennis player
the topic has been edited to provide the proper spelling
and learn to spell properly people's names
Doug Nadel
I do not think that Doug is related in any way to the tennis player
the topic has been edited to provide the proper spelling
cheers
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
- Anuj Dhawan
- Founder
- Posts: 2816
- Joined: Sun Apr 21, 2013 7:40 pm
- Location: Mumbai, India
- Contact:
Re: Doug Nadel' s REXX code.
His site does not lists codes now, so may be you need to search around.
Thanks,
Anuj
Disclaimer: My comments on this website are my own and do not represent the opinions or suggestions of any other person or business entity, in any way.
Anuj
Disclaimer: My comments on this website are my own and do not represent the opinions or suggestions of any other person or business entity, in any way.
Re: Doug Nadel' s REXX code.
Yes, actually I was looking for SDSFHIGH REXX of his, in case someone has it it'll help or if there can be more that will be great.
-
- Global Moderator
- Posts: 838
- Joined: Wed Sep 11, 2013 3:57 pm
Re: Doug Nadel' s REXX code.
what happened when You googled with SDSFHIGH
if You had You would not have had the need to ask
since the code is copyrighted it is improper to post it on a public forum
but since it was posted somewhere else by Kolusu ( who is an IBM employee )
You might as well download it from where he posted it
if You had You would not have had the need to ask
since the code is copyrighted it is improper to post it on a public forum
but since it was posted somewhere else by Kolusu ( who is an IBM employee )
You might as well download it from where he posted it
cheers
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
- prino
- Registered Member
- Posts: 68
- Joined: Sun Jun 01, 2014 4:15 am
- Location: Vilnius, Lithuania
- Contact:
Re: Doug Nadel' s REXX code.
That should teach you to always make backups of stuff you want to take around. Even, as a last resort, on paper...
-
- Global Moderator
- Posts: 588
- Joined: Wed Nov 20, 2013 11:53 am
- Location: Mars
Re: Doug Nadel' s REXX code.
You could check CBT TAPE which also has lot of REXX just incase if you are not aware..
[ Post made via Android ]
[ Post made via Android ]
zprogrammer
-
- Global Moderator
- Posts: 838
- Joined: Wed Sep 11, 2013 3:57 pm
Re: Doug Nadel' s REXX code.
not certainly Doug' s stuff, the people at CBT are pretty observant of the licensing and copyright issuesYou could check CBT TAPE which also has lot of REXX just incase if you are not aware..
cheers
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
Re: Doug Nadel' s REXX code.
What about the people who are already using these codes? They have it already right?
Re: Doug Nadel' s REXX code.
Right. But it is still copyroghted and all that that means. Generally, that means that you can only pass it on if you delete all copies that you have yourself.
Regards
Nic
Nic
-
- Global Moderator
- Posts: 838
- Joined: Wed Sep 11, 2013 3:57 pm
Re: Doug Nadel' s REXX code.
I beg to disagree ...Generally, that means that you can only pass it on if you delete all copies that you have yourself.
distributing licensed copyrighted material has nothing to do with keeping copies of it
according to some points of view even the possession of licensed(*) and copyrighted material without using it, is illegal
in case of artifacts as Doug' s ( I remember reading somewhere the proper legalese )
You can keep using them even after the original author stopped distributing them
BUT YOU WERE NOT ALLOWED TO REDISTRIBUTE THEM
there are quite a few samples of such material around
cheers
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
Re: Doug Nadel' s REXX code.
I did write "generally" because I knew someone would query the statement if it was not there. Arse-covering!
Regards
Nic
Nic
- prino
- Registered Member
- Posts: 68
- Joined: Sun Jun 01, 2014 4:15 am
- Location: Vilnius, Lithuania
- Contact:
Re: Doug Nadel' s REXX code.
For what it's worth, my copy of Doug's "sdsf_highlighting.txt" does not contain any copyright information, and having just verified the last on-line source of 17 March 2010, that also lacks any copyright statement. The only note about copyrights on the site read
But given that I'm pretty much clueless about copyright rules, I've got no clue how to combine that with a file that does not contain copyrights.Although this is not an official IBM page, those mainframe related programs distributed on this page which were written by Doug Nadel were written on IBM-owned equipment and as such are (c) Copyright IBM Corp. 1998, 2000. All rights reserved. Programs not written by Doug Nadel are the property of their authors who retain all copyrights.
-
- Registered Member
- Posts: 26
- Joined: Sat Oct 12, 2013 2:30 am
Re: Doug Nadel' s REXX code.
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
Create an account or sign in to join the discussion
You need to be a member in order to post a reply
Create an account
Not a member? register to join our community
Members can start their own topics & subscribe to topics
It’s free and only takes a minute