NoMainWin
dim funcs$(300)
dim subs$(300)
dim labels$(300)
FILEDIALOG "Select program to append index", "*.bas", SelectedFile$
if right$(lower$(SelectedFile$),3)<>"bas" then end
open SelectedFile$ for input as #1
while eof(#1)=0
    numline=numline+1
    line input#1,textline$
    textline$=trim$(textline$)
    select case
        case lower$(FNWORD$(textline$," ",1))="sub"
            numsubs=numsubs+1
            subs$(numsubs)=FNWORD$(textline$," ",2)
        case lower$(FNWORD$(textline$," ",1))="function"
            numfuncs=numfuncs+1
            textline$=REPLACE$(textline$,"("," ")
            funcs$(numfuncs)=FNWORD$(textline$," ",2)
        case left$(textline$,1)="["
            numlabels=numlabels+1
            labels$(numlabels)=FNWORD$(textline$,"]",1)+"]"
    end select
wend
close #1
sort subs$(), 1, numsubs
sort funcs$(), 1, numfuncs
sort labels$(), 1, numlabels
width=25
open SelectedFile$ for append as #1
print #1, ""
print #1, "'                            INDEX"
print #1, ""
print #1, "'";LADJUST$("FUNCTIONS",width);LADJUST$("SUBROUTINES",width);LADJUST$("LABELS",width)
count=max(numfuncs,numsubs) : count=max(count,numlabels)
for i=1 to count
    print#1, "'";LADJUST$(funcs$(i),width);LADJUST$(subs$(i),width);LADJUST$(labels$(i),width)
next i
close #1
NOTICE "Program Complete."
END

FUNCTION FNWORD$(string$,separator$,i)
'=breaks up string$ in parts, separator$
    If separator$=" " then string$=COMPRIMEER$(string$) 'remove extra blancs
    string$=trim$(string$)
    string$=string$+separator$
    a=1
    for j=1 to i
        b=instr(string$,separator$,a)
        aold=a
        a=b+1
    next j
    x$=mid$(string$,aold,b-aold)
    FNWORD$=trim$(x$)
END FUNCTION

FUNCTION COMPRIMEER$(string$)
'=remove extra spaces from string
    a=len(string$)
    b=0
    for i=1 to a
        b$=mid$(string$,i,1)
        if b$<>" " then
                c$=c$+b$
                b=0
            else
                if b=0 then
                        c$=c$+b$
                        b=1
                    else
                        'skip
                end if
        end if
    next i
    c$=trim$(c$)
    COMPRIMEER$=c$
END FUNCTION

FUNCTION LADJUST$(string$,length)
'=Force string$ into a fixed length, left adjusted
    string$=REPLACE$(string$,chr$(0)," ")
    if len(string$)<length then                      'fill with blanks
            string$ = string$+space$(length-len(string$))
        else
            if len(string$)>length then                      'trim
                string$=left$(string$,length)
            end if
    end if
    LADJUST$=string$
END FUNCTION

FUNCTION REPLACE$(string$,tobereplaced$,replacement$)
'=Replace tobereplaced$ with replacement$ in string$ at all locations
    lenstring      =len(string$)
    lentobereplaced=len(tobereplaced$)
    lenreplacement =len(replacement$)
    start=1
[start]
    pos=instr(string$,tobereplaced$,start)
    if pos<>0 then
            string$=left$(string$,pos-1)+replacement$+right$(string$,lenstring-pos-lentobereplaced+1)
            lenstring=len(string$)
            start=pos+lenreplacement
            if start+lentobereplaced-1>lenstring then REPLACE$=string$ : exit function
        else
            REPLACE$=string$
            EXIT function
    end if
    goto [start]
END FUNCTION