/**/
v="$VER: RFSFileList  Rexx FileList Creator Williamson 54.05"
debug=0
system="Amiga ECS"              /* Your system name and address here */
listnote="Available files, updated "date()
default="  Sorry, there is no description for this area"||cr||cr
/*          ^^ spaces required! */
/*  You must create these files */
bbslist="BBS:TEXT/bbsn.list"    /* filearea config  */
htext="CFG:filelistheader.txt"  /* System header */
areatext='area.text'            /* area description */
/* output files - edit names to suit */
allfileslist="MAIL:FILELISTS/01670104.LST"    /* Output File List */
allfilesarc ="MAIL:FILELISTS/01670104.LHA"    /* Archived Normal List */
filesbbs ="files.bbs"           /* area desc and files */
/* WB2 List Lformat parameters  */
EXCLUDE='~(area.text|files.bbs|LZTEMP.#?|.info)'    /* LIST exclusion parameters    */
LFMT_LIST='"%-20N%7L %-9D %C"'  /* all files list   */
LFMT_BBS='"%-30N %C"'           /* areas.bbs        */
FLLEN=77                        /* list line length  */
MARGINALL=39                    /* margin for LFMT_LIST  - wraptofile prepends a space  */
/* used internally */
fileslist="OS4:TMP/ALST-"Pragma('ID')      /* temporary all file */
tmpbbs="T:MLST-"Pragma('ID')            /* temporary area list */
script="RFSfileList";ver="v"||right(v,5);fmvers=script ver
cr='0a'x;lf='0a'x
CSI='9b'x;AOFF=CSI||'0m';BOLD=CSI||'1m';ULINE=CSI||'4m';ITALICS=CSI||'3;40m'

if ~show("L", "rexxsupport.library") then
    if ~addlib("rexxsupport.library", 0, -30, 0) then do
            say "Couldn't access support.library !"
            exit 20
    end

options results
options failat 20
signal on halt
signal on ioerr
signal on break_c
signal on break_d

call close('STDOUT')
call open('STDOUT',"CON:0/10/640/100/"script ver"/CLOSE",'w')
call close('STDIN')
call open('STDIN','*','R')
call Pragma("P",-1)

/* Start Area Processing */
if ~open('dlst',bbslist, 'R') then do
    call writeln(STDOUT, "Couldn't open fileareas list" bbslist)
    signal cleanup
end
if show('p',"ROOFLOG") then address 'ROOFLOG' 'logline' left(time(),5) script': Updating FILE Listing'
call writeln(STDOUT, lf||ITALICS||" "fmvers||lf||" by Robert Williamson 1:167/104.0@fidonet"||AOFF)
/* Start Area Processing */
call writeln(STDOUT, 'Reading file area configuration')
area=1
do while ~eof('dlst')
    call writech(STDOUT,'.')
    blstln=readln('dlst')
    if blstln="" then iterate
    parse var blstln Number.area '"' Path.area '"' '"' Name.area '"'
    area=area+1
end /*eof*/
call close('dlst')

areas=area-1
call writeln(STDOUT,'Found 'areas' file areas')

/* open all file listing, put title, date and system header */
call writeln(STDOUT,ULINE||"Generating All Files Listing for "system||AOFF||cr)
if debug then call writeln(STDOUT,'Adding date/version header to 'fileslist)
open('tbl', fileslist, 'W')
  call writech('tbl'," "fmvers" by Robert Williamson 1:167/104.0@fidonet"||cr)
  call writech('tbl'," FileListing for" system  delstr(space(date(), 1, "-"), 8, 2) time()||cr ||cr)
close('tbl')

if ~exists('htext') then do
    if debug then call writeln(STDOUT,'Adding headerfile' htext 'to 'fileslist)
    com='Type >> "'fileslist'" "'htext'"'
    address COMMAND com
end

do area=1 to areas
    areadir=addslash(dequote(Path.area))
    if debug then call writeln(STDOUT,'Updating area' Name.area)
    call listandsort(areadir,areadir||filesbbs,LFMT_BBS)
    call addareatext(areadir,areadir||filesbbs,areatext,areadir||filesbbs,'prepend')

    call writeln(STDOUT,'Appending 'areadir Number.area Name.area' to 'fileslist)
    tbuf=CR||CR
    tbuf=tbuf'ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸'||CR
    tbuf=tbuf'³ °°°°°±±±±±²²²²²ÛÛÛÛÛ²²²²²³'center("AREA: "Number.Area,21)'³²²²²²ÛÛÛÛÛ²²²²²±±±±±°°°°° ³'||CR
    tbuf=tbuf'ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´'||CR
    tbuf=tbuf'³ °°°°°±±±±±²²²²²³'center(Name.Area,41)'³²²²²²±±±±±°°°°° ³'||CR
    tbuf=tbuf'ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;'||CR

    if debug then call writeln(STDOUT,'Adding Area Banner to 'fileslist)
    if ~open('tbl', fileslist, 'A') then do
        call writeln(STDOUT,'Cannot append Area Header to 'fileslist)
        signal cleanup
    end
    call writech('tbl',tbuf)
    close('tbl')
    drop tbuf
    if exists(areadir||areatext) then do
        if debug then call writeln(STDOUT,'Adding Area description to 'fileslist)
        com='Type >> "'fileslist'" "'areadir||areatext'"'
        address COMMAND com
    end

    call listandsort(areadir,tmpbbs,LFMT_LIST)

    if ~open('ifn',tmpbbs,'R') then do
        call writeln(STDOUT,'wraptofile:Cannot open 'tmpbbs)
        signal cleanup
    end
    if ~open('ofn',fileslist,'A') then do
        call writeln(STDOUT,'wraptofile:Cannot append Area List to 'fileslist)
        signal cleanup
    end
    do while ~eof('ifn')
        line=readln('ifn')
        if left(line,1) ~= " " then call writech('ofn',' 'wrap_line(line,FLLEN,MARGINALL)) 
        else call writech('ofn',line||cr)
    end /*eof */
    call close('ifn')
    call close('ofn')
end
address COMMAND 'Copy' fileslist allfileslist
address COMMAND 'FileNote "'allfileslist'" "'listnote'"'
call writeln(STDOUT,'Archiving 'allfileslist' as 'allfilesarc)
address COMMAND 'lha -2 u "'allfilesarc'" "'allfileslist'"'
address COMMAND 'FileNote "'allfilesarc'" "'listnote'"'
call writeln(STDOUT,' File Listing completed')
cleanup:
call delete(fileslist)
call delete(tmpbbs)
exit 0
   
listandsort:
/* list <tdir> with <lfmt> and sort to <tfile> */
tdir=arg(1);tfile=arg(2);lfmt=arg(3)
las='PIPE LIST 'tdir||exclude' FILES NOHEAD LFORMAT 'lfmt' | SORT In: 'tfile
address command las
return 0

/* prepend area.text to files.bbs                               */
/*    addareatext(areadir,files.bbs,area.text,output)           */
/*    addareatext(areadir,files.bbs,area.text,output,where)     */
/* where= append or prepend(DEFAULT)                            */
/*  example:                                                    */
/*    call addareatext(Path.area,availlist,areatext,availlist)  */
addareatext:
descfile=addslash(dequote(arg(1)))||arg(3)
inlist=arg(2);tolist=arg(4);where=arg(5)
if ~exists(inlist) then do
    call writeln(STDOUT,'addareatext: cannot find 'inlist)
    return 20
end

if ~exists(descfile) then do
    call writeln(STDOUT,'addareatext: cannot find 'descfile' using 'default)
    if where='append' then do
        call open('ds',descfile,'A')
        call writech('ds',default)
    end;else do
        call open('ds',descfile,'W')
        call writech('ds',default)
    end
    call close('ds')  
end
if where='append' then call join(inlist,descfile,tolist)
    else call join(descfile,inlist,tolist)
return 0

wrap_line:
text=arg(1)
right_edge=arg(2)  /* line length */
left_edge=arg(3)  /*   margin    */
new_text=''
do while length(text) > 0
    broken_word=0
    if length(text) < right_edge then do
        new_text=new_text || text || '0a'x
        text=''
    end;else do
        temp_text=strip(text,l)
        diff=length(text) - length(temp_text)
        first_break=lastpos(' ',temp_text,right_edge - diff)
        break_point=first_break + diff
        if left_edge=break_point then do
            break_point=right_edge - 1
            broken_word=1
        end
        new_text=new_text || strip(left(text,break_point),t)
        if broken_word then do
            new_text=new_text || '-'
        end
        new_text=new_text || '0a'x
        text=copies(' ',left_edge) || strip(right(text,length(text) - break_point),l)
    end
end
return new_text

/*
    join -- a 'front end' for join. Fixes a problem with join.
    uses a tempfile if target filename is same as one to cat
*/
join:
x=arg(1)' 'arg(2)' 'arg(3)
temp='arexxtempfile'
do i=1 to (words(x)-1)
    if word(x,i)=word(x,words(x)) then do
        oops=word(x,words(x))
        x=delword(x,words(x))||'TO '||temp
        address COMMAND 'Join' x
        address COMMAND 'Copy 'temp' 'oops
        call delete(temp)
        return 0
    end
end
x=arg(1)' 'arg(2)' TO 'arg(3)
address COMMAND 'Join' x
return 0

addslash:
curr=arg(1)
select
    when right(curr, 1)=":" then nop
        when right(curr, 1)="/" then nop
            otherwise curr=curr"/"
end
return curr

/* a useful procedure by Walt Sullivan  */
dequote:
parse arg thing
parse var thing '"' unq_thing '"'
if unq_thing ~= "" then return unq_thing
return thing

halt:
ioerr:
break_c:
break_d:
call writech(stdout,cr)
call cleanup()
exit 10