program prune;

{Goes thru your files one by one and asks whether you want to delete
  them.  Actually DEC's REV is more useful.}

var
 files:text;
 retloc:integer;
 resp:char;
 gn,jfn:packed record case Boolean of
	true:(ret:integer);
	false:(bits:set of 0..35);
	end;
 group:packed array[1:200]of char;
 next:integer;
function curjfn(var f:file):integer;extern;
procedure prfile;
 (*this procedure prints a line showing all versions of the current
	file, if it is the first in its group and there are more
	than one version*)
 var mult:Boolean;  (* multiple versions *)
 begin
 if gn.bits and [13,14,15,16] = []
   then write(tty,'  ');		(* if same group, indent *)
 jsys(30B%jfns\;101B%.priou\,0:files,0);
 if (gn.bits and [13,14,15,16] <> [])	(* we are in a new group *)
    and (5 in jfn.bits)			(* we are wildcarding vers.*)
  then begin
  mult := false;
  jsys(30B%jfns\;group,10000B:files,0); (* cur. file, with * for ver *)
  jsys(20B%gtjfn\,2;[2,11,13,14,17],group;input);
  while nextfile(input) <> 0 do
    begin
    mult := true;
    write(tty, ',');
    jsys(30B%jfns\;101B%.priou\,0:input,10B:0);  (* vers. number *)
    end;
  if mult
    then begin
    writeln(tty);
    write(tty,'  ');
    jsys(30B%jfns\;101B%.priou\,0:files,0);
    end
  end
 end;

{Call this to delete a file, when user type Y}
procedure doit;
 begin
 write(tty,'es');  {complete the YES}
 jsys(26B%delf\,2,retloc;400000B:files);  {kill the file}
   {tell him whether it worked}
 if retloc = 2
   then writeln(tty,'  [OK]')
   else begin
   writeln(tty);
   write(tty,'% '); jsys(11B%erstr\,3;101B%.priou\,400000B:-1,0);
   writeln(tty);
   end;
 end;

{This if the user said N, don't delete the file}
procedure dont;
 begin
 writeln(tty,'o');  {complete the NO}
 end;

{This if user did something other than Y or N}
procedure badcom;
 begin
 writeln(tty);
 writeln(tty,'?  Type Y to delete the file, N not to, S to see it before deciding');
 end;

{Here if the user wants to see his file - just the first 4 lines}
procedure show;
 var line:packed array[1:132]of char;lines,len:integer;
 begin
 writeln(tty,'ee it');  {complete the SEE IT}
 reset(files);
 lines := 0;
 while (lines < 4) and not eof(files) do
  begin
  readln(files,line:len);
  if len > 0
    then begin
    writeln(tty,line:len);
    lines := lines+1;
    end;
  end;
 close(files);
 end;

begin
gn.bits := [13,14,15,16]; (* new file *)
reset(tty,'',0,0,0,1);      (* map lower case *)
loop  {loop until he gives you a valid file spec}
  write(tty,'Files: ');
  jsys(20B%gtjfn\,2,retloc;120123B:-3,100B:101B;files);
  writeln(tty);
  exit if retloc = 2;
  write(tty,'% '); jsys(11B%erstr\,3;101B%.priou\,400000B:-1,0);
  writeln(tty);
  end;
jfn.ret := curjfn(files);

repeat  {this is the main loop - over all files in the wildcard}
 repeat	 (* until get a legal response*)
  prfile; write(tty,'?  ');
  jsys(73B%pbin\;;resp);
  if ord(resp) >= 140B
    then resp := chr(ord(resp) - 40B);
  case resp of
   'Y': doit;
   'N': dont;
   'S': show;
   others: badcom
   end
  until resp in ['Y','N'];
 gn.ret := nextfile(files)
 until gn.ret = 0
end.