Using this Rexx (from Douglas H Adams), works perfect)
Did rewrite some code
//Lasse
-----Ursprungligt meddelande-----
Från: IBM Mainframe Discussion List <[email protected]> För Mark Zelden
Skickat: den 23 januari 2024 17:43
Till: [email protected]
Ämne: Re: Custom ISPF command
On Tue, 23 Jan 2024 07:54:50 -0600, Tom Marchant <[email protected]>
wrote:
>"Obviously, you still need to restart ISPF to enable the new commands."
>
>It isn't obvious to me. For another example of modifying the command
>table dynamically, see Gilbert Saint-Fluor's FASTPATH command on the
>CBT tape. I use it regularly. Issuing the FASTPATH command within ISPF
>adds some commands to the command table and they are immediately usable.
>
>--
I use FASTPATH and also my own USERCMDS table, which at times I've had to
incorporate into SITECMDS or ISPCMDS depending on what the ISPF customization
is at the shop I'm at.
As far as adding them dynamically, on some systems I access rarely, I simply
use this CLIST to add all "my stuff" after ISPF invocation. So NO - you do not
need to restart ISPF.
http://www.mzelden.com/mvsfiles/ispcmdsa.txt
Best Regards,
Mark
--
Mark Zelden - Zelden Consulting Services - z/OS, OS/390 and MVS ITIL v3
Foundation Certified mailto:[email protected] Mark's MVS Utilities:
http://www.mzelden.com/mvsutil.html
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions, send email to
[email protected] with the message: INFO IBM-MAIN
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: INFO IBM-MAIN
/**** Rexx Procedure ***************************************************
* *
* ISPF Commands Table Utility *
* *
* This utility is an alternative to ISPF/PDF option 3.9. *
* It supports all the function of option 3.9 plus the following: *
* (1) Any application ID may be specified, even a currently active *
* one (including ISP and ISR) -- if a table for an active *
* application is changed, it is stored on DASD, but the active *
* copy is not affected; *
* (2) The application ID defaults to the currently active one; *
* (3) The output table library may be specified (the default is the *
* data set currently allocated to ISPTABL; *
* (4) The following additional commands are supported: *
* (a) FIND finds a character string within the verb, action or *
* description fields; *
* (b) LOCATE positions the display by verb; *
* (c) RFIND repeats the FIND action; *
* (d) SORT sorts by verb, except that all aliases are sorted at *
* the beginning of the commands table (aliases must precede *
* the commands they reference) -- the order of duplicate *
* verbs is preserved. *
* *
* Additional members required: *
* Msgs: CMDS00 (imbedded) *
* Panels: CMDP001, CMDP001A (imbedded) *
* Tables: CMDSCMDS *
* *
* Douglas H. Adams *
* Mail code 110-SH28 *
* Rockwell International Corporation *
* 2201 Seal Beach Boulevard *
* P. O. Box 2515 *
* Seal Beach, California 90740-1515 *
* *
* (213) 797-2618 *
* *
* September 19, 1990 *
* *
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*
* partly rewritten 2013, by Lars Höglund Konsult AB (www.lhkab.com) *
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*
* *
* when who What *
* 2020-01-10 Lasse Reorganize some code (www.lhkab.com) *
* *
***********************************************************************/
signal on syntax /* trap rexx syntax errors */
signal on novalue /* trap unititalized variables */
signal off error /* handle positive rc command failures in code */
signal off failure /* handle negative rc command failures in code */
signal off halt /* allow normal hi/he termination */
parse arg parms /* do not 'upper' */
call B_initialize
call C_mainline
call X_cleanup
exit cmdr001_rc
B_initialize :
/*-----------------------------------------------*/
/* Init */
/*-----------------------------------------------*/
parse source rxenv rxinv me rxdd rxdsn rxname rxhost rxaspc .
false = 0
true = 1
cmdr001_rc = 0
/* running system */
run_sysname = mvsvar('SYSNAME')
irc = ISPF("CONTROL ERRORS RETURN")
irc = ISPF("VGET (ZSCREEN)")
file = 'CMDS'zscreen
sort = 'SORT'zscreen
parse var parms parm_applid .
applid = strip(parm_applid)
/* Invoke recursively to use application commands table for RFIND */
if applid == '' then
do
irc = ISPF("VGET (ZAPPLID)")
irc = ISPF("SELECT CMD(%"me zapplid") NEWAPPL(CMDS) PASSLIB")
exit 0
end
return
C_mainline :
/*-----------------------------------------------*/
/* mainline */
/*-----------------------------------------------*/
call CA_initial_checking
msg = ''
cur = 'APPLID'
call SA_display_cmdp001
do while cmdp001_rc = 0
call D_process_cmdp001
call SA_display_cmdp001
end /*do while cmdp001_rc = 0*/
return
CA_initial_checking :
/*-----------------------------------------------*/
/* Stuff to check/do before processing */
/*-----------------------------------------------*/
/* fetch the datasetname of ISPTABL */
call listdsi 'ISPTABL FILE'
tabledsn = "'"sysdsname"'"
/* dynamically create LIBDEF members */
panel1 = 'CMDP001'
panel2 = 'CMDP001A'
msgmem = 'CMDS00'
call load_dynlib
irc = ISPF('LIBDEF ISPPLIB LIBRARY ID('dynlib') STACK')
irc = ISPF('LIBDEF ISPMLIB LIBRARY ID('dynlib') STACK')
return
D_process_cmdp001 :
/*-----------------------------------------------*/
/* Process panel */
/*-----------------------------------------------*/
applcmds = applid"CMDS"
appltemp = applid"TEMP"
bpxrc = bpxwdyn("ALLOC FI("file") DA("tabledsn") SHR REUSE")
if bpxrc = 0 then
do
call build
if result = 0 then
call commands
irc = ISPF("TBSTATS DUMMY LIBRARY(DUMMY)")
bpxrc = bpxwdyn("FREE FI("file")")
end
return
SA_display_cmdp001 :
/*-----------------------------------------------*/
/* Display panel */
/*-----------------------------------------------*/
if arg(1) = 'LOCK' then
irc = ISPF('CONTROL DISPLAY LOCK')
/*irc = ISPF('VGET ('variables') PROFILE')*/
/*irc = ISPF('ADDPOP ROW(02) COLUMN(02)') */
irc = ISPF('DISPLAY PANEL(CMDP001) MSG('msg') CURSOR('cur')')
cmdp001_rc = irc
/*irc = ISPF('REMPOP')*/
/*irc = ISPF('VPUT ('variables') PROFILE')*/
return
Alias: procedure expose appltemp
/*-----------------------------------------------*/
/* Alias resolution */
/*-----------------------------------------------*/
irc = ISPF("TBGET" appltemp "ROWID(ROWID)")
parse var zctact action zctverb .
do level = 1 by 1 until action ^== "ALIAS" ! rc <> 0
irc = ISPF("TBTOP" appltemp)
irc = ISPF("TBSCAN" appltemp "ARGLIST(ZCTVERB)")
parse var zctact action zctverb .
end level /*do level = 1 by 1 until action ^== "ALIAS" ! rc <> 0*/
irc = ISPF("TBSKIP" appltemp "ROW("rowid") NOREAD")
return level
Build:
/*-----------------------------------------------*/
/* Build temporary command table */
/*-----------------------------------------------*/
irc = ISPF("TBCREATE" appltemp ,
"NAMES(ZCTVERB ZCTTRUNC ZCTACT ZCTDESC)",
"LIBRARY("file")")
if rc <> 0 then
do
irc = ISPF("SETMSG MSG(CMDS003)")
return 8
end
rowcurr = 0
irc = ISPF("TBSTATS" applcmds "STATUS1(STATUS1) STATUS2(STATUS2)",
"ROWCURR(ROWCURR)")
exist? = status1 = 1
closed? = status2 = 1
if ^exist? ! rowcurr = 0 then
do
zctverb = copies('_',8)
zcttrunc = '_'
zctact = copies('_',60)
zctdesc = copies('_',57)
irc = ISPF("TBADD" appltemp)
end
else
do
if closed? then
irc = ISPF("TBOPEN" applcmds "NOWRITE")
irc = ISPF("TBTOP" applcmds)
do rowcurr
irc = ISPF("TBSKIP" applcmds)
/*
select
when abbrev(zctdesc,'**') !,
abbrev(zctdesc,'-U') !,
abbrev(zctdesc,'-A') !,
abbrev(zctdesc,'-T') then
parse var zctdesc twochar 3 xctdesc
otherwise
nop
end /*select*/
*/
irc = ISPF("TBADD" appltemp "MULT("rowcurr")")
end /*do rowcurr*/
if closed? then
irc = ISPF("TBEND" applcmds)
end
irc = ISPF("TBTOP" appltemp)
return 0
Commands:
/*-----------------------------------------------*/
/* Command Processing */
/*-----------------------------------------------*/
parse value "0" with csrpos cursor zverb verb operand
changed? = false
zdltitle = center('Command table' applid '('run_sysname')',65,'-')
irc = ISPF("TBDISPL" appltemp "PANEL(CMDP001A) POSITION(CRP)")
do while irc < 8
If crp = 0 then
crp = ztdtop
irc = ISPF("VGET (ZVERB ZSCROLLN)")
do ztdsels
Changed? = true
parse upper var sel linecmd +1 number
if number == '' then
number = 1
select
when linecmd == 'D' then call delete
when linecmd == 'I' then call insert
when linecmd == 'R' then call repeat
otherwise call update
end /*select*/
if ztdsels > 1 then
irc = ISPF("TBDISPL" appltemp)
end /*do ztdsels*/
irc = ISPF("TBTOP" appltemp)
irc = ISPF("TBSKIP" appltemp "NUMBER("ztdtop")")
select
when verb == 'CANCEL' then leave
when zverb == 'DOWN' then call down
when verb == 'FIND' then call find
when verb == 'LOCATE' then call locate
when verb == 'RFIND' then call rfind
when verb == 'SORT' then call sort
when zverb == 'UP' then call up
otherwise nop
end /*select*/
irc = ISPF("TBDISPL" appltemp "PANEL(CMDP001A) CURSOR("cursor")",
"CSRROW("crp") CSRPOS("csrpos") AUTOSEL(NO) POSITION(CRP)")
end /*do while irc < 8*/
call enda
return 0
Delete:
/*-----------------------------------------------*/
/* Delete command */
/*-----------------------------------------------*/
do number
irc = ISPF("TBDELETE" appltemp)
irc = ISPF("TBSKIP" appltemp "NOREAD")
end
if ztdsels = 1 then
crp = max(crp-1,0)
return 0
Down:
/*-----------------------------------------------*/
/* Down command */
/*-----------------------------------------------*/
irc = ISPF("TBSKIP" appltemp "NUMBER("zscrolln") NOREAD")
if rc <> 0 then
irc = ISPF("TBBOTTOM" appltemp "NOREAD")
return 0
Enda:
/*-----------------------------------------------*/
/* End command */
/*-----------------------------------------------*/
if verb == "CANCEL" ! ^changed? then
do
irc = ISPF("TBEND" appltemp)
return 0
end
/* delete all "blank" commands */
irc = ISPF("TBTOP" appltemp)
irc = ISPF("TBSKIP" appltemp)
do while irc = 0
if translate(zctverb," ","_") = "" then
irc = ISPF("TBDELETE" appltemp)
irc = ISPF("TBSKIP" appltemp)
end /*do while irc = 0*/
irc = ISPF("TBQUERY" appltemp "ROWNUM(ROWNUM)")
if rownum = 0 then
do
/* no commands left, remove original cmdtable */
irc = ISPF("TBERASE" applcmds "LIBRARY("file")")
irc = ISPF("TBEND" appltemp)
irc = ISPF("SETMSG MSG(CMDS005)")
end
else
do
irc = ISPF("TBQUERY" appltemp "ROWNUM(CURSIZE)")
cursize = format(cursize)
moddate = date("Ordered")
modtime = substr(time("Normal"),1,5)
user = sysvar("SYSUID")
irc = ISPF("TBCLOSE" appltemp "NAME("applcmds") LIBRARY("file")")
irc = ISPF("LMINIT DATAID(DATAID) DDNAME("file")")
irc = ISPF("LMMSTATS DATAID("dataid") MEMBER("applcmds")",
"MODDATE("moddate") MODTIME("modtime")",
"CURSIZE("cursize") INITSIZE("cursize") USER("user")")
irc = ISPF("LMFREE DATAID("dataid")")
irc = ISPF("SETMSG MSG(CMDS002)")
end
return 0
Find:
/*-----------------------------------------------*/
/* Find command */
/*-----------------------------------------------*/
irc = ISPF("TBGET" appltemp)
csrpos = 1
cursor = ''
call search
save_operand = operand
save_crp = crp
save_csrpos = csrpos
save_cursor = cursor
return 0
Insert:
/*-----------------------------------------------*/
/* Insert command */
/*-----------------------------------------------*/
call update
zctverb = copies('_',8)
zcttrunc = "_"
zctact = copies('_',60)
zctdesc = copies('_',57)
do number
irc = ISPF("TBADD" appltemp "MULT("number")")
end
if ztdsels = 1 then
crp = crp+1
return 0
Locate:
/*-----------------------------------------------*/
/* Locate command */
/*-----------------------------------------------*/
Zctverb = operand"*"
irc = ISPF("TBSCAN" appltemp "ARGLIST(ZCTVERB) NOREAD POSITION(CRP)")
If rc <> 0 then
do
irc = ISPF("TBTOP" appltemp)
cmd = "TBSCAN" appltemp "ARGLIST(ZCTVERB) NOREAD POSITION(CRP)"
irc = ISPF(cmd)
end
if rc = 0 then
irc = ISPF("TBSKIP" appltemp "NUMBER(-1)")
return 0
Repeat:
/*-----------------------------------------------*/
/* Repeat command */
/*-----------------------------------------------*/
call update
do number
irc = ISPF("TBADD" appltemp "MULT("number")")
end
if ztdsels = 1 then
crp = crp+1
return 0
Rfind:
/*-----------------------------------------------*/
/* Rfind command */
/*-----------------------------------------------*/
if symbol("save_operand") ^== "VAR" then
do
irc = ISPF("SETMSG MSG(CMDS004)")
return 4
end
operand = save_operand
if crp = save_crp then
do
cursor = save_cursor
csrpos = save_csrpos+1
end
else
do
cursor = ''
csrpos = 1
end
call search
save_crp = crp
save_cursor = cursor
save_csrpos = csrpos
return 0
Search:
/*-----------------------------------------------*/
/* Search for character string */
/*-----------------------------------------------*/
operand = strip(operand,"both","'")
operand = strip(operand,"both","""")
if operand = '' then
do
irc = ISPF("SETMSG MSG(CMDS000)")
return 0
End
select
when cursor == 'ZCTVERB' then
do
pos_verb = pos(operand,zctverb,csrpos)
pos_act = pos(operand,zctact)
pos_desc = pos(operand,zctdesc)
end
when cursor == 'ZCTACT' then
do
pos_verb = 0
pos_act = pos(operand,zctact,csrpos)
pos_desc = pos(operand,zctdesc)
end
when cursor == 'ZCTDESC' then
do
pos_verb = 0
pos_act = 0
pos_desc = pos(operand,zctdesc,csrpos)
end
otherwise
do
pos_verb = pos(operand,zctverb)
pos_act = pos(operand,zctact)
pos_desc = pos(operand,zctdesc)
end
end /*select*/
do while rc = 0 & pos_verb = 0 & pos_act = 0 & pos_desc = 0
irc = ISPF("TBSKIP" appltemp "POSITION(CRP)")
pos_verb = pos(operand,zctverb)
pos_act = pos(operand,zctact)
pos_desc = pos(operand,zctdesc)
end
select
when rc = 0 & pos_verb <> 0 then
do
cursor = 'ZCTVERB'
csrpos = pos_verb
end
when rc = 0 & pos_act <> 0 then
do
cursor = 'ZCTACT'
csrpos = pos_act
end
when rc = 0 & pos_desc <> 0 then
do
cursor = 'ZCTDESC'
csrpos = pos_desc
end
otherwise
do
cursor = ''
csrpos = 0
irc = ISPF("SETMSG MSG(CMDS001)")
irc = ISPF("TBTOP" appltemp)
irc = ISPF("TBSKIP" appltemp "NUMBER("ztdtop") POSITION(CRP)")
end
end /*select*/
return 0
Sort:
/*-----------------------------------------------*/
/* Sort command */
/*-----------------------------------------------*/
irc = ISPF("TBCREATE" sort,
"NAMES(ZCTVERB ZCTTRUNC ZCTACT ZCTDESC LEVEL ORDER)",
"REPLACE LIBRARY("file")")
irc = ISPF("TBSORT" sort "FIELDS(LEVEL,N,D ZCTVERB,C,A ORDER,C,A)")
irc = ISPF("TBQUERY" appltemp "ROWNUM(ROWNUM)")
irc = ISPF("TBTOP" appltemp)
do rownum
irc = ISPF("TBSKIP" appltemp "POSITION(ORDER)")
parse var zctact action .
if action == "ALIAS" then
level = alias()
else
level = 0
irc = ISPF("TBADD" sort "ORDER MULT("rownum")")
end /*do rownum*/
irc = ISPF("TBTOP" sort)
irc = ISPF("TBEND" appltemp)
irc = ISPF("TBCREATE" appltemp,
"NAMES(ZCTVERB ZCTTRUNC ZCTACT ZCTDESC)",
"LIBRARY("file")")
do rownum
irc = ISPF("TBSKIP" sort)
irc = ISPF("TBADD" appltemp "MULT("rownum")")
end /*do rownum*/
irc = ISPF("TBEND" sort)
irc = ISPF("TBTOP" appltemp)
Changed? = true
return 0
Up:
/*-----------------------------------------------*/
/* Up command */
/*-----------------------------------------------*/
irc = ISPF("TBSKIP" appltemp "NUMBER("!!-zscrolln")")
return 0
Update:
/*-----------------------------------------------*/
/* Update selected row */
/*-----------------------------------------------*/
zctverb = translate(zctverb," ","_")
zcttrunc = translate(zcttrunc," ","_")
zctact = translate(zctact," ","_")
zctdesc = translate(zctdesc," ","_")
irc = ISPF("TBPUT" appltemp)
return 0
X_cleanup :
/*-----------------------------------------------*/
/* cleanup */
/*-----------------------------------------------*/
irc = ISPF('LIBDEF ISPPLIB')
irc = ISPF('LIBDEF ISPMLIB')
bpxrc = bpxwdyn("FREE FI("dynlib")")
bpxrc = bpxwdyn("FREE FI("file")")
return
Y_log_process :
/*-----------------------------------------------*/
/* Displaying processing status */
/*-----------------------------------------------*/
parse arg text
say time() left(text,60) me
do forever
text = delstr(text,1,60)
if text = '' then
leave
say time() left(text,60) me
end /*do forever*/
return
Z_error :
/*-----------------------------------------------*/
/* Errormessage */
/*-----------------------------------------------*/
parse arg etext
if etext > ' ' then
do
call Y_log_process left('-',60,'-')
call Y_log_process etext
call Y_log_process left('-',60,'-')
end
call Y_log_process left('-',60,'-')
call Y_log_process terminate
call Y_log_process left('-',60,'-')
do queued()
pull dmy
end /*do queued()*/
call X_cleanup
exit 8
ZA_ispf_error :
/*-----------------------------------------------*/
/* Error in ISPF function */
/*-----------------------------------------------*/
parse arg command
parse var command function rest
call Z_error zerrsm zerrlm
return
ISPF :
/*-----------------------------------------------*/
/* Process ISPF-cmd */
/*-----------------------------------------------*/
arg ispfcmd
address 'ISPEXEC' ispfcmd
if rc > 8 then
call ZA_ispf_error ispfcmd
return rc
/*************************************************/
/* */
/* Rexx Error Handling Common Routines */
/* */
/*************************************************/
syntax: /* Signal ON SYNTAX Entry Point */
novalue: /* Signal ON NOVALUE Entry Point */
error: /* Signal ON ERROR Entry Point */
failure: /* Signal ON FAILURE Entry Point */
halt: /* Signal ON HALT Entry Point */
trace o /* turn trace off */
parse source . . me .
signal off novalue /* Ignore no-value variables within trap */
trap_errortext = 'Not Present'/* Error text available only with RC */
trap_condition = Condition('C') /* Which trap sprung? */
trap_description = Condition('D') /* What caused it? */
trap_rc = rc /* What was the return code? */
if datatype(trap_rc) = 'NUM' then /* Did we get a return code? */
trap_errortext = Errortext(trap_rc) /* What was the message? */
trap_linenumber = sigl /* Where did it happen? */
trap_line = sourceline(trap_linenumber) /* What is the code line? */
ER. = '' /* Initialize error output stem */
ER.1 = 'An error has occurred in Rexx module:' me
ER.2 = ' Error Type :' trap_condition
ER.3 = ' Error Line Number :' trap_linenumber
ER.4 = ' Instruction :' trap_line
ER.5 = ' Return Code :' trap_rc
ER.6 = ' Error Message text:' trap_errortext
ER.7 = ' Error Description :' trap_description
ER.8 = 'Please report the problem to your' contact
ER.0M= 8
do i = 1 to ER.0 /* Print error report to screen */
say ER.i
end /*do i = 1 to ER.0*/
call Z_error ''
load_dynlib :
/*-----------------------------------------------*/
/* loads panel, message and/or skels code into a */
/* library. */
/* */
/* Note that there is no reason to use */
/* different libraries for any of these objects, */
/* as long as they are named differently! */
/* */
/*-----------------------------------------------*/
dynlib = 'DYN'random(99999)
alloc = "ALLOC FI("dynlib") RTDSN(SYSDSNAME) " !!,
"LRECL(80) BLKSIZE(0) DIR(5) " !!,
"NEW DELETE REUSE " !!,
"SPACE(1,1)"
bpxrc = bpxwdyn(alloc)
if bpxrc = 0 then
ispdyn = sysdsname
else
ispdyn = 'NOT FOUND'
"NEWSTACK"
member = panel1
queue ")panel "
queue ")attr default(%+_) format(mix) "
queue " /* PANEL KEYLIST(KEYLIST-NAME,KEYLIST-APPLID) "
queue " /* % type(text) intens(high) defaults displayed for "
queue " /* + type(text) intens(low) information only "
queue " /* _ type(input) intens(high) caps(on) just(left) "
queue "Ó TYPE(AB) /* action bar unsel choice "
queue "ó TYPE(ABSL) GE(ON) /* action bar separator line "
queue "Ò TYPE(PT) /* panel title line "
queue "ò TYPE(PIN) /* panel instruction line "
queue "½ TYPE(FP) /* field prompt attribute "
queue "[ TYPE(PS) /* Point&Shoot "
queue "] TYPE(DT) /* description text "
queue "# TYPE(NT) SKIP(ON) /* normal text, skip on "
queue "£ TYPE(SAC) /* available selection choice"
queue "^ TYPE(SAC) CSRGRP(99) RADIO(ON) "
queue "§ TYPE(CEF) CAPS(ON) PADC(USER) /* choice entry field padded?"
queue "$ TYPE(NEF) CAPS(ON) PADC(USER) /* normal entry field padded?"
queue "á TYPE(NEF) PADC(USER) /* normal entry field padded?"
queue "à TYPE(NEF) PADC(' ') /* normal entry field padded?"
queue "{ TYPE(WASL) SKIP(ON) GE(ON) /* work area separator line "
queue "¤ TYPE(VOI) PADC(USER) /* variable output info "
queue "\ TYPE(CH) /* column heading "
queue "} AREA(SCRL) EXTEND(ON) "
queue "@ AREA(DYNAMIC) "
queue "â type(input) color(white) "
queue ")body cmd(zcmd) expand(;;) "
queue "Ò;-; Command Table Utility ;-; "
queue "#Command½===>$zcmd; ; "
queue "% "
queue "# Application ID. . . . . .$Z # "
queue "# Output table library. . .$TABLEDSN #"
queue " "
queue " "
queue "+The name of the command table to be processed is formed by",
"prefixing"
queue "+the application id to the string 'CMDS'. For example:"
queue "+ Application ID. . . . . . TST "
queue "+results in a command table name of 'TSTCMDS'. "
queue "+ "
queue "+This utility allows you to examine or modify,",
"any command table, even those"
queue "+for currently active application IDs",
"(including ISP and ISR). If a command"
queue "+table is modified, it will be stored in the above",
"'output table library'."
queue "+"
queue "+If you sort the table, aliases will be grouped",
"together at the beginning of"
queue "+the table, since they must precede the commands",
"they reference."
queue "+The order of duplicate verbs will be maintained. "
queue ")init "
queue " .zvars = '(applid)' "
queue " &zcmd = &z "
queue " if (&zhtop = isr00003) "
queue " .help = isr39000 "
queue " else "
queue " .help = isp39000 "
queue " .cursor = applid "
queue ")proc "
queue " if (.resp = enter) "
queue " if (&zverb ^= ' ') "
queue " .msg = ispz002 "
queue " else "
queue " if (&zcmd ^= ' ') "
queue " .msg = ispz001 "
queue " ver (&applid,nonblank,name,msg=ispu340) "
queue " &applid = trunc(&applid,4) "
queue " if (.trail ^= ' ') "
queue " .msg = ispu333 "
queue " ver (&tabledsn,nonblank,dsname) "
queue ")end "
call put_object
member = panel2
queue ")panel "
queue ")attr default(%+_) format(mix) "
queue " /* PANEL KEYLIST(KEYLIST-NAME,KEYLIST-APPLID) "
queue " /* % type(text) intens(high) defaults displayed for "
queue " /* + type(text) intens(low) information only "
queue " /* _ type(input) intens(high) caps(on) just(left) "
queue "Ó TYPE(AB) /* action bar unsel choice "
queue "ó TYPE(ABSL) GE(ON) /* action bar separator line "
queue "Ò TYPE(PT) /* panel title line "
queue "ò TYPE(PIN) /* panel instruction line "
queue "½ TYPE(FP) /* field prompt attribute "
queue "[ TYPE(PS) /* Point&Shoot "
queue "] TYPE(DT) /* description text "
queue "# TYPE(NT) SKIP(ON) /* normal text, skip on "
queue "£ TYPE(SAC) /* available selection choice"
queue "^ TYPE(SAC) CSRGRP(99) RADIO(ON) "
queue "§ TYPE(CEF) CAPS(ON) PADC(USER) /* choice entry field padded?"
queue "$ TYPE(NEF) CAPS(ON) PADC(USER) /* normal entry field padded?"
queue "á TYPE(NEF) PADC(USER) /* normal entry field padded?"
queue "à TYPE(NEF) PADC(' ') /* normal entry field padded?"
queue "{ TYPE(WASL) SKIP(ON) GE(ON) /* work area separator line "
queue "¤ TYPE(VOI) PADC(USER) /* variable output info "
queue "\ TYPE(CH) /* column heading "
queue "} AREA(SCRL) EXTEND(ON) "
queue "@ AREA(DYNAMIC) "
queue "â type(input) color(white) "
queue ")body cmd(zcmd) expand(;;) "
queue "¤zdltitle; ;+ "
queue "#Command½===>$zcmd; ;#Scroll½===>$amt + "
queue "+ "
queue "]Maincmd:%Cancel, End, Find, Locate, Rfind, Sort "
queue "]Linecmd:%Dn = Delete, In = Insert, Rn = Repeat "
queue "{ "
queue "ò First 2 char in Desc has the following meaning "
queue "ò **=Normal -U=Utvecklare -A=Admin -T=Teknik "
queue "ò and will be shown depending on choises in ",
"'M - Menu settings'"
queue "+ "
queue "\ Verb T Action "
queue "\ Description "
queue ")model "
queue "$z $z $z+$z ",
" #"
queue " âz ",
" #"
queue ")init "
queue " .zvars = '(sel zctverb zcttrunc zctact zctdesc)' "
queue " If (&ZHTOP = ISR00003) "
queue " .HELP = ISR39000 "
queue " Else "
queue " .HELP = ISP39000 "
queue " if (&amt = &z) "
queue " &amt = 'csr' "
queue " &sel = &z "
queue ")Proc "
queue " &verb = trunc(&zcmd,' ') "
queue " &operand = .trail "
queue " &verb = trans(trunc(&verb,1) "
queue " C,CANCEL E,END F,FIND L,LOCATE R,RFIND S,SORT) "
queue " ver (&verb,list,CANCEL,END,FIND,LOCATE,RFIND,SORT) "
queue " if (&ztdsels ^= '0000') "
queue " &test = trunc(&sel,1) "
queue " &trail = .trail "
queue " ver (&test,list,D,I,R) "
queue " ver (&trail,num) "
queue " if (&test ^= 'D') "
queue " &zctverb = trunc(&zctverb,'_') "
queue " ver (&zcttrunc,num) "
queue " if (&zcttrunc ^= '0') "
queue " ver (&zcttrunc,range,2,8) "
queue "/*vput (scin) profile "
queue ")end "
call put_object
member = msgmem
queue "CMDS000 'String missing' .ALARM = YES "
queue "'The FIND/RFIND command requires a target string. "
queue "CMDS001 '&OPERAND not found' .ALARM = YES "
queue "'&OPERAND not found in verb, action, or description' "
queue "CMDS002 '&APPLID.CMDS saved' "
queue "'Command table &APPLID.CMDS saved in &TABLEDSN",
"Logoff/Login to activate.'"
queue "CMDS003 '&APPLID not available' "
queue "'Command table for &APPLID is in use on another screen' "
queue "CMDS004 'Enter a FIND command' "
queue "'The RFIND key works only after a FIND command",
"character string is entered.'"
queue "CMDS005 '&APPLID.CMDS removed' "
queue "'Command table &APPLID.CMDS emptied in &TABLEDSN' "
call put_object
return
put_object :
/*-----------------------------------------------*/
/* write source to file */
/*-----------------------------------------------*/
tfil = 'TFIL'random(9999)
bpxrc = bpxwdyn("ALLOC FI("tfil") DA('"ispdyn"("member")') SHR REUSE")
"EXECIO" queued() "DISKW "tfil" (FINIS"
bpxrc = bpxwdyn("FREE FI("tfil")")
"DELSTACK"
return
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: INFO IBM-MAIN
