Doug Nadel' s REXX code.

Time Sharing Option, Interactive System Productivity Facility and REstructured eXtended eXecutor

Moderator: mickeydusaor

Post Reply
Sandy
Registered Member
Posts: 51
Joined: Sat Jun 15, 2013 1:07 pm

Doug Nadel' s REXX code.

Post by Sandy »

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?
enrico-sorichetti
Global Moderator
Global Moderator
Posts: 841
Joined: Wed Sep 11, 2013 3:57 pm

Re: Doug Nadel's REXX code.

Post by enrico-sorichetti »

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 8-)
Sandy
Registered Member
Posts: 51
Joined: Sat Jun 15, 2013 1:07 pm

Re:Doug Nadel's REXX code.

Post by Sandy »

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
enrico-sorichetti
Global Moderator
Global Moderator
Posts: 841
Joined: Wed Sep 11, 2013 3:57 pm

Re: Doug Nadel's REXX code.

Post by enrico-sorichetti »

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
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 8-)
User avatar
Anuj Dhawan
Founder
Posts: 2816
Joined: Sun Apr 21, 2013 7:40 pm
Location: Mumbai, India
Contact:
India

Re: Doug Nadel' s REXX code.

Post by Anuj Dhawan »

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.
Sandy
Registered Member
Posts: 51
Joined: Sat Jun 15, 2013 1:07 pm

Re: Doug Nadel' s REXX code.

Post by Sandy »

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.
enrico-sorichetti
Global Moderator
Global Moderator
Posts: 841
Joined: Wed Sep 11, 2013 3:57 pm

Re: Doug Nadel' s REXX code.

Post by enrico-sorichetti »

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
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 8-)
User avatar
prino
Registered Member
Posts: 68
Joined: Sun Jun 01, 2014 4:15 am
Location: Vilnius, Lithuania
Contact:

Re: Doug Nadel' s REXX code.

Post by prino »

Sandy wrote: Mon Mar 19, 2018 11:22 am And I don't have the backup of those REXXs in my new company
That should teach you to always make backups of stuff you want to take around. Even, as a last resort, on paper...
Robert AH Prins
robertahprins @ the.17+Gb.Google thingy
Some z/OS code here
Sandy
Registered Member
Posts: 51
Joined: Sat Jun 15, 2013 1:07 pm

Re: Doug Nadel' s REXX code.

Post by Sandy »

Yes, learned it hard way. :x
zprogrammer
Global Moderator
Global Moderator
Posts: 588
Joined: Wed Nov 20, 2013 11:53 am
Location: Mars

Re: Doug Nadel' s REXX code.

Post by zprogrammer »

You could check CBT TAPE which also has lot of REXX just incase if you are not aware..

[ Post made via Android ] Image
zprogrammer
enrico-sorichetti
Global Moderator
Global Moderator
Posts: 841
Joined: Wed Sep 11, 2013 3:57 pm

Re: Doug Nadel' s REXX code.

Post by enrico-sorichetti »

You could check CBT TAPE which also has lot of REXX just incase if you are not aware..
not certainly Doug' s stuff, the people at CBT are pretty observant of the licensing and copyright issues
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 8-)
Sandy
Registered Member
Posts: 51
Joined: Sat Jun 15, 2013 1:07 pm

Re: Doug Nadel' s REXX code.

Post by Sandy »

What about the people who are already using these codes? They have it already right?
nicc
Global Moderator
Global Moderator
Posts: 691
Joined: Wed Apr 23, 2014 8:45 pm

Re: Doug Nadel' s REXX code.

Post by nicc »

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
enrico-sorichetti
Global Moderator
Global Moderator
Posts: 841
Joined: Wed Sep 11, 2013 3:57 pm

Re: Doug Nadel' s REXX code.

Post by enrico-sorichetti »

Generally, that means that you can only pass it on if you delete all copies that you have yourself.
I beg to disagree ...
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 8-)
nicc
Global Moderator
Global Moderator
Posts: 691
Joined: Wed Apr 23, 2014 8:45 pm

Re: Doug Nadel' s REXX code.

Post by nicc »

I did write "generally" because I knew someone would query the statement if it was not there. Arse-covering!
Regards
Nic
User avatar
prino
Registered Member
Posts: 68
Joined: Sun Jun 01, 2014 4:15 am
Location: Vilnius, Lithuania
Contact:

Re: Doug Nadel' s REXX code.

Post by prino »

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
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.
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.
Robert AH Prins
robertahprins @ the.17+Gb.Google thingy
Some z/OS code here
Mainframe Bear
Registered Member
Posts: 26
Joined: Sat Oct 12, 2013 2:30 am

Re: Doug Nadel' s REXX code.

Post by Mainframe Bear »

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 
Sandy
Registered Member
Posts: 51
Joined: Sat Jun 15, 2013 1:07 pm

Re: Doug Nadel' s REXX code.

Post by Sandy »

Thank you so much! :)
Post Reply

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

Register

Sign in

Return to “TSO, ISPF & REXX (Do you still do CLIST?!).”