home *** CD-ROM | disk | FTP | other *** search
/ World of A1200 / World_Of_A1200.iso / programs / disk / directory / lhadopus / lhadir.dopus < prev    next >
Text File  |  1995-02-27  |  20KB  |  658 lines
  1. /*
  2.   $VER: LhADir.dopus 1.3 (14.11.93)
  3.   Copyright © 1993 by EAV Productions International
  4.   Placed in the public domain. No restrictions on distribution or usage.
  5.  
  6.   This ARexx script for Directory Opus allows you to show the contents
  7.   (files and directories) of LhA archive files in a DOpus window and
  8.   operate on it as with a normal directory.
  9.  
  10.   With LhADir.dopus you can:
  11.  
  12.    - browse through the directory structure of an archive file
  13.    - read/play/show a single file from an archive
  14.    - delete files and directories with the Delete button
  15.    - extract or add files or directories with the Copy button
  16.  
  17.   LhADir.dopus was tested with Directory Opus v4.11 and LhA V1.50r.
  18.  
  19.   Possible arguments (not case sensitive) for LhADir.dopus:
  20.  
  21.    GETDIR, BROWSE, PARENT, ROOT, DELETE, COPY, MAKEDIR, GETSIZES,
  22.    READ, ANSIREAD, HEXREAD, SHOW, PLAY, LOOPPLAY, PRINT, ICONINFO,
  23.    VERSION, MULTIVIEW, VIEWTEK, RETINADISPLAY, AMIGAGUIDE.
  24. */
  25.  
  26. signal on syntax   /* intercept syntax errors */
  27. options results    /* need results from DOpus */
  28. options failat 21  /* external commands are allowed returncode 20 */
  29. numeric digits 10  /* needed for convertdate routine */
  30. lf='0a'x           /* ascii code for linefeed */
  31.  
  32. parse arg command ' ' screenname ' "' doubleclick '"'
  33. command=upper(command)
  34. if screenname~='' then address(screenname)  /* ARexx port and pubscreen name are the same */
  35.                   else screenname=address()
  36. parse var screenname '.' port  /* port number */
  37.  
  38. busy on            /* busy mouse pointer on */
  39. status 3           /* get active window */
  40. window=result
  41. status 9 window    /* get number of selected entries */
  42. entries=result
  43. checkabort         /* reset abort flag */
  44.  
  45. call checkconfig
  46. call checklhadir(window)
  47.  
  48. if doubleclick~=='' then do
  49.    selected=doubleclick
  50.    filetype=-1
  51.    entries=1
  52.    end
  53. else if entries>0 then call getnextitem
  54.  
  55. topline=""
  56. if pos('|'command'|','|GETDIR|BROWSE|PARENT|ROOT|DELETE|COPY|MAKEDIR|GETSIZES|')>0 then interpret 'call do'command
  57. else do
  58.  
  59.    ntimes=entries
  60.    async=pos('|'command'|','|READ|ANSIREAD|HEXREAD|')>0
  61.    internal=async | (pos('|'command'|','|SHOW|PLAY|LOOPPLAY|PRINT|ICONINFO|')>0)
  62.    if entries=0 | async | (internal & ~(lhadir & entries>0)) | command='VERSION' then ntimes=1
  63.  
  64.    do ntimes
  65.       checkabort  /* did the user press both mouse buttons? */
  66.       if result then call quitit("Aborted...")
  67.  
  68.       if entries>0 then do
  69.          call getnextitem
  70.          if lhadir then do
  71.             thisfile='"T:'selected'"'
  72.             call patchname
  73.             address command 'LhA e -q -x2 -a -C0 -Qw -Qo "'lhapath || lhaname'" T: "'lhasubdir || patched'"'
  74.             if rc>0 then call quitit("Error while extracting file.")
  75.             end
  76.          else
  77.             if internal then thisfile=''
  78.                         else thisfile='"'selected'"'
  79.          end
  80.  
  81.       if internal then do
  82.          interpret "'"command thisfile"'"
  83.          abort=(result~=0)
  84.          end
  85.       else do
  86.          if ~lhadir & entries>0 then thisfile='"'windowpath || selected'"'
  87.  
  88.          select  /* external commands */
  89.             when command='VERSION'       then call doversion
  90.             when command='MULTIVIEW'     then address command 'MultiView' thisfile 'PUBSCREEN' screenname
  91.             when command='VIEWTEK'       then address command 'Work:OtherTools/VT' thisfile
  92.             when command='RETINADISPLAY' then address command 'Work:RetinaTools/RetinaDisplay' thisfile
  93.             when command='AMIGAGUIDE'    then address command 'SYS:Utilities/AmigaGuide' thisfile 'PUBSCREEN' screenname
  94.  
  95.             otherwise call quitit("Error, LhADir.dopus does not support the command '"command"'.")
  96.             end
  97.          abort=0
  98.          end
  99.  
  100.       busy on
  101.       if lhadir & entries>0 then do
  102.          if async then do
  103.             /* This library is needed for the delay function. */
  104.             if ~show('L','rexxsupport.library') then call addlib('rexxsupport.library',0,-30)
  105.             call delay(50)  /* wait a second before deleting */
  106.             end
  107.          delete '"T:'selected'"'
  108.          busy on
  109.          end
  110.       if thisfile~=='' then do
  111.          selectfile '"'selected'" 0 1'  /* deselect item */
  112.          if topline='' then topline="OK"
  113.          end
  114.       if abort then call quitit
  115.       end
  116.    end
  117.  
  118. call quitit(topline)  /* finished */
  119.  
  120.  
  121. /************************************************
  122.  *                                              *
  123.  *  All of LhADir.dopus' functions are defined  *
  124.  *  below as subroutines.                       *
  125.  *                                              *
  126.  ************************************************/
  127.  
  128. dogetdir:
  129. dobrowse:
  130.  
  131.    if entries>0 then
  132.       if filetype>0 then  /* list a new dir */
  133.          if lhadir then lhasubdir=lhasubdir || selected'/'
  134.                    else windowpath=windowpath || selected'/'
  135.       else do             /* list an archive file */
  136.          if pos('|'upper(right(selected,4)'|'),'|.LHA|.LZH|.RUN|')=0 then call quitit("Error, LhADir.dopus can only list LhA archives.")
  137.          if lhadir then do
  138.             request "This is an archive in an archive."lf"Extract it to 'T:' and then list it?"
  139.             if ~result then call quitit("Aborted...")
  140.             busy on
  141.             call patchname
  142.             toptext "Extracting from archive..."
  143.             address command 'LhA e -q -x2 -a -C0 -Qw -Qo "'lhapath || lhaname'" T: "'lhasubdir || patched'"'
  144.             if rc>0 then call quitit("Error while extracting from archive.")
  145.             lhapath='T:'
  146.             lhaname=selected
  147.             lhasubdir=''
  148.             call lhalist
  149.             end
  150.          else do
  151.             lhadir=1
  152.             lhapath=windowpath
  153.             lhaname=selected
  154.             lhasubdir=''
  155.             call lhalist
  156.             end
  157.          end
  158.    else  /* rescan current dir */
  159.       if lhadir then do
  160.          status 6 window  /* get number of entries */
  161.          if result>0 then call lhalist
  162.          end
  163.  
  164.    if command="BROWSE" then do
  165.       selectfile '"'selected'" 0 1'
  166.       call swapactive
  167.       end
  168.    if lhadir then do
  169.       call showlhadir
  170.       topline="OK"
  171.       end
  172.    else status 13 window set '"'windowpath'"'
  173.    return
  174.  
  175.  
  176. doparent:
  177.  
  178.    if lhadir & lhasubdir~=='' then do
  179.       cuthere=lastpos('/',lhasubdir,length(lhasubdir)-1)
  180.       lhasubdir=left(lhasubdir,cuthere)
  181.       call showlhadir
  182.       topline="OK"
  183.       end
  184.    else parent
  185.    return
  186.  
  187.  
  188. doroot:
  189.  
  190.    if lhadir & lhasubdir~=='' then do
  191.       lhasubdir=''
  192.       call showlhadir
  193.       topline="OK"
  194.       end
  195.    else root
  196.    return
  197.  
  198.  
  199. dodelete:
  200.  
  201.    if lhadir then do
  202.       if entries=0 then call quitit
  203.       if bittst(d2c(olddelflags),0) then do
  204.          request "Do you really wish to delete"lf"selected entries from archive?"
  205.          if ~result then call quitit("Aborted...")
  206.          busy on
  207.          end
  208.       call open('actionfile','T:actionfile'port,'W')
  209.       do entries
  210.          call getnextitem
  211.          call patchname
  212.          if filetype<0 then call writeln('actionfile','"'lhasubdir || patched'"')
  213.                        else call writeln('actionfile','"'lhasubdir || patched'/#?"')
  214.          removefile '"'selected'"' 1
  215.          end
  216.       call close('actionfile')
  217.       toptext "Deleting from archive..."
  218.       address command 'LhA d -q -Qp -Qo "'lhapath || lhaname'" @T:actionfile'port
  219.       if rc>0 then topline="Error while deleting from archive."
  220.               else topline="OK"
  221.       delete 'T:actionfile'port
  222.       delete 'T:LhADir.list'port  /* archive contents has changed */
  223.       busy on
  224.       end
  225.    else do
  226.       modify deleteflags olddelflags  /* restore user prefs */
  227.       delete
  228.       end
  229.    return
  230.  
  231.  
  232. docopy:
  233.  
  234.    if entries=0 then call quitit
  235.    sourcelhadir=lhadir
  236.    source=windowpath
  237.    store=lhapath'::'lhaname'::'lhasubdir
  238.    call checklhadir(1-window)
  239.  
  240.    if sourcelhadir then do
  241.       if windowpath='' then quitit("Error, no destination directory selected!")
  242.  
  243.       if lhadir then do
  244.          call createdirs
  245.          windowpath='T:LhADir'port'/'lhasubdir
  246.          store2=lhapath'::'lhaname'::'lhasubdir
  247.          end
  248.  
  249.       parse var store lhapath'::'lhaname'::'lhasubdir
  250.       call lhaextract
  251.  
  252.       if lhadir then do
  253.          parse var store2 lhapath'::'lhaname'::'lhasubdir
  254.          source=windowpath
  255.          entries=0
  256.          call lhaadd
  257.          end
  258.       else do
  259.          rescan 1-window
  260.          setwintitle '"LhADir archive list"'
  261.          end
  262.       if topline='' then topline="OK"
  263.       end
  264.    else
  265.       if lhadir then call lhaadd
  266.                 else copy
  267.    return
  268.  
  269.  
  270. domakedir:
  271.  
  272.    result=''
  273.    getstring '"Enter directory name"'
  274.    dirtomake=result
  275.    if dirtomake=='' then call quitit
  276.    if lhadir then do  /* create empty dir in archive */
  277.       call createdirs(dirtomake'/')
  278.       address command 'LhA r -q -e -r -Qw -Qo "'lhapath || lhaname'" T:LhADir'port'/' '"'lhasubdir || dirtomake'"'
  279.       if rc>0 then topline="Error while adding to archive."
  280.               else topline="Directory created."
  281.       delete 'T:LhADir'port
  282.       busy on
  283.       call lhalist
  284.       call showlhadir
  285.       end
  286.    else do
  287.       if upper(right(dirtomake,4))='.LHA' then do  /* create new archive */
  288.          call open('emptyarchive',windowpath || dirtomake,'W')
  289.          call writech('emptyarchive','00'x)
  290.          call close('emptyarchive')
  291.          topline="Empty archive created."
  292.          rescan window
  293.          end
  294.       else makedir '"'dirtomake'"'  /* normal makedir */
  295.       end
  296.    return
  297.  
  298.  
  299. dogetsizes:
  300.  
  301.    if lhadir then do
  302.  
  303.       status 8 window  /* get number of dirs selected */
  304.       n=result
  305.       getselecteddirs '/'
  306.       thesedirs=result
  307.       ndirs=0
  308.       do n
  309.          ndirs=ndirs+1
  310.          parse var thesedirs dirname.ndirs '/' thesedirs
  311.          fileinfo '"'dirname.ndirs'"' '/'
  312.          parse var result . '/' filesize '/'
  313.          if filesize>0 then ndirs=ndirs-1  /* already calculated */
  314.          end
  315.  
  316.       call initreadlist
  317.       dirsize.=0
  318.       dirsecs.=0
  319.  
  320.       do while nextline~="-------- ------- ----- --------- --------"
  321.  
  322.          name=nextline
  323.          fileinfo=readln('tempfile')
  324.          nextline=readln('tempfile')
  325.          if left(nextline,1)=':' then nextline=readln('tempfile')
  326.  
  327.          if upper(left(name,complen))==compare then do
  328.             dirname=substr(name,complen+1)
  329.             if pos('/',dirname)>0 then do
  330.                parse var dirname dirname '/'
  331.                do i=1 to ndirs
  332.                   if upper(dirname)==upper(dirname.i) then do
  333.                      toptext windowpath || name
  334.                      parse var fileinfo size . 24 date 34 time .
  335.                      call convertdate
  336.                      dirsize.i=dirsize.i+size
  337.                      if seconds>dirsecs.i then dirsecs.i=seconds
  338.                      leave
  339.                      end
  340.                   end
  341.                end
  342.             end
  343.          end
  344.       call close('tempfile')
  345.  
  346.       do i=1 to ndirs
  347.          addfile '"'dirname.i'"' dirsize.i '1' dirsecs.i '"" ----RWED 0 0'
  348.          selectfile '"'dirname.i'"'
  349.          end
  350.       displaydir
  351.       end
  352.  
  353.    getsizes
  354.    return
  355.  
  356.  
  357. doversion:
  358.  
  359.    if entries=0 then thisfile='REXX:LhADir.dopus'
  360.    toptext "Searching for version string..."
  361.    address command 'Version >T:Version.temp' thisfile 'FULL'
  362.    call open('tempfile','T:Version.temp','R')
  363.    topline=readln('tempfile')
  364.    call close ('tempfile')
  365.    delete 'T:Version.temp'
  366.    return
  367.  
  368.  
  369. /************************************************
  370.  *                                              *
  371.  *  Subroutine to show the contents of an LhA   *
  372.  *  archive in a Directory Opus window.         *
  373.  *                                              *
  374.  ************************************************/
  375.  
  376. showlhadir:
  377.  
  378.    call initreadlist
  379.    status 13 window set '"'lhapath||lhaname'/'lhasubdir'"'
  380.    toptext "Listing archive..."  /* toptext will obscure error message */
  381.    setwintitle '"LhADir archive list"'
  382.  
  383.    ndirs=0
  384.    now=date('I')*86400 + time('S')
  385.  
  386.    do while nextline~="-------- ------- ----- --------- --------"
  387.  
  388.       name=nextline
  389.       fileinfo=readln('tempfile')
  390.       nextline=readln('tempfile')
  391.       if left(nextline,1)=':' then do
  392.          parse var nextline 3 comment
  393.          nextline=readln('tempfile')
  394.          end
  395.       else comment=''
  396.  
  397.       if upper(left(name,complen))==compare then do
  398.          name=substr(name,complen+1)
  399.          if name~=='' then do
  400.             if pos('/',name)=0 then do  /* it's a file */
  401.                parse var fileinfo size . 24 date 34 time 43 atts .
  402.                call convertdate
  403.                addfile '"'name'"' size '-1' seconds '"'comment'"' atts '0 0'
  404.                end
  405.             else do                     /* it's a dir */
  406.                parse var name name '/'
  407.                flag=0
  408.                do i=ndirs to 1 by -1
  409.                   if upper(name)==upper(dirname.i) then do
  410.                      flag=1
  411.                      leave
  412.                      end
  413.                   end
  414.                if ~flag then do  /* a new dir */
  415.                   ndirs=ndirs+1
  416.                   dirname.ndirs=name
  417.                   addfile '"'name'"' '"" 1' now '"" ----RWED 0 0'
  418.                   end
  419.                end
  420.             end
  421.          end
  422.       end
  423.    call close('tempfile')
  424.    displaydir
  425.    return
  426.  
  427.  
  428. checklhadir:
  429.  
  430.    parse arg thiswin
  431.    status 13 thiswin  /* get window path */
  432.    windowpath=result
  433.    test=upper(windowpath)
  434.    cuthere=pos('.LHA/',test)
  435.    if cuthere=0 then cuthere=pos('.LZH/',test)
  436.    if cuthere=0 then cuthere=pos('.RUN/',test)
  437.    lhadir=(cuthere>0)
  438.    if lhadir then do
  439.       cutagain=lastpos('/',windowpath,cuthere)
  440.       if cutagain=0 then cutagain=pos(':',windowpath)
  441.       lhapath=left(windowpath,cutagain)
  442.       lhaname=substr(windowpath,cutagain+1,cuthere-cutagain+3)
  443.       lhasubdir=substr(windowpath,cuthere+5)
  444.       end
  445.    return
  446.  
  447.  
  448. lhaextract:
  449.  
  450.    status 8 window  /* get number of dirs selected */
  451.    anydirs=(result>0)
  452.    flag=anydirs & lhasubdir~==''
  453.    if anydirs then lhaopts='x -q -a -C0 -Qo'
  454.               else lhaopts='e -q -x2 -a -C0 -Qw -Qo'
  455.    if flag then do
  456.       makedir '"'windowpath'LhADir'port'"'
  457.       busy on
  458.       destdir=windowpath'LhADir'port'/'
  459.       end
  460.    else destdir=windowpath
  461.  
  462.    call open('actionfile','T:actionfile'port,'W')
  463.    call writeln('actionfile','"'destdir'"')
  464.  
  465.    do i=1 to entries
  466.       call getnextitem
  467.       if flag then moveit.i=selected
  468.       call patchname
  469.       if filetype<0 then call writeln('actionfile','"'lhasubdir || patched'"')
  470.                     else call writeln('actionfile','"'lhasubdir || patched'/#?"')
  471.       selectfile '"'selected'" 0 1'
  472.       end
  473.  
  474.    call close('actionfile')
  475.    if follow then scrolltoshow 0
  476.  
  477.    toptext "Extracting from archive..."
  478.    address command 'LhA' lhaopts '"'lhapath || lhaname'" @T:actionfile'port
  479.    if rc>0 then topline="Error while extracting from archive."
  480.    delete 'T:actionfile'port
  481.    busy on
  482.  
  483.    if flag then do
  484.       do i=1 to entries
  485.          move '"'windowpath'LhADir'port'/'lhasubdir || moveit.i'" "'windowpath'"'
  486.          busy on
  487.          end
  488.       delete '"'windowpath'LhADir'port'"'
  489.       busy on
  490.       end
  491.    return
  492.  
  493.  
  494. lhaadd:
  495.  
  496.    flag=(upper(right(source,length(lhasubdir)))=upper(lhasubdir))
  497.    if flag then homedir=left(source,length(source)-length(lhasubdir))
  498.    else do  /* all files must be copied to T: before they can be added */
  499.       homedir='T:LhADir'port'/'
  500.       call createdirs
  501.       end
  502.    call open('actionfile','T:actionfile'port,'W')
  503.    call writeln('actionfile','"'homedir'"')
  504.  
  505.    if entries=0 then do  /* copying between two archives */
  506.       call writeln('actionfile','#?')
  507.       flag=0  /* delete the temp dir afterwards */
  508.       end
  509.  
  510.    do entries
  511.       call getnextitem
  512.       call writeln('actionfile','"'lhasubdir || selected'"')
  513.       if ~flag then do
  514.          copy '"' || source || selected'" "T:LhADir'port'/'lhasubdir'"'
  515.          busy on
  516.          end
  517.       selectfile '"'selected'" 0 1'
  518.       end
  519.  
  520.    call close('actionfile')
  521.    toptext "Adding to archive..."
  522.    address command 'LhA r -q -e -r -Qo "'lhapath || lhaname'" @T:actionfile'port
  523.    if rc>0 then topline="Error while adding to archive."
  524.            else topline="OK"
  525.    if ~flag then delete 'T:LhADir'port
  526.    delete 'T:actionfile'port
  527.    busy on
  528.    call swapactive
  529.    call lhalist
  530.    call showlhadir
  531.    call swapactive
  532.    return
  533.  
  534.  
  535. lhalist:
  536.  
  537.    toptext "Listing archive..."
  538.    address command 'LhA >T:LhADir.list'port 'vv -N -Qw -Qo "'lhapath || lhaname'"'
  539.    if rc>0 then call quitit("Error while listing archive.")
  540.    return
  541.  
  542.  
  543. /************************************************
  544.  *                                              *
  545.  *  EAV subroutine to convert date and time to  *
  546.  *  seconds past 01-Jan-78.                     *
  547.  *                                              *
  548.  *  Example input: date='03-Jun-93'             *
  549.  *                 time='18:34:05'              *
  550.  *                                              *
  551.  ************************************************/
  552.  
  553. convertdate:
  554.  
  555.    parse var time hours ':' minutes ':' seconds .
  556.    parse var date day '-' month '-' year .
  557.    month=pos(month,'  JanFebMarAprMayJunJulAugSepOctNovDec')/3
  558.    month=right(month,2,'0')
  559.    century=19+(year<78)
  560.    thisdate=century || year || month || day
  561.    seconds=seconds + minutes*60 + hours*3600 + date('i',thisdate,'S')*86400
  562.    return
  563.  
  564.  
  565. getnextitem:
  566.  
  567.    getnextselected
  568.    selected=result
  569.    if follow then scrolltoshow '"'selected'"'
  570.    fileinfo '"'selected'"' '/'
  571.    parse var result . '/' . '/' . '/' filetype '/'
  572.    return
  573.  
  574.  
  575. createdirs:
  576.  
  577.    parse arg subdirs
  578.    subdirs='T:LhADir'port'/'lhasubdir || subdirs
  579.    lastone=lastpos('/',subdirs)
  580.    cuthere=0
  581.    do until cuthere=lastone
  582.       cuthere=pos('/',subdirs,cuthere+1)
  583.       makedir '"'left(subdirs,cuthere-1)'"'
  584.       end
  585.    busy on
  586.    return
  587.  
  588.  
  589. checkconfig:
  590.  
  591.    query dirflags
  592.    olddirflags=result
  593.    if olddirflags<0 then olddirflags=256+olddirflags  /* bug in DOpus? */
  594.    if bittst(d2c(olddirflags),5) then do
  595.       request "The config setting 'Re-read changed buffers'"lf"must be switched off. Shall I do this for you?"
  596.       if ~result then call quitit("Error, config setting 'Re-read changed buffers' must be switched off.")
  597.       modify dirflags olddirflags-32
  598.       end
  599.  
  600.    query updateflags
  601.    follow=bittst(d2c(result),1)  /* scroll window to follow operations? */
  602.  
  603.    query deleteflags
  604.    olddelflags=result
  605.    modify deleteflags 8  /* don't ask when deleting internal */
  606.    return
  607.  
  608.  
  609. swapactive:
  610.  
  611.    otherwindow
  612.    window=1-window
  613.    return
  614.  
  615.  
  616. patchname:
  617.  
  618.    /* Patch for problem with LhA's -Qw option. */
  619.    patched=translate(selected,'?????????','[]()#~%|*')
  620.    return
  621.  
  622.  
  623. initreadlist:
  624.  
  625.    if ~exists(lhapath || lhaname) then call quitit("Error, file '"lhaname"' not found.")
  626.    if ~exists('T:LhADir.list'port) then call lhalist  /* someone deleted it */
  627.    call open('tempfile','T:LhADir.list'port,'R')
  628.    nextline=readln('tempfile')
  629.    parse var nextline "'" thisarc "':"
  630.    if upper(thisarc)~==upper(lhapath || lhaname) then do  /* it's another archive's list */
  631.       call close('tempfile')
  632.       call lhalist
  633.       call open('tempfile','T:LhADir.list'port,'R')
  634.       call readln('tempfile')
  635.       end
  636.    do 2
  637.       call readln('tempfile')  /* waste these 2 lines */
  638.       end
  639.    compare=upper(lhasubdir)
  640.    complen=length(compare)
  641.    nextline=readln('tempfile')
  642.    return
  643.  
  644.  
  645. syntax:
  646.  
  647.    call quitit("Syntax Error" rc"," errortext(rc) "in line" sigl".")
  648.  
  649.  
  650. quitit:
  651.  
  652.    parse arg topline
  653.    modify deleteflags olddelflags       /* restore user prefs */
  654.    if topline~='' then toptext topline  /* display final message */
  655.    if pos('Error',topline)>0 then beep  /* an error occurred */
  656.    busy off                             /* busy mouse pointer off */
  657.    exit                                 /* stop script here */
  658.