+ delp tool which deletes all generated pascal files

utils/Makefile

@@ -1,5 +1,5 @@
 #
-# Makefile generated by fpcmake v0.99.13 on 1999-11-25 23:45
+# Makefile generated by fpcmake v0.99.13 on 1999-12-01 14:14
 #
 
 defaultrule: all
@@ -132,7 +132,7 @@ endif
 # Targets
 
 override DIROBJECTS+=$(wildcard tply h2pas)
-override EXEOBJECTS+=ppufiles ppudump ppumove ppdep ptop rstconv data2inc fpcmake
+override EXEOBJECTS+=ppufiles ppudump ppumove ppdep ptop rstconv data2inc fpcmake delp
 
 # Clean
 

utils/Makefile.fpc

@@ -4,7 +4,7 @@
 
 [targets]
 dirs=tply h2pas
-programs=ppufiles ppudump ppumove ppdep ptop rstconv data2inc fpcmake
+programs=ppufiles ppudump ppumove ppdep ptop rstconv data2inc fpcmake delp
 
 [clean]
 units=ppu ptopu

utils/delp.pp

@@ -0,0 +1,217 @@
+{
+    $Id$
+    Copyright (c) 1999 by Peter Vreman
+
+    Deletes all files generated for Pascal (*.exe,units,objects,libs)
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+program Delp;
+uses
+  dos;
+
+const
+  version='v1.00';
+
+function DStr(l:longint):string;
+var
+  TmpStr : string[32];
+  i : byte;
+begin
+  Str(l,tmpstr);
+  i:=Length(TmpStr);
+  while (i>3) do
+   begin
+     i:=i-3;
+     if TmpStr[i]<>'-' then
+      Insert('.',TmpStr,i+1);
+   end;
+  DStr:=TmpStr;
+end;
+
+
+Procedure EraseFile(Const HStr:String);
+var
+  f : file;
+  i : word;
+begin
+  Assign(f,Hstr);
+  {$I-}
+   Erase(f);
+  {$I+}
+  i:=ioresult;
+end;
+
+
+function MatchesMask(What, Mask: string): boolean;
+
+  function upper(const s : string) : string;
+  var
+    i  : longint;
+  begin
+     for i:=1 to length(s) do
+      if s[i] in ['a'..'z'] then
+       upper[i]:=char(byte(s[i])-32)
+      else
+       upper[i]:=s[i];
+     upper[0]:=s[0];
+  end;
+
+  Function CmpStr(const hstr1,hstr2:string):boolean;
+  var
+    found : boolean;
+    i1,i2 : longint;
+  begin
+    i1:=0;
+    i2:=0;
+    found:=true;
+    while found and (i1<length(hstr1)) and (i2<=length(hstr2)) do
+     begin
+       if found then
+        inc(i2);
+       inc(i1);
+       case hstr1[i1] of
+         '?' :
+           found:=true;
+         '*' :
+           begin
+             found:=true;
+             if (i1=length(hstr1)) then
+              i2:=length(hstr2)
+             else
+              if (i1<length(hstr1)) and (hstr1[i1+1]<>hstr2[i2]) then
+               begin
+                 if i2<length(hstr2) then
+                  dec(i1)
+               end
+             else
+              if i2>1 then
+               dec(i2);
+           end;
+         else
+           found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
+       end;
+     end;
+    if found then
+      found:=(i1>=length(hstr1)) and (i2>=length(hstr2));
+    CmpStr:=found;
+  end;
+
+var
+  D1,D2 : DirStr;
+  N1,N2 : NameStr;
+  E1,E2 : Extstr;
+begin
+{$ifdef linux}
+  FSplit(What,D1,N1,E1);
+  FSplit(Mask,D2,N2,E2);
+{$else}
+  FSplit(Upper(What),D1,N1,E1);
+  FSplit(Upper(Mask),D2,N2,E2);
+{$endif}
+  MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
+end;
+
+type
+  PMaskItem=^TMaskItem;
+  TMaskItem=record
+    Mask  : string[15];
+    Files : longint;
+    Size  : longint;
+    Next  : PMaskItem;
+  end;
+
+var
+  masklist : pmaskitem;
+
+procedure AddMask(s:string);
+var
+  maskitem : PMaskItem;
+  i : longint;
+begin
+  repeat
+    i:=pos(' ',s);
+    if i=0 then
+     i:=length(s)+1;
+    New(maskitem);
+//    fillchar(maskitem^,sizeof(tmaskitem),0);
+    maskitem^.mask:=Copy(s,1,i-1);
+    maskitem^.next:=masklist;
+    masklist:=maskitem;
+    Delete(s,1,i);
+  until s='';
+end;
+
+
+var
+  Dir    : Searchrec;
+  Total  : longint;
+  hp     : pmaskitem;
+  found  : boolean;
+begin
+  AddMask('*.exe *.so *.dll');
+  AddMask('ppas.bat ppas.sh link.res fpcmaked');
+  AddMask('*.tpu *.tpp *.tpw *.tr');
+  AddMask('*.log *.bak');
+  AddMask('*.ppu *.o *.a *.s');
+  AddMask('*.ppw *.ow *.aw *.sw');
+  AddMask('*.pp1 *.o1 *.a1 *.s1');
+  AddMask('*.ppo *.oo *.ao *.so');
+  WriteLn('DelPascal ',version,' (C) 1999 Peter Vreman');
+  Writeln;
+  FindFirst('*.*',$20,Dir);
+  Total:=0;
+  while (doserror=0) do
+   begin
+     hp:=masklist;
+     while assigned(hp) do
+      begin
+        if MatchesMask(Dir.Name,hp^.mask) then
+         begin
+           EraseFile(Dir.Name);
+           inc(hp^.Files);
+           inc(hp^.Size,Dir.Size);
+           break;
+         end;
+        hp:=hp^.next;
+      end;
+     FindNext(Dir);
+   end;
+{Write Results}
+  found:=false;
+  hp:=masklist;
+  while assigned(hp) do
+   begin
+     if hp^.Files>0 then
+      begin
+        WriteLn(' - Removed ',hp^.Files:2,' ',hp^.Mask,' (',DStr(hp^.Size)+' Bytes)');
+        inc(Total,hp^.Size);
+        found:=true;
+      end;
+     hp:=hp^.next;
+   end;
+  if not found then
+   WriteLn(' - No Redundant Files Found!')
+  else
+   WriteLn(' - Total ',DStr(Total),' Bytes Freed');
+end.
+{
+  $Log$
+  Revision 1.1  1999-12-01 22:45:04  peter
+    + delp tool which deletes all generated pascal files
+
+}
+