/* REXX MAKEPARA (v.2) Create a new paragraph by copying the $EXAMPLE member into member being edited, then customizes the template into a legitmate paragraph. The user must place the cursor on the line which contains the new paragraph name, and must specify a line command of A (after) or B (before) to identify the location of the new paragraph. Use '(routine name) ?' for HELP-text. The '$EXAMPLE' member has the general shape of a paragraph as you will see in the code below: a two-line comment, the paragraph name-line, a call to BRANCH, an address specification, and a 'return' line. There are two spots in this text where four x'EA' characters appear. After the example text is copied in, those x'EA' blocks are changed to the actual name that was on the CALL. After the pro-forma code is loaded and fixed, the programmer can begin filling in the actual code for that paragraph. Written by G052811 Chris Lewis 19960415 Impact Analysis . SYSEXEC MARK . SYSEXEC RUNDATA . SYSEXEC TRAPOUT Modification History 19960425 ctl Fixed problem with multiple '(' within a function call. Fixed problem where user could not create a paragraph ahead of the call. 19960508 fxc Upper case orignal call 19960508 ctl Handle extra '(' in call 19960730 ctl Remove commas and semicolons from paragraph name 20200405 fxc REXXSKEL 20020513 20210402 fxc position cursor at 'address' ; MARK 20230726 fxc adjust HELP; 20230816 fxc correct HELP; change '3f' to 'ea'; 20240621 fxc chg all # to $; 20250522 fxc trace MARK; cosmetics; 20250524 fxc (v.2) add Impact Analysis; mem must be in THIS dataset; use RUNDATA to locate SRC; c all sw. to sw.0; */ address ISREDIT /* REXXSKEL ver.960119 */ "macro (parms) NOPROCESS" /* parameters */ if rc = 20 then do /* ISREDIT not available */ parse source . . exec_name . ex_nam = Left(exec_name,8) /* predictable size */ helpmsg = ex_nam "is an EDIT macro" call HELP /* and don't come back */ end parse upper var parms parms "((" opts /* split off OPTS */ signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = Trace( "O" ); rc = Trace( tv ) info = parms /* to enable parsing */ if WordPos( "?",info ) > 0 then call HELP /* -*/ address ISPEXEC "CONTROL ERRORS RETURN" call A_INIT /* Initialization -*/ if helpmsg <> "" then call HELP call B_CHECK /* Copy template if nec. -*/ if sw.0error_found then return call C_PROCESS /* Customize the template -*/ exit /*@ MAKEPARA */ /* Initialization. . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address ISREDIT "(data) = LINE .zcsr" /* contents of line .zcsr */ "(cpos) = LINENUM" .zcsr /* Line number of cursor */ "(dsn) = DATASET" /* dsn fully qualified w/o */ /* quotes */ parse upper var data . "CALL" paraname . /* find paragraph name */ if paraname = "" then if pos("(",data) > 0 then do /* must be a function */ parse var data . paraname "(" . parse value reverse(paraname) with paraname . paraname = reverse(paraname) end if paraname = "" then helpmsg = helpmsg, "Unable to find paraname on line" cpos "Line" data if pos("(",paraname) > 0 then parse var paraname paraname "(" . paraname = strip(paraname,,";") /* Remove any semicolons */ paraname = strip(paraname,,",") /* Remove any commas */ "PROCESS RANGE A B" /* Allow line cmds of A or B */ if rc > 0 then helpmsg = helpmsg "No line commands entered." return /*@ A_INIT */ /* Copy template into place. . ----------------------------------------------------------------- */ B_CHECK: /*@ */ if branch then call BRANCH address ISPEXEC stat = Sysdsn("'"dsn"("mem")'") = "OK" if stat then return /* already there */ call BA_GET_SRC /* Copy the master template -*/ "lminit dataid( baseid ) dataset( '"src"' )" "lminit dataid( testid ) dataset( '"dsn"' )" "lmcopy fromid( "baseid" ) frommem( "mem" )", "todataid( "testid" ) tomem( "mem" )" /* copy into dataset */ sw.0error_found = rc > 0 /* from default */ if sw.0error_found then do say "Copy Failed" rc say "From dsn" src say "From mem" mem say "To dsn" dsn /* THIS dataset */ say "To mem" mem end return /*@ B_CHECK */ /* Template does not exist in this dataset. Acquire a copy of the template for future use. . ----------------------------------------------------------------- */ BA_GET_SRC: /*@ */ if branch then call BRANCH address TSO "NEWSTACK" "RUNDATA READ TBLKEY MAKEPARA " /* sets SRC */ do queued() /* return from RUNDATA */ pull tag tagval if tag = "" then do sw.0Error_Found = 1 "DELSTACK" say tag tagval return end tagval = Space( tagval,1 ) @z = Value( tag,tagval ) /* tag <-- tagval */ end /* queued */ if Symbol( 'src' ) = 'LIT' then do helpmsg = "RUNDATA did not supply a required value. ", "Correct the RUNDATA table as specified", "in the HELP text before proceeding. " call HELP /* ...and don't come back! -*/ end "DELSTACK" return /*@ BA_GET_SRC */ /* Customize the template. Place cursor to set address spec. . ----------------------------------------------------------------- */ C_PROCESS: /*@ */ if branch then call BRANCH address ISREDIT "(cmd) = RANGE_CMD" /* was A or B used? */ cmd.A = "AFTER" /* copy after or */ cmd.B = "BEFORE" /* copy before */ "(first) = LINENUM" .zfrange /* find first occurence */ "COPY" cmd.cmd first mem /* copy member here */ findval = 'eaeaeaea'X /* Label name in template */ "FIND '"findval"' 1 NX FIRST" /* find where I put it */ "(procline) = CURSOR" /* There are 2 label names in the template paragraph and one on the line where the original CALL was found. Convert both to new name. We may not want to convert all. */ (up_case) "C NX '"findval"' '"paraname"'" "C NX '"findval"' '"paraname"'" /* Set cursor to line; change original CALL. */ "CURSOR =" cpos "1" "C NX '"paraname"' '"paraname"'" if opts <> '' then opts = "((" opts "MARK" opts /* TRACE might be on... */ "CAPS OFF" "CURSOR = "procline "FIND '...'" return /*@ C_PROCESS */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO info = parms /* Use PARMS, not OPTS */ up_case = 'CAPS' parse value KEYWD( "MEMBER" ) "$EXAMPLE" with, mem . return /*@ LOCAL_PREINIT */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg ex_nam = Left(exec_name,8) /* predictable size */ say " " say " "ex_nam" (edit macro) emplaces a new pro-forma REXX paragraph in a " say " specified location and names it appropriately. To " say " operate, place an 'A' (after) or 'B' (before) to specify " say " the location of the new paragraph, place the cursor on the" say " 'call' statement line, and issue the MAKEPARA command. " say " This is best done via a program function key. " say " " say " " say " Syntax: "ex_nam" MEMBER member (Defaults)" say " " say " member names the member which is the pro-forma text to be " say " inserted. If not specified, the default is " say " $EXAMPLE. This member MUST exist in the same " say " dataset. If it does not, RUNDATA will be called to " say " supply the default value (SRC) which dataset " say " contains the master copy of and that will " say " be replicated into the current dataset. " say " " say " RUNDATA should be 'salted' with TBLKEY=MAKEPARA and " say " SRC= the unquoted, fully-qualified dsn where the " say " master copy is stored. " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " 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 execution " say " into 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" (( trace ?r noupdt " 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','5d'x ) /* 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 */ "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 . sw.0nested = sysvar("SYSNEST") = "YES" sw.0batch = sysvar("SYSENV") = "BACK" sw.0inispf = sysvar("SYSISPF") = "ACTIVE" 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 */