/* ARKList.rexx */

/*
     Format

       ARKList <file[.LZH]>

   Lists .LZH file contents in a more desirable fashion.

*/

signal on failure; signal off error; signal on syntax; signal on break_c
call addlib 'rexxextra.library',-20,-30,0

facility = 'ARKList'
retcode = 0
tname = 't:'||facility||pragma('ID')
args. = ''
template = 'FILE/A'
dtemplate = template

parse arg g_c
do while g_c='?'
  options prompt dtemplate': '  /* this template is      */
  parse pull g_c		/* displayed to the user */
  if g_c='?' then do
    g_s=sourceline(3)
    if pos('/*',g_s)=0 then break; if pos('*/',g_s)>0 then break
    say
    g_s=sourceline(4)
    do i=5 while pos('*/',g_s)=0; say g_s; g_s=sourceline(i); end
    say
    end
  end
interpret Cparse(g_c,template,'args')
if args.ERRCODE > 1 then do; say facility'-E-BADARGS,' args.ERRTEXT; exit 5; end

infile = 'asdf'

'LHARC >'tname' -x v 'args.FILE
if ~open(infile,tname,'R') then do
  say facility'-E-OPENIN, cannot open temp file:' tname
  exit 20
  end
do until eof(infile)
   inline = readln(infile)
   if find(inline,'Listing of') = 1 then do
     /* a new archive listing */
     parse var inline . "'" lzfile "'"
     inline = readln(infile)
     inline = readln(infile)
     if right(upper(lzfile),4) = '.LZH' then
       lzfile = substr(lzfile,1,length(lzfile)-4)
     else nop
     end
   else if left(inline,8) = '--------' then do
     /* end of listing */
     inline = readln(infile)
     end
   else if inline ~= '' then do
     /* should be a file in the archive */
     parse var inline osize =9 psize =16 . =22 fdate =30 . =51 fname
     if fname ~= '' then do
       if length(fname) > 33 then fname = '<=='||right(fname,30)
       else fname = left(fname,33)
       outline = fname||' '||right(osize,8)||'  '||left(fdate,10)||' '||lzfile
       call writeln stdout, outline
       end
     else nop
     end
   end
call close(infile)

GetOut:
'Delete' tname 'quiet'
exit retcode

break_c:
break_d:
break_e:
break_f:
  say facility'-E-BREAK, Control-C interrupt'; retcode = 20; signal GetOut
failure:
  say facility'-E-FAIL, Line:' sigl', Error:' rc; retcode = rc; signal GetOut
syntax:
  say facility'-E-SYNTAX, Line:' sigl', Error:' rc; retcode = rc; signal GetOut
error:
  say facility'-E-ERROR, Line:' sigl', Error:' rc; retcode = rc; signal GetOut