408 lines
18 KiB
Rexx
408 lines
18 KiB
Rexx
/* REXX POST ...a notation on the ISPF LOG
|
|
|**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**|
|
|
| |
|
|
| WARNING: EMBEDDED COMPONENTS. |
|
|
| See text following TOOLKIT_INIT |
|
|
| |
|
|
|**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**|
|
|
|
|
Written by Frank Clarke, Oldsmar FL
|
|
|
|
Impact Analysis
|
|
. SYSPROC TRAPOUT
|
|
|
|
Modification History
|
|
20010612 fxc REXXSKEL v.20010524; enable full-screen entry of text
|
|
if not specified as a parm.
|
|
20011002 fxc fixed scroll-amt field;
|
|
|
|
*/
|
|
arg argline
|
|
address ISPEXEC /* REXXSKEL ver.20010524 */
|
|
arg parms "((" opts
|
|
|
|
signal on syntax
|
|
signal on novalue
|
|
|
|
call TOOLKIT_INIT /* conventional start-up -*/
|
|
rc = trace(tv)
|
|
info = parms /* to enable parsing */
|
|
"CONTROL ERRORS RETURN" /* I'll handle my own */
|
|
|
|
parse arg parms "((" /* preserve case */
|
|
info = parms /* to enable parsing */
|
|
|
|
call A_INIT /* -*/
|
|
call B_POST /* -*/
|
|
|
|
/* \sw.nested then call DUMP_QUEUE -*/
|
|
exit /*@ POST */
|
|
/*
|
|
. ----------------------------------------------------------------- */
|
|
A_INIT: /*@ */
|
|
if branch then call BRANCH
|
|
address TSO
|
|
|
|
/* = '------------------------' template for max length */
|
|
zerrsm = 'LOG message via POST: '
|
|
zerralrm = "NO"
|
|
zerrhm = "ISR00000"
|
|
|
|
return /*@ A_INIT */
|
|
/*
|
|
. ----------------------------------------------------------------- */
|
|
B_POST: /*@ */
|
|
if branch then call BRANCH
|
|
address ISPEXEC
|
|
|
|
rc = 0 /* init */
|
|
if parms = "" then do /* text not specified */
|
|
call DEIMBED /* extract panel -*/
|
|
call BA_SETUP_LIBDEF /* enable panel -*/
|
|
call BG_GET_TEXT /* -*/
|
|
end
|
|
|
|
if rc = 0 then do /* text available */
|
|
zerrlm = info
|
|
"LOG MSG(ISRZ002)" /* This line posts to the log */
|
|
end
|
|
else do
|
|
zerrsm = "Entry declined"
|
|
zerrlm = "Non-zero RC from NOTETXT intercepted. No note was",
|
|
"posted to the LOG."
|
|
zerralrm = "YES"
|
|
"SETMSG MSG(ISRZ001)"
|
|
end
|
|
|
|
if parms = "" then, /* text not specified */
|
|
call BZ_DROP_LIBDEF /* -*/
|
|
|
|
return /*@ B_POST */
|
|
/*
|
|
. ----------------------------------------------------------------- */
|
|
BA_SETUP_LIBDEF: /*@ */
|
|
if branch then call BRANCH
|
|
address ISPEXEC
|
|
|
|
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_SETUP_LIBDEF */
|
|
/*
|
|
. ----------------------------------------------------------------- */
|
|
BG_GET_TEXT: /*@ */
|
|
if branch then call BRANCH
|
|
address ISPEXEC
|
|
|
|
"DISPLAY PANEL(NOTETXT)"
|
|
|
|
return /*@ BG_GET_TEXT */
|
|
/*
|
|
. ----------------------------------------------------------------- */
|
|
BZ_DROP_LIBDEF: /*@ */
|
|
if branch then call BRANCH
|
|
address ISPEXEC
|
|
|
|
dd = ""
|
|
do Words(ddnlist) /* each LIBDEF DD */
|
|
parse value ddnlist dd with dd ddnlist
|
|
$ddn = $ddn.dd /* PLIB322 <- PLIB */
|
|
"LIBDEF ISP"dd
|
|
address TSO "FREE FI("$ddn")"
|
|
end
|
|
ddnlist = ddnlist dd
|
|
|
|
return /*@ BZ_DROP_LIBDEF */
|
|
/*
|
|
. ----------------------------------------------------------------- */
|
|
LOCAL_PREINIT: /*@ customize opts */
|
|
address TSO
|
|
|
|
|
|
return /*@ LOCAL_PREINIT */
|
|
/* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */
|
|
/*
|
|
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 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 */
|
|
/*
|
|
. ----------------------------------------------------------------- */
|
|
HELP: /*@ */
|
|
address TSO;"CLEAR"
|
|
if helpmsg <> "" then do ; say helpmsg; say ""; end
|
|
ex_nam = Left(exec_name,8) /* predictable size */
|
|
|
|
say " "
|
|
say " "ex_nam" will insert a message of your choice to the ISPF Log "
|
|
say " dataset. This may be useful for tracking your time when "
|
|
say " involved in multiple projects. "
|
|
say " "
|
|
say " Syntax: "ex_nam" <text> "
|
|
say " "
|
|
say " <text> is any message you wish inserted onto the log. If "
|
|
say " <text> is not specified as a parm, you will be "
|
|
say " prompted to enter it. "
|
|
say " "
|
|
"NEWSTACK"; pull ; "CLEAR" ; "DELSTACK "
|
|
say " Debugging tools provided include: "
|
|
say " "
|
|
say " BRANCH: show all paragraph entries. "
|
|
say " "
|
|
say " TRACE tv: will use value following TRACE to place the execution in"
|
|
say " 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 "
|
|
|
|
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 */
|
|
|
|
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 = "exec_name tv helpmsg sw. zerrhm zerralrm ",
|
|
"zerrsm zerrlm tk_init_stacks branch monitor ",
|
|
"noupdt"
|
|
|
|
call LOCAL_PREINIT /* for more opts -*/
|
|
|
|
return /*@ TOOLKIT_INIT */
|
|
|
|
/* -------------- REXXSKEL back-end removed for space -------------- */
|
|
/*
|
|
)))PLIB NOTETXT
|
|
)ATTR
|
|
% TYPE(TEXT) INTENS(HIGH) SKIP(ON)
|
|
+ TYPE(TEXT) INTENS(LOW) SKIP(ON)
|
|
_ TYPE(INPUT) INTENS(LOW) CAPS(ON)
|
|
{ TYPE(INPUT) INTENS(LOW) CAPS(OFF)
|
|
@ TYPE(TEXT) INTENS(HIGH) COLOR(YELLOW)
|
|
! TYPE(INPUT) INTENS(NON)
|
|
)BODY EXPAND(ºº)
|
|
@º-º% Specify Logging Text @º-º
|
|
%COMMAND ===>_ZCMD
|
|
%SCROLL ===>_ZAMT+
|
|
+
|
|
+
|
|
+
|
|
Please enter the text to be posted to the LOG file:
|
|
+
|
|
Text ===>{info
|
|
+
|
|
)INIT
|
|
)PROC
|
|
)END
|
|
*/ |