/*
   $VER: LhADir.dopus 1.1 (16.8.93)
   © 1993 EAV Productions International
   Placed in the public domain. No restrictions on distribution or usage.

   This ARexx script for Directory Opus allows you to show the contents
   (files and directories) of LhA archive files in a DOpus window and
   operate on it as with a normal directory.

   With LhADir.dopus you can:

    - browse through the directory structure of an archive file
    - read/play/show a single file from an archive
    - delete files and directories with the Delete button
    - extract or add files or directories with the Copy button

   LhADir.dopus was tested with Directory Opus v4.01 and LhA V1.50r.

   Possible arguments (not case sensitive) for LhADir.dopus:

    GETDIR, BROWSE, PARENT, ROOT, DELETE, COPY, MAKEDIR,
    READ, ANSIREAD, HEXREAD, SHOW, PLAY, LOOPPLAY, PRINT, ICONINFO,
    VERSION, MULTIVIEW, VIEWTEK, RETINADISPLAY.
*/

signal on syntax    /* intercept syntax errors */
options results     /* need results from DOpus */
options failat 21   /* external commands are allowed returncode 20 */
numeric digits 10   /* needed for convertdate routine */
lf='0a'x            /* ascii code for linefeed */

parse arg command ' ' port ' "' doubleclick '"'
command=upper(command)
if port~='' then address(port)
            else port=address()
parse var port '.' port  /* DOpus port number */

busy on             /* switch busy mouse pointer on */
status 3            /* get active window */
window=result
status 9 window     /* get number of selected entries */
entries=result

call checkconfig
call checklhadir(window)

if doubleclick~='' then do
   selected=doubleclick
   filetype=-1
   entries=1
   end
else if entries>0 then call getnextitem

topline=""

select              /* internal LhADir.dopus commands */
   when command='GETDIR'  then call dogetdir
   when command='BROWSE'  then call dogetdir
   when command='PARENT'  then call doparent
   when command='ROOT'    then call doroot
   when command='DELETE'  then call dodelete
   when command='COPY'    then call docopy
   when command='MAKEDIR' then call domakedir

   otherwise do
      if entries>0 & filetype>0 then call quitit
      if lhadir & entries>0 then do
         thisfile='"T:'selected'"'
         call patchname
         address command 'LhA e -q -x2 -a -C0 -Qw -Qo "'lhapath || lhaname'" T: "'lhasubdir || patched'"'
         if rc>0 then call quitit("Error while extracting file.")
         pause=50
         end
      else thisfile=''

      select        /* internal DOpus commands */
         when command='READ'     then read thisfile
         when command='ANSIREAD' then ansiread thisfile
         when command='HEXREAD'  then hexread thisfile
         when command='SHOW'     then show thisfile
         when command='PLAY'     then play thisfile
         when command='LOOPPLAY' then lplay thisfile
         when command='PRINT'    then print thisfile
         when command='ICONINFO' then iconinfo thisfile

         otherwise do
            pause=0
            if ~lhadir & entries>0 then thisfile='"'windowpath || selected'"'

            select  /* external commands */
               when command='VERSION'       then call doversion
               when command='MULTIVIEW'     then address command 'MultiView SCREEN' thisfile
               when command='VIEWTEK'       then address command 'Work:OtherTools/VT >NIL:' thisfile
               when command='RETINADISPLAY' then address command 'Work:RetinaTools/RetinaDisplay' thisfile

               otherwise topline="Error, unknown command for LhADir.dopus."
               end
            end
         end

      if lhadir & entries>0 then do
         /* The next library is needed for the delay function. */
         if ~show('L','rexxsupport.library') then call addlib('rexxsupport.library',0,-30)
         call delay(pause)  /* wait a second before deleting */
         delete '"T:'selected'"'
         end
      if thisfile~='' then do
         selectfile '"'selected'" 0 1'  /* deselect item */
         if topline='' then topline="OK"
         end
      end
   end

call quitit(topline)  /* finished */


/************************************************
 *                                              *
 *  All of LhADir.dopus' functions are defined  *
 *  below as subroutines.                       *
 *                                              *
 ************************************************/

dogetdir:

   if entries>0 then
      if filetype>0 then  /* list a new dir */
         if lhadir then lhasubdir=lhasubdir || selected'/'
                   else windowpath=windowpath || selected'/'
      else do             /* list an archive file */
         if pos(upper(right(selected,4)),'.LHA.LZH.RUN')=0 then call quitit("Error, LhADir.dopus can only list LhA archives.")
         if lhadir then do
            request "This is an archive in an archive."lf"Extract it to 'T:' and then list it?"
            if ~result then call quitit("Aborted...")
            busy on
            call patchname
            toptext "Extracting from archive..."
            address command 'LhA e -q -x2 -a -C0 -Qw -Qo "'lhapath || lhaname'" T: "'lhasubdir || patched'"'
            if rc>0 then call quitit("Error while extracting from archive.")
            lhapath='T:'
            lhaname=selected
            lhasubdir=''
            call lhalist
            end
         else do
            lhadir=1
            lhapath=windowpath
            lhaname=selected
            lhasubdir=''
            call lhalist
            end
         end
   else  /* rescan current dir */
      if lhadir then do
         status 6 window  /* get number of entries */
         if result>0 then call lhalist
         end

   if command="BROWSE" then do
      selectfile '"'selected'" 0 1'
      call swapactive
      end
   if lhadir then do
      call showlhadir
      topline="OK"
      end
   else status 13 window set '"'windowpath'"'
   return


doparent:

   if lhadir & lhasubdir~='' then do
      cuthere=lastpos('/',lhasubdir,length(lhasubdir)-1)
      lhasubdir=left(lhasubdir,cuthere)
      call showlhadir
      topline="OK"
      end
   else parent
   return


doroot:

   if lhadir & lhasubdir~='' then do
      lhasubdir=''
      call showlhadir
      topline="OK"
      end
   else root
   return


dodelete:

   if lhadir then do
      if entries=0 then call quitit
      if bittst(d2c(olddelflags),0) then do
         request "Do you really wish to delete"lf"selected entries from archive?"
         if ~result then call quitit("Aborted...")
         end
      call open('actionfile','T:actionfile'port,'W')
      do entries
         call getnextitem
         call patchname
         if filetype<0 then call writeln('actionfile','"'lhasubdir || patched'"')
                       else call writeln('actionfile','"'lhasubdir || patched'/#?"')
         removefile '"'selected'"' 1
         end
      call close('actionfile')
      toptext "Deleting from archive..."
      address command 'LhA d -q -Qp -Qo "'lhapath || lhaname'" @T:actionfile'port
      if rc>0 then topline="Error while deleting from archive."
              else topline="OK"
      delete 'T:actionfile'port
      delete 'T:LhADir.list'port  /* archive contents has changed */
      busy on
      end
   else do
      modify deleteflags olddelflags  /* restore user prefs */
      delete
      end
   return


docopy:

   if entries=0 then call quitit
   sourcelhadir=lhadir
   source=windowpath
   store=lhapath'::'lhaname'::'lhasubdir
   call checklhadir(1-window)

   if sourcelhadir then do
      if windowpath='' then quitit("Error, no destination directory selected!")

      if lhadir then do
         call createdirs
         windowpath='T:LhADir'port'/'lhasubdir
         store2=lhapath'::'lhaname'::'lhasubdir
         end

      parse var store lhapath'::'lhaname'::'lhasubdir
      call lhaextract

      if lhadir then do
         parse var store2 lhapath'::'lhaname'::'lhasubdir
         source=windowpath
         entries=0
         call lhaadd
         end
      else do
         rescan 1-window
         setwintitle '"LhADir archive list"'
         end
      if topline='' then topline="OK"
      end
   else
      if lhadir then call lhaadd
                else copy
   return


domakedir:

   result=''
   getstring '"Enter directory name"'
   dirtomake=result
   if dirtomake='' then call quitit
   if lhadir then do  /* create empty dir in archive */
      call createdirs(dirtomake'/')
      address command 'LhA r -q -e -r -Qw -Qo "'lhapath || lhaname'" T:LhADir'port'/' '"'lhasubdir || dirtomake'"'
      if rc>0 then topline="Error while adding to archive."
              else topline="Directory created."
      delete 'T:LhADir'port
      busy on
      call lhalist
      call showlhadir
      end
   else do
      if upper(right(dirtomake,4))='.LHA' then do  /* create new archive */
         call open('emptyarchive',windowpath || dirtomake,'W')
         call writech('emptyarchive','00'x)
         call close('emptyarchive')
         topline="Empty archive created."
         rescan window
         end
      else makedir dirtomake  /* normal makedir */
      end
   return


doversion:

   if thisfile='' then thisfile='REXX:LhADir.dopus'
   toptext "Searching for version string..."
   address command 'Version >T:Version.temp' thisfile 'FULL'
   call open('tempfile','T:Version.temp','R')
   topline=readln('tempfile')
   call close ('tempfile')
   delete 'T:Version.temp'
   return


/************************************************
 *                                              *
 *  Subroutine to show the contents of an LhA   *
 *  archive in a Directory Opus window.         *
 *                                              *
 ************************************************/

showlhadir:

   if ~exists(lhapath || lhaname) then call quitit("Error, file '"lhaname"' not found.")
   if ~exists('T:LhADir.list'port) then call lhalist  /* someone deleted it */
   call open('tempfile','T:LhADir.list'port,'R')

   nextline=readln('tempfile')
   parse var nextline "'" nextline "':"
   if nextline~=lhapath || lhaname then do  /* it's a another archive's list */
      call close('tempfile')
      call lhalist
      call open('tempfile','T:LhADir.list'port,'R')
      call readln('tempfile')
      end

   status 13 window set '"'lhapath || lhaname'/'lhasubdir'"'
   toptext "Listing archive..."  /* toptext will obscure error message */
   setwintitle '"LhADir archive list"'

   do 2
      call readln('tempfile')  /* waste these 2 lines */
      end

   ndirs=0
   compare=upper(lhasubdir)
   complen=length(compare)
   nextline=readln('tempfile')

   do while nextline~="-------- ------- ----- --------- --------"

      name=nextline
      fileinfo=readln('tempfile')
      nextline=readln('tempfile')
      if left(nextline,1)=':' then do
         parse var nextline 3 comment
         nextline=readln('tempfile')
         end
      else comment=''

      if upper(left(name,complen))=compare then do

         name=substr(name,complen+1)
         if name~='' then do
            parse var fileinfo size . . date time atts .
            call convertdate

            if pos('/',name)=0 then  /* it's a file */
               addfile '"'name'"' size '-1' seconds '"'comment'"' atts '0 0'
            else do                  /* it's a dir */
               parse var name name '/'
               flag=0
               do i=ndirs to 1 by -1
                  if upper(name)=upper(dirname.i) then do
                     flag=1
                     dirsize.i=dirsize.i+size
                     if seconds>dirsecs.i then dirsecs.i=seconds
                     leave
                     end
                  end
               if ~flag then do  /* a new dir */
                  ndirs=ndirs+1
                  dirname.ndirs=name
                  dirsize.ndirs=size
                  dirsecs.ndirs=seconds
                  end
               end
            end
         end
      end
   call close('tempfile')

   do i=1 to ndirs
      addfile '"'dirname.i'"' dirsize.i '1' dirsecs.i '"" ----RWED 0 0'
      end

   displaydir
   return


checklhadir:

   parse arg thiswin
   status 13 thiswin  /* get window path */
   windowpath=result
   test=upper(windowpath)
   cuthere=pos('.LHA/',test)
   if cuthere=0 then cuthere=pos('.LZH/',test)
   if cuthere=0 then cuthere=pos('.RUN/',test)
   lhadir=(cuthere>0)
   if lhadir then do
      cutagain=lastpos('/',windowpath,cuthere)
      if cutagain=0 then cutagain=pos(':',windowpath)
      lhapath=left(windowpath,cutagain)
      lhaname=substr(windowpath,cutagain+1,cuthere-cutagain+3)
      lhasubdir=substr(windowpath,cuthere+5)
      end
   return


lhaextract:

   status 8 window  /* get number of dirs selected */
   anydirs=(result>0)
   flag=anydirs & lhasubdir~=''
   if anydirs then lhaopts='x -q -a -C0 -Qo'
              else lhaopts='e -q -x2 -a -C0 -Qw -Qo'
   if flag then do
      makedir '"'windowpath'LhADir'port'"'
      busy on
      destdir=windowpath'LhADir'port'/'
      end
   else destdir=windowpath

   call open('actionfile','T:actionfile'port,'W')
   call writeln('actionfile','"'destdir'"')

   do i=1 to entries
      call getnextitem
      if flag then moveit.i=selected
      call patchname
      if filetype<0 then call writeln('actionfile','"'lhasubdir || patched'"')
                    else call writeln('actionfile','"'lhasubdir || patched'/#?"')
      selectfile '"'selected'" 0 1'
      end

   call close('actionfile')
   if follow then scrolltoshow 0

   toptext "Extracting from archive..."
   address command 'LhA' lhaopts '"'lhapath || lhaname'" @T:actionfile'port
   if rc>0 then topline="Error while extracting from archive."
   delete 'T:actionfile'port
   busy on

   if flag then do
      do i=1 to entries
         move '"'windowpath'LhADir'port'/'lhasubdir || moveit.i'" "'windowpath'"'
         busy on
         end
      delete '"'windowpath'LhADir'port'"'
      busy on
      end
   return


lhaadd:

   flag=(upper(right(source,length(lhasubdir)))=upper(lhasubdir))
   if flag then homedir=left(source,length(source)-length(lhasubdir))
   else do  /* all files must be copied to T: before they can be added */
      homedir='T:LhADir'port'/'
      call createdirs
      end
   call open('actionfile','T:actionfile'port,'W')
   call writeln('actionfile','"'homedir'"')

   if entries=0 then do  /* copying between two archives */
      call writeln('actionfile','#?')
      flag=0  /* delete the temp dir afterwards */
      end

   do entries
      call getnextitem
      call writeln('actionfile','"'lhasubdir || selected'"')
      if ~flag then do
         copy '"' || source || selected'" "T:LhADir'port'/'lhasubdir'"'
         busy on
         end
      selectfile '"'selected'" 0 1'
      end

   call close('actionfile')
   toptext "Adding to archive..."
   address command 'LhA r -q -e -r -Qo "'lhapath || lhaname'" @T:actionfile'port
   if rc>0 then topline="Error while adding to archive."
           else topline="OK"
   if ~flag then delete 'T:LhADir'port
   delete 'T:actionfile'port
   busy on
   call swapactive
   call lhalist
   call showlhadir
   call swapactive
   return


lhalist:

   toptext "Listing archive..."
   address command 'LhA >T:LhADir.list'port 'vv -N -Qw -Qo "'lhapath || lhaname'"'
   if rc>0 then call quitit("Error while listing archive.")
   return


/************************************************
 *                                              *
 *  EAV subroutine to convert date and time to  *
 *  seconds past 01-Jan-78.                     *
 *                                              *
 *  Example input: date='03-Jun-93'             *
 *                 time='18:34:05'              *
 *                                              *
 ************************************************/

convertdate:

   parse var time hours ':' minutes ':' seconds
   parse var date day '-' month '-' year
   month=pos(month,'  JanFebMarAprMayJunJulAugSepOctNovDec')/3
   month=right(month,2,'0')
   century=19+(year<78)
   thisdate=century || year || month || day
   seconds=seconds + minutes*60 + hours*3600 + date('i',thisdate,'S')*86400
   return


getnextitem:

   getnextselected
   selected=result
   if follow then scrolltoshow '"'selected'"'
   fileinfo '"'selected'"' '/'
   parse var result . '/' . '/' . '/' filetype '/'
   return


createdirs:

   parse arg subdirs
   subdirs='T:LhADir'port'/'lhasubdir || subdirs
   lastone=lastpos('/',subdirs)
   cuthere=0
   do until cuthere=lastone
      cuthere=pos('/',subdirs,cuthere+1)
      makedir '"'left(subdirs,cuthere-1)'"'
      end
   busy on
   return


checkconfig:

   query dirflags
   olddirflags=result
   if olddirflags<0 then olddirflags=256+olddirflags  /* bug in DOpus? */
   if bittst(d2c(olddirflags),5) then do
      request "The config setting 'Re-read changed buffers'"lf"must be switched off. Shall I do this for you?"
      if ~result then call quitit("Error, config setting 'Re-read changed buffers' must be switched off.")
      modify dirflags olddirflags-32
      end

   query updateflags
   follow=bittst(d2c(result),1)  /* scroll window to follow operations? */

   query deleteflags
   olddelflags=result
   modify deleteflags 8  /* don't ask when deleting internal */
   return


swapactive:

   otherwindow
   window=1-window
   return


patchname:

   /* Patch for problem with LhA -Qw option. */
   patched=translate(selected,'?????????','[]()#~%|*')
   return


syntax:

   call quitit("Syntax Error" rc"," errortext(rc) "in line" sigl".")


quitit:

   parse arg topline
   modify deleteflags olddelflags       /* restore user prefs */
   if topline~='' then toptext topline  /* display final message */
   if pos('Error',topline)>0 then beep  /* an error occurred */
   busy off                             /* switch busy pointer off */
   exit                                 /* stop script here */