home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / opus / v4 / lhadir / lhadir.dopus < prev    next >
Text File  |  1977-12-31  |  21KB  |  884 lines
  1. /*
  2.   $VER: LhADir.dopus 1.11 (12.1.95)
  3.   Copyright © 1993-1995 by Edmund Vermeulen.
  4.   Placed in the public domain. No restrictions on distribution or usage.
  5.  
  6.   LhADir.dopus is an ARexx script for Directory Opus that allows you to show
  7.   the contents of LhA archives in a DOpus window and operate on the files and
  8.   directories inside the archive as if it is a normal directory.
  9. */
  10.  
  11. ver='$VER: LhADir.dopus 1.11C (12.1.95)'  /* for compiled version */
  12.  
  13. signal on syntax    /* intercept syntax errors */
  14. options results        /* need results */
  15. options failat 21    /* external commands are allowed return code 20 */
  16. numeric digits 10    /* needed for convertdate routine */
  17. lf='a'x            /* ascii code for linefeed */
  18.  
  19. parse arg command portname . '"' selected '"'
  20. upper command
  21. if portname~=='' then
  22.    address(portname)
  23. else
  24.    portname=address()
  25. parse var portname '.' port  /* port number */
  26.  
  27. busy 'ON'        /* busy mouse pointer on */
  28. status 3        /* get active window */
  29. win=result
  30. status 9 win        /* get number of selected entries */
  31. entries=result
  32. checkabort        /* reset abort flag */
  33.  
  34. call checkconfig
  35. call checklhadir(win)
  36.  
  37. if selected~=='' then do
  38.    filetype=-1
  39.    entries=1
  40.    end
  41. else
  42.    if entries>0 then
  43.       call getnextone
  44.  
  45. topline=""
  46. listlha=0
  47. notmove=command~='MOVE'
  48.  
  49. select
  50.    when command='GETDIR' then
  51.       call dogetdir
  52.    when command='BROWSE' then
  53.       call dobrowse
  54.    when command='PARENT' then
  55.       call doparent
  56.    when command='ROOT' then
  57.       call doroot
  58.    when command='DELETE' then
  59.       call dodelete
  60.    when command='COPY' then
  61.       call docopy
  62.    when command='MOVE' then
  63.       call domove
  64.    when command='MAKEDIR' then
  65.       call domakedir
  66.    when command='GETSIZES' then
  67.       call dogetsizes
  68.    otherwise do
  69.       async=pos('|'command'|','|READ|ANSIREAD|HEXREAD|')>0
  70.       if entries=0|async|command='VERSION' then
  71.      n=1
  72.       else
  73.      n=entries
  74.       thisfile=''
  75.       internal=1
  76.  
  77.       do until n=0
  78.      n=n-1
  79.      if lhadir&entries>0 then do
  80.         if filetype>0 then
  81.            call quitit("Error, directories cannot be viewed.")
  82.         address command 'LhA e -q -x2 -Qo "'patch(lhafile,0)'" T: "'patch(lhasubdir||selected,1)'"'
  83.         if rc>0 then
  84.            call quitit("Error while extracting file.")
  85.         thisfile='"T:'selected'"'
  86.         end
  87.  
  88.      select  /* internal commands */
  89.         when command='READ' then
  90.            read thisfile
  91.         when command='ANSIREAD' then
  92.            ansiread thisfile
  93.         when command='HEXREAD' then
  94.            hexread thisfile
  95.         when command='SHOW' then
  96.            show thisfile
  97.         when command='PLAY' then
  98.            play thisfile
  99.         when command='LOOPPLAY' then
  100.            loopplay thisfile
  101.         when command='PRINT' then
  102.            print thisfile
  103.         when command='ICONINFO' then
  104.            iconinfo thisfile
  105.         when command='RUN' then
  106.            run thisfile
  107.         otherwise do  /* external commands */
  108.            internal=0
  109.            if ~lhadir&entries>0 then
  110.           thisfile='"'winpath||selected'"'
  111.            query screenname
  112.            if result=0 then
  113.           screenname=portname  /* for compatibility */
  114.            else
  115.           screenname=result
  116.  
  117.            select
  118.           when command='VERSION' then
  119.              call doversion
  120.           when command='UNDMS' then
  121.              call doundms
  122.           when command='MULTIVIEW' then
  123.              address command 'MultiView' thisfile 'PUBSCREEN' screenname 'FONTNAME' fontname 'FONTSIZE' fontsize
  124.           when command='AMIGAGUIDE' then
  125.              address command 'AmigaGuide' thisfile 'PUBSCREEN' screenname
  126.           when command='VIEWTEK' then
  127.              address command 'VT >NIL:' thisfile
  128.           when command='RETINADISPLAY' then
  129.              address command 'Work:RetinaTools/RetinaDisplay' thisfile
  130.           when command='FASTVIEW' then
  131.              address command 'FastView' thisfile DITHER
  132.           otherwise
  133.              call quitit("Error, LhADir.dopus does not support the command '"command"'.")
  134.           end
  135.            abort=0
  136.            end
  137.         end
  138.  
  139.      if internal then
  140.         abort=result~=0
  141.      busy 'ON'
  142.      if lhadir&entries>0 then do
  143.         if async then do
  144.            if ~show('l','rexxsupport.library') then
  145.           call addlib('rexxsupport.library',0,-30)  /* needed for delay() */
  146.            call delay(75)  /* wait a bit before deleting */
  147.            end
  148.         delete '"T:'selected'"'
  149.         busy 'ON'
  150.         end
  151.      else
  152.         if internal then
  153.            n=0
  154.      if thisfile~=='' then do
  155.         selectfile '"'selected'" 0 1'  /* deselect item */
  156.         if topline=="" then
  157.            topline="OK"
  158.         end
  159.      checkabort
  160.      if result|abort then
  161.         call quitit("Aborted...")
  162.      if n>0 then
  163.         call getnextone
  164.      end
  165.       end
  166.    end
  167.  
  168. call quitit(topline)  /* finished */
  169.  
  170.  
  171. dobrowse:
  172. dogetdir:
  173.  
  174.    if entries>0 then
  175.       if filetype>0 then  /* list a new dir */
  176.      if lhadir then
  177.         lhasubdir=lhasubdir||selected'/'
  178.      else
  179.         winpath=winpath||selected'/'
  180.       else do  /* list an archive file */
  181.      if pos('|'upper(right(selected,4)'|'),'|.LHA|.LZH|.RUN|')=0 then
  182.         call quitit("Error, LhADir.dopus can only list LhA archives.")
  183.      if lhadir then do
  184.         request "This is an archive in an archive."lf"Extract it to 'T:' and then list it?"
  185.         uset=result
  186.         if uset then
  187.            destpath='T:'
  188.         else do
  189.            busy 'ON'
  190.            status 13 1-win  /* get window path */
  191.            destpath=result
  192.            if result=='' then
  193.           call quitit("Aborted...")
  194.            request "Use the current destination window"lf"'"destpath"' instead?"
  195.            if ~result then
  196.           call quitit("Aborted...")
  197.            end
  198.         busy 'ON'
  199.         toptext "Extracting from archive..."
  200.         address command 'LhA e -q -x2 -a -C0 -Qo "'patch(lhafile,0)'" "'destpath'" "'patch(lhasubdir||selected,1)'"'
  201.         if rc>0 then
  202.            call quitit("Error while extracting from archive.")
  203.         if ~uset&command='GETDIR' then
  204.            rescan 1-win
  205.         lhafile=destpath||selected
  206.         end
  207.      else
  208.         lhafile=winpath||selected
  209.      lhadir=1
  210.      lhasubdir=''
  211.      listlha=1
  212.      end
  213.    else  /* rescan current dir */
  214.       if lhadir then do
  215.      status 6 win  /* get number of entries */
  216.      listlha=result>0
  217.      end
  218.  
  219.    if command='BROWSE' then do
  220.       selectfile '"'selected'" 0 1'
  221.       call swapactive
  222.       end
  223.    if lhadir then do
  224.       call showlhadir
  225.       topline="OK"
  226.       end
  227.    else
  228.       status 13 win 'SET "'winpath'"'
  229.    return
  230.  
  231.  
  232. doparent:
  233.  
  234.    if lhadir&lhasubdir~=='' then do
  235.       cuthere=lastpos('/',left(lhasubdir,length(lhasubdir)-1))
  236.       lhasubdir=left(lhasubdir,cuthere)
  237.       call showlhadir
  238.       topline="OK"
  239.       end
  240.    else
  241.       parent
  242.    return
  243.  
  244.  
  245. doroot:
  246.  
  247.    if lhadir&lhasubdir~=='' then do
  248.       lhasubdir=''
  249.       call showlhadir
  250.       topline="OK"
  251.       end
  252.    else
  253.       root
  254.    return
  255.  
  256.  
  257. dodelete:
  258.  
  259.    if lhadir then do
  260.       if entries=0 then
  261.      call quitit
  262.       if notmove then do
  263.      if askdelete then do
  264.         status 26 'SET Delete'
  265.         request "Do you really wish to delete selected entries"lf"from archive?"
  266.         if ~result then
  267.            call quitit("Aborted...")
  268.         busy 'ON'
  269.         end
  270.      call getall
  271.      end
  272.       call open('actionfile','T:actionfile'port,'w')
  273.       do i=1 to entries
  274.      if type.i>0 then
  275.         wild='/#?'
  276.      else
  277.         wild=''
  278.      call writeln('actionfile','"'patch(lhasubdir||name.i,1)||wild'"')
  279.      removefile '"'name.i'" 0'
  280.      end
  281.       call close('actionfile')
  282.       toptext "Deleting from archive..."
  283.       address command 'LhA d -q -Qp -Qo "'patch(lhafile,0)'" @T:actionfile'port
  284.       if rc>0 then do
  285.      topline="Error while deleting from archive."
  286.      listlha=1
  287.      call showlhadir
  288.      end
  289.       else do
  290.      topline="OK"
  291.      displaydir
  292.      end
  293.       delete 'T:actionfile'port
  294.       delete 'T:LhADir.list'port  /* archive contents has changed */
  295.       busy 'ON'
  296.       end
  297.    else do
  298.       if notmove then
  299.      restore
  300.       delete
  301.       end
  302.    return
  303.  
  304.  
  305. domove:
  306. docopy:
  307.  
  308.    if entries=0 then
  309.       call quitit
  310.    problem=0
  311.    src=winpath
  312.    s_lhadir=lhadir
  313.    s_lhafile=lhafile
  314.    s_lhasubdir=lhasubdir
  315.    call checklhadir(1-win)
  316.  
  317.    if s_lhadir then do
  318.       if winpath=='' then do
  319.      errortext="No destination directory selected!"
  320.      toptext errortext
  321.      notify errortext
  322.      call quitit
  323.      end
  324.       if lhadir then
  325.      winpath='T:LhADir'port'/'lhasubdir
  326.       call getall
  327.       call lhaextract
  328.       if lhadir then do
  329.      src=winpath
  330.      call lhaadd
  331.      end
  332.       else
  333.      if problem then
  334.         rescan 1-win
  335.      else do
  336.         do i=1 to entries
  337.            fileinfo '"'name.i'"' '1c'x
  338.            info.i=result
  339.            end
  340.         call swapactive
  341.         do i=1 to entries
  342.            parse var info.i name '1c'x size '1c'x '1c'x type '1c'x '1c'x days '1c'x seconds '1c'x comment '1c'x atts '1c'x
  343.            if type>0 then
  344.           size=0
  345.            addfile '"'name'"' size type seconds+days*86400 '"'comment'"' atts '0 0'
  346.            end
  347.         displaydir
  348.         call swapactive
  349.         end
  350.       end
  351.    else
  352.       if lhadir then do
  353.      if ~notmove then do
  354.         cuthere=lastpos('/',lhafile)
  355.         if cuthere=0 then
  356.            cuthere=pos(':',lhafile)
  357.         name=substr(lhafile,cuthere+1)
  358.         if left(lhafile,length(src))==src then do
  359.            name=substr(lhafile,length(src)+1)
  360.            parse var name name '/'
  361.            fileinfo '"'name'"' '1c'x
  362.            parse var result '1c'x '1c'x '1c'x '1c'x sel '1c'x
  363.            if sel then do
  364.           errortext="You can't move an archive into itself!"
  365.           toptext errortext
  366.           notify errortext
  367.           call quitit
  368.           end
  369.            end
  370.         end
  371.      call getall
  372.      call lhaadd
  373.      end
  374.       else do  /* normal copy or move */
  375.      restore
  376.      if notmove then
  377.         copy
  378.      else
  379.         move
  380.      end
  381.  
  382.    if (s_lhadir|lhadir)&~notmove&~problem then do
  383.       lhadir=s_lhadir
  384.       lhafile=s_lhafile
  385.       lhasubdir=s_lhasubdir
  386.       checkabort
  387.       if result then
  388.      call quitit("Aborted...")
  389.       call dodelete
  390.       end
  391.    return
  392.  
  393.  
  394. domakedir:
  395.  
  396.    getstring '"Enter directory name or archive name.lha"'
  397.    dirtomake=result
  398.    if rc|dirtomake=='' then
  399.       call quitit
  400.    now=date('i')*86400+time('s')
  401.    if lhadir then do  /* create empty dir in archive */
  402.       call createdirs(dirtomake'/')
  403.       address command 'LhA a -q -e -r -Qo "'patch(lhafile,0)'" T:LhADir'port'/' '"'patch(lhasubdir||dirtomake,1)'"'
  404.       if rc>0 then
  405.      topline="Error while adding to archive."
  406.       else do
  407.      topline="Directory created."
  408.      addfile '"'dirtomake'" 0 1' now '"" ----RWED 0 1'
  409.      end
  410.       delete 'T:LhADir'port
  411.       delete 'T:LhADir.list'port
  412.       busy 'ON'
  413.       end
  414.    else do
  415.       if upper(right(dirtomake,4))=='.LHA' then  /* create new archive */
  416.      if open('emptyarchive',winpath||dirtomake,'w') then do
  417.         call writech('emptyarchive','0'x)
  418.         call close('emptyarchive')
  419.         topline="Empty archive created."
  420.         protect '"'winpath||dirtomake'" RWD'
  421.         addfile '"'dirtomake'" 1 -1' now '"" ----RW-D 0 1'
  422.         end
  423.      else
  424.         topline="Error creating archive."
  425.       else do  /* normal makedir */
  426.      restore
  427.      makedir '"'dirtomake'"'
  428.      end
  429.       end
  430.    return
  431.  
  432.  
  433. dogetsizes:
  434.  
  435.    if lhadir then do
  436.       status 6 win  /* get total number of entries */
  437.       tot=result
  438.       status 8 win  /* get number of dirs selected */
  439.       seldirs=result
  440.       n=1
  441.       do i=1 to tot
  442.      getentry i
  443.      dirname.n=result
  444.      fileinfo '"'result'"' '1c'x
  445.      parse var result '1c'x filesize '1c'x '1c'x type '1c'x sel '1c'x
  446.      if type>0&sel&filesize=0 then
  447.         n=n+1
  448.      end
  449.       dirsize.=0
  450.       dirsecs.=0
  451.       ndirs=n-1
  452.       call readlist(0)
  453.       end
  454.    getsizes
  455.    return
  456.  
  457.  
  458. doversion:
  459.  
  460.    if entries=0 then
  461.       thisfile='REXX:LhADir.dopus'
  462.    toptext "Searching for version string..."
  463.    address command 'Version >T:Version.temp' thisfile 'FILE FULL'
  464.    call open('tempfile','T:Version.temp','r')
  465.    topline=readln('tempfile')
  466.    call close ('tempfile')
  467.    delete 'T:Version.temp'
  468.    return
  469.  
  470.  
  471. doundms:
  472.  
  473.    if entries=0|upper(right(selected,4))~=='.DMS' then
  474.       call quitit("No DMS file selected.")
  475.    drive.1='DF0:'
  476.    drive.0='RAD:'
  477.    status 26 'SET' drive.1
  478.    status 27 'SET' drive.0
  479.    toptext thisfile
  480.    request "Please insert disk and select"lf"destination drive for DMS file"
  481.    dest=result
  482.    busy 'ON'
  483.    checkabort
  484.    if result then
  485.       call quitit("Aborted...")
  486.  
  487.    address command 'Run >NIL: <NIL: DMS <NIL: >PIPE:dmsout WRITE' thisfile 'TO' drive.dest 'NOTEXT'
  488.    address command 'Status >T:ProcessNo COMMAND DMS'
  489.    call open('temp','T:ProcessNo','r')
  490.    process=readln('temp')
  491.    close('temp')
  492.    delete 'T:ProcessNo'
  493.    busy 'ON'
  494.  
  495.    nomess=1
  496.    errors=''
  497.    buffer=''
  498.    call open('dmsout','PIPE:dmsout','r')
  499.    do until eof('dmsout')
  500.       buffer=buffer||readch('dmsout',25)
  501.       here=verify(buffer,'a0d'x,'m')
  502.       if here>0 then do
  503.      line=left(buffer,here-1)
  504.      if nomess&left(line,7)=='No Disk' then do
  505.         toptext "Insert disk in" drive.dest
  506.         nomess=0
  507.         end
  508.      parse var line ' ' line
  509.      buffer=substr(buffer,here+1)
  510.      if pos('ERROR',upper(line))>0 then do
  511.         errors=errors||lf||line
  512.         beep
  513.         busy 'ON'
  514.         end
  515.      if left(line,9)=='unPacking' then do
  516.         toptext selected '-' line
  517.         checkabort
  518.         if result then do
  519.            address command 'Break' process 'C'
  520.            topline="Aborted..."
  521.            end
  522.         end
  523.      end
  524.       end
  525.    call close('dmsout')
  526.    if errors~=='' then do
  527.       toptext thisfile
  528.       notify "Error Report"||lf||errors
  529.       end
  530.    return
  531.  
  532.  
  533. checklhadir:
  534.  
  535.    arg checkwin
  536.    status 13 checkwin  /* get window path */
  537.    winpath=result
  538.    test=upper(winpath)
  539.    cuthere=pos('.LHA/',test)
  540.    if cuthere=0 then
  541.       cuthere=pos('.LZH/',test)
  542.    if cuthere=0 then
  543.       cuthere=pos('.RUN/',test)
  544.    lhadir=cuthere>0
  545.    if lhadir then do
  546.       lhafile=left(winpath,cuthere+3)
  547.       lhasubdir=substr(winpath,cuthere+5)
  548.       end
  549.    return
  550.  
  551.  
  552. lhaextract:
  553.  
  554.    status 8 win  /* get number of dirs selected */
  555.    anydirs=result>0
  556.    mustmove=anydirs&s_lhasubdir~==''
  557.    if mustmove then
  558.       destpath=winpath'LhADir'port'/'
  559.    else
  560.       destpath=winpath
  561.  
  562.    call open('actionfile','T:actionfile'port,'w')
  563.    do i=1 to entries
  564.       if type.i>0 then
  565.      wild='/#?'
  566.       else
  567.      wild=''
  568.       call writeln('actionfile','"'patch(s_lhasubdir||name.i,1)||wild'"')
  569.       end
  570.    call close('actionfile')
  571.  
  572.    if anydirs then
  573.       lhacmd='x'
  574.    else
  575.       lhacmd='e -x2'
  576.    toptext "Extracting from archive..."
  577.    address command 'LhA' lhacmd '-q -a -C0 -Qo "'patch(s_lhafile,0)'" "'destpath'" @T:actionfile'port
  578.    problem=rc>0
  579.    if problem then
  580.       topline="Error while extracting from archive."
  581.    else do
  582.       topline="OK"
  583.       if notmove then
  584.      none
  585.       end
  586.  
  587.    if mustmove then do
  588.       do i=1 to entries
  589.      move '"'winpath'LhADir'port'/'s_lhasubdir||name.i'" "'winpath'"'
  590.      end
  591.       delete '"'winpath'LhADir'port'"'
  592.       end
  593.    delete 'T:actionfile'port
  594.    busy 'ON'
  595.    return
  596.  
  597.  
  598. lhaadd:
  599.  
  600.    mustcopy=upper(right(src,length(lhasubdir)))~==upper(lhasubdir)
  601.    if mustcopy then do  /* all files must be copied to T: before they can be added */
  602.       homedir='T:LhADir'port'/'
  603.       call createdirs
  604.       end
  605.    else
  606.       homedir=left(src,length(src)-length(lhasubdir))
  607.    call open('actionfile','T:actionfile'port,'w')
  608.    call writeln('actionfile','"'patch(homedir,0)'"')
  609.  
  610.    if s_lhadir then
  611.       call writeln('actionfile','#?')
  612.    else do
  613.       do i=1 to entries
  614.      call writeln('actionfile','"'patch(lhasubdir||name.i,0)'"')
  615.      if mustcopy then do
  616.         copy '"'||src||name.i||'" "T:LhADir'||port||'/'||lhasubdir||'"'
  617.         busy 'ON'
  618.         end
  619.      end
  620.       end
  621.    call close('actionfile')
  622.  
  623.    if pos('.LZH/',test)>0 then
  624.       method='-0'
  625.    else
  626.       method=''
  627.    toptext "Adding to archive..."
  628.    address command 'LhA r' method '-q -e -r -Qo "'patch(lhafile,0)'" @T:actionfile'port
  629.    problem=rc>0
  630.    if problem then
  631.       topline="Error while adding to archive."
  632.    else do
  633.       topline="OK"
  634.       if notmove then
  635.      none
  636.       end
  637.    delete 'T:actionfile'port
  638.    if mustcopy|s_lhadir then
  639.       delete 'T:LhADir'port
  640.    busy 'ON'
  641.    call swapactive
  642.    listlha=1
  643.    call showlhadir
  644.    call swapactive
  645.    return
  646.  
  647.  
  648. lhalist:
  649.  
  650.    address command 'LhA >T:LhADir.list'port 'vv -N -Qw -Qo "'lhafile'"'
  651.    if rc>0 then do
  652.       setwintitle '"<Directory not available>"'
  653.       call quitit("Error while listing archive.")
  654.       end
  655.    return
  656.  
  657.  
  658. getnextone:
  659.  
  660.    getnextselected
  661.    selected=result
  662.    if follow then
  663.       scrolltoshow '"'selected'"'
  664.    fileinfo '"'selected'"' '1c'x
  665.    parse var result '1c'x '1c'x '1c'x filetype '1c'x
  666.    return
  667.  
  668.  
  669. getall:
  670.  
  671.    status 6 win  /* get total number of entries */
  672.    tot=result
  673.    n=1
  674.    do i=1 to tot
  675.       getentry i
  676.       name.n=result
  677.       fileinfo '"'result'"' '1c'x
  678.       parse var result '1c'x '1c'x '1c'x type.n '1c'x sel '1c'x
  679.       if sel then
  680.      n=n+1
  681.       end
  682.    return
  683.  
  684.  
  685. createdirs:
  686.  
  687.    parse arg subdir
  688.    dirstocreate='T:LhADir'port'/'lhasubdir||subdir
  689.    here=0
  690.    do until here=0
  691.       here=pos('/',dirstocreate,here+1)
  692.       if here>0 then
  693.      makedir '"'left(dirstocreate,here-1)'"'
  694.       end
  695.    busy 'ON'
  696.    return
  697.  
  698.  
  699. swapactive:
  700.  
  701.    otherwindow
  702.    win=1-win
  703.    return
  704.  
  705.  
  706. showlhadir:
  707.  
  708.    status 13 win 'SET "'lhafile'/'lhasubdir'"'
  709.    toptext "Listing archive..."  /* toptext obscures error message */
  710.    setwintitle '"LhADir listed archive"'
  711.    now=date('i')*86400+time('s')
  712.    ndirs=0
  713.    call readlist(1)
  714.    return
  715.  
  716.  
  717. readlist:
  718.  
  719.    arg show  /* showdir or getsizes? */
  720.    if listlha|~exists('T:LhADir.list'port) then
  721.       call lhalist
  722.    call open('tempfile','T:LhADir.list'port,'r')
  723.    nextline=readln('tempfile')
  724.    parse var nextline 21 whicharc "':"
  725.    if upper(whicharc)~==upper(lhafile) then do  /* it's another archive's list */
  726.       call close('tempfile')
  727.       call lhalist
  728.       call open('tempfile','T:LhADir.list'port,'r')
  729.       call readln('tempfile')
  730.       end
  731.    do 2
  732.       call readln('tempfile')  /* waste these 2 lines */
  733.       end
  734.  
  735.    compstr=upper(lhasubdir)
  736.    complen=length(compstr)
  737.    nextline=readln('tempfile')
  738.  
  739.    do forever
  740.       name=nextline
  741.       infoline=readln('tempfile')
  742.       do while pos('% ',infoline)<22
  743.      name=infoline
  744.      infoline=readln('tempfile')
  745.      end
  746.       if name=='-------- ------- ----- --------- --------' then
  747.      leave
  748.       nextline=readln('tempfile')
  749.       if left(nextline,1)==':' then do
  750.      parse var nextline 3 comment
  751.      nextline=readln('tempfile')
  752.      end
  753.       else
  754.      comment=''
  755.  
  756.       if upper(left(name,complen))==compstr then do
  757.      name=substr(name,complen+1)
  758.      if name~==''&pos('"',name)=0 then do
  759.         if pos('/',name)>0 then do  /* it's a dir */
  760.            parse var name dirname '/'
  761.            olddir=0
  762.            i=ndirs+1
  763.            do while i>1&~olddir
  764.           i=i-1
  765.           olddir=upper(dirname)==upper(dirname.i)
  766.           end
  767.            if olddir&~show then do
  768.           toptext winpath||name
  769.           call convertdate
  770.           dirsize.i=dirsize.i+size
  771.           if seconds>dirsecs.i then
  772.              dirsecs.i=seconds
  773.           end
  774.            if show&~olddir then do  /* a new dir */
  775.           ndirs=ndirs+1
  776.           dirname.ndirs=dirname
  777.           addfile '"'dirname'" 0 1' now '"" ----RWED 0 0'
  778.           end
  779.            end
  780.         else  /* it's a file */
  781.            if show then do
  782.           call convertdate
  783.           addfile '"'name'"' size '-1' seconds '"'comment'"' atts '0 0'
  784.           end
  785.         end
  786.      end
  787.       end
  788.    call close('tempfile')
  789.    if ~show then
  790.       do i=1 to ndirs
  791.      addfile '"'dirname.i'"' dirsize.i '1' dirsecs.i '"" ----RWED 0 0'
  792.      selectfile '"'dirname.i'"'
  793.      end
  794.    displaydir
  795.    return
  796.  
  797.  
  798. convertdate:  /* convert a file's date stamp to seconds past 01-Jan-78 */
  799.  
  800.    parse var infoline size . '% ' day '-' month '-' year ' ' hours ':' minutes ':' seconds atts .
  801.    minus=day='00'
  802.    if minus then
  803.       day='01'
  804.    century=19+(year<78)
  805.    month=pos(month,'  JanFebMarAprMayJunJulAugSepOctNovDec')/3
  806.    month=right(month,2,'0')
  807.    if month='00' then
  808.       month='01'
  809.    seconds=seconds+minutes*60+hours*3600+(date('i',century||year||month||day,'s')-minus)*86400
  810.    return
  811.  
  812.  
  813. patch:  /* patch file names containing strange characters */
  814.  
  815.    parse arg patched,apostrophe
  816.    verstr='*#?|%()[]~'
  817.    if apostrophe then
  818.       verstr=verstr"'"
  819.    pos=1
  820.    do until here=0
  821.       here=verify(substr(patched,pos),verstr,'m')
  822.       if here>0 then do
  823.      pos=pos+here+1
  824.      patched=insert("'",patched,pos-3)
  825.      end
  826.       end
  827.    if left(patched,1)='@' then
  828.       patched='*'patched
  829.    return patched
  830.  
  831.  
  832. syntax:
  833.  
  834.    call quitit("Syntax Error" rc"," errortext(rc) "in line" sigl".")
  835.  
  836.  
  837. checkconfig:
  838.  
  839.    status 26
  840.    okaystring=result
  841.    status 27
  842.    cancelstring=result
  843.  
  844.    query dirflags
  845.    olddirflags=result
  846.    if olddirflags<0 then  /* bug in DOpus? */
  847.       olddirflags=256+olddirflags
  848.    if bittst(d2c(olddirflags),5) then do
  849.       request "The config setting 'Re-read changed buffers'"lf"must be switched off. Shall I do this for you?"
  850.       if ~result then do
  851.      remember  /* something to restore */
  852.      call quitit("Error, config setting 'Re-read changed buffers' must be switched off.")
  853.      end
  854.       modify dirflags olddirflags-32
  855.       end
  856.  
  857.    remember                /* remember user settings */
  858.    busy 'ON'
  859.    query updateflags
  860.    follow=bittst(d2c(result),1)        /* scroll window to follow operations? */
  861.    modify updateflags 0            /* no progress indicator */
  862.    query deleteflags
  863.    askdelete=bittst(d2c(result),0)    /* ask before deleting? */
  864.    modify deleteflags 8            /* don't ask when deleting internal */
  865.    modify replaceflags 1        /* don't ask when replacing internal */
  866.    modify iconflags 0            /* no icons please */
  867.    query font 2                /* text viewer font */
  868.    parse var result fontname '.font/' fontsize
  869.    return
  870.  
  871.  
  872. quitit:
  873.  
  874.    parse arg topline
  875.    status 26 'SET' okaystring        /* restore okay and */
  876.    status 27 'SET' cancelstring        /* cancel strings */
  877.    restore                   /* restore user settings */
  878.    if topline~=="" then
  879.       toptext topline            /* display final message */
  880.    if pos("Error",topline)>0 then
  881.       beep                /* an error occurred */
  882.    busy 'OFF'                /* busy mouse pointer off */
  883.    exit                    /* stop script here */
  884.