/* REXX SUPED SuperEdit replacement Use '(routine name) ?' for HELP-text. |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| | | | WARNING: EMBEDDED COMPONENTS. | | See text following TOOLKIT_INIT | | | |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| Written by Frank Clarke, rexxhead@yahoo.com Impact Analysis . SYSEXEC SUPBR Modification History 19980309 fxc upgrade from v.950824 to v.19980225; imbed panel ZSUPEDIT; RXSKLY2K; DECOMM; 19980811 fxc change BROWSE to VIEW 19991129 fxc upgrade from v.19980225 to v.19991109; new DEIMBED; 20210408 fxc add SUPEDH Help panel; upgrade REXXSKEL to v.20210402 20230128 fxc use MEMLIST when no member is specified; allows user to select Edit, View, Delete, &c. 20230527 fxc re-enable Browse-from-edit 20230608 fxc use &ZUP/&ZCONT 20230613 fxc add DEL to DEIMBED ALLOC 20230726 fxc adjust HELP; 20230806 fxc chg SYSPROC to SYSEXEC in Impact Analysis; 20240305 fxc align panel names; 20240309 fxc change dollar-sign to @ everywhere; */ arg argline address TSO /* REXXSKEL ver.20210402 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = trace(tv) info = parms /* to enable parsing */ if Sysvar("SYSISPF") = "NOT ACTIVE" then do arg argline "ISPSTART CMD("Sysvar("SYSICMD") argline ")" exit end /* ISPF not active */ call A_EDREC /* -*/ call A_INIT /* -*/ call B_ISPF_FUNCS /* -*/ exit /*@ SUPED */ /* . ----------------------------------------------------------------- */ A_EDREC: /*@ */ if branch then call BRANCH address ISPEXEC "EDREC QUERY" if rc = 0 then "EDREC INIT"; else, if rc = 4 then do "DISPLAY PANEL(ISREDM02)" if rc = 8 then exit if rc > 8 then do "SETMSG MSG(ISRZ002)" exit end if zedcmd = "" then do "EDREC PROCESS" if rc = 4 then do; zerrsm="EDREC PROCESS :: RC=4" zerrlm = zerrsm "SETMSG MSG(ISRZ002)" end end; else, if zedcmd = "C" then do /* CANCEL */ "EDREC CANCEL" end; else, if zedcmd = "D" then do /* DEFER */ "EDREC DEFER " end end /* QUERY = 4 */ else do "SETMSG MSG("zerrmsg")" exit end return /*@ A_EDREC */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO parse value "" with bore member zopt func = "EDIT" altfunc = "VIEW" op = func return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ B_ISPF_FUNCS: /*@ */ if branch then call BRANCH address ISPEXEC "CONTROL ERRORS RETURN" zerrsm = "" call BA_PROLOG /* -*/ call BP_DISPLAY_PANEL /* -*/ call BZ_EPILOG /* -*/ return /*@ B_ISPF_FUNCS */ /* . ----------------------------------------------------------------- */ BA_PROLOG: /*@ */ if branch then call BRANCH address ISPEXEC call DEIMBED /* -*/ dd = "" do Words(ddnlist) /* each LIBDEF DD */ parse value ddnlist dd with dd ddnlist @ddn = @ddn.dd /* PLIB322 <- PLIB */ "LIBDEF ISP"dd "LIBRARY ID("@ddn") STACK" end ddnlist = ddnlist dd return /*@ BA_PROLOG */ /* . ----------------------------------------------------------------- */ BP_DISPLAY_PANEL: /*@ */ if branch then call BRANCH address ISPEXEC do forever "DISPLAY PANEL(ZSUPEDIT)" if rc > 0 then leave if bore = "Y" then, /* wants to Browse */ op = altfunc else op = func if member = "" then meminfo = "" else meminfo = "("member")" if zopt = "" then iterate if zopt < "I" then do /* 3-level set */ ed_dsn = Value("PRJ"zopt)"."Value("LIB"zopt)"."Value("TYP"zopt) ed_dsn = Strip(ed_dsn,,".") /* lop trailing dots */ end ; else, /* 3-level set */ if zopt > "H" then do /* n-level set */ ed_dsn = Value("DSN"zopt) if Left(ed_dsn,1) = "'" then, ed_dsn = Strip(ed_dsn,,"'") else ed_dsn = Userid()"."ed_dsn end /* n-level set */ call D_GET_DSORG /* -*/ if sysdsorg = "PS" then do (OP) "DATASET('"ed_dsn"') PROFILE(DEFAULT)" call M_MSG(rc) end ; else, /* sequential */ if meminfo <> "" then do /* single member */ (OP) "DATASET('"ed_dsn||meminfo"') PROFILE(DEFAULT)" call M_MSG(rc) end /* single member */ else do /* no member */ "LMINIT DATASET('"ed_dsn"') DATAID(SUP00)" dflt = Left( op,1 ) "MEMLIST DATAID("sup00") FIELD(9) DEFAULT("dflt")" "LMFREE DATAID("sup00")" end /* no member */ zopt = '' end /* forever */ return /*@ BP_DISPLAY_PANEL */ /* . ----------------------------------------------------------------- */ BZ_EPILOG: /*@ */ if branch then call BRANCH address ISPEXEC dd = "" do Words(ddnlist) /* each LIBDEF DD */ parse value ddnlist dd with dd ddnlist "LIBDEF ISP"dd end return /*@ BZ_EPILOG */ /* . ----------------------------------------------------------------- */ D_GET_DSORG: /*@ */ if branch then call BRANCH address TSO rc = LISTDSI("'"ed_dsn"'") return /*@ D_GET_DSORG */ /* . ----------------------------------------------------------------- */ M_MSG: /*@ */ if branch then call BRANCH address ISPEXEC arg retcode . if op = "EDIT" then do /* Edit */ if member = "" then do /* No memberber */ if rc = 0 then do; zerrsm="Dataset saved" zerrlm="Dataset saved as" ed_dsn; end else, if rc = 4 then do; zerrsm="Dataset not changed" zerrlm="Dataset was not changed or Edit was cancelled"; end end /* No member */ else do /* Member */ if rc = 0 then do; zerrsm="Member saved" zerrlm=member "has been saved in" ed_dsn; end else, if rc = 4 then do; zerrsm="Member not changed" zerrlm=member "was not changed or Edit was cancelled" end end /* Member */ end /* Edit */ else do /* View */ if member = "" then do /* No memberber */ if rc = 0 then do; zerrsm="View completed" zerrlm = ed_dsn "was viewed" end end /* No member */ else do /* Member */ if rc = 0 then do; zerrsm="Member viewed" zerrlm=member "viewed in dataset" ed_dsn; end else, if rc = 4 then do; zerrsm = "Member not found or in use" zerrlm = member "was not found in" ed_dsn, "or was in use by another process" end end /* Member */ end /* View */ if zerrsm \= "" then, "SETMSG MSG(ISRZ002)" return /*@ M_MSG */ /* Parse out the embedded components at the back of the source code. . ----------------------------------------------------------------- */ DEIMBED: Procedure expose, /*@ */ (tk_globalvars) ddnlist @ddn. daid. address TSO fb80po.0 = "NEW DEL UNIT(VIO) SPACE(5 5) TRACKS DIR(40)", "RECFM(F B) LRECL(80) BLKSIZE(0)" parse value "" with ddnlist @ddn. daid. lastln = sourceline() currln = lastln /* */ if Left(sourceline(currln),2) <> "*/" then return currln = currln - 1 /* previous line */ "NEWSTACK" address ISPEXEC do while sourceline(currln) <> "/*" text = sourceline(currln) /* save with a short name ! */ if Left(text,3) = ")))" then do /* package the queue */ parse var text ")))" ddn mbr . /* PLIB PANL001 maybe */ if Pos(ddn,ddnlist) = 0 then do /* doesn't exist */ ddnlist = ddnlist ddn /* keep track */ @ddn = ddn || Random(999) @ddn.ddn = @ddn address TSO "ALLOC FI("@ddn")" fb80po.0 "LMINIT DATAID(DAID) DDNAME("@ddn")" daid.ddn = daid end daid = daid.ddn "LMOPEN DATAID("daid") OPTION(OUTPUT)" do queued() parse pull line "LMPUT DATAID("daid") MODE(INVAR) DATALOC(LINE) DATALEN(80)" end "LMMADD DATAID("daid") MEMBER("mbr")" "LMCLOSE DATAID("daid")" end /* package the queue */ else push text /* onto the top of the stack */ currln = currln - 1 /* previous line */ end /* while */ address TSO "DELSTACK" return /*@ DEIMBED */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO return /*@ LOCAL_PREINIT */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg; say "" ex_nam = Left(exec_name,8) /* predictable size */ say " "ex_nam" provides an easy interface for editing your favorite " say " datasets. " say " " say " Syntax: "ex_nam" no parms " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " " say " Debugging tools provided include: " say " " say " MONITOR displays key information throughout processing. " say " Displays most paragraph names upon entry. " say " " say " NOUPDT by-pass all update logic. " say " " say " BRANCH show all paragraph entries. " say " " say " TRACE tv will use value following TRACE to place the " say " execution in REXX TRACE Mode. " say " " say " " say " Debugging tools can be accessed in the following manner: " say " " say " TSO "ex_nam" parameters (( debug-options " say " " say " For example " say " " say " TSO "ex_nam" (( MONITOR TRACE ?R " if sysvar("SYSISPF") = "ACTIVE" then, address ISPEXEC "CONTROL DISPLAY REFRESH" exit /*@ HELP */ /* . ----------------------------------------------------------------- */ BRANCH: Procedure expose, /*@ */ sigl exec_name rc = trace("O") /* we do not want to see this */ arg brparm . origin = sigl /* where was I called from ? */ do currln = origin to 1 by -1 /* inch backward to label */ if Right(Word(Sourceline(currln),1),1) = ":" then do parse value sourceline(currln) with pgfname ":" . /* Label */ leave ; end /* name */ end /* currln */ select when brparm = "NAME" then return(pgfname) /* Return full name */ when brparm = "ID" then do /* wants the prefix */ parse var pgfname pgfpref "_" . /* get the prefix */ return(pgfpref) end /* brparm = "ID" */ otherwise say left(sigl,6) left(pgfname,40) exec_name "Time:" time("L") end /* select */ return /*@ BRANCH */ /* . ----------------------------------------------------------------- */ DUMP_QUEUE: /*@ Take whatever is in stack */ rc = trace("O") /* and write to the screen */ address TSO "QSTACK" /* how many stacks? */ stk2dump = rc - tk_init_stacks /* remaining stacks */ if stk2dump = 0 & queued() = 0 then return say "Total Stacks" rc , /* rc = #of stacks */ " Begin Stacks" tk_init_stacks , /* Stacks present at start */ " Excess Stacks to dump" stk2dump do dd = rc to tk_init_stacks by -1 /* empty each one. */ say "Processing Stack #" dd " Total Lines:" queued() do queued();pull line;say line;end /* pump to the screen */ "DELSTACK" /* remove stack */ end /* dd = 1 to rc */ return /*@ DUMP_QUEUE */ /* Handle CLIST-form keywords added 20020513 . ----------------------------------------------------------------- */ CLKWD: Procedure expose info /*@ hide all except info */ arg kw kw = kw"(" /* form is 'KEY(DATA)' */ kw_pos = Pos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ rtpt = Pos(") ",info" ",kw_pos) /* locate end-paren */ slug = Substr(info,kw_pos,rtpt-kw_pos+1) /* isolate */ info = Delstr(info,kw_pos,rtpt-kw_pos+1) /* excise */ parse var slug (kw) slug /* drop kw */ slug = Reverse(Substr(Reverse(Strip(slug)),2)) return slug /*@CLKWD */ /* Handle multi-word keys 20020513 . ----------------------------------------------------------------- */ KEYWD: Procedure expose info /*@ hide all vars, except info*/ arg kw kw_pos = wordpos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ kw_val = word(info,kw_pos+Words(kw))/* get the next word */ info = Delword(info,kw_pos,2) /* remove both */ return kw_val /*@ KEYWD */ /* . ----------------------------------------------------------------- */ KEYPHRS: Procedure expose, /*@ */ info helpmsg exec_name /* except these three */ arg kp wp = wordpos(kp,info) /* where is it? */ if wp = 0 then return "" /* not found */ front = subword(info,1,wp-1) /* everything before kp */ back = subword(info,wp+1) /* everything after kp */ parse var back dlm back /* 1st token must be 2 bytes */ if length(dlm) <> 2 then /* Must be two bytes */ helpmsg = helpmsg, "Invalid length for delimiter("dlm") with KEYPHRS("kp")" if wordpos(dlm,back) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg, "No matching second delimiter("dlm") with KEYPHRS("kp")" if helpmsg <> "" then call HELP /* Something is wrong */ parse var back kpval (dlm) back /* get everything b/w delim */ info = front back /* restore remainder */ return Strip(kpval) /*@ KEYPHRS */ /* . ----------------------------------------------------------------- */ NOVALUE: /*@ */ say exec_name "raised NOVALUE at line" sigl say " " say "The referenced variable is" condition("D") say " " zsigl = sigl signal SHOW_SOURCE /*@ NOVALUE */ /* . ----------------------------------------------------------------- */ SHOW_SOURCE: /*@ */ call DUMP_QUEUE /* Spill contents of stacks -*/ if sourceline() <> "0" then /* to screen */ say sourceline(zsigl) rc = trace("?R") nop exit /*@ SHOW_SOURCE */ /* . ----------------------------------------------------------------- */ SS: Procedure /*@ Show Source */ arg ssbeg ssend . if ssend = "" then ssend = 10 if \datatype(ssbeg,"W") | \datatype(ssend,"W") then return ssend = ssbeg + ssend do ssii = ssbeg to ssend ; say Strip(sourceline(ssii),'T') ; end return /*@ SS */ /* . ----------------------------------------------------------------- */ SWITCH: Procedure expose info /*@ */ arg kw sw_val = Wordpos(kw,info) > 0 /* exists = 1; not found = 0 */ if sw_val then /* exists */ info = Delword(info,Wordpos(kw,info),1) /* remove it */ return sw_val /*@ SWITCH */ /* . ----------------------------------------------------------------- */ SYNTAX: /*@ */ errormsg = exec_name "encountered REXX error" rc "in line" sigl":", errortext(rc) say errormsg zsigl = sigl signal SHOW_SOURCE /*@ SYNTAX */ /* Can call TRAPOUT. . ----------------------------------------------------------------- */ TOOLKIT_INIT: /*@ */ address TSO info = Strip(opts,"T",")") /* clip trailing paren */ parse source sys_id how_invokt exec_name DD_nm DS_nm, as_invokt cmd_env addr_spc usr_tokn parse value "" with tv helpmsg . parse value 0 "ISR00000 YES" "Error-Press PF1" with, sw. zerrhm zerralrm zerrsm if SWITCH("TRAPOUT") then do "TRAPOUT" exec_name parms "(( TRACE R" info exit end /* trapout */ sw.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = sysvar("SYSISPF") = "ACTIVE" if Word(parms,1) = "?" then call HELP /* I won't be back */ "QSTACK" ; tk_init_stacks = rc /* How many stacks? */ parse value SWITCH("BRANCH") SWITCH("MONITOR") SWITCH("NOUPDT") with, branch monitor noupdt . parse value mvsvar("SYSNAME") sysvar("SYSNODE") with, #tk_cpu node . parse value KEYWD("TRACE") "N" with tv . tk_globalvars = "exec_name tv helpmsg sw. zerrhm zerralrm ", "zerrsm zerrlm tk_init_stacks branch monitor ", "noupdt" call LOCAL_PREINIT /* for more opts -*/ return /*@ TOOLKIT_INIT */ /* ))) PLIB ZSUPEDIT SuperEdit )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) @ TYPE( TEXT ) INTENS( HIGH ) COLOR( YELLOW ) )BODY EXPAND(||) WIDTH(&ZSCREENW) @Unsupported ----------------% Super Editor @----------------------------------- %SELECT LIBRARY%===>_ZOPT %BROWSE DATA?%==>_Z+ (N/Y) %SELECT MEMBER %===>_MEMBER + (Blank for member list) + +ISPF LIBRARIES: %A+ PROJECT%===>_PRJA +%B+%===>_PRJB +%C+%===>_PRJC +%D+%===>_PRJD + + LIBRARY%===>_LIBA + %===>_LIBB + %===>_LIBC + %===>_LIBD + + TYPE %===>_TYPA + %===>_TYPB + %===>_TYPC + %===>_TYPD + % %E+ PROJECT%===>_PRJE +%F+%===>_PRJF +%G+%===>_PRJG +%H+%===>_PRJH + + LIBRARY%===>_LIBE + %===>_LIBF + %===>_LIBG + %===>_LIBH + + TYPE %===>_TYPE + %===>_TYPF + %===>_TYPG + %===>_TYPH + + +OTHER PARTITIONED OR SEQUENTIAL DATASETS: %I+ DATASET NAME %===>_DSNI + %J+ DATASET NAME %===>_DSNJ + %K+ DATASET NAME %===>_DSNK + %L+ DATASET NAME %===>_DSNL + %M+ DATASET NAME %===>_DSNM + %N+ DATASET NAME %===>_DSNN + %O+ DATASET NAME %===>_DSNO + %P+ DATASET NAME %===>_DSNP + %Q+ DATASET NAME %===>_DSNQ + )INIT IF (&MSG = ' ') .MSG = &MSG .ZVARS = '(BORE)' .HELP = SUPEDH .CURSOR = ZOPT &CCMD = ' ' &SVOL = ' ' )REINIT .CURSOR = ZOPT &ZOPT = '' )PROC &MSG = ' ' VER(&ZOPT,LIST,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) IF (&ZOPT=A) VER(&PRJA,NB,NAME) VER(&LIBA,NB,NAME) IF (&ZOPT=B) VER(&PRJB,NB,NAME) VER(&LIBB,NB,NAME) IF (&ZOPT=C) VER(&PRJC,NB,NAME) VER(&LIBC,NB,NAME) IF (&ZOPT=D) VER(&PRJD,NB,NAME) VER(&LIBD,NB,NAME) IF (&ZOPT=E) VER(&PRJE,NB,NAME) VER(&LIBE,NB,NAME) IF (&ZOPT=F) VER(&PRJF,NB,NAME) VER(&LIBF,NB,NAME) IF (&ZOPT=G) VER(&PRJG,NB,NAME) VER(&LIBG,NB,NAME) IF (&ZOPT=H) VER(&PRJH,NB,NAME) VER(&LIBH,NB,NAME) IF (&ZOPT=I) VER(&DSNI,NB,DSNAME) IF (&ZOPT=J) VER(&DSNJ,NB,DSNAME) IF (&ZOPT=K) VER(&DSNK,NB,DSNAME) IF (&ZOPT=L) VER(&DSNL,NB,DSNAME) IF (&ZOPT=M) VER(&DSNM,NB,DSNAME) IF (&ZOPT=N) VER(&DSNN,NB,DSNAME) IF (&ZOPT=O) VER(&DSNO,NB,DSNAME) IF (&ZOPT=P) VER(&DSNP,NB,DSNAME) IF (&ZOPT=Q) VER(&DSNQ,NB,DSNAME) VPUT ( PRJA LIBA TYPA PRJB LIBB TYPB PRJC LIBC TYPC PRJD LIBD TYPD PRJE LIBE TYPE PRJF LIBF TYPF PRJG LIBG TYPG PRJH LIBH TYPH DSNI DSNJ DSNK DSNL DSNM DSNN DSNO DSNP DSNQ MEMBER ) PROFILE )END &MEMBER = ' ' VPUT (NAME-LIST) ASIS )END ))) PLIB SUPEDH HELP for SuperEdit )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) @ TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) %TUTORIAL |-| SuperEdit |-| TUTORIAL %Next Selection ===>_ZCMD + SuperEdit provides an easy way to get directly to your most commonly needed datasets. The panel provides for eight (8) three-level datasets and nine (9) others. Invoke SuperEdit as 'SUPED;D' to get to the 'D' dataset directly. (Others by extension.) It is possible to Browse (View) the data rather than Edit by selecting the option on the panel. )PROC &ZUP = SUPEDH &ZCONT = SUPEDH )END */