/*rx
 *
 * ExtractFilesLhA.rexx - Extract selected files from an LhA archive
 *                        previously listed in a DOpus window by ListLha.rexx
 *
 * $VER: ExtractFilesLhA 40.9 (22/05/94) by Geoff Seeley
 *
 * Usage: ARexx command ExtractFilesLhA.rexx (from DOpus)
 *
 */

/* configuration variables (change these to suit your setup) */

LhaCommand    = 'XFH_Work:C/Archivers/File/LhA '
OutputWindow  = '>CON:30/145/640/100/LhA_Output/CLOSE/SCREENDOPUS.1 '
InputWindow   = '<CON:30/245/640/50/LhA_Input/AUTO/SCREENDOPUS.1 '
ExtractList   = 'T:lha_file_list'
ListLhARexx   = 'RX DOpus:ARexx/ListLhA.rexx'

/*--------------------------------------------------------------------------*/
/* misc. variables */

DOpusPort = 'DOPUS.1'

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

/* make sure we've got somebody to talk to */

if showlist('Ports', DOpusPort) = 0 then do
   say 'Directory Opus ARexx port not found. Aborting.'
   call CleanUp
end

address 'DOPUS.1'
options results

Busy on

/* get the path/name of the LhA archive file */

'Status 14 -1'
LhaArchive = result

/* make sure it's an LhA archive listing buffer */

if (IsLhAFile(LhaArchive) = 0) then do

   /* try other window */

   OtherWindow
   'Status 14 -1'
   LhaArchive = Result
   
   if (IsLhAFile(LhaArchive) = 0) then do

      /* try first selected file */

      OtherWindow
      'GetNextSelected -1'
      LhaArchive = RESULT
      if LhaArchive ~= 0 & IsLhaFile(LhaArchive) then do

         /* list it in the window first */

         address COMMAND ListLhARexx

         Busy on
      end
      else do

         /* try first selected file in other window */

         OtherWindow
         'GetNextSelected -1'
         LhaArchive = RESULT
         if LhaArchive ~= 0 & IsLhaFile(LhaArchive) then do

            /* list it in the window first */

            address COMMAND ListLhARexx

            Busy on
         end
         else do

            Notify "Sorry, no LhA archive buffer found. You must use the ListLha button first."
            call CleanUp
         end
      end
   end

end

TopText "Extracting File(s) From an LhA Archive"

call FindLhAPath
LhaArchive = LhaPath || LhaArchive

/* check for existance of archive */

if ~exists(LhaArchive) then do

   Notify "Can't seem to find '" || LhaArchive || "'. Aborting."
   call CleanUp

end

/* get the destination path from the other window */

OtherWindow

'Status 13 -1'
DestinationPath = result

OtherWindow

/* check for valid destination path */

if DestinationPath = '' then do

   Notify "The destination path is invalid\Pick another destination"
   call CleanUp

end

/* build extract from settings */

LhaExtractCmd = GetLhaOpts()

/* get list of selected entries */

GetSelectedAll
SelectedEntries = result

if SelectedEntries = 'RESULT' then do

   /* none selected, delete all? */

   Request "Extract *ALL* files from LhA archive?"
   DoAll = RESULT
   Busy on

   if DoAll = "1" then do

      TopText "Extracting file(s) from LhA archive..."

      CliCommand = LhaCommand || OutputWindow || InputWindow || LhaExtractCmd ||Quote(LhaArchive)
      CliCommand = CliCommand || ' "*"'

      pragma('Directory', DestinationPath)
      address command CliCommand

      OtherWindow
      'Rescan -1'

      TopText "Finished extracting selected file(s) from LhA archive."
   end
   else
      TopText "Extraction Of File(s) Aborted..."

   call CleanUp
end

NumberOfEntries = words(SelectedEntries)

/* extract the files */

call ExtractFileList

/* update destination window, tell user we are finished */

OtherWindow
'Rescan -1'

TopText "Finished extracting selected file(s) from LhA archive."

call CleanUp

exit

/*----------------------------------------------------------------------------*/

ExtractFileList: /* build a list of selected files, extract list */

   if exists(ExtractList) then
      delete(ExtractList)

   if ~open(FileList, ExtractList, 'W') then do
      Notify "Can't open file " || ExtractList
      call CleanUp
   end

   TopText "Creating file(s) list..."

   do EntryNumber = 1 to NumberOfEntries
      Index = word(SelectedEntries, EntryNumber)
      GetEntry Index+1
      Entry = result
      File = substr(Entry, 10)
      File = Quote(File)
      call ReplaceMetaChars
      if ExtOpts = '-x0 e ' then do
         File = GetFileInPath(File)
         File = Quote(File)
      end
      writeln(FileList, File)
      selection = Index||' 0 0'
      SelectEntry selection
   end

   'DisplayDir -1'

   close(FileList)

   /* form CLI command and extract the file(s) */

   TopText "Extracting file(s) from LhA archive..."

   CliCommand = LhaCommand || OutputWindow || InputWindow || LhaExtractCmd ||Quote(LhaArchive)
   CliCommand = CliCommand || ' @' || ExtractList

   pragma('Directory', DestinationPath)
   address command CliCommand

return

/*--------------------------------------------------------------------------*/

IsLhAFile: procedure   /* look at extension, return 1 if right, else 0 */

   parse arg AFileName

   lps = lastpos(".", AFileName)               
   if lps = 0 then                           
      return 0

   FileExt = upper(right(AFileName,length(AFileName)-lps))

   if FileExt ~= "LHA" & FileExt ~= "LZH" then
      return 0
   else
      return 1

return 0

/*--------------------------------------------------------------------------*/

FindLhAPath: /* grab invisible file path to archive */

   /* find number of entries, path is the last one */

   'Status 6 -1'

   GetEntry Result
   LhaPath = Result

return
 
/*--------------------------------------------------------------------------*/

ReplaceMetaChars: /* replace special wildcards with ? */

   File = translate(File, '???', '()`', '?')

return

/*--------------------------------------------------------------------------*/

GetLhaOpts: procedure expose ExtOpts OvrOpts /* get LhA options */

   if open('opts', 'ENV:LHAREXX_EXT_OPTS', 'R') then do
      ExtOpts = readln('opts')
      close('opts')
   end
   else
      ExtOpts = '-x x '
 
   if open('opts', 'ENV:LHAREXX_OVR_OPTS', 'R') then do
      OvrOpts = readln('opts')
      close('opts')
   end
   else
      OvrOpts = '-m0 '

   Opts = OvrOpts||ExtOpts

return Opts

/*--------------------------------------------------------------------------*/

GetFileInPath: procedure /* return file from path */

   parse arg FilePath
   if lastpos('/', FilePath) = 0 then
      return StripQuotes(FilePath)
   DivPos = max(lastpos(':', FilePath),lastpos('/', FilePath)) +1
   parse var FilePath PathSpec =DivPos FileName
   Filename = StripQuotes(Filename)

return Filename

/*--------------------------------------------------------------------------*/

Quote: procedure /* add quotes to string */

   parse arg string

return '"'||string||'"'

/*---------------------------------------------------------------------------*/

StripQuotes: procedure /* strip quotes from string */

   parse arg string

return strip(string,, '"')

/*---------------------------------------------------------------------------*/

CleanUp: /* clean up files and exit */

   if exists(ExtractList) then
      delete(ExtractList)

   Busy off

   exit 0

return