/*
  $VER: ArcDir.dopus5 1.1 (6.6.97)
  Written by Edmund Vermeulen <edmundv@xs4all.nl>.

  ZIP support added (31.1.98) by Frédéric Falempin (spectref@minitel.net)

  ARexx script for Directory Opus 5 to show the contents of an LhA, LZX,
  or ZIP archive in an Opus lister and operate on the files and
  directories inside the archive as if it is a normal directory.

  Function : ARexx      DOpus5:ARexx/ArcDir.dopus5 Browse {Qp} {f} {Ql}
  Flags : Run asynchronously
*/


/*trace intermediates*/


/******************** NOTE!!!!!! ******************

Change your filetype *IDs* in the 'idtype =' line
below to EXACTLY match your IDs for LhA and LZX
archives.  The order must remain as the ID for LhA
first and LZX second.

eg. If your ID for LhA archives is 'LHA' and your
    ID for LZX archives is 'LZX' then the line will
    read as:

idtype = 'LHA LZX'

ThE CaSe Is ImPoRtAnT!!!!

If you don't get this right, the script will not be
able to match archives correctly.

To find out your filetype IDs for LhA and LZX archives,
run DOpus and then run the Check-ID.rexx script, it
will prompt you with what the line should read for
your filetypes.
***************************************************/

idtype = "aLHA aLZX aZIP"  /* Change this line to suit your IDs - see NOTE above */

parse arg cmd ' ' portname ' "' arcfile '" ' handle ' ' arcsubdir

address value portname
options results
options failat 21
signal on syntax
signal on halt
signal on break_c
lf='0a'x
killit = 0
tempfiles. = ''

dopus getfiletype '"'arcfile'"' id
arctype = find(idtype,result)
if arctype = 0 then exit

if ~show('l','rexxsupport.library') then call addlib('rexxsupport.library',0,-30)

if exists('LIBS:locale.library') then do
   if ~show(l,'locale.library') then call addlib('locale.library',0,-30)
   catalog=opencatalog('ArcDir.catalog','english',0)
   end
else
   catalog=0

dopus version
newopus=result~='RESULT' & translate(result,'.',' ')>=5.1215
deskdrop = result ~= 'RESULT' & translate(result,'.',' ') >= 5.1559

dopus getdesktop
deskpath = result

if upper(cmd)='BROWSE' | handle=0 then do
   lister new
   handle=result
   lister set handle source
   end
else
   lister empty handle

call arclist


/* Attach a handler to the lister and wait for an event to happen. */

handlername='ArcDir'handle
lister set handle handler handlername quotes
call openport(handlername)

viewcommands='Read HexRead Show Play'  /* you may add other Opus commands if you wish */
notsupported='Rename Comment Protect'
traps='Copy CopyAs Delete MakeDir Parent Root ScanDir Move MoveAs' viewcommands notsupported
do while traps~=''
   parse var traps trapcommand traps
   dopus addtrap trapcommand handlername
   end

thishandle=handle
lister set handle busy off

do until event='inactive'
   if waitpkt(handlername) then do

      packet=getpkt(handlername)
      if packet~='00000000'x then do

         event=getarg(packet,0)
         handle=getarg(packet,1)
         namestr=getarg(packet,2)
         user=getarg(packet,3)
         pathstr=getarg(packet,4)
         arguments=getarg(packet,5)
         qualifier=getarg(packet,6)
         deststr=getarg(packet,7)

      moveerr = 0
      moving = 0
      tdesktop = 0
      fdesktop = 0
      subdrop = 0
      copyas = 0
      skipit = 0
      notdone = ''
      donot = ''

         if newopus then
            lister wait thishandle quick
         else do
            lister query thishandle busy
            if result=1 then call delay(10)
            end

        if pos('control',qualifier) > 0 then moving = 1
        if pos('subdrop',qualifier) > 0 then subdrop = 1

         select
            when event='doubleclick' then do
               if left(namestr,1)='"' then
                  parse var namestr '"' namestr '"'
               if namestr='' then
                  fileinfo.type=1
               else
                  lister query handle entry '"'namestr'"' stem fileinfo.
               if fileinfo.type>0 then do  /* it's a dir */
                  if qualifier='shift' then do
                     lister new
                     newhandle=result
                     address command 'Copy >NIL: T:ArcDir.list'handle 'T:ArcDir.list'newhandle
                     lister set newhandle source
                     address 'AREXX' 'DOpus5:ARexx/ArcDir.dopus5 GETDIR' portname '"'arcfile'"' newhandle arcsubdir||namestr'/'
                     end
                  else do
                     arcsubdir=arcsubdir||namestr'/'
                     call arclist
                     end
                  end
               else
                  call viewsingle
               end

            when event='reread' | event='ScanDir' then do
               call delete('T:ArcDir.list'handle)
               call arclist
               end

            when event='path' then
               call dopath

            when event = 'dropfrom' & user = 0 then do
               allents = namestr
               call getall
               otherhandle = 0
               tdesktop = 1
               if arguments = 'desktop' then
               winpath = deskpath
               else
                 if arguments ~= '' & words(arguments) = 1 then winpath = arguments
               if moving then do
                 do i = 1 to entries
                   lister select handle name.i on
                 end
                 lister refresh handle
                 end
               call arcextract
               if moving then call dodelete
               if tdesktop then dopus checkdesktop deskpath
               end

            when event = 'drop' then do
               parse var namestr '"' droppath '"'
               if pos(right(droppath,1),'/:') > 0 then
                 lister read handle '"'droppath'"' force
               else do
                  parse var namestr '"' dropfile '"'
                  if pos(':',dropfile) = 0 then do
                     lister query user path
                     dropfile = result||dropfile
                     end
                  else
                     if deskdrop then do
                        if pos('/',dropfile) > 0 then
                           droppath = left(dropfile,lastpos('/',dropfile))
                        else
                           droppath = left(dropfile,pos(':',dropfile))
                           dopus matchdesktop droppath
                           if result then fdesktop = 1
                        end
                     else do
                        call displayerror(getcatstr(23,'Command not supported in ArcDir.'))
                        iterate
                     end
                 dopus getfiletype '"'dropfile'"' id
                 arcid = find(idtype,result) & result~=""
                 if arcid > 0 then do
                    arctype = arcid
                    arcfile = dropfile
                    arcsubdir = ''
                    call delete('T:ArcDir.list'handle)
                    call arclist
                    end
                else do
                    allents = namestr
                    call getall
                    if ~fdesktop then
                       otherhandle = user
                    else
                       otherhandle = 0
                    if fdesktop then call getmore
                    call arcadd
                    end
                 end
              end

            when event = 'dropfrom' then
               if qualifier = 'shift' then do
                  parse var namestr '"' namestr '"'
                  lister query handle entry '"'namestr'"' stem fileinfo.
                  if fileinfo.type > 0 then do
                     address command 'Copy >NIL: T:ArcDir.list'handle 'T:ArcDir.list'user
                     address 'AREXX' 'DOpus5:ARexx/ArcDir.dopus5 GETDIR' portname '"'arcfile'"' user arcsubdir||namestr'/'
                     end
                  end
               else do
                  allents = namestr
                  call getall
                  otherhandle = user
                  call arcextract
                  end

            when upper(event)='PARENT' | upper(event)='ROOT' then
               call doparentroot

            when event='Delete' then
               call dodelete

            when event='MakeDir' then
               call domakedir

            when event='Copy' then do
               lister query handle selentries
               allents=result
               call getall
               if handle=thishandle then do
                  otherhandle=user
                  call arcextract
                  end
               else do
                  otherhandle=handle
                  handle=user
                  call arcadd
                  end
               end

            when event = 'Move' then do
               lister query handle selentries
               allents = result
               call getall
               moving = 1
               if handle = thishandle then do
                  otherhandle = user
                  call arcextract
                  if ~moveerr then call dodelete
                   end
               else do
                   otherhandle = handle
                   handle = user
                   call arcadd
                   if ~moveerr then command wait source otherhandle delete
                   end
               end

            when ((event = 'CopyAs' | event = 'MoveAs') & (user ~= 0 | handle ~= 0)) then do
               if handle ~= thishandle then do
                  call displayerror(getcatstr(23,'Command not supported in ArcDir.'))
                  iterate
               end
               if event = 'MoveAs' then moving = 1
               copyas = 1
               lister query handle selentries
               allents = result
               call getall
               call getnewname
               if skipit then iterate
               if handle = thishandle then do
                  otherhandle = user
                  call arcextract
                  if moving & ~moveerr then do
                     do i = 1 to entries
                        if find(donot,name.i) ~= 0 then lister select handle name.i off
                        end
                     lister refresh handle
                     call dodelete
                     end
                  end
               end

            when pos(event,viewcommands)>0 then do
               lister query handle firstsel
               parse var result '"' namestr '"'
               lister select handle '"'namestr'"' off
               lister refresh handle
               call viewsingle
               end

            when pos(event,notsupported)>0 then do
               lister set handle busy on
               call displayerror(getcatstr(23,'Command not supported in ArcDir.'))
               lister set handle busy off
               end

            otherwise
               nop
            end

         lister set handle busy off
         call reply(packet,0)
         end
      end
   end

call delete('T:ArcDir.list'handle)
call closeport(handlername)
if catalog~=0 then
   call closecatalog(catalog)
exit


doparentroot:

   if arcsubdir='' then do
      cuthere=lastpos('/',arcfile)
      if cuthere=0 | upper(event)='ROOT' then
         cuthere=pos(':',arcfile)
      normaldir=left(arcfile,cuthere)
      if qualifier='shift' then do
         lister new normaldir
         newhandle=result
         lister wait newhandle
         lister set newhandle source
         end
      else do
         lister set handle title
         lister read handle normaldir
         end
      end
   else do
      if upper(event)='ROOT' then
         newsubdir=''
      else do
         cuthere=lastpos('/',left(arcsubdir,length(arcsubdir)-1))
         newsubdir=left(arcsubdir,cuthere)
         end
      if qualifier='shift' then do
         lister new
         newhandle=result
         address command 'Copy >NIL: T:ArcDir.list'handle 'T:ArcDir.list'newhandle
         lister set newhandle source
         address 'AREXX' 'DOpus5:ARexx/ArcDir.dopus5 GETDIR' portname '"'arcfile'"' newhandle newsubdir
         end
      else do
         arcsubdir=newsubdir
         call arclist
         end
      end
   return


dopath:

   if pos(right(namestr,1),'/:')=0 then
      namestr=namestr'/'
   if left(namestr,length(arcfile))=arcfile then do
      if namestr=arcfile'/'arcsubdir then
         call delete('T:ArcDir.list'handle)
      else
         arcsubdir=substr(namestr,length(arcfile)+2)
      call arclist
      end
   else do
      cuthere=pos('.LHA/',upper(namestr))
      if cuthere=0 then
         cuthere=pos('.LZH/',upper(namestr))
      if cuthere>0 then
         arctype='LHA'
      else do
         cuthere=pos('.LZX/',upper(namestr))
         if cuthere>0 then
            arctype='LZX'
         else do
            cuthere=pos('.ZIP/',upper(namestr))
            if cuthere>0 then
               arctype='ZIP'
            end
         end
      if cuthere>0 then do
         call delete('T:ArcDir.list'handle)
         arcfile=left(namestr,cuthere+3)
         arcsubdir=substr(namestr,cuthere+5)
         call arclist
         end
      else
         lister read handle '"'namestr'"' force
      end
   return


dodelete:

   lister set handle busy on
   lister query handle selentries
   allents=result
   call getall
   if entries=0 then
      return

   lister query handle numselfiles
   nfiles=result
   lister query handle numseldirs
   ndirs=result
   call dorequest('"'getcatstr(5,'Warning: you cannot get back'lf||,
      'what you delete! OK to delete:'lf||lf'%s file(s) and'lf||,
      '%s drawer(s) (and their contents)?',nfiles,ndirs)'"',
      getcatstr(6,'Proceed|Cancel'))
   if ~rc then
      return

   lister set handle title getcatstr(7,'Deleting from archive...')
   lister refresh handle full

   select
      when arctype=1 then do
         call open('actionfile','T:actionfile'handle,'w')
         do i=1 to entries
            if type.i>0 then
               wild='/#?'
            else
               wild=''
            call writeln('actionfile','"'patch(arcsubdir||name.i,"'")||wild'"')
            end
         call close('actionfile')
         address command 'LhA d -q -X -Qp -Qo "'patch(arcfile)'" @T:actionfile'handle
         problem=rc>0
         address command 'Delete >NIL: T:LhA_ArcWork.#? QUIET'
         problem=problem | rc=0
         call delete('T:actionfile'handle)
         end
      when arctype='2' then do
         lzxcmd='LZX d -q -X0 --' lzxkludge(patch(arcfile))
         linelen=0
         n=0
         do i=1 to entries
            if type.i>0 then
               dothis=lzxkludge(patch(arcsubdir||name.i,'[')'/#?')
            else
               dothis=lzxkludge(patch(arcsubdir||name.i))
            linelen=linelen+length(dothis)+1
            if i=1 | linelen>255 then do
               n=n+1
               dothese.n=dothis
               linelen=length(lzxcmd)+length(dothis)+1
               end
            else
               dothese.n=dothese.n dothis
            end
         do i=1 to n
            address command lzxcmd dothese.i
            problem=rc>0
            if problem then
               leave
            end
         end
      when arctype='3' then do
         zipcmd='zip -d -g "'arcfile'"'
         linelen=0
         n=0
         do i=1 to entries
            if type.i>0 then
               dothis='"'translate(expatch(expatch(arcsubdir||name.i,'[*?#\','[',']'),'\','\'),'?','"')'/#?"'
            else
               dothis='"'translate(expatch(expatch(arcsubdir||name.i,'[*?#\','[',']'),'\','\'),'?','"')'"'
            linelen=linelen+length(dothis)+1
            if i=1 | linelen>255 then do
               n=n+1
               dothese.n=dothis
               linelen=length(zipcmd)+length(dothis)+1
               end
            else
               dothese.n=dothese.n dothis
            end
            do i=1 to n
            address command zipcmd dothese.i
            problem=rc>0
            if problem then
               leave
            end
         end
      end


   if problem then
      call displayerror(getcatstr(8,'Error while deleting from archive.'))
   else do
      call delete('T:ArcDir.list'handle)
      do i=1 to entries
         if name.i='' then do
            lister query handle separate
            if result='filesfirst' then do
               lister query handle numfiles
               entryno=result
               end
            else
               entryno=0
            lister remove handle '#'entryno
            end
         else
            lister remove handle '"'name.i'"'
         end
      end

   lister set handle title 'ArcDir:' arcname
   lister refresh handle full
   return


domakedir:

   lister set handle busy on
   dopus getstring '"'getcatstr(15,'Enter directory name')'" 31 ""' getcatstr(16,'OK|Cancel')
   dirtomake=result
   if dirtomake=='' | dirtomake='RESULT' then
      return

   now=date('i')*86400+time('s')
   call createdirs(dirtomake'/')

   select
      when arctype=1 then
         address command 'LhA a -q -e -r -X -Qo "'patch(arcfile)'" T:ArcDir'handle'/' '"'patch(arcsubdir||dirtomake,"'")'"'
      when arctype=2 then do
         oldcurrent=pragma('d')
         call pragma('d','T:ArcDir'handle)
         address command 'LZX a -q -e -r -X0 --' lzxkludge(patch(arcfile)) lzxkludge(patch(arcsubdir||dirtomake))
         call pragma('d',oldcurrent)
         end
      when arctype=3 then do
         oldcurrent=pragma('d')
         call pragma('d','T:ArcDir'handle)
         address command 'Zip -r -q -g "'arcfile'" "'translate(expatch(expatch(arcsubdir||dirtomake,"[*?\#","[","]"),"\","\"),'?','"')'"'
         call pragma('d',oldcurrent)
         end
      end

   if rc>0 then
      call displayerror(getcatstr(13,'Error while adding to archive.'))
   else do
      lister add handle '"'dirtomake'" -1 1' now '----rwed'
      lister refresh handle
      end

   address command 'Delete >NIL: T:ArcDir'handle 'ALL QUIET'
   call delete('T:ArcDir.list'handle)
   return


createdirs:

   parse arg subdir
   dirstocreate='T:ArcDir'handle'/'arcsubdir||subdir
   here=0
   do until here=0
      here=pos('/',dirstocreate,here+1)
      if here>0 then
         call makedir(left(dirstocreate,here-1))
      end
   return


arclist:

   lister set handle busy on
   lister clear handle
   lister set handle title getcatstr(1,'Listing archive...')
   lister set handle path arcfile'/'arcsubdir
   lister refresh handle full

   if ~exists(arcfile) then do
      call displayerror(getcatstr(22,'Error: archive not found'))
      return
      end

   if ~exists('T:ArcDir.list'handle) then do
      select
         when arctype=1 then do
            address command 'LhAQuickList >T:ArcDir.list'handle '"'arcfile'"'
            if rc>0 then
               address command 'LhA >T:ArcDir.list'handle 'vv -N -X -Qw -Qo "'arcfile'"'
            end
         when arctype=2 then
            address command 'LZX >T:ArcDir.list'handle 'v -X0 --' lzxkludge(patch(arcfile))
         when arctype=3 then
            address command 'UnZip >T:ArcDir.list'handle '-Z -l -T "'expatch(arcfile,'[*?#\"','\','')'"'
         end

      if rc>0 then
         call displayerror(getcatstr(2,'Error while listing archive.'))
      end

   oldcurrent=pragma('d')
   call pragma('d','DOpus5:C')
   select
      when arctype=1 | arctype=2 then
         address command 'ArcDirList >T:ArcDir.list'handle'@ T:ArcDir.list'handle '"'patchstar(arcsubdir)'"'
      when arctype=3 then
         address command 'Rx >T:ArcDir.list'handle'@ dopus5:arexx/DopusZipList T:ArcDir.list'handle patchstar(arcsubdir)
      end
   call pragma('d',oldcurrent)

   if ~open('tempfile','T:ArcDir.list'handle'@','r') then do
      call displayerror(getcatstr(24,'ArcDirList not found!'))
      return
      end
   thisline=readln('tempfile')
   do while thisline~=''
      lister add handle thisline
      thisline=readln('tempfile')
      end
   call close('tempfile')
   call delete('T:ArcDir.list'handle'@')

   cuthere=lastpos('/',arcfile)
   if cuthere=0 then
      cuthere=lastpos(':',arcfile)
   arcname=substr(arcfile,cuthere+1)
   lister set handle title 'ArcDir:' arcname
   lister refresh handle full
   return


arcextract:

  lister set handle busy on
  if ~tdesktop then do
   if otherhandle=0 then
      if newopus then
         winpath=deststr
      else do
         call displayerror(getcatstr(9,'No destination selected!'))
         moveerr = 1
         return
         end
   else do
      if checkhandler() then do
         moveerr = 1
         return
         end
      lister set otherhandle busy on
      lister query otherhandle path
      if subdrop then
        winpath = arguments
      else
        winpath=result
      end
  end

   lister query handle numdirs
   anydirs=result>0
   mustmove=anydirs & arcsubdir~==''
   if mustmove then do
      destpath=winpath'ArcDir'handle
      call makedir(destpath)
      destpath=destpath'/'
      end
   else
      destpath=winpath

   if copyas then do
      realpath = destpath
      destpath = winpath'ArcDir'handle'x'
      call makedir(destpath)
      destpath = destpath'/'
      end


   lister set handle title getcatstr(10,'Extracting from archive...')
   lister refresh handle full

   select
      when arctype=1 then do
         call open('actionfile','T:actionfile'handle,'w')
         do i=1 to entries
            if type.i>0 then
               wild='/#?'
            else
               wild=''
            call writeln('actionfile','"'patch(arcsubdir||name.i,"'")||wild'"')
            end
         call close('actionfile')

         if anydirs then
            cmd='x'
         else
            cmd='e -x2'
         address command 'LhA' cmd '-q -a -C0 -X -Qo "'patch(arcfile)'" "'destpath'" @T:actionfile'handle
         problem=rc>0
         call delete('T:actionfile'handle)
         end
      when arctype=2 then do
         if anydirs then
            cmd='x'
         else
            cmd='e'
         lzxcmd='LZX' cmd '-q -a -C0 -X0 --' lzxkludge(patch(arcfile))

         linelen=0
         n=0
         do i=1 to entries
            if type.i>0 then
               dothis=lzxkludge(patch(arcsubdir||name.i,'[')'/#?')
            else
               dothis=lzxkludge(patch(arcsubdir||name.i))
            linelen=linelen+length(dothis)+1
            if i=1 | linelen>255 then do
               n=n+1
               dothese.n=dothis
               linelen=length(lzxcmd)+length(dothis)+1
               end
            else
               dothese.n=dothese.n dothis
            end

         oldcurrent=pragma('d')
         call pragma('d',destpath)
         do i=1 to n
            address command lzxcmd dothese.i
            problem=rc>0
            if problem>0 then
               leave
            end
         call pragma('d',oldcurrent)
         end

      when arctype=3 then do
         if anydirs then
            cmd=''
         else
            cmd=' -j'
         zipcmd='Unzip'cmd' -qq "'expatch(arcfile,'[*?#"\','\')'"'

         linelen=0
         n=0
         do i=1 to entries
            if type.i>0 then
               dothis='"'translate(expatch(arcsubdir||name.i,'[*?#','[',']'),'??','"\')'/#?"'
            else
               dothis='"'translate(expatch(arcsubdir||name.i,'[*?#','[',']'),'??','"\')'"'
            linelen=linelen+length(dothis)+1
            if i=1 | linelen>255 then do
               n=n+1
               dothese.n=dothis
               linelen=length(zipcmd)+length(dothis)+1
               end
            else
               dothese.n=dothese.n dothis
          end

          oldcurrent=pragma('d')
          call pragma('d',destpath)
          do i=1 to n
             address command zipcmd dothese.i
             problem=rc>0
             if problem>0 then leave
          end
          call pragma('d',oldcurrent)
          end
       end

         if problem then
            call displayerror(getcatstr(11,'Error while extracting from archive.'))
         else
            do i=1 to entries
               lister select handle '"'name.i'"' off
            end

         lister set handle title 'ArcDir:' arcname
         lister refresh handle full

         if mustmove & ~copyas then do
            address command 'DOpus5:C/Move >NIL: "'destpath||arcsubdir'#?" "'winpath'"'
            address command 'Delete >NIL: "'winpath'ArcDir'handle'" ALL QUIET'
            end

         if copyas then do
            do i = 1 to entries
               if type.i < 0 then do
                  if ~open('tempfile',winpath||newname.i,'R') then
                     if mustmove & copyas then
                        address command 'DOpus5:c/Move >NIL: "'destpath||arcsubdir||name.i'" "'winpath||newname.i'"'
                     else
                        address command 'DOpus5:c/Move >NIL: "'destpath||name.i'" "'winpath||newname.i'"'
                  else do
                     call close('tempfile')
                     notdone = notdone||'\/'||name.i||'->'||newname.i
                     donot = donot||' '||name.i
                     end
                  end
               else
                  address command 'DOpus5:c/Move >NIL: "'destpath||arcsubdir||name.i'#?" "'winpath'"'
               end
            address command 'Delete >NIL: "'realpath'" ALL QUIET FORCE'
            address command 'Delete >NIL: "'destpath'" ALL QUIET FORCE'
            if notdone ~= '' then do
               count = 0
               text = ''
               do while notdone ~= ''
                  count = count + 1
                  parse var notdone what.count '\/' notdone
                  text = text||what.count||lf
                  end
                  text = 'Files not copied because'||lf||'a file with the same'||lf||'destination name existed:'||lf||text
                  if newopus then
                     lister request handle '"'text'" OK'
                  else
                     dopus request '"'text'" OK'
                  end
               end

            if otherhandle~=0 then do
               lister set otherhandle busy off
               lister read otherhandle '"'winpath'"' force
               end
    return


arcadd:

   if checkhandler() then
      return
   lister set handle busy on
if ~fdesktop then do
  lister set otherhandle busy on
  lister query otherhandle path
  frompath = result
  end
else frompath = deskpath

if ~subdrop then do
   mustcopy=upper(right(src,length(arcsubdir)))~==upper(arcsubdir)
   if mustcopy then do
      homedir='T:ArcDir'handle'/'
      call createdirs
      end
   else
      homedir=left(frompath,length(frompath)-length(arcsubdir))
   end
else do
  mustcopy = 1
  temp = substr(arguments,length(arcfile) + 2)
  homedir = 'T:ArcDir'handle'/'
  arcsubdir = temp'/'
  call createdirs
  end

  if mustcopy then
  do i = 1 to entries
    if ~fdesktop then
      lister query otherhandle entry '"'name.i'"' stem fileinfo.
    else
      fileinfo.type = -1
    if fileinfo.type > 0 then
      address command 'Copy "'frompath||name.i'" "T:ArcDir'handle'/'arcsubdir||name.i'" ALL CLONE QUIET'
    else
      if ~fdesktop then
        address command 'Copy "'frompath||name.i'" "T:ArcDir'handle'/'arcsubdir'" CLONE QUIET'
      else
        address command 'Copy "'name.i'" "T:ArcDir'handle'/'arcsubdir'" CLONE QUIET'
  end


   lister set handle title getcatstr(12,'Adding to archive...')
   lister refresh handle full

   select
      when arctype=1 then do
         call open('actionfile','T:actionfile'handle,'w')
         call writeln('actionfile','"'patch(homedir)'"')
         do i=1 to entries
            if ~fdesktop then
               call writeln('actionfile','"'patch(arcsubdir||name.i,0)'"')
            else
               call writeln('actionfile','"'patch(substr(name.i,length(homedir) + 1),0)'"')
            end
         call close('actionfile')

         if pos('.LZH/',test)>0 then
            method='-0'
         else
            method=''
         address command 'LhA r' method '-q -e -r -X -Qo "'patch(arcfile)'" @T:actionfile'handle
         problem=rc>0
         call delete('T:actionfile'handle)
         end


      when arctype=2 then do
         lzxcmd='LZX u -q -a -e -r -X0 --' lzxkludge(patch(arcfile,0))
         linelen=0
         n=0
         do i=1 to entries
            if ~fdesktop then
               dothis=lzxkludge(patch(arcsubdir||name.i))
            else
               dothis=lzxkludge(patch(substr(name.i,length(homedir) + 1),0))
            linelen=linelen+length(dothis)+1
            if i=1 | linelen>255 then do
               n=n+1
               dothese.n=dothis
               linelen=length(lzxcmd)+length(dothis)+1
               end
            else
               dothese.n=dothese.n dothis
            end

         oldcurrent=pragma('d')
         call pragma('d',homedir)
         do i=1 to n
            address command lzxcmd dothese.i
            problem=rc>0
            if problem then
               leave
            end
         call pragma('d',oldcurrent)
         end

     when arctype=3 then do
         zipcmd='zip -q -g -r -n .info "'arcfile'"'
         linelen=0
         n=0
         do i=1 to entries

           /* if type.i>0 then do*/

            if ~fdesktop then do
               dothis=translate(expatch(expatch(arcsubdir||name.i,'[*?#\','[',']'),'\','\'),"?",'"')
               dothis='"'dothis'"'
               end
            else do
               dothis=translate(expatch(expatch(arcsubdir||name.i,'[*?#\','[',']'),'\','\'),"?",'"')
               dothis='"'dothis'"'
               end
            linelen=linelen+length(dothis)+1
            if i=1 | linelen>255 then do
               n=n+1
               dothese.n=dothis
               linelen=length(zipcmd)+length(dothis)+1
               end
            else
               dothese.n=dothese.n dothis
            end

         oldcurrent=pragma('d')
         call pragma('d',homedir)
         do i=1 to n
            address command zipcmd dothese.i
            problem=rc>0
            if problem then
               leave
            end
         call pragma('d',oldcurrent)
         end
      end

   if mustcopy then
      address command 'Delete >NIL: T:ArcDir'handle 'ALL QUIET'

   if problem then do
      call displayerror(getcatstr(13,'Error while adding to archive.'))
      moveerr = 1
      end
   else do
      if ~moving & ~fdesktop then
         do i=1 to entries
            lister select otherhandle '"'name.i'"' off
         end
      else
         if fdesktop & moving then do
             do i = 1 to entries
                if ~moveerr then command delete '"'name.i'"'
             end
             moving = 0
             end
      if ~fdesktop then lister refresh otherhandle
      if subdrop then do
         arcsubdir = reverse(arcsubdir)
         where = pos('/',arcsubdir,2)
         if where = 0 then arcsubdir = ''
            else arcsubdir = reverse(substr(arcsubdir,where))
         end
      call delete('T:ArcDir.list'handle)
      call arclist
      end

if ~fdesktop then lister set otherhandle busy off
return


viewsingle:

   lister set handle busy on
   lister set handle title getcatstr(10,'Extracting from archive...')
   lister refresh handle full

   select
      when arctype=1 then
         address command 'LhA e -q -x2 -X -Qo "'patch(arcfile)'" T: "'patch(arcsubdir||namestr,"'")'"'
      when arctype=2 then
         address command 'LZX e -q -X0 --' lzxkludge(patch(arcfile)) 'T:' lzxkludge(patch(arcsubdir||namestr))
      when arctype=3 then
         address command 'UnZip -qq -j 'expatch(expatch(arcfile,'[*?#"\','[',']'),'"\','\') '"'translate(expatch(arcsubdir||namestr,'[*?#','[',']'),'??','"\')'" -d T: '
      end

   if rc>0 then
      call displayerror(getcatstr(11,'Error while extracting from archive.'))

   thisfile='T:'namestr
   commandline='address' portname'; command' event '""'thisfile'"";'

   dopus getfiletype '"'thisfile'"' id
   if ~(event='doubleclick' & (result='LHA' | result='LZX' | result='ZIP')) then
      commandline=commandline,
         'command wait protect name ""'thisfile'"" set RWED;',
         'do until ~exists('''thisfile''') | delete('''thisfile''');',
            'call delay(200);',
            'end'

   address command 'Run >NIL: <NIL: RX "'commandline'"'

   lister set handle title 'ArcDir:' arcname
   lister refresh handle full
   return


getall:

   entries=0
   do while allents~=''
      entries=entries+1
      parse var allents '"' name.entries '"' allents
      if name.entries='' then
         type.entries=1
      else do
         if ~fdesktop then do
            lister query handle entry '"'name.entries'"' stem fileinfo.
            type.entries=fileinfo.type
            end
         else
            type.entries = -1
         end
      end
   return

getmore:  /* Get .info for drop from DeskTop */
preentries = entries
do i = 1 to entries
  if exists(name.i||'.info') then do
    preentries = preentries + 1
    name.preentries = name.i||'.info'
    type.preentries = -1
    end
end
entries = preentries
return


patch:  /* patch filenames containing strange characters */

   parse arg patched,extra
   strange='*#?|%()~'extra
   if arctype=1 then
      strange=strange'[]'
   pos=1
   do until here=0
      here=verify(substr(patched,pos),strange,'m')
      if here>0 then do
         pos=pos+here+1
         patched=insert("'",patched,pos-3)
         end
      end
   if arctype=1 & left(patched,1)='@' then
      patched='%'patched
   if arctype=2 then
      if length(patched)-lastpos('/',patched)>=30 then
         patched=patched'#?'
   return patched

expatch:   /* An attempt to improve patch function, it's more powerful, but slower */
           /* I've only used it to patch some names in ZIP operations (Fred) */
   parse arg patched,strange,insertbefore,insertafter,ifpresent
   if ifpresent='' | verify(patched,ifpresent,'m')~=0 then do
      pos=1
      do until here=0
         here=verify(substr(patched,pos),strange,'m')
         if here>0 then do
            patched=insert(insertbefore,patched,pos+here-2)
            patched=insert(insertafter,patched,pos+here+length(insertbefore)-1)
            pos=pos+here+length(insertbefore||insertafter)
            end
         end
      end
   return patched

patchstar:

   parse arg remain
   patched=''
   do until remain=''
      parse var remain before '*' remain
      patched=patched||before
      if remain~=='' then
         patched=patched'**'
      end
   return patched


lzxkludge:

   parse arg string
   if pos(' ',string)>0 then
      do while pos("'*",string)>0
         parse var string fore "'*" aft
         string=fore'?'aft
         end
   if pos('*',string)=0 then
      string='"'string'"'
   return string


getnewname:
newname. = ''
do i = 1 to entries
  if type.i < 0 then do
    text = 'Copy|Move 'name.i' as:'
    lister getstring handle '"'text'" 30 "'name.i'" OK|Skip|Cancel'
    select
    when result = 'RESULT' then do
      skipit = 1
      return
      end
    when result = name.i then iterate
    when result ~= '' & result ~= name.i & result ~= 'RESULT' then newname.i = result
    otherwise
    end
/*
    select
    when dopusrc = 0 then do
      skipit = 1
      return
      end
    when dopusrc = 1 | dopusrc = -1 then
      if result = '' | result = 'RESULT' then do
        i = i - 1
        iterate
        end
      else newname.i = result
    when dopusrc = 2 then iterate
    otherwise
    end
*/
    end
end


getcatstr:

   parse arg msgno,msgstring
   if catalog~=0 then
      msgstring=getcatalogstr(catalog,msgno,msgstring)
   do i=3 to arg()
      parse var msgstring fore '%s' aft
      msgstring=fore||arg(i)||aft
      end
   return msgstring


checkhandler:

   lister query otherhandle handler
   return ~(result='RESULT' | result='')


syntax:

   call displayerror('Syntax Error' rc',' errortext(rc) 'in line' sigl'.')
   exit


halt:
break_c:

   lister set thishandle handler
   lister clear thishandle
   lister set thishandle path
   lister set thishandle title 'ArcDir.dopus5 halted.'
   lister refresh thishandle full
   lister set thishandle title
   exit


displayerror:

   parse arg message
   lister set handle title message
   lister refresh handle full
   command flash
   call dorequest('"'message'"' getcatstr(4,'OK'))
   lister set handle title 'ArcDir:' arcname
   return


dorequest:

   parse arg reqargs
   if newopus then
      lister request handle reqargs
   else
      dopus request reqargs
   return