Using this Rexx (from Douglas H Adams), works perfect) Did rewrite some code
//Lasse -----Ursprungligt meddelande----- Från: IBM Mainframe Discussion List <IBM-MAIN@LISTSERV.UA.EDU> För Mark Zelden Skickat: den 23 januari 2024 17:43 Till: IBM-MAIN@LISTSERV.UA.EDU Ämne: Re: Custom ISPF command On Tue, 23 Jan 2024 07:54:50 -0600, Tom Marchant <m42tom-ibmm...@yahoo.com> 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:m...@mzelden.com Mark's MVS Utilities: http://www.mzelden.com/mvsutil.html ---------------------------------------------------------------------- For IBM-MAIN subscribe / signoff / archive access instructions, send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN ---------------------------------------------------------------------- For IBM-MAIN subscribe / signoff / archive access instructions, send email to lists...@listserv.ua.edu 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 lists...@listserv.ua.edu with the message: INFO IBM-MAIN