194 lines
7.0 KiB
Rexx
194 lines
7.0 KiB
Rexx
/* REXX COMMANDS Show the contents of xxxCMDS and allow
|
|
selection and parameter entry.
|
|
|**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**|
|
|
| |
|
|
| WARNING: EMBEDDED COMPONENTS. |
|
|
| |
|
|
|**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**|
|
|
*/
|
|
address TSO
|
|
arg line
|
|
exec_name = Sysvar(Sysicmd)
|
|
if Sysvar(sysispf) = "NOT ACTIVE" then do
|
|
line = line "(( RESTARTED" /* tell the next invocation */
|
|
"ISPSTART CMD("exec_name line")" /* Invoke ISPF if nec. */
|
|
exit /* ...and restart it */
|
|
end
|
|
restarted = WordPos("RESTARTED",opts)>0/* called from READY-mode ? */
|
|
tv = ""
|
|
arg parms "((" opts
|
|
opts = Strip(opts,"T",")") /* lop trailing banana */
|
|
|
|
parse var opts "TRACE" tv .
|
|
parse value tv "O" with tv . /* guarantee a value */
|
|
rc = Trace(tv)
|
|
|
|
if parms = "?" then call HELP
|
|
parse value parms "ISP" with cmdtblID .
|
|
$tn$ = cmdtblID"CMDS" /* ISPCMDS by default */
|
|
|
|
address ISPEXEC
|
|
"CONTROL ERRORS RETURN"
|
|
call DEIMBED /* extract panel FCCMDSP -*/
|
|
$ddn = $ddn.PLIB
|
|
"LIBDEF ISPPLIB LIBRARY ID("$ddn") STACK"
|
|
"TBTOP" $tn$
|
|
do forever
|
|
"TBDISPL" $tn$ "PANEL(FCCMDSP) CURSOR(ACTION) AUTOSEL(NO)"
|
|
if rc > 4 then leave
|
|
do ztdsels
|
|
select
|
|
when action = "S" then
|
|
do /* Select */
|
|
"CONTROL DISPLAY SAVE" /* in case we display s'thing */
|
|
(zctact)
|
|
"CONTROL DISPLAY RESTORE" /* return from display */
|
|
end
|
|
when WordPos(action,"D") > 0 then "TBDELETE" $tn$
|
|
when WordPos(action,"E B") > 0 then call F_FIXTBL /* -*/
|
|
otherwise nop
|
|
end /* Select */
|
|
if ztdsels = 1 then ztdsels = 0
|
|
else "TBDISPL" $tn$ /* next row */
|
|
end /* ztdsels */
|
|
action = "" /* clear for re-display */
|
|
end /* forever */
|
|
"LIBDEF ISPPLIB"
|
|
|
|
if restarted then do
|
|
@@ = OutTrap("ll.")
|
|
exit 4
|
|
end
|
|
exit /*@ COMMANDS */
|
|
/*
|
|
. ----------------------------------------------------------------- */
|
|
F_FIXTBL: /*@ */
|
|
address ISPEXEC
|
|
|
|
save. = ""
|
|
parse value zctverb zcttrunc zctact with ,
|
|
save.vb save.tr save.act
|
|
save.desc = zctdesc
|
|
do forever
|
|
"DISPLAY PANEL(FCCMDFIX)"
|
|
if rc > 0 then leave
|
|
end
|
|
if save.vb = zctverb then,
|
|
if save.tr = zcttrunc then,
|
|
if save.act = zctact then,
|
|
if save.desc = zctdesc then return
|
|
"TBMOD" $tn$
|
|
|
|
return /*@ F_FIXTBL */
|
|
/*
|
|
. ----------------------------------------------------------------- */
|
|
HELP: /*@ */
|
|
say "HELP for" Sysvar(Sysicmd) "not available"
|
|
exit /*@ HELP */
|
|
/*
|
|
Parse out the embedded components at the back of the source code.
|
|
|
|
The components are enclosed in a comment whose start and end are on
|
|
individual lines for easier recognition.
|
|
|
|
Each component is identified by a triple-close-paren ")))" in
|
|
column 1 followed by a DDName and a membername. The text of the
|
|
component begins on the next line.
|
|
|
|
There are no restrictions on the DDName, but it is probably a good
|
|
idea to pick a name which relates to its use so that mainline
|
|
processing can, for example, determine what sort of LIBDEF to do.
|
|
Note also that a 3-digit random number will be generated for each
|
|
DDName to guard against the possibility that processing may be
|
|
interleaved or recursive. It is up to the programmer to add the
|
|
code to properly LIBDEF each component type.
|
|
. ----------------------------------------------------------------- */
|
|
DEIMBED: Procedure expose, /*@ */
|
|
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 */
|
|
/*
|
|
)))PLIB FCCMDSP
|
|
)ATTR
|
|
% TYPE(TEXT) INTENS(HIGH) SKIP(ON)
|
|
+ TYPE(TEXT) INTENS(LOW) SKIP(ON)
|
|
_ TYPE(INPUT) INTENS(HIGH) CAPS(ON)
|
|
! TYPE(OUTPUT) INTENS(HIGH) SKIP(ON)
|
|
)BODY EXPAND(ºº)
|
|
%º-º Current Command Table Contents º-º
|
|
%COMMAND ===>_ZCMD %SCROLL ===>_AMT +
|
|
+
|
|
+ CmdName CmdDescription
|
|
)MODEL
|
|
_Z+ !ZCTVERB + !ZCTDESC
|
|
)INIT
|
|
.ZVARS = '(ACTION)'
|
|
)REINIT
|
|
IF (&MSG = ' ')
|
|
&ACTION = ' '
|
|
REFRESH (&ACTION)
|
|
)END
|
|
)))PLIB FCCMDFIX
|
|
)ATTR
|
|
% TYPE(TEXT) INTENS(HIGH) SKIP(ON)
|
|
+ TYPE(TEXT) INTENS(LOW) SKIP(ON)
|
|
_ TYPE(INPUT) INTENS(HIGH) CAPS(ON)
|
|
} TYPE(INPUT) INTENS(HIGH) CAPS(OFF)
|
|
! TYPE(OUTPUT) INTENS(HIGH) SKIP(ON)
|
|
)BODY EXPAND(ºº)
|
|
%º-º Current Command Table Line Contents º-º
|
|
%COMMAND ===>_ZCMD
|
|
%SCROLL ===>_AMT +
|
|
+
|
|
+ Verb ===>_zctverb +
|
|
|
|
+ Truncation ===>_z+
|
|
|
|
+ Action ===>_zctact
|
|
|
|
+ Description ===>}zctdesc
|
|
|
|
)INIT
|
|
.ZVARS = '(ZCTTRUNC)'
|
|
)PROC
|
|
)END
|
|
*/ |