--- Merging r21470 into '.':

D    utils/checkcvs.pp
--- Merging r21471 into '.':
U    utils/rmcvsdir.pp
--- Merging r21472 into '.':
U    utils/delp.pp

# revisions: 21470,21471,21472
r21470 | marco | 2012-06-03 13:16:17 +0200 (Sun, 03 Jun 2012) | 3 lines
Changed paths:
   D /trunk/utils/checkcvs.pp

 * removed checkcvs. We stopped using CVS 7 years ago, and don't check $Log:'s
   that often anymore. There is nothing worth keeping from this source (which is by me btw)
r21471 | marco | 2012-06-03 13:25:37 +0200 (Sun, 03 Jun 2012) | 2 lines
Changed paths:
   M /trunk/utils/rmcvsdir.pp

 * adding a copyright banner and a short description.
r21472 | marco | 2012-06-03 14:36:56 +0200 (Sun, 03 Jun 2012) | 2 lines
Changed paths:
   M /trunk/utils/delp.pp

 * changed delp from unit dos to unit sysutils. (path lengths)

git-svn-id: branches/fixes_2_6@21636 -

.gitattributes

@@ -12752,7 +12752,6 @@ utils/Makefile svneol=native#text/plain
 utils/Makefile.fpc svneol=native#text/plain
 utils/README.txt svneol=native#text/plain
 utils/bin2obj.pp svneol=native#text/plain
-utils/checkcvs.pp svneol=native#text/plain
 utils/creumap.pp svneol=native#text/plain
 utils/data2inc.exm -text
 utils/data2inc.pp svneol=native#text/plain

utils/checkcvs.pp

@@ -1,238 +0,0 @@
-Program checkcvs;
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team.
-
-    A simple filter program which displays what happened on CVS today.
-
-    Without parameters it shows the newest CVS log entry.
-    If you specify a nummeric parameter smaller than 365,
-    CheckCvs searches for ALL entries n days back.
-    Great to quickly check what changed after an update etc.
-
-    Todo : add getopts and some switches to increase configurability.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-Uses Dos;
-
-Const bufferlimit=10000;
-
-Type
-   Array12type = ARRAY [1..12] Of longint;
-
-Const
-   MonthCumm : Array12type = (0,31,59,90,120,151,181,212,243,273,304,334);
-
-Function LeapYr( Year : longint) : boolean;
-Begin
-   LeapYr := (Year Mod 4 = 0) And ((Year Mod 100 <> 0) Or (Year Mod 400 = 0));
-End;
-
-Function DayNr( Day,Month,Year: longint) : longint;
-{Modified version. A daynr function that returns daynr since 1-1-1980.
-Leapyears ok till 2100.}
-
-Var
-   i : longint;
-Begin
-   i := MonthCumm[Month]+Day;
-   If (Month > 2) And LeapYr( Year ) Then
-      INC( i );
-   INC(I,(Year-1980)*365 + (Year-1976) SHR 2);
-   {  - (Year -2000) DIV 100; makes it ok till 2400}
-   DayNr := i;
-End ;
-
-{TrimLeft isn't overloaded for pascal string yet.}
-
-Procedure LTrim(Var P : String;Ch:Char);
-
-Var I,J : longint;
-
-Begin
-  I := Length(P);      { Keeping length in local data eases optimalisations}
-  If (I>0) Then
-    Begin
-      J := 1;
-      while (P[J]=Ch) AND (J<=I) Do INC(J);
-      If J>1 Then
-        Delete(P,1,J-1);
-    End;
-End;
-
-Var NewestBuffer : PChar;       {Buffer containing the "newest" data}
-    BufferIndex  : Longint;     {Bytes in buffer}
-    NewestDate   : Longint;     {Newest date (the one in NewestBuffer)}
-    CheckMode    : boolean;     {Do we search newest, or all msgs since
-                                  <parameter> days ago}
-
-Procedure CheckAfile(Name:String;Firstday:longint);
-{Outputs filename and relevant CVSLOG entries for all files that have log
-entries newer than FirstDay.}
-
-Var  F               : Text;
-     Lines           : longint;
-     Found           : boolean;
-     S,S2,S3         : String;
-     ValidLogEntry   : boolean;
-     Day,Month,Year  : longint;
-     PosDate         : longint;
-     FirstLogEntry   : boolean;
-
-Procedure AppendLine (S : String);
-
-Begin
- If CheckMode Then
-  Begin
-   If (Length(S)<>0) AND ((Length(S)+BufferIndex+2)<BufferLimit) Then
-    Begin
-     Move(S[1],NewestBuffer[BufferIndex],Length(S));
-     Inc(BufferIndex,Length(S));
-     {$Ifndef Unix}
-      NewestBuffer[BufferIndex]:=#13;
-      Inc(BufferIndex);
-     {$EndIf}
-     NewestBuffer[BufferIndex]:=#10;
-     Inc(BufferIndex);
-    End;
-  End
- Else
-  Begin
-   Writeln(S);
-  End;
-End;
-
-Function ReadTwo(Position:longint): longint; INLINE;
-
-Begin
-  ReadTwo := (ord(S[Position])-48)*10+(ord(S[Position+1])-48);
-End;
-
-Begin
-  Assign(F,Name);
-  Reset(F);
-  Lines := 5;
-  Found := FALSE;
-                                       in the first lines}
-    ReadLn(F,S);
-    LTrim(S,' ');
-      Found := TRUE;
-    dec(Lines);
-  Until ((Lines=0) Or Found) Or EOF(F);
-  If Not Found Then
-   BEGIN
-    Close(F);
-    EXIT;
-   END;
-  Found := FALSE;
-                                       in the first lines}
-    ReadLn(F,S);
-    LTrim(S,' ');
-    If Copy(S,1,5)='$Log:' Then
-      Found := TRUE;
-  Until (Found) Or EOF(F);
-  If Not Found Then
-    EXIT;
-  ValidLogEntry := FALSE;
-  FirstLogEntry := TRUE;
-  Repeat
-    ReadLn(F,S);
-    S3 := S;
-    LTrim(S3,' ');
-    If Copy(S3,1,8)='Revision' Then
-      Begin
-        ValidLogEntry := FALSE;
-        S2 := S;
-        Delete(S3,1,9);
-        S := S3;
-        Lines := Pos(' ',S);
-        If Lines<>0 Then
-          Begin
-            Delete(S,1,Lines);
-            LTrim(S,' ');
-            Year := ReadTwo(1)*100+ReadTwo(3);
-            Month := ReadTwo(6);
-            Day := ReadTwo(9);
-            PosDate := DayNr(Day,Month,Year);
-            If CheckMode Then
-             Begin
-              If PosDate>=NewestDate Then
-               Begin
-                NewestDate:=PosDate;
-                BufferIndex:=0;
-                ValidLogEntry := TRUE;
-                AppendLine('File: '+Name);
-                AppendLine(S2);
-               End;
-             End
-            Else
-            If (PosDate>=FirstDay) Then
-              Begin
-                ValidLogEntry := TRUE;
-                If FirstLogEntry Then
-                  Begin
-                    FirstLogEntry := FALSE;
-                    AppendLine('File: '+Name);
-                  End;
-                AppendLine(S2);
-              End;
-          End;
-      End
-    Else
-      If ValidLogEntry And (S[1]<>'}') Then
-       AppendLine(S);
-  Until EOF(F) Or (S[1]='}');
-  Close(F);
-End;
-
-Var year, month, mday, wday: word;
-    TheDay,Days            : longint;
-    D                      : SearchRec;
-
-Procedure SearchExtension(Pattern:String);
-
-Begin
-  FindFirst(Pattern,Anyfile-Directory,D);
-  while DosError = 0 Do
-                   Begin
-                     CheckAFile(D.Name,TheDay);
-                     FindNext(D);
-                   End;
-  FindClose(D);
-End;
-
-
-Begin
-  GetMem(NewestBuffer,bufferlimit);
-  BufferIndex:=0;
-  NewestDate:=0;
-  GetDate(year, month, mday, wday);      {GetDate}
-  TheDay := DayNr(MDay,Month,Year);        {Convert to something linear}
-
-  If ParamCount<>0 Then                  {If parameter is nummeric, subtract}
-    Begin
-     CheckMode:=FALSE;
-      Val(ParamStr(1),Days,Year);
-      If (Year=0) And (Days<365) Then      {  n days from current date}
-        dec(TheDay,Days);
-    End
-   Else
-    CheckMode:=True;
-  SearchExtension('*.pp');               {Scan files in simple FindFirst loop}
-  SearchExtension('*.pas');
-  SearchExtension('*.inc');
-  If CheckMode AND (BufferIndex<>0) THEN
-   Begin
-    For Days:=0 TO BufferIndex-1 Do
-     Write(NewestBuffer[Days]);
-   End;
-  FreeMem(NewestBuffer,bufferlimit);
-End.

utils/delp.pp

@@ -1,5 +1,5 @@
 {
-    Copyright (c) 1999-2010 by Peter Vreman, Michael Van Canneyt
+    Copyright (c) 1999-2012 by Peter Vreman, Michael Van Canneyt
 
     Deletes all files generated for Pascal (*.exe,units,objects,libs)
 
@@ -20,14 +20,15 @@
  ****************************************************************************}
 program Delp;
 
+{$mode ObjFPC}{$H+}
+
 uses
-  dos,getopts;
+  Sysutils,getopts;
 
 const
-  Version   = 'Version 1.2';
+  Version   = 'Version 1.3';
   Title     = 'DelPascal';
-  Copyright = 'Copyright (c) 1999-2010 by the Free Pascal Development Team';
-
+  Copyright = 'Copyright (c) 1999-2012 by the Free Pascal Development Team';
 
 function DStr(l:longint):string;
 var
@@ -45,33 +46,20 @@ begin
   DStr:=TmpStr;
 end;
 
-
-Procedure EraseFile(Const HStr:String);
-var
-  f : file;
+procedure dosfsplit(path:ansistring;var dir,name,ext:ansistring);
+// implementation of dos.fsplit on top of sysutils routines to avoid
+// path length issues.
+// a lot of old tooling uses fsplit, maybe move this to sysutils?
 begin
-  Assign(f,Hstr);
-  {$I-}
-   Erase(f);
-  {$I+}
-  if ioresult<>0 then;
+  dir:=extractfiledir(dir);
+  name:=changefileext(extractfilename(path),'');
+  ext:=extractfileext(path);
+  if (length(ext)>0) and (ext[1]='.') then
+    delete(ext,1,1);
 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;
@@ -117,16 +105,16 @@ function MatchesMask(What, Mask: string): boolean;
   end;
 
 var
-  D1,D2 : DirStr;
-  N1,N2 : NameStr;
-  E1,E2 : Extstr;
+  D1,D2 : ansistring;
+  N1,N2 : ansistring;
+  E1,E2 : ansistring;
 begin
 {$ifdef Unix}
-  FSplit(What,D1,N1,E1);
-  FSplit(Mask,D2,N2,E2);
+  DosFSplit(What,D1,N1,E1);
+  DosFSplit(Mask,D2,N2,E2);
 {$else}
-  FSplit(Upper(What),D1,N1,E1);
-  FSplit(Upper(Mask),D2,N2,E2);
+  DosFSplit(Uppercase(What),D1,N1,E1);
+  DosFSplit(Uppercase(Mask),D2,N2,E2);
 {$endif}
   MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
 end;
@@ -191,9 +179,8 @@ begin
   Until C=EndOfOptions;
 end;
 
-
 var
-  Dir    : Searchrec;
+  Dir    : TSearchrec;
   Total  : longint;
   hp     : pmaskitem;
   found  : boolean;
@@ -231,24 +218,24 @@ begin
     BaseDir:=Paramstr(I);
     If BaseDir[Length(BaseDir)]<>DirectorySeparator then
       BaseDir:=BaseDir+DirectorySeparator;
-    FindFirst(basedir+'*.*',anyfile,Dir);
-    while (doserror=0) do
-      begin
-      hp:=masklist;
-      while assigned(hp) do
-        begin
-        if MatchesMask(Dir.Name,hp^.mask) then
-          begin
-          EraseFile(BaseDir+Dir.Name);
-          inc(hp^.Files);
-          inc(hp^.Size,Dir.Size);
-          break;
-          end;
-        hp:=hp^.next;
-        end;
-        FindNext(Dir);
+    if FindFirst(basedir+'*.*',faanyfile,Dir)=0 then
+     begin
+       repeat
+         hp:=masklist;
+         while assigned(hp) do
+           begin
+             if MatchesMask(Dir.Name,hp^.mask) then
+               begin
+                 DeleteFile(BaseDir+Dir.Name);
+                 inc(hp^.Files);
+                 inc(hp^.Size,Dir.Size);
+                 break;
+               end;
+             hp:=hp^.next;
+           end;
+        until FindNext(Dir)<>0;
+        FindClose(Dir);
       end;
-    FindClose(Dir);
     Inc(I);
     end;
   { Write Results }

utils/rmcvsdir.pp

@@ -1,3 +1,27 @@
+{
+    Copyright (c) 1999-2012 by Marco van de Voort and Free Pascal Core 
+
+    Recursively deletes .cvs and .svn directories essentially "exporting" a
+    repository in place.  Typically used when cleaning out old checkouts, to
+    prepare for a GNU diff session with another checkout.
+
+    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 rmcvsdir;
+
 uses
    sysutils;