/* 25 Jan 2003. Daniel Hellerstein (danielh@crosslink.net)
                 DirTree ver 1.16d
  Sort (and display) all files in a directory tree by filename.
  Also supports directory summary capabilities.

   You may freely use this utility,
   You may also find the 3 procedures used here to be useful.
   These are:
        resolve_filename: return a fully qualified filename, given                    
                          a relative filename and directory information
        StemSort: sort a stem variable (using a bubble sort)
        dir_exists: detects whether a directory exists

Standard disclaimer:
  This program, and its included procedures, may be
  freely used, but you use them at your own risk.

For usage instructions, enter DIRTREE ? at an os/2 command prompt.

*/

/***** -- User changeable parameters    ****/


/* assume that "periodless" names refer to directories
   1 = Yes
   0 = No
  If 1, then f:\dir1  means "search for *.* in f:\dir1"
  If 0, then F:\dir1 means "search for dir1 in F:\ "
  In any case, F:\DIR1\ means "search for *.* in f:\dir1, and
  F:\DIR1. means "search for DIR.1 in F:\"  */
assume_dir=1

/* color used in "duplicate file finder mode" html output (this
   color highlights the filename, subsequent rows contain path of duplicate files) */
bgcolor='#55aaaa'

/* used as a filler when the file name has not changed */
filler=' "" '

/* suppresses bold highlighting (set NOANSI=1 if you are getting odd 
  characters displayed */
noansi=0

/* default output file (if -FILE is given with no argument ) */
outfile='DIRTREE.LST'

/* By default, should a listing display date and size info.
    ShowInfo=1  : yes
    ShowInfo=0  : no */
showinfo=1

/* character used to indicate depth of subdirectory
   (used with -DIRSUMMARY option */
subflag='$'

/* program string for displaying html output */
vu_prog='NETSCAPE -l en '

/**** End of user changeable parameters  ****/


parse arg  aa
parse var aa dirfile '-' astuff
if astuff<>'' then astuff='-'||astuff


/****/
/* set character display attributes */
if noansi=1  then do
   normal='';bold='';aesc=''
end 
else do
  aesc='1B'x
  normal=aesc||'[0;m'
  bold=aesc||'[1;m'
end /* do */


if aa='?' | strip(aa)='-?' | strip(aa)='/?'  then do
say bold'DirTree ver 1.16d:'normal' List files and/or subdirectories in a directory tree. '
say
say bold"Usage:"normal" x:>DIRTREE directory\file_pattern [-options]  "
say "  Where:    "bold"directory"normal" = directory tree to list (default is current directory) "
say "         "bold"file_pattern"normal" = a file pattern (* is the default)"
say "       or, you can use dir1\file1 dir2\file2 ... to list multiple 'trees' "
say "  "bold"Options include:"normal
say '      -SUMMARY =  Just display  a summary (#files/#bytes).       '
say "      -Onxds   =  Sort by n(ame), x(tension),d(ate), and/or s(ize). "
say "                  The  default is to sort by name only."
say "      -D       =  Decending sort (default is ascending). "
say " "
say "   To list all options, enter DIRTREE ?? "
say 
say bold"Examples:"normal" x:>dirtree \archive1\*.zip -Ond -D "
say "          x:>dirtree  -summary "
say "          x:>dirtree  f:\archive1\*.zip e:\projects\* -SHORT -FILEONLY A.LST "
say '          x:>dirtree  "pets\My Cat*.*" -SHORT -FILEONLY A.LST '
say "          x:>dirtree  * -x  \OLD \ARCHIVE "
say bold"Or,"normal" enter DIRTREE at a command prompt (with no arguments) to be prompted. "
exit
end

if dirfile='??' then do
say '  '||bold||"Options (DirTree ver 1.16d):"||normal
say '   -CT          = Count of files with this "filename"'
say "   -D           = Decending sort (default is ascending) "
say '   -DIRSUMMARY = Display summary of each directory '
say '                 (in dir: #files/#bytes; in subtree: subdirs/files/bytes) '
say '   -DUP        = Find duplicate files (-Ondxs will be suppressed)'
say '   -DUP NOCRC  = Find duplicate files, but do NOT check file CRC '
say '   -FILE filename.ext = Write results to filename.ext '
say '   -FILEONLY file.ext = same as -FILE, and do not display results on screen'
say '   -HTML file.ext     = Write results using HTML formatting         '
say '   -HTML_VU file.ext  = Same as -HTML, and run Netscape to view file.ext    '
say "   -Onxds       = Sort by n(ame), x(tension), d(ate), and/or s(ize) "
say "   -PAUSE nn    = Pause every nn lines. If nn not listed, pause every 20 lines"
say '   -SHORT,-LONG,-VERYLONG = Style of display '
say '   -SUMMARY     = Display  summary (#files/#bytes); '
say '                  (do NOT display matching files)'
say '   -X  xstr     = Exclude files that contain xstr in their fully qualifed name'
say '                  Xstr can contain several space delimited substrings'
say '  *:filename    = Search ALL drives for filename '
say '  LOCAL:filename    = Search ALL LOCAL drives for filename '
say '  REMOTE:filename   = Search ALL REMOTE (LAN) drives for filename '



exit
end /* do */
say

/*---   Load REXX libraries ----- */
/* Load up advanced REXX functions */
foo=rxfuncquery('sysloadfuncs')
if foo=1 then do
  call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  call SysLoadFuncs
end

foo=rxfuncquery('rexxlibregister')
if foo=1 then do
 call rxfuncadd 'rexxlibregister','rexxlib', 'rexxlibregister'
 call rexxlibregister
end
gotrexxlib=rxfuncquery('rexxlibregister')



sortorder=''
dopause=0
pause_after=20          /* pause every 20 lines */
isdescend=0
docount=0
dolong=0
lmxdate=14
dosummary=0
dodirsummary=0
toscreen=1
tofile=0
nbdd=0
excstring=''
dohtml=0
htmlview=0
duplook=0

if dirfile='' & (abbrev(translate(astuff),'-SUM')+abbrev(translate(astuff),'-DIRS'))>0 then
  dirfile='*.*'

if dirfile<>'' then do 
  if dirfile='*' then dirfile='*.*'

/*if assume_dir=1 & pos('.',dirfile)=0 & right(strip(dirfile),1)<>"\" then dirfile=strip(dirfile)||'\' */

  if pos('"',dirfile)=0 then do
      dirfile=space(dirfile)
      dirfile=translate(dirfile,'+',' ')
      bdd=dirfile
  end 
  else do               /* parse out " xxx " stuff */
     t1=dirfile
     bdd=''
     do forever
       if t1='' then leave
       parse var t1 a1 '"' a2 '"' t1
       if  a1<>'' then do
          bdd=bdd'+'strip(a1)
       end
       if a2<>'' then do
          bdd=bdd'+'strip(a2)
       end 
     end
  end 
  bdd=strip(bdd,'l','+')

/* pull out each subdir, and fix */
  do until bdd=''

      parse var bdd dirfile '+' bdd
      dirf=translate(dirfile)

/* check for *: syntax, IF found, expand */
     if abbrev(strip(dirf),'*:')=1 | ,
       abbrev(strip(dirf),'LOCAL:')=1 | ,
        abbrev(strip(dirf),'REMOTE:')=1 then do
        parse var dirfile XX ':' dirfile1
        XX=translate(STRIP(XX))
        IF XX='*' then XX='USED'
        oy=sysdrivemap(,XX)
        do until oy=''
           parse var oy aa oy
           bdd=strip(aa)||dirfile1||'+'||bdd
        end /* do */
        iterate
     end 

     nbdd=nbdd+1    
     adrive=''
     if pos(':',dirfile)>0 then do
           parse var dirfile adrive ':' dirfile
           adrive=adrive':'
     end 
     dirfile=translate(dirfile,'\','/')
     apath=''
     aname=dirfile

     if assume_dir=1 & pos('.',dirfile)=0 & right(strip(dirfile),1)<>"\" ,
        & pos('*',dirfile)=0  then 
       dirfile=strip(dirfile)||'\' 

     ii=lastpos('\',dirfile)
     if ii>0 then do
         apath=left(dirfile,ii)
         aname=substr(dirfile,ii+1)
     end 
     if aname='' then aname='*.*'
     filename.nbdd=aname
     adir.nbdd=strip(adrive||apath)

  end

  astuff=translate(astuff)||' '
  if pos('-DIR',astuff)>0 then dodirsummary=1
  if pos('-D ',astuff)>0 then isdescend=1
  if pos('-CT',astuff)>0 then docount=1
  if pos('-LONG',astuff)>0 then dolong=1
  if pos('-VERYLONG',astuff)>0 then dolong=2
  if pos('-INFO',astuff)>0 then do
      dolong=0 ; showinfo=1  /* normal, with date & size */
  end
  if pos('SHORT',astuff)>0  then dolong=-1
  if pos('-SUM',astuff)>0 then dosummary=1
  if pos('-X',astuff)>0 then do
    parse upper var astuff . '-X ' excstring '-' astuff ; excstring=strip(excstring)
  end

  if pos('-DUP',astuff)>0 then do
       parse upper var astuff . '-DUP ' a23 '-'  . ; parse var a23 a2 .
       duplook=2
       if abbrev(a2,'NOCRC')=1 then duplook=1
  end

  if pos('-HTML',astuff)>0 then do
       dohtml=1
       tofile=1
       toscreen=0
       parse upper var astuff . '-HTML' a23 '-'  . ; parse var a23 a2 a3 .
       if right(strip(a2),2)='VU' |abbrev(strip(a2),'VIEW')=1 then do
          htmlview=1
          a2=a3
       end 
       a2=strip(a2)
       if a2='' then a2=outfile
       if stream(a2,'c','query exists')=' ' then do
           say "Writing HTML results to "a2
       end
       else do
          say "OverWriting HTML results to: "a2
          foo=sysfiledelete(a2)
       end
       foo=stream(a2,'c','open write')
       if foo<>'READY:' then do
                say "Sorry, can not write to: "a2
                exit
       end 
       outfile=a2
       call ini_html    /* initialize html stuff in outfile */
  end 

  if pos('-PAUSE',astuff)>0 then do
      dopause=1
      parse upper var astuff . '-PAUSE' a23 '-'  . ; parse var a23 a2 .
      if datatype(a2)='NUM'  then 
        pause_after=max(1,a2)
      else
        pause_after=20
  end 

  if pos('-FILE',astuff)>0 then do
       tofile=1
       parse upper var astuff . '-FILE' a23 '-'  . ; parse var a23 a2 a3 .
       if strip(a2)='ONLY' then do
          toscreen=0
          a2=a3
       end 
       a2=strip(a2)
       if a2='' then a2=outfile
       if stream(a2,'c','query exists')=' ' then do
           say "Writing results to "a2
       end
       else do
          say "OverWriting results to: "a2
          foo=sysfiledelete(a2)
       end
       foo=stream(a2,'c','open write')
       if foo<>'READY:' then do
                say "Sorry, can not write to: "a2
                exit
       end 
       outfile=a2
  end 

  if dolong=-1  then do
    filler='    '
    lmxdate=8
  end
  parse var astuff . '-O' sortorder .
 
  tt1='' ; tt2=''
  if htmlview=1 then do
      tt1='<tt>' ; tt2='</tt>'
  end 

  do yy=1 to nbdd
    adir.yy=resolve_filename('',adir.yy,,1)
    if adir.yy='' then do
       say "No such directory: "adir.yy
       exit
    end 
  end
  if nbdd=1 then do
       call dosay "Searching in: "||tt1||adir.1||tt2
       call dosay "         for: "||tt1||filename.1||tt2
   end
   else do
     do yy=1 to nbdd
       call dosay "Searching in: "||tt1||adir.yy||tt2
       call dosay "         for: "||tt1||filename.yy||tt2
     end
  end 
   if excstring<>'' then do
      do www=1 to words(excstring)
         if www=1 then
            call dosay "Excluding files that match: *"||tt1||strip(word(excstring,www))||"*"||tt2
        else
            call dosay "                          : *"||tt1||strip(word(excstring,www))||"*"||tt2
      end
    end
end 

else do                        /* from keyboard */
  say bold'DirTree ver 1.16d:'normal' sort files (and subdirectories) in & under a directory.'
  call charout," Starting directory: "
  parse pull adir
  adir=resolve_filename('',adir,,1)
  if adir='' then do
     say "No such directory: "adir
     exit
  end 
  call charout, " Files to find (default=*): "
  parse pull filename
  if filename='' then filename='*'

  adir.1=adir
  filename.1=filename
  nbdd=1

  dosummary=yesno(' Summary stats only (Y=yes)?',,'N')
  if dosummary<>1 then do
     sortorder=1+yesno(' Sort order: ','Date Size Name Xtension ','N') 
    sortorder=substr('DSNE',sortorder,1)
    isdescend=yesno(' Display order ','Ascending Descending','A')
    dolong=yesno('Info to display ','Short Info VeryLong ','I')
    if dolong=1 then do
       dolong=0; showinfo=1
    end 
    dopause=yesno('Pause every 20 lines ',,'Y')
  end
  else do
       dosummary=1
       isdecend=0
  end 
end

/* ready to rumble */

do jj=1 to nbdd
  ddd=adir.jj
  if length(ddd)=3 then ddd=strip(ddd,,'\')
  else
  if dir_exists(ddd)=0 then do
      say "% No such directory: "adir.jj
       exit
  end 
end

if dosummary=1 | dodirsummary=1  then do               /* just # files, # bytes, and # dirs? */
   dohtml=0                             /* html only for file listing */
   foo=dir_summary(nbdd)
   signal alldone
end 

if dohtml=1 then dopause=0

if sortorder='' then sortorder='N'
fils.=0
iat=0
do mm=1 to nbdd
  oo=sysfiletree_FILES(adir.mm||filename.mm,'tfils.','FTS')
  do iuu=1 to tfils.0
     iat=iat+1
     fils.iat=tfils.iuu
  end /* do */
  fils.0=iat
end

/* grab the files */
lmxname=0; lmxsize=0 ;mm=0
lmxpath=0
crcs.=''
if duplook=2 then  say "   ... computing CRCs for matching files "
do mm0=1 to fils.0
   mm=mm+1
   parse var fils.mm0  date.mm size.mm . aa .
   if excstring<>'' then do
     do www=1 to words(excstring)
         excstring1=strip(word(excstring,www))
         if pos(excstring1,translate(aa))>0 then do
             mm=mm-1
            iterate mm0
         end
      end
   end
   nam.mm=translate(filespec("n",aa)); path.mm=filespec('p',aa)
   if duplook>1 then crcs.mm=filecrc(aa)
   if nbdd>1 | dohtml=1 then path.mm=translate(filespec("D",aa))||path.mm
   lmxsize=max(length(size.mm),lmxsize)
   lmxname=max(length(nam.mm),lmxname)
   lmxpath=max(length(path.mm),lmxpath)

   if left(date.mm,2)<80 then
      date.mm='20'||date.mm
   else
     date.mm='19'||date.mm
end 
call dosay "# of matching files= " mm

if duplook>0 then do
   sortorder='NSCD'
end 

srtx.=''
kk=0
do ll2=1 to mm
  do ll=1 to length(sortorder)
     atype=substr(sortorder,ll,1)
     select
        when atype='N' then do
            srtx.ll2=srtx.ll2||left(nam.ll2,lmxname+1,' ')
        end
        when atype='X' then do
            parse upper var nam.ll2 . '.' anextx .
            srtx.ll2=srtx.ll2||left(anextx,lmxname+1,' ')
        end
        when atype='S' then do
            srtx.ll2=srtx.ll2||right(size.ll2,lmxsize+1,'0')
        end
        when atype='D' then do
            srtx.ll2=srtx.ll2||left(date.ll2,15,' ')
        end
        when atype='C' then do
            srtx.ll2=srtx.ll2||left(crcs.ll2,18,' ')
        end
        otherwise do
            nop
        end
     end  /* select */
  end /* do */
  srtx.ll2=srtx.ll2||right(ll2,7,' ')
end /* do */
srtx.0=mm
if srtx.0>0 then do             /* any matches? */
  if duplook=1 then call dosay 'Duplicate file find (without using CRC)'
  if duplook=2 then call dosay 'Duplicate file find'
  if duplook=0 then call dosay "Sorting by " sortorder " ... "
  if dohtml=1 then do 
     call lineout outfile,'</pre>'
     if duplook=0 then do               /* don't bother with jump line if dup file find mode */
        do igoo=1 to 26
           alet=d2c(igoo+64)
           call lineout outfile,'<a href="#'||alet||'">'Alet'</a>&nbsp;'
        end
     end 
     call lineout outfile,'<br><ul>' 
  end /* do */
  

  /* use rexxlib sort, if available */
  if gotrexxlib=0 then do
     foo=arraysort('srtx',,,,,,'I')
  end 
  else do
    call stemsort 'srtx.',1 
  end
end

oldname='..'
oldsize='..'
olddate='..'
oldpath='..'
oldext='..'


j1=1 ; j2=srtx.0 ; j3=1
if isdescend=1  then do
   j1=srtx.0; j2=1; j3=-1
end /* do */
   
oldlet=''

/* Now write the output, using filename, date or time (optional), and path -- or CRC */
ict=0
iwrot=0
totbytes=0
totdirs=0
paths.=0
jdid=0
olddup='' ; oldddt='' ; nuniques=0

if dohtml=1 & duplook>0 then call dosay '<table>'

do mm=j1 to j2 by j3
  jdid=jdid+1
  ba=inkey('n')
  if c2d(ba)=27 then do
     say 
     say   bold'  Cancel ('jdid' of 'srtx.0')'normal
     EXIT
  end 

   totbytes=totbytes+size.mm
   if dopause=1 then do
       iwrot=iwrot+1
       if iwrot=pause_after+1 then do             /* pause it */
           call charout,bold||'#'mm' ... G(o), ESC to exit, any other key to continue '||normal
           akey=sysgetkey()
           if c2d(akey)=27 then exit
           if translate(akey)='G' then dopause=0
           call charout,'0d'x||copies(' ',60)||'0d'x
           iwrot=1
       end 
   end          /* pause? */
   ith=strip(word(srtx.mm,words(srtx.mm)))
   aa='!'||path.ith
   if paths.aa=0 then do
       totdirs=totdirs+1
       paths.aa=1
   end 

/* duplicate file mode */
   if duplook>0 then do         

        newd=strip(subword(srtx.mm,1,2))
        if newd=olddup then do                  /* duplicate found */  
            pth=path.ith
            ddt=substr(date.ith,3)
            ddt=overlay(':',ddt,length(ddt)-2,1)
            ddt=overlay(' ',ddt,length(ddt)-5,1)

            a2='<a href="file:///'||strip(path.ith||nam.ith)||'" target="viewer">'||strip(path.ith)||'</a>'

            if ddt=oldddt then do
               if dohtml=0 then
                   call dosay '   '||left(path.ith,lmxpath+4,' ')
               else
                   call dosay '<tr><td colspan=2>&nbsp;&nbsp;&nbsp;'||a2||'</td>'
            end 
            else do
                oldddt=ddt
               if dohtml=0 then
                    call dosay '   '||left(path.ith,lmxpath+4,' ')||' ['||ddt||']'
                else
                    call dosay '<tr><td>&nbsp;&nbsp;&nbsp;'||a2||'</td><td>&nbsp;&nbsp;&nbsp;<em>'||ddt||'</em></td>'
            end
        end 
        else do                         /* not a duplicate, start new list */
            ssz=strip(size.ith)
            nuniques=nuniques+1
            select
                   when ssz>10000000 then do
                      ssz=left(ssz,length(ssz)-5)/10
                      ssz=ssz||'m'
                       say " gooooob  " ssz
                   end 
                   when ssz>9999 then do
                      ssz=left(ssz,length(ssz)-2)/10
                      ssz=ssz||'k'
                   end

                   otherwise nop
            end
            ddt=substr(date.ith,3)
            ddt=overlay(':',ddt,length(ddt)-2,1)
            ddt=overlay(' ',ddt,length(ddt)-5,1)
            oldddt=ddt
            if dohtml=0 then
                 call dosay left(nam.ith,lmxname,' ')||' ('||ssz||' '||crcs.ith||')'
            else
                 call dosay  '<tr bgcolor="'||bgcolor||'"><td>'||nam.ith||'</td><td><tt>'||ssz||' '||crcs.ith||'</tt></td>'

            pth=path.ith
            a2='<a href="file:///'||strip(pth||nam.ith)||'" target="viewer">'||strip(pth)||'</a>'

            if dohtml=0 then
                call dosay '   '||left(path.ith,lmxpath+4,' ')||' ['||ddt||']'
            else
                call dosay '<tr><td>&nbsp;&nbsp;&nbsp;'||a2||'</td><td>&nbsp;&nbsp;&nbsp;<em>'||ddt||'</em></td>'
 
            olddup=newd
        end 
        iterate
   end 

/* if here, not -DUP */
   a2=left(nam.ith,lmxname)

   if a2=oldname then do                        /*always list filename */
       mold=1
       a2=left(filler,lmxname,' ')
       ict=ict+1
   end
   else do                      /* new name */
       mold=0
       oldname=a2
       if docount=1 then call dosay '('ict') 'tmpline
       ict=1
    end
    if dohtml=1 & mold=0 then do
        a2='<li><a href="file:///'||strip(path.ith||nam.ith)||'" target="viewer" '
        a2=a2||'>'||strip(nam.ith)||'</a>&nbsp;&nbsp;&nbsp;'
        alet=left(strip(nam.ith),1)
           
      if alet<>oldlet then do
           if verify(alet,'ABCDEFGHIJKLMNOPQRTSUVWXYZ')=0 then do
             a2='<a name="'||translate(alet)||'">'||a2||'</a>'
             oldlet=alet
          end
      end

    end 
    if dohtml=1 & mold=1 then do
        a2='<br>&nbsp;&nbsp;&nbsp;&nbsp;<a href="file:///'||strip(path.ith||nam.ith)||'" target="viewer">'||strip(path.ith)||'</a>'
    end 
   

   if pos('S',sortorder)>0 then do                      /* size is optional */
      if oldsize<>size.ith then do
        a3=right(strip(size.ith,'l','0'),lmxsize)
        oldsize=size.ith
      end
      else do
        a3=right(filler,lmxsize)
      end
      if dolong=0 | showinfo=1 then
          nop
      else
        a2=a2||' '||a3
   end
   if pos('D',sortorder)>0 then do                      /*date is optional */
      if olddate<>date.ith then do
        a3=substr(date.ith,3)
        parse var a3 yr '/' mo '/' day '/' hr '/' min
        a3=yr'-'mo'-'day
        if dolong<>-1 then a3=a3||' 'hr':'min
        olddate=date.ith
      end
      else do
        a3=right(filler,lmxdate)
      end
      if (dolong=0 | showinfo=1) then
          nop
      else
         a2=a2||' '||a3
   end
   if dolong=-1 & ict>1 & length(path.ith)>=length(oldpath) then do         /* shorten path? */
      a1=translate(translate(path.ith,' ',':\/'))
      a1old=translate(translate(oldpath,' ',':/\'))
      jj=0 ; buffer=''
      do forever
         jj=jj+1
         if jj>words(a1) | jj>words(a1old) then do
            lastmatch=jj-1
            leave
         end
         if word(a1,jj)<>word(a1old,jj) then do
             lastmatch=jj-1
             leave
         end 
         oog=copies(' ',length(word(a1,jj))+1)
         buffer=buffer||oog
      end
      if lastmatch=0 then do
        showpath=path.ith
      end
      else do
         showpath=buffer
         do jj=lastmatch+1 to words(a1)
            showpath=showpath'\'||strip(word(a1,jj))
         end
      end
      oldpath=path.ith
   end
   else do
       oldpath=path.ith
       showpath=path.ith
   end /* do */

   if showpath<>'\' then  showpath=strip(showpath,'t','\')
   select
     when dolong=2 then do  
         a2=a2||' '||date.ith||'   '||left(size.ith,10)
         if dohtml=0 then a2=a2||' 'path.ith||nam.ith
     end 
     when dolong=1 & dohtml=0 then a2=a2||' '||path.ith||nam.ith

     when dolong=0 & showinfo=1 then do
           ssz=strip(size.ith)
           if pos('S',sortorder)=0 then do                      /* size is optional */
              select
                   when ssz>9999 then ssz=left(ssz,length(ssz)-3)||'k'
                   when ssz>10000000 then ssz=left(ssz,length(ssz)-6)||'m'
                   otherwise nop
              end
            end

            ddt=substr(date.ith,3)
            ddt=overlay(':',ddt,length(ddt)-2,1)
            ddt=overlay(' ',ddt,length(ddt)-5,1)
            ssz7=left(ssz,7)
           if dohtml=1 then ssz7='<tt>'ssz7'</tt>'

            bbb=a2||' '||ddt||'   '||ssz7||' '
           if dohtml<>1 then bbb=bbb||strip(showpath)

           if length(bbb)>79 & dohtml=0 then do
               a2=a2||' '||ddt||'   '||ssz7
               ioo=76-length(a2)
               a2=a2||'...'||right(strip(showpath),max(20,ioo))
           end 
           else do
             if dohtml=0 then
                      a2=a2||' '||ddt||'   '||ssz7||' '||strip(showpath)
             else
                      a2=a2||' '||ddt||'   '||ssz7
           end 

     end
     when (dolong=0 | dolong=1) & dohtml=1 then nop
     otherwise a2=a2||' 'showpath
   end
   
/* either write line, or retain (and write with count later) */
   if docount=1 then do
      if ict=1 then tmpline=a2
   end
   else do
      call dosay a2 
   end


end 

if dohtml=1 & duplook>0 then call dosay '</table>'

if docount=1 then call dosay '('ict') 'tmpline
if docount=0 then do
  if dohtml=1 then do
    if duplook>0 then call dosay '<ul>'
    call dosay '<p><li># of directories= 'totdirs ', # of files='srtx.0 ', bytes='||addcomma(totbytes)
    if duplook=2 then   call dosay '<li># of unique files='nuniques
    if duplook=1 then   call dosay '<li># of unique files (CRC not checked)='nuniques
    if duplook>0 then call dosay '</ul>'
  end
  else do
    call dosay '# of directories= 'totdirs ', # of files='srtx.0 ', bytes='||addcomma(totbytes)
  end

end 

if dohtml=1 then do
   call lineout outfile,'</ul></body></html>'
end 


alldone:
if tofile=1 then call lineout outfile
if htmlview=1 then do
   goo=resolve_filename(outfile,,,)
    foo=vu_prog' file:///'goo
      '@start /f 'foo
      say " >>> view "goo " with " vu_prog
      say"       (it might take a few seconds)"
end

exit


/*     ************************************************               */
/* the following procedures might prove useful in other contexts....  */
/*      *************************************************              */

/* this simple sort procedure is courtesy of Stan Irish, and
was obtained from comp.lang.rexx
Usage:
   call StemSort 'stemname.',column
where
    stemname = The name of a stem variable containing an "array" to
               sort.   
                  stemname.0 MUST be set to the number of elements
                  in the array!
    column   = (optional) the column number (the character number of
               values in (stemname.) to sort from. 
               If not specified, sort from column 1.

No value is returned, but 'stemname.' is sorted in place.

*/


StemSort:
  !stem = arg(1)
  call StemSortProc !stem,arg(2)
  return 0

StemSortProc:Procedure expose (!stem)
/* returns:  nothing
 Uses:     xxx = value(stemname.i) to get element values
       and  rc  = value(stemname.i,xxx) to set element values
*/

  sortstem = arg(1)
  If datatype(arg(2)) = 'NUM' then SortColumn = arg(2)
  Else SortColumn = 1

  d = value(sortstem||0) % 2              /* d is a distancemeasurement     */
  do while d > 0
    do until finished             /* start of mini-bubblesort loop   */
      finished = 1
      do i=1 to value(sortstem||0)-d
        j = i+d           /* we now compare and swap items i and i+d */
        if substr(value(sortstem||i),SortColumn) >substr(value(sortstem||j),SortColumn) then
          do
            temp = value(sortstem||i)
            rc = value(sortstem||i,value(sortstem||j))
            rc = value(sortstem||j,temp)
            finished = 0
          end
      end
    end                           /* end of mini-bubblesort loop     */
    d = d%2
  end
  RETURN ''


/* --------------------------------------------------------------------*/
/* Resolve a filename into a fully qualified file.
   This will take  a variety of filenames; including such forms as:
   FOO.BAR, E:FOO.BAR,  XYZ\FOO.BAR, and E:ABC\FOO.BAR

   Returns the fully qualified filename; or (if nocheck<>1,
   a '' if this filename does not exist.

Usage:
  filename=resolve_filename(a_filename,a_directory,default_ext,nocheck)
where
  a_filename = a filename  to use
               a_filename can contain "path information". If this
               is relative path information, then the path information
               from a_filename will be appended to the a_directory.
 a_directory = a directory, or a relative directory, to use.
               If a relative directory, a_directory will be converted
               to a fully qualified directory before path information
               from a_filename is appended.
 default_ext = add this extension to a_filename, if a_filename does not
               have a period (a .) in it
    nocheck  = If 1, do NOT verify the existence of this file
and
  filename   = a fully qualified filename, or a '' (signifying "no such
               file)


Hint: if you do not specify a filename, then resolve_filename will
      check for the existence of a directory (rather then an explicit
      file within the directory
*/

resolve_filename:procedure

parse arg afile,adir,defext,nocheck
afile=strip(afile) ; adir=strip(adir)

curdir0=directory()
curdir=curdir0'\'

if adir='' then adir=curdir     /* no adir specified, use current */

if right(adir,1)<>'\' & right(adir,1)<>':' then adir=adir'\'

usedrive=filespec('D',adir)
usedrive0=usedrive

if usedrive='' then usedrive=filespec('D',curdir) /* no drive in adir, use current*/

usepath=filespec('P',adir)
if left(usepath,1)<>'\' then do    /* relative to current usedrive path */
   foo=directory(usedrive)'\'
   foo2=directory(curdir0)
   usepath=filespec('p',foo)||usepath
end /* do */
oldfile=filespec('n',afile)

/* a hack, but what the heck.. */
do forever
  if pos('\\',usepath)=0 then leave
  parse var usepath a1 '\\' a2
  if length(a1)=0 then 
     usepath='\'
  else
     usepath=a1'\'
  if a2='' then leave
  usepath=usepath||a2
end
select
  when substr(afile,2,2)=":\" then do /* if 2-3 = :\, then use afile as is */
     usefile=afile
  end /* do */

  when substr(afile,2,1)=':' then do    /* relative file name on drive */
       
      if usedrive0='' then do            /* perhaps use usepath? */
          usefile=left(afile,2)||usepath||oldfile
      end               /* otherwise, use afile as is */
      else do
         usefile=afile
      end /* do */
  end
  when left(afile,1,1)='\' then do      /* attach adir drive */
      usefile=usedrive||afile
  end
  otherwise do
      usefile=usedrive||usepath||afile
  end
end

if pos('.',afile)=0 & defext<>'' then usefile=usefile||'.'||strip(defext,'l','.')

/* a hack, but what the heck.. */
do forever
  if pos('\\',usefile)=0 then leave
  parse var usefile a1 '\\' a2
  usefile=a1'\'
  if a2='' then leave
  usefile=a1||a2
end

if nocheck=1 then return usefile

if afile='' then do                     /* check for existence of directory*/
   isit=dir_exists(afile)
   if isit=0 then return ''
   return afile
end

file=stream(usefile,'c','query exists')  /* check for existence of a file */
return usefile


/*************************************************/
/* Check for the existence of a directory. Correctly identifies
   empty directories.
Usage:
   flag=dir_exists(a_directory)
where
   flag=1 if a_directory exists (it might be an empty directory )
   flag=0 if it doesn't exist
*/
dir_exists:procedure 
parse arg adir

adir=strip(adir)
adir=strip(adir,'t','\')
nowdir=directory()
nowdrive=filespec('d',nowdir'\')
nowpath=filespec('p',nowdir'\')
adr=filespec('d',adir)
if adr='' then do
   if abbrev(adir,'\')=0 then 
       adir=nowdrive||nowpath||adir
   else
       adir=nowdrive||adir
end /* do */

foo=sysfiletree(adir,goo,'D')
if  goo.0>0  then return 1
return 0

/* summary of this directory tree */
dir_summary:procedure expose filename. adir. toscreen tofile outfile excstring dodirsummary ,
                subflag dopause pause_after bold normal htmlview
parse arg ndo
totfils=0
totdirs=0
totsize=0
numeric digits 12
dirstats.=0

if htmlview=1 then call lineout outfile,'<Pre>'

do mm=1 to ndo
   todo=adir.mm||filename.mm
   oo=sysfiletree(todo,'fils','BTS')
   aline='>> '||translate(todo)
   if length(todo)>40 then do
      call dosay aline
      aline=''
   end
   nfiles=0 ; nsize=0
   isz=0
   do m=1 to fils.0
      isdir=0
      attribs=translate(strip(word(fils.m,3)))
      fname=translate(word(fils.m,4))
      if fname='.' | fname='..' then iterate
      if excstring<>'' then do
        do www=1 to words(excstring)
           excstring1=strip(word(excstring,www))
           if pos(excstring1,translate(fname))>0 then iterate m
        end
      end 
      if substr(attribs,2,1)='D' then isdir=1   /* this is a directory */
      thissize=word(fils.m,2)
      if dodirsummary=1  then do
         dname=filespec('d',fname)||filespec('p',fname)
         if dirstats.dname.!x=0 then do
            ii=dirstats.0+1
            dirstats.ii=dname
            dirstats.0=ii
            dirstats.!maxchar=max(dirstats.!maxchar,length(dname))
            if isdir=0 then do 
               dirstats.dname.!ct=1
               dirstats.dname.!size=thissize
            end
            dirstats.dname.!x=1
         end 
         else do
            if isdir=0 then do
                dirstats.dname.!size=thissize+dirstats.dname.!size
                dirstats.dname.!ct=1+dirstats.dname.!ct
            end
         end
      end
      if isdir=0 then do
        isz=isz+thissize
        nfiles=nfiles+1
     end
    end

    aline=aline||" : # files=" nfiles
    aline=aline||" ("||addcomma(isz)||")"
    totsize=totsize+isz
    totfils=totfils+nfiles

  oo=sysfiletree(adir.mm,'fils2','DTS')
  if excstring='' then do
     ndirs=fils2.0
  end
  else do
     ndirs=0
      do ll=1 to fils2.0
        do www=1 to words(excstring)
           excstring1=strip(word(excstring,www))
           if pos(excstring1,translate(fils2.ll))>0 then leave ll
         end
         ndirs=ndirs+1
      end               /* ll loop */

/*   if pos(excstring,translate(fils2.ll))=0 then ndirs=ndirs+1 */
  end 
  aline1=aline"; # directories= "ndirs
  if length(aline1)>80 then   aline1=aline||'0d0a'x||"   # directories= "ndirs
  aline=aline1
  totdirs=totdirs+ndirs
  call dosay aline
end
if ndo>1 then do
   todo='==  Total: '
   aline=todo||" # files=" totfils
   aline=aline||" ("||addcomma(totsize)||")"

  aline=aline"; # directories= "totdirs
  call dosay aline
end
if htmlview=1 then call lineout outfile,'</Pre>'

if dodirsummary=1 then do
   if htmlview=1 then do 
      call lineout outfile,'<table>'
      subflag='&nbsp;&nbsp;'
   end

   waslevel=0
   do mm=1 to dirstats.0  /* determine "displayed" names */
      arf=dirstats.mm
      goo=translate(arf,' ','\')
      nlevel=words(goo)
      pud='  '
      if nlevel>2 then pud='  '||copies(subflag,nlevel-2)
      pud=pud||' '||copies(' ',1+(nlevel-1)*2)
      geeble=pud||word(Goo,nlevel)
      if waslevel=0 then  waslevel=nlevel+1
      if nlevel<=waslevel then geeble=arf
      dirstats.mm.!showme=geeble
      dirstats.!showmax=max(dirstats.!showmax,length(geeble))
   end 
   call dosay ' '
   if htmlview<>1 then do
      call dosay left("Directory",dirstats.!showmax)||"  #files (bytes) [ Subdirs : #files (bytes) "
      call dosay '     '||copies('-',dirstats.!showmax)
   end
   else do
       call dosay '<tr><th bgcolor="#00eeff">Directory</th><th bgcolor="#00ffdd">#files <em>bytes</em></th><th><tt>Subdirs #files  <em>bytes</em></tt> '
   end
   iwrot=4
   do mm=1 to dirstats.0                /* subtree sizes, and display */

    if dopause=1 then do
       iwrot=iwrot+1
       if iwrot=pause_after+1 then do             /* pause it */
           call charout,bold||'#'mm' ... G(o), ESC to exit, any other key to continue '||normal
           akey=sysgetkey()
           if c2d(akey)=27 then exit
           if translate(akey)='G' then dopause=0
           call charout,'0d'x||copies(' ',60)||'0d'x
           iwrot=1
       end 
     end          /* pause? */


      arf=dirstats.mm
      arf2=lefT(arf,dirstats.!maxchar)
      files_in=dirstats.arf.!ct ; bytes_in=dirstats.arf.!size
      nsubs=0
      do mm2=mm+1 to dirstats.0
         arf3=dirstats.mm2
         if abbrev(arf3,arf)=0 then leave
         files_in=files_in+dirstats.arf3.!ct
         bytes_in=bytes_in+dirstats.arf3.!size
         nsubs=nsubs+1
      end
      if htmlview<>1 then do
         geeble=left(dirstats.mm.!showme,dirstats.!showmax)|| ' '  dirstats.arf.!ct '(' || dirsizeM(dirstats.arf.!size) || ')'
         if nsubs>0 then geeble=geeble||' ['nsubs ': ' || files_in || ' (' ||dirsizeM(bytes_in)||')'
         call dosay geeble
      end 
      else do
         bgg=''
         if nsubs>0 then bgg='bgcolor="#afafaf"'
         call dosay '<TR '||bgg||'><td>'||dirstats.mm.!showme||'</td>'
         call dosay '<td>'||dirstats.arf.!ct
         call dosay '&nbsp;</em>'||dirsizeM(dirstats.arf.!size)||'</em></td>'
         if nsubs>0 then do 
            call dosay '<td><tt>'||nsubs||'&nbsp;&nbsp;'||files_in||'&nbsp;'
            call dosay '<em>'||dirsizeM(bytes_in)||'</em></tt></td>'
         end 
      end 

   end 

end
if htmlview=1 then call lineout outfile,'</table>'

say
return 1

/************/
/* ADD COMMAS TO A NUMBER */
addcomma:procedure
parse arg aval,ndec
parse var aval p1 '.' p2

if ndec='' then do
   p2=''
end
else do
   p2='.'||left(p2,ndec,'0')
end /* do */

plen=length(p1)
p1new=''
do i=1 to 10000 while plen>3
   p1new=','right(p1,3)||p1new
   p1=delstr(p1,plen-2)
   plen=plen-3
end /* do */

return p1||p1new||p2

/*****************/
dosay:
parse arg a1
if tofile>0 then do
   call lineout outfile,a1
end
if toscreen>0 then do
   say a1
end
return  0

/*********/
/* write html header stuff */
ini_html:

call lineout outfile,'<html><head><title>Results of DIRTREE</title></head>'
call lineout outfile,'<body>'
call lineout outfile,'<h2>DirTree Results </h2>'
return


/*************/
/* express size as xxx.xM  or xxx.xK */
dirsizeM:procedure
parse arg asize;asize=strip(asize)
if asize<1000 then return asize
if asize<1000000 then do
    asize=asize/1000
   parse var asize a1 '.' a2

    return a1||'.'||lefT(a2,1)||'k'
end
asize=asize/1000000
parse var asize a1 '.' a2
return a1||'.'||lefT(a2,1)||'m'

/* -------------------- */
/* choose between multiple alternatives (by default,a yes or no ),
return 1 if yes (or 0,1,2,... for chosen altenative ) */

yesno:procedure
parse arg amessage , altans,def,arrowok
ahdr=''
if pos('|',amessage)>0 then parse var amessage ahdr '|' amessage
aesc='1B'x
cy_ye=aesc||'[37;46;m'
cyanon=cy_ye
normal=aesc||'[0;m'
bold=aesc||'[1;m'
re_wh=aesc||'[31;47;m'
reverse=aesc||'[7;m'

aynn=' '
if def='' then
 defans=''
else
 defans=translate(left(strip(def),1))
if altans='' then altans='No Yes'

w.0=words(altans)
do iw0=1 to w.0
     w.iw0=strip(word(altans,iw0))
     a.iw0=translate(left(w.iw0,1))
     aa.iw0=substr(w.iw0,2)
     aynn=aynn||bold
     if  a.iw0=defans then aynn=aynn||cy_ye
     aynn=aynn||a.iw0||normal||aa.iw0
     if iw0<w.0 then aynn=aynn'|'
end
if arrowok=1 then aynn=aynn||' [UP]'
do forever
 foo1=normal||ahdr||reverse||amessage||normal||aynn||' 'normal
 if length(amessage)+length(altans)<70 then
    foo1=normal||ahdr||reverse||amessage||normal||aynn||' 'normal
 else
    foo1=normal||ahdr||reverse||amessage||normal||'0d0a'x||'    '||aynn||' 'normal
 call charout, foo1
 anans=translate(sysgetkey('echo'))
 ianans=c2d(anans)
 if anans='' | ianans=13 | ianans=10 then  anans=defans

 if arrowok=1 & ianans=0 then do
     ians=c2d(sysgetkey('noecho'))
     if ians=72 then  do
           say ;say
           return -1  /* -1 : up key */
     end
 end /* do */

 do ijj=1 to w.0
    if abbrev(anans,a.ijj)=1 then do
        say
        return Ijj-1
    end
 end /* do */
 call charout,'0d'x
end


/*************/
/* meticulous sysfiletree, return list of directories */
sysfiletree_DIRS: procedure expose tfils.
parse arg getit
aesc='1B'x
normal=aesc||'[0;m'
bold=aesc||'[1;m'
reverse=aesc||'[7;m'

tfils.0=0
wow=sysfiletree(getit,'tfils.','DO')
say '  'reverse"(hit ESC to cancel)"normal
mm=0
do forever
  ba=inkey('n')
  if c2d(ba)=27 then do
     say 
     say   bold"  Cancel "normal
     EXIT
  end 

   mm=mm+1
   if mm>tfils.0 then leave
   getit1=strip(tfils.mm,,'\')||'\*.*'
   wow=sysfiletree(getit1,'stuff0.','DO')
   if stuff0.0=0 then iterate
   ij=0
   do jj=tfils.0+1 to tfils.0+stuff0.0
       ij=ij+1
       tfils.jj=stuff0.ij
   end 
   tfils.0=tfils.0+stuff0.0
   foo=cursor(,1) 
   call charout,left("  Total= "tfils.0 "("stuff0.0" directories in "||filespec('d',getit1)||filespec('p',getit1)||')',79)
  
end
say
return 1




/*************/
/* meticulous sysfiletree, returl list of files */
sysfiletree_files: procedure expose tfils. 
parse arg getit,foo,atype

dd=filespec('d',getit)||filespec('p',getit)
dname=filespec('n',getit)
dd2=strip(dd,,'\')||'\*.*'
oy=sysfiletree_dirs(dd2)
do mm=0 to tfils.0
   ds.mm=tfils.mm
end 
jj=tfils.0+1
ds.jj=dd
tfils.0=jj
ds.0=tfils.0
drop tfils.
aesc='1B'x
normal=aesc||'[0;m'
bold=aesc||'[1;m'
reverse=aesc||'[7;m'

btype=space(translate(atype,' ','S'),0)
iat=0

do mm=1 to ds.0
   adir=strip(ds.mm,,'\')||'\'||dname
   wow=sysfiletree(adir,'ffils.',btype)

   do nn=1 to ffils.0
     iat=iat+1
     tfils.iat=ffils.nn
   end 

   foo=cursor(,1) 
   call charout,left("  Total files= "iat "("ffils.0" files in "adir,79)
   ba=inkey('n')
   if c2d(ba)=27 then do
     say 
     say   bold"  Cancel "normal
     EXIT
   end 

end
tfils.0=iat
return 1