/* REXX MAKEPARA Create a new paragraph by copying the #EXAMPLE member into member being edited. Then customize the template into legitmate paragraph. The user must place the cursor on the line which contains the new paragraph name. Must specify a line command of A (after) or B (before). Is an edit macro. Written by Chris Lewis 19960415 Impact Analysis . SYSPROC 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 original call 19960508 ctl Handle extra "(" in call 19960730 ctl Remove commas and semicolons from paragraph name 19980520 fxc upgrade from v.960119 to v.19980225; DECOMM; RXSKLY2K; change ALL occurrences of the paragraph-name to uppercase; 20020129 fxc combine 6 versions */ address ISREDIT /* REXXSKEL ver.19980225 */ "MACRO (parms) NOPROCESS" parse upper var parms parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = trace(tv) info = parms /* to enable parsing */ call A_INIT /* -*/ if helpmsg ^= "" then call HELP call B_CHECK /* -*/ if sw.0error_found then return call C_PROCESS /* -*/ exit /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address ISREDIT call AA_KEYWDS /* -*/ "(data) = LINE .zcsr" /* contents of line .zcsr */ "(cpos) = LINENUM" .zcsr /* Line number of cursor */ "(dsn) = DATASET" /* dsn fully qualified w/o */ /* quotes */ up_case = "CAPS" /* caps */ 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 */ /* . ----------------------------------------------------------------- */ AA_KEYWDS: /*@ */ if branch then call BRANCH address TSO parse value KEYWD("MEMBER") "#EXAMPLE" with, mem . parse value KEYWD("FROM") "'DTAFXC.@@.REXX'" with, basedsn . return /*@ AA_KEYWDS */ /* Create a #EXAMPLE member here if necessary. . ----------------------------------------------------------------- */ B_CHECK: /*@ */ if branch then call BRANCH address ISPEXEC "CONTROL ERRORS RETURN" /* Handle my own errors. */ stat = sysdsn("'"dsn"("mem")'") = "OK" if stat then return /* already there */ "LMINIT DATAID(BASEID) DATASET("basedsn")" "LMINIT DATAID(TESTID) DATASET('"dsn"')" "LMCOPY FROMID("baseid") FROMMEM("mem")", "TODATAID("testid") TOMEM("mem")" /* copy into dataset */ sw.error_found = rc > 0 /* from default */ if sw.error_found then do say "Copy Failed" rc say "From dsn" basedsn say "From mem" mem say "To dsn" basedsn say "To mem" mem end return /*@ B_CHECK */ /* . -----------------------------------------------------------------.*/ 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 = "3f3f3f3f"X /* Label name in template */ "FIND" findval " 1 NX FIRST" /* find where I put it */ /* 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. */ (up_case) "C NX "findval paraname "C NX "findval paraname /* Set cursor to line; change original CALL. */ "C ALL "paraname paraname "CURSOR =" cpos "1" "CAPS OFF" return /*@ C_PROCESS */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ if branch then call BRANCH address TSO return /*@ LOCAL_PREINIT */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then do ; say helpmsg; say ""; end say " " say " MAKEPARA Create a new paragraph by copying the #EXAMPLE " say " member into member being edited. Must specify " say " a line command of A (after) or B (before). " say " Is an edit macro. " say " " say " Syntax: MAKEPARA FROM - Alternate DSN " say " MEMBER - Alternate template" say " " say " This is an Edit Macro that will copy in a paragraph " say " template and then convert the paragraph label. " say " Place the cursor on the line which contains the new " say " paragraph name. Place an A (after) or B (before) " say " on the you wish to copy after or before. is " say " used to specify the dataset the template should be " say " copied from. If not specified it will default to: " say " " say " DTAFXC.@@.REXX " say " " say " If is specified it should conform to TSO " say " naming conventions. Fully qualified if quoted. " say " is used to specify an alternate template. " say " If not specified it will default to #EXAMPLE. " say " " say " If the template does not exist in the dataset being " say " edited then it will copied in from . " say " " pull "CLEAR" 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" say " the execution in REXX TRACE Mode." say " " say " " say " Debugging tools can be accessed in the following manner:" say " " say " TSO" exec_name" parameters (( debug-options" say " " say " For example:" say " " say " TSO" exec_name " (( MONITOR TRACE ?R" 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 . $a#y = sigl /* where was I called from ? */ do $b#x = $a#y to 1 by -1 /* inch backward to label */ if Right(Word(Sourceline($b#x),1),1) = ":" then do parse value sourceline($b#x) with $l#n ":" . /* Paragraph */ leave ; end /* name */ end /* $b#x */ select when brparm = "NAME" then return($l#n) /* Return full name */ when brparm = "ID" then do /* Return prefix */ parse var $l#n $l#n "_" . /* get the prefix */ return($l#n) end /* brparm = "ID" */ otherwise say left(sigl,6) left($l#n,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 */ "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 */ /* . ----------------------------------------------------------------- */ 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+1) /* 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 address TSO "CLEAR" ssend = ssbeg + ssend do ssii = ssbeg to ssend ; say sourceline(ssii) ; end address TSO "CLEAR" 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 */ /* . ----------------------------------------------------------------- */ 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 */ 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 . sw.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = sysvar("SYSISPF") = "ACTIVE" parse value KEYWD("TRACE") "O" with tv . tk_globalvars = "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 */