/* ------------------------------------------------------------ REXX

 Run   Execute edited data directly, no need to save first.

 How it works:
  The data  edited is  copied to  a temporary  pds member,  then the
  temporary dataset plus the base dataset are ALTLIBd and LIBDEFd to
  ISPPLIB,  ISPMLIB, ISPSLIB  and ISPTLIB.  This allows  part of  an
  application to  be tested, even  when the  base dataset is  not in
  your ISPxLIB / SYSEXEC concatenations.
  RUN  then analyzes  the edited  data to  determine the  data type.
  ISPF display-  and select  panels, ISPF  skeletons, TSO  CLIST and
  REXX are detected.

 Author: Willy Jensen of Harders-Jensen IT Consult

  ------------------------------------------------------------------ */

 Address Ispexec "control errors return"
 Address Isredit "MACRO PROCESS (PRM)"
 Address Isredit
 "(ds) = dataset"
 "(m)  = member"
 "(lr) = lrecl"
 "(rf) = recfm"
 if m = "RUN" then exit xmsg('You cannot re-execute RUN')
 parse value '0' with msgidopt xdd1 xds1 xdd2 xds2 ddlist libdef altlib,
  type ispfile
 Call Silent('PROFILE')
 do n=1 to $.0 while msgidopt=0
   if wordpos('MSGID',$.n)>0 then msgidopt=1
 end
 if msgidopt=0 then "profile msgid"

 /* load data to stem */
 "(ll)=linenum .zlast"
 line.0=ll
 Do lnr=1 to ll
   "(s)= Line (lnr)"
   line.lnr=strip(s,'t')
 End

 /* get data type from parm */
 upper prm
 if prm<>'' then do
   zz=prm',' words(prm)',' wordpos(prm,'DP SP SK CL RX')
   if words(prm)=1 & wordpos(prm,'DP SP SK CL RX')>0 then type=prm
   else exit xmsg('Invalid parm:' prm)
 end

 /* analyze to determine data type */
 if type='' then do
   u1=translate(line.1)
   parse var u1 uw1 uw2 uw3 uw4 .
   Select
     when wordpos(uw1,')ATTR )PANEL')>0 then type='DP'
     when pos('/*',u1)>0 & pos('REXX',u1)>0 then type='RX'
     when uw1='PROC' & datatype(uw2)='NUM' then type='CL'
     when EdFind("')' 1 1 first")=0 then type='SK'
     when EdFind("'//' 1 2 first")=0 then type='SK'
     when right(ds,8)='.ISPSLIB' then type='SK'
     otherwise type='?'
   End
 End
 if type='?' then call close 8 'Could not determine data type'

 /* panel - display or selection? */
 if type='DP' then if EdFind("'ZSEL' word first")=0 then type='SP'

 Address TSO
 "delstack"

 /* allocate temp pds */
 rf=left(rf,1)',B'
 cc=bpxwdyn('alloc new rtddn(xdd1) rtdsn(xds1)',
            'lrecl('lr') recfm('rf') blksize(0)',
            'tracks space(1,1) dir(1) unit(sysda)')
 if cc<>0 then call close 8 "alloc temp pds failed rc" cc
 ddlist=ddlist xdd1

 /* write member      */
 runmbr='R'right(left(space(translate(time('l'),' ','.:'),0),10),7)
 cc=bpxwdyn('alloc shr da('xds1'('runmbr')) rtddn(xdd2)')
 if cc<>0 then call close 8 "alloc temp mbr failed rc" cc
 ddlist=ddlist xdd2

 "execio" line.0 "diskw" xdd2 "(stem line. finis)"
 cc=rc
 zz=bpxwdyn('free dd('xdd2')')
 if zz<>0 then say 'free dd xdd2 rc' zz
 ddlist=XWord(xdd2,ddlist)
 xdd2=''
 if cc<>0 then call close 8 "write temp mbr failed" rc

 /* setup libdefs and altlib */
 cc=bpxwdyn('alloc shr da('ds') rtddn(xdd3)')
 if cc<>0 then call close 8 "alloc baseds failed rc" cc
 cc=bpxwdyn('concat ddlist('xdd1','xdd3')')
 if cc<>0 then call close 8 "concat failed rc" cc
 ddlist=ddlist xdd3
 Call DoLibdef 'ispplib'
 Call DoLibdef 'ispmlib'
 Call DoLibdef 'ispslib'
 Call DoLibdef 'isptlib'

 altlib='EXEC'
 if type='CL' then altlib='CLIST'
 "altlib act appl("altlib") ddname("xdd1") "
 if cc<>0 then do
   altlib=''
   call close 8 'altlib' altlib 'rc' rc
 end

 /* display panel     */
 if type='DP' then do                     /* panel */
   address ispexec "display panel("runmbr")"
   if rc>8 then call close 8 "Display rc" rc zerrlm
   call close 0 'Display panel ok'
 end

 /* expand skeleton */
 if type='SK' then do
   /* if ISPFILE libref is not used, then create and use, else use ZTEMPF */
   fttemp='TEMP'
   ftlr=max(lr,200)
   if listdsi('ISPFILE FILE')<>0 then do
     cc=bpxwdyn('alloc new delete dd(ispfile) reuse',
        'lrecl('ftlr') recfm(v,b) blksize(0) tracks space(1,1) unit(sysda)')
     if cc<>0 then call close 8 "alloc ISPFILE failed rc" cc
     parse value 'ISPFILE' ddlist 'ISPFILE;' with ztempn ddlist';'fttemp
   end
   address ispexec
   "ftopen" fttemp
   if rc<>0 then call close 8 'ftopen rc' rc zerrlm
   "ftincl" runmbr
   parse value rc zerrlm with cc err
   "ftclose"
   if cc<>0 then call close 8 'ftincl' runmbr 'rc' cc err
   /* edit */
   if fttemp='TEMP' then "vget ztempn"
   "lminit dataid(xdid) ddname("ztempn")"
   if rc<>0 then say "lminit failed" rc zerrlm
   else do
     "view dataid("xdid")"
     if rc>8 then say "view failed" rc zerrlm
     "lmfree dataid("xdid")"
     if rc<>0 then say "lmfree failed" rc zerrlm
   end
   address tso
   Call Close 0 'Skeleton ok'
 end

 /* CLIST */
 if type='CL' then do
   signal on error  name Close
   signal on syntax name Close
   "%"runmbr
   Call Close 0 m '(CLIST) ended rc' rc
 end

 /* REXX */
 if type='RX' | type='?' then do
   signal on error  name Close
   signal on syntax name Close
   Interpret "Call" runmbr
   Call Close 0 m '(REXX) ended rc' rc
 end

 /* selection panel     */
 if type='SP' then do
   address ispexec "select panel("runmbr")"
   if rc>8 then call close 8 "Select rc" rc zerrlm
   call close 0 'Select panel ok'
 end

 Call Close 20 'Internal error for type' type

 /* terminate */
Close:
 Address TSO
 signal off error
 signal off syntax
 "delstack"
 do n=1 to words(libdef) /* release libdefs */
   Address ispexec "libdef" word(libdef,n)
 end
 if altlib<>'' then do
   "altlib deact appl("altlib")"
   if rc<>0 then say 'altlib' altlib 'deact rc' rc
 end
 if ddlist<>'' then call silent 'free dd('ddlist')'
 parse arg _rc _msg
 if _msg<>'' then Call Xmsg _msg
 if msgidopt=0 then "profile nomsgid"
 Exit word(_rc 0,1)

XMsg:
trace off
 parse arg zedlmsg
 address ispexec"setmsg msg(isrz000)"
 return 0

Silent: zz=outtrap(word(arg(2) '$.',1))
        address tso arg(1);zz=outtrap('off');return rc

Xword: Procedure
 trace off
 arg w,s
 n=wordpos(w,s)
 if n=0 then return s
 return delword(s,n,1)

EdFind: address isredit "find" arg(1); return rc

DoLibdef:
 address ispexec "libdef" arg(1) "library id("xdd1") stack"
 if rc<>0 then call close 8 'libdef' arg(1) 'rc' rc zerrlm
 libdef=libdef arg(1)
 Return 0