/*rx
    $VER: $Id: CutTree.mm,v 1.7 1994/06/20 01:08:10 tf Exp $

    Remove recursively all empty directories in a given path.

    This ARexx script needs the AmigaDOS commands "List", "Delete"
    and "Protect" available in your path.

    Initial revision by Tobias Ferber, 20-Mar-94
*/

options results
options failat 10

/* initialize globals */

pathname = ""
template = "PATH/K/A,AUTO/S"
tempfile = "T:CutTreeTemp." || pragma('Id')
tempsize = "T:CutTreeSizeTemp." || pragma('Id')
args     = ""
cliopts  = ""

dg       = 0  /* gauge increment */
gstepN   = 0

ESC      = '1b'x

signal on HALT
signal on BREAK_C
signal on BREAK_D

/* parse args */

do ac=1 while ac <= arg()
  av= arg(ac)
  select
    when upper(av) = "PATH" then do
      if ac < arg() then do
        ac= ac+1
        pathname= arg(ac)
        if words(pathname) < 1 then pathname= pragma('D')
        end
      else exit bad_args('Missing pathname after' ESC'bPATH'ESC'n keyword.')
      end /* PATH */

    when upper(av) = "AUTO" then cliopts = cliopts || 'a'

    otherwise exit bad_args('Unknown keyword:' ESC'b' || av || ESC'n')

  end /* select */

end /* do */

call pragma('W','N')


/* try to get missing pathname */

if words(pathname) < 1 then do
  cwd= strip(pragma('D'),'B','"')
  REQUESTFILE DRAWER '"'cwd'"' TITLE '"Delete empty drawers in ..."' DRAWERSONLY NOICONS SAVEMODE
  if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then pathname= result
  end

if words(pathname) < 1 then
  exit bad_args("Not enough arguments for CutTree...  Exiting...")

if ~exists(pathname) then do
  REQUESTCHOICE TITLE   '"CutTree Request"',
                BODY    '"CutTree failed to locate your directory*n*n' ||,
                        ESC'c'ESC'b' || pathname || ESC'n'ESC'l'       || '"',
                GADGETS '"Exit"'
  exit 10
  end

signal on ERROR
signal on IOERR

signal on FAILURE
/*signal on NOVALUE*/
signal on SYNTAX


/* do the hard part */

numflames= 0

COMPLETE 0; MESSAGE CLEAR; MESSAGE OPEN; WORKING '"Please wait..."'
MESSAGE '"Generating temporary index' tempfile 'from' pathname '..."'
address command 'List ALL DIRS DIR "' || pathname || '" LFORMAT "%p%n" NOHEAD TO "' || tempfile || '"'

CALL init_gauge(tempfile,2)

if ~open('fp',tempfile,'R') then do
  REQUESTCHOICE TITLE   '"CutTree Request"',
                BODY    '"Could not open temporary file*n*n'     ||,
                        ESC'c'ESC'b' || tempfile || ESC'n'ESC'l' || '"',
                GADGETS '"Exit"'
  exit 10
  end

do until eof('fp')

  pname= strip( readln('fp') )
  if (words(pname) > 0) & exists(pname) then do

    MESSAGE '"Processing' pname '..."'
    address command 'List ALL FILES DIR "' || pname || '" LFORMAT "%l" NOHEAD TO "' || tempsize || '"'
    CALL step_gauge(1)

    numfiles = 0
    if open('sfp',tempsize,'R') then do
      numbytes= 0
      do until eof('sfp')
        l = strip( readln('sfp') )
        if words(l) > 0 then do
          numbytes = numbytes + l /* I love REXX */
          numfiles = numfiles + 1
          end
        end
      call close('sfp')
      address command 'Delete QUIET FILE "'tempsize'"'

      if (numbytes = 0) & (numfiles = 0) then do
        MESSAGE '"'pname 'is empty ... removing ..."'
        address command 'Protect ALL QUIET FLAGS rwed FILE "' || pname || '"'
        address command 'Delete ALL QUIET FILE "' || pname || '"'
        numflames= numflames + 1
        end
      else MESSAGE '"'pname 'contains' numbytes 'bytes in' numfiles 'file(s)"'
      end
    else MESSAGE '"Error: could not open temporary file' tempsize'"'
    CALL step_gauge(1)
    end
  end
call close('fp')
MESSAGE '"done. ' numflames 'empty directories have been deleted."'
ADDRESS COMMAND 'Delete QUIET FILE "'tempfile'"'
call step_gauge(100)
IF POS('a',cliopts) > 0 THEN MESSAGE CLOSE
exit 0

/**/

bad_args: PROCEDURE EXPOSE template ESC
  PARSE ARG msg

  REQUESTCHOICE TITLE   '"CutTree Request"',
                BODY    '"' || msg || '*n*n'                     ||,
                        'CutTree args template:*n*n'             ||,
                        ESC'c'ESC'b' || template || ESC'n'ESC'l' || '"',
                GADGETS '"Okay"'
  RETURN 0

/*@*/


/* translate '"' into '*"' and '*' into '**' */

transquote: procedure
  parse arg s
  t= s
  q= max( lastpos('*',s), lastpos('"',s) )
  do while q > 0
    t= insert('*',t,q-1,1)
    s= left(s,q-1)
    q= max( lastpos('*',s), lastpos('"',s) )
    end
  return '"' || t || '"'


/* return the non-file part of a pathname */

pathonly: procedure
  parse arg path
  if (words(path) > 0) & (right(path,1) ~= ':') then do
    if right(path,1) = '/' then path= left(path,length(path)-1)
    if lastpos('/',path) > lastpos(':',path) then path= left(path,lastpos('/',path)-1)
                                             else path= left(path,lastpos(':',path))
    end
  return path


/* concatenate the filename to the pathname and return the resulting string */

tackon: procedure
  parse arg path,file
  do while left(file,1) = '/'
    file= substr(file,2)
    path= pathonly(path)
    end
  if (words(path) > 0) & (right(path,1) ~= '/') & (right(path,1) ~= ':') then path= path || '/'
  if (right(file,1) = '/') then file= left(file,length(file)-1)
  return path || file


/* create all non-existant directories in a path */

makepath: procedure
  parse arg path
  if right(path,1) = '/' then path= left(path,length(path)-1)
  if ~exists(path) then do
    call makepath( pathonly(path) )
    address command 'MakeDir NAME "'path'"'
    end
  return 0


/*
 * return   1  if the device or volume name in given pathname exists
 *             or if no device or volume was present (current device)
 *          0  if the device or volume name does not exist
 */

canexist: procedure
  parse upper arg path
  if pos(':',path) < 1 then return 1 /* current device */
  call pragma('W','N')
  return exists( left(path,lastpos(':',path)) )


/* stretch the blue completion bar */

step_gauge: PROCEDURE EXPOSE dg gstepN
  ARG increment
  gstepN= gstepN + 1
  c= MIN(TRUNC(gstepN * increment * dg),100)
  COMPLETE c
  IF c >= 100 THEN WORKING '"done."'
  RETURN 0


/* initialize the gauge increment by counting the #of steps to be performed */

init_gauge: PROCEDURE EXPOSE dg gstepN
  PARSE ARG fname,steps_per_entry

  dg = 0         /* gauge increment */
  gstepN = 0     /* #of performed steps */

  IF OPEN('fp',fname,'R') THEN DO
    numentries= 0
    DO UNTIL EOF('fp')
      IF WORDS(READLN('fp')) > 0 THEN
        numentries= numentries+1
      END
    WORKING '"Processing' numentries 'entries..."'
    dg = 100 / (numentries * steps_per_entry)
    CALL SEEK('fp',0,'B')
    CALL CLOSE('fp')
    END

  /*MESSAGE CLEAR; MESSAGE OPEN*/
  /*COMPLETE 0*/
  RETURN 0


/* error/break handling */

IOERR:
ERROR:
  err= rc
  ESC = '1b'x

  signal off ERROR
  signal off IOERR

  WORKING '"I/O problem trapped... Execution halted."'
  MESSAGE '"I/O problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"CutTree Error Trap' err'"',
                BODY    '"There was a problem with external I/O in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                || '"',
                GADGETS '"I''ll better exit"'
  exit


FAILURE:
NOVALUE:
SYNTAX:
  err= rc
  ESC = '1b'x

  signal off FAILURE
  signal off NOVALUE
  signal off SYNTAX

  WORKING '"Internal problem trapped... Execution halted."'
  MESSAGE '"Internal problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"CutTree Internal Error' err'"',
                BODY    '"CutTree seems to have an internal problem in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                    || '"',
                GADGETS '"I''ll better exit"'
  exit


HALT:
BREAK_C:
BREAK_D:
  signal off HALT
  signal off BREAK_C
  signal off BREAK_D

  WORKING '"Break signal trapped... Execution halted."'
  MESSAGE '"Break signal trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"CutTree Break Trap"',
                BODY    '"Script execution halted."',
                GADGETS '"Stop"'
  exit