/*                                                         REXX
  List all ispf in-storage command tables
  Can list command table contents internally.
  Can call table-edit function.

  Updates
  2018-10-18  Major rewrite
*/

 parse value copies('0 ',30) with $edit $all lstn alst.0 .
 parse value '' with list
 parse source . . $me .

 address ispexec
 "control errors return"
 "vget zscrmaxw"
 width=zscrmaxw
 if width>160 then width=160

 /* determine if called as command handler */
 arg p1,pid,pcmd,ptable,ptext,passtext
 if p1 pcmd='XISPTBL CMD' then Exit PCmdX()
 if p1 pcmd='XISPTBL SEL' then Exit LCmdX()

 $pid  = right(left(space(translate(time('l'),' ','.:'),0),10),7)
 table = 'P'$pid
 tliblist=ListTlibs()

 /* make list of tables */
 cc=XISP("tbcreate" table "names(zsel tblname tbllib)")
 if cc<>0 then exit xmsg('Create work table' cc zerrlm)
 cc=XIsp("qtabopen list(alst.)")
 if cc<>0 then Exit Epilog('QTAB rc' cc zerrlm)
 zsel=''
 do n=1 to alst.0
   if right(strip(alst.n),4)<>'CMDS' then iterate
   list=list alst.n
 end

 /* make list table, display table */
 do n=1 to words(list)
   tblname=word(list,n)
   zerrlm=''
   tbllib=LocDsn(tliblist,tblname)
   "tbadd" table
 end
 cc=XISPTBL('table('table') panel(ispctl#1)',
           'proc('$me') id('$pid') sel(s e)',
           'hdr(ISPF Command Table List) passtext(prim)')
 Exit Epilog()

 /* cleanup       */
Epilog:
 parse arg m,c
 if m<>'' then say m
 cc=XIsp("tbend" table)
 exit word(c 0,1)

XMsg: if arg(1)<>'' then say arg(1);return word(arg(2) 0,1)
ISPMSG:
 parse arg zedlmsg
 address ispexec"setmsg msg(isrz000)"
 return 0
XIsp: zerrlm='';address ispexec arg(1); xisprc=rc; return rc

LocDsn: Procedure
 trace off
 arg list,mbr .
 do n=1 to words(list)
   dsn=word(list,n)
   if sysdsn("'"dsn"("mbr")'")='OK' then return dsn
 end
 return 'library not located'

ListTlibs: Procedure /* locate mbrname in library */
 trace off
 parse value '' with tlqpl tlqbl tlqll tlltype
 address ispexec
 "qbaselib ISPPROF id(tlqpl)"
 "qbaselib ISPTLIB id(tlqbl)"
 "qlibdef  ISPTLIB id(tlqll) type(tlLtype)"
 if tlltype='LIBRARY' then "qbaselib" tlqll "id(tlqll)"
 tlrtn=space(translate(tlqpl tlqll tlqbl," ","',"))
 do n=words(tlrtn) to 1 by -1
   w=word(tlrtn,n)
   if left(w,3)='SYS' & substr(w,9,2)='.T' then tlrtn=delword(tlrtn,n,1)
 end
 return tlrtn

/* Primary command subroutine */
Pcmdx:
 exit ispmsg('Invalid command' ptext)

/* Line command subroutine */
Lcmdx:
 "tbget" ptable
 err=''

 if left(ptable,1)='P' then select /* primary selection */
   when ptext='S' then,
     cc=XISPTBL('table('tblname') panel(ispctl#2) width('width')',
           'proc('$me') sel(s ex) passtext('tblname tbllib')',
           'hdr(ISPF Command Table' tblname 'in' tbllib')')
   when ptext='E' & pos('.',tbllib)>0 then cc=Ispcte(tbllib tblname)
   otherwise err='Y'
 end

 else select                       /* secondary selection */
   when ptext='S' then do
     parse var passtext tblname tbllib
     "display panel(ispctl#3)"
   end
   when ptext='EX' then ""zctact
   otherwise err='Y'
 end

 if err='Y' then zsel='?'zsel
 else zsel=''
 "tbput" ptable
 exit 0