program REVISE(input,output,device,exfile,namefile);

{ REVISE scans through RT-11 device directories for files matching given wild
-card specifications and gives the user the option of inspecting or deleting
the file.

  Largely based in concept on the REV program for DEC 10/20 but without
    some of the features (i.e. no rename or back ).

  Contains a wild card string matching system in Pascal.

  Also contains a Pascal definition of RT-11 directory structure and
    provides routines for opening the directory and scanning successive
    entries therein.

  Also contains a routine for interpreting RT-11 directory date entries
    into DD-Mmm-YY format.

  REVISE was written to compile under OREGON SOFTWARE Pascal-2 and RT-11
    by:
                     Peter A. Stockwell,
                     Biochemistry Dept.,
                     University of Otago,
                     Dunedin,
                     New Zealand.
    during SEP-84.

  Since this program is highly system specific (to RT-11) the Pascal code
    uses some features that are specific to OS Pascal-2 as well as to
    RT-11.  I have not always bothered to flag these, since I do not
    view portability of this program as being of particular importance.
 }

const
  %include 'dircon.pas';

type
  %include 'dirtyp.pas';

  fnamestring = packed array [1..fnamelen] of char;

var
  %include 'dirvar.pas';

  pattern : fnamestring;

  lpattern: integer;

  errstat: integer;

  namefile: text;             { of names to be deleted }

  exfile: text;               { for opening the files for examination/del }

  delcount: integer;

  ndelete: integer;


procedure getlin(var cline: fnamestring;
                 var clength: integer);

external;         { from the OS pascal library - gets a command line }


procedure exitst(estatus: integer);

external;         { from OS pascal library - exits with given status }



{                                                            }
{                     function confirm                       }
{                                                            }

function confirm(default: char): boolean;

{ to prompt for a Y/N response and give the default value if <CR> only
  is given }

external;

function confirm;

  var
    byte: char;

    valid: boolean;


  begin
  valid := false;
  while (not valid) do
    begin
    write(' (Y/N) [',default,'] > ');
    if eoln then
      begin
      byte := default;
      readln;
      end
    else
      readln(byte);
    if byte in ['Y','y','N','n'] then
      begin
      if byte in ['Y','y'] then
        confirm := true
      else
        confirm := false;
      valid := true;
      end
    end;                  { of while loop }
  end;                    { of function confirm }



  {                                                            }
  {                    function linein                         }
  {                                                            }

  function linein(var xfile: text; var line: packed array
                  [lstart..lstop: integer] of char;
                  lazy: boolean): integer;


  { reads a line from input file into conformant array line, truncating
    at range of array.
    If line exceeds array, a message is printed at the terminal.
    On eof, a length of -1 is returned }

  var
    i, j, nchars, lpt: integer;

    byte: char;

    stopit: boolean;

  begin
  nchars := 0;
  lpt := lstart;
  if eof(xfile) then
    linein := -1
  else
    begin
  if (not lazy) then
    if eoln(xfile) then
      readln(xfile);
    if eof(xfile) then
      linein := -1
    else
      begin
      stopit := false;
      while not stopit do
        begin
        if eoln(xfile) or eof(xfile) then
          stopit := true
        else
          begin
          read(xfile,byte);
          if lpt <= lstop then
            begin
            line[lpt] := byte;
            nchars := nchars + 1;
            end
          else
            begin
            stopit := true;
            nchars := lstop - lstart + 1;
            writeln('Line truncated at ',nchars:3,' chars: ');
            if nchars <= 50 then
              j := nchars - lstart + 1
            else
              j := 51 - lstart;
            for i := lstart to j do
              write(line[i]);
            if nchars > 50 then
              write('...');
            writeln;
            end;
          lpt := lpt + 1;
          end;          { of if eoln else clause }
        end;              { of while loop }
      linein := nchars;
      end;                  { of if eof else clause }
    end;
    for i := lpt to lstop do
      line[i] := ' ';
  end;                          { of function linein }





  {                                                            }
  {                    function stringout                      }
  {                                                            }

  procedure stringout(var xfile: text; var line: packed array
                      [lstart..lstop: integer] of char;
                      nchars: integer);

  external;

  procedure stringout;

{  to write out a string of characters from a conformant array up to the
   limit nchars }

  var
    limit: integer;

    sptr: integer;

    abyte: char;


  begin
  limit := lstart + nchars - 1;
  for sptr := lstart to limit do
    begin
    abyte := line[sptr];
    if abyte in [' '..'~'] then
      write(xfile,abyte)
    else
      write(xfile,'?');
    end;
  end;                      { of procedure stringout }



{                                                            }
{                  procedure radasc                          }
{                                                            }

procedure radasc(rad50: uword16;
                 var asciistring: threechars);

external;      { in dirsub.pas - converts word to 3 ascii chars }



{                                                            }
{                      function dirnxt                       }
{                                                            }

function dirnxt(var pattern: packed array
                  [plower..pupper: integer] of char;
                var fname: packed array
                  [lower..upper: integer] of char;
                var thisentry: basicentry): integer;

external;

{ returns position of next filename which matches pattern, else returns 0 }



{                                                            }
{                      procedure dirdat                      }
{                                                            }

procedure dirdat(var xfile: text;
                 dateword: uword16);

external;

{ the file 'DIRDAT.PAS' which contains the routine for translating
  and printing/writing the date from rt-11 directory format into standard
  system date format }



{                                                            }
{                     function dirini                        }
{                                                            }

function dirini(var devname: packed array
                  [lower..upper: integer] of char): boolean;

external;         { in file dirsub.pas }


{                                                            }
{                    procedure dspfil                        }
{                                                            }

procedure dspfil(var xfile: text;
                 var fname: packed array
                   [lower..upper: integer] of char);

external;          { in file dspfil.pas }



{                                                            }
{                   procedure showcommand                    }
{                                                            }

procedure showcommand;

  begin
  writeln;
  writeln('REVISE commands:');
  writeln;
  writeln('     H (elp)  } show this display');
  writeln('     ?        }');
  writeln;
  writeln('     A (bort) } abort revision without deleting files');
  writeln('     Q (uit)  }');
  writeln('     E (xit)    stop revision and delete marked files');
  writeln('     I (nfo)    give full details of directory entry');
  writeln('     T (ype)    type the file for examination');
  writeln('     D (elete)  mark this file for deletion');
  writeln;
  writeln('     C (ontinue) or <RET> for next file');
  writeln;
  end;                   { of procedure showcommand }

{                                                            }
{                    procedure showinfo                      }
{                                                            }

procedure showinfo(var xfile: text;
                   var fname: packed array
                     [lower..upper: integer] of char;
                   var direntry: basicentry;
                   fposition: uword16);

{ displays at xfile all of the fields of a basic RT-11 directory entry - 
  rather lazily expects the name to be translated into ascii already }

  var
    iptr: integer;

    asc3: threechars;

  begin
  writeln(xfile);
  stringout(xfile,fname,fnamelen);
  writeln(xfile,' - details:');
  writeln(xfile,
'          Position   = ',fposition:-7,' ( = ',fposition:1,'.)');
  writeln(xfile);
  with direntry do
    begin
    write(xfile,'          Status     = ',status:-7);
    if (status and protected) <> 0 then
      writeln(xfile,'   = protected')
    else
      writeln(xfile);
    for iptr := 1 to rnamelen do
      begin
      write(xfile,'          Name[',iptr:1,']    = ',radname[iptr]:-7);
      radasc(radname[iptr],asc3);
      write(xfile,' ( = "');
      stringout(xfile,asc3,3);
      writeln(xfile,'")');
      end;
    writeln(xfile,
'          Size       = ',filelength:-7,' ( = ',filelength:1,'.)');
    writeln(xfile,
'          Tentative  = ',tentword:-7,' (only used if file tentative)');
    write(xfile,'          Created on = ',created:-7,' = ');
    dirdat(xfile,created);
    end;
  writeln(xfile);
  writeln(xfile);
  end;                       { of procedure showinfo }



{                                                            }
{                    function revisefiles                    }
{                                                            }

function revisefiles: integer;

{ revises files according to given filespec and returns the number to be
  deleted }

  var
    ndeleted: integer;

    response: char;

    nstring: fnamestring;

    nposition: integer;

    iptr: integer;

    thisentry: basicentry;

    nextentry: boolean;

    exfile: text;


  procedure formline;

    begin
    stringout(output,nstring,fnamelen);
    write(' (',thisentry.filelength:1,', ');
    dirdat(output,thisentry.created);
    write('): ');
    end;               { of procedure formline }


  begin
  ndeleted := 0;
  repeat
    nposition := dirnxt(pattern,nstring,thisentry);
    if nposition <> 0 then
      begin
      nextentry := false;
      repeat
        formline;
        if not eoln then
          read(response)
        else
          response := 'C';            { default is continue }
        readln;
        if response in ['D','A','Q','E','T','I','C',
                         'd','a','q','e','t','i','c'] then
          case response of
            'A','Q','a','q':              { abort/quit }
              begin
              nposition := -1;
              ndeleted := 0;
              nextentry := true;
              end;
            'E','e':                      { exit }
              begin
              nposition := -1;
              nextentry := true;
              end;
            'T','t':                      { type }
              dspfil(exfile,nstring);
            'I','i':                      { information }
              showinfo(output,nstring,thisentry,nposition);
            'D','d':                      { delete }
              if (thisentry.status and protected) = 0 then
                begin
                stringout(namefile,nstring,fnamelen);
                writeln(namefile);
                ndeleted := ndeleted + 1;
                nextentry := true;
                end
              else
                begin
                writeln('Can''t delete: file is protected');
                writeln;
                end;
            'C','c':                      { continue }
              nextentry := true;
            end              { of case body }
        else
          showcommand;
      until nextentry;
      end;
  until nposition <= 0;
  revisefiles := ndeleted;
  close(exfile);
  end;                       { of procedure revisefiles }
  


begin                      { revise main program body }
writeln('REVISE: (v 1.0) for revising files in disk directories.');
while lpattern <= 0 do
  begin
  getlin(pattern,lpattern);
  if pattern[1] = '?' then
    begin
    writeln;
    writeln(
'REVISE expects a valid RT-11 file specification which may contain');
    writeln(
'  wildcard characters.  (e.g. DY0:*P%D*.LST)  If a device name only is');
    writeln(
'  to be used then it must be concluded with a colon otherwise it will');
    writeln(
'  be considered as a filename.');
    writeln;
    lpattern := -1;
    end;
  if lpattern <= 0 then
    write('Filespecs? ');
  end;
if dirini(pattern) then
  begin
  rewrite(namefile,'sy:delnam.lst','/temp',errstat);
  if errstat < 0 then
    begin
    writeln;
    writeln('?REVISE-F-Unable to open temporary file "SY:DELNAM.LST"');
    exitst(4);
    end;
  showcommand;
  ndelete := revisefiles;
  if ndelete > 0 then
    begin
    writeln;
    write('Delete ',ndelete:1,' files');
    if confirm('N') then
      begin
      writeln;
      break(namefile);
      reset(namefile);
      for delcount := 1 to ndelete do
        begin
        lpattern := linein(namefile,pattern,false);
        if lpattern > 0 then
          begin
          reset(exfile,pattern,,errstat);
          if errstat >= 0 then
            begin
            write('?REVISE-I-deleting ');
            stringout(output,pattern,fnamelen);
            delete(exfile);
            writeln;
            end;
          end;
        end;
      end;
    end;
  end
else
  begin
  writeln;
  writeln('?REVISE-F-Unable to open directory.');
  writeln;
  exitst(4);
  end;
end.