paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-07 01:26:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: removed TGatherFileProgress

Browse Source 
git-svn-id: trunk@24970 -
This commit is contained in:
mattias 2010-04-26 14:48:50 +00:00
parent e8430676fb
commit 7a5869db43
1 changed files with 8 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
components/codetools/definetemplates.pas
View File

@ -574,12 +574,8 @@ function GetDefaultCompilerFilename: string;
function CreateDefinesInDirectories(const SourcePaths, FlagName: string function CreateDefinesInDirectories(const SourcePaths, FlagName: string
): TDefineTemplate; ): TDefineTemplate;
type
TGatherFileProgress = procedure(Sender: TObject; PercentDone: Byte;
const Msg: string; var aContinue : Boolean) of object;
function GatherFiles(Directory, ExcludeDirMask, IncludeFileMask: string; function GatherFiles(Directory, ExcludeDirMask, IncludeFileMask: string;
const OnProgress: TGatherFileProgress): TStringList; const OnProgress: TDefinePoolProgress): TStringList;
procedure ReadMakefileFPC(const Filename: string; List: TStrings); procedure ReadMakefileFPC(const Filename: string; List: TStrings);
procedure ParseMakefileFPC(const Filename, SrcOS: string; procedure ParseMakefileFPC(const Filename, SrcOS: string;
@ -601,28 +597,27 @@ type
// some useful functions // some useful functions
function GatherFiles(Directory, ExcludeDirMask, IncludeFileMask: string; function GatherFiles(Directory, ExcludeDirMask, IncludeFileMask: string;
const OnProgress: TGatherFileProgress): TStringList; const OnProgress: TDefinePoolProgress): TStringList;
{ ExcludeDirMask: check FilenameIsMatching vs the short file name of a directory { ExcludeDirMask: check FilenameIsMatching vs the short file name of a directory
IncludeFileMask: check FilenameIsMatching vs the short file name of a file IncludeFileMask: check FilenameIsMatching vs the short file name of a file
} }
var var
FileCount: integer; FileCount: integer;
aContinue: boolean; Abort: boolean;
procedure Search(CurDir: string); procedure Search(CurDir: string);
var var
FileInfo: TSearchRec; FileInfo: TSearchRec;
ShortFilename: String; ShortFilename: String;
Filename: String; Filename: String;
aContinue: Boolean;
begin begin
//DebugLn(['Search CurDir=',CurDir]); //DebugLn(['Search CurDir=',CurDir]);
if FindFirstUTF8(CurDir+FileMask,faAnyFile,FileInfo)=0 then begin if FindFirstUTF8(CurDir+FileMask,faAnyFile,FileInfo)=0 then begin
repeat repeat
inc(FileCount); inc(FileCount);
if (FileCount mod 100=0) and Assigned(OnProgress) then begin if (FileCount mod 100=0) and Assigned(OnProgress) then begin
OnProgress(nil,0,'Scanned files: '+IntToStr(FileCount),aContinue); OnProgress(nil,0,-1,'Scanned files: '+IntToStr(FileCount),Abort);
if not aContinue then break; if Abort then break;
end; end;
ShortFilename:=FileInfo.Name; ShortFilename:=FileInfo.Name;
if (ShortFilename='') or (ShortFilename='.') or (ShortFilename='..') then if (ShortFilename='') or (ShortFilename='.') or (ShortFilename='..') then
@ -635,7 +630,7 @@ var
or (not FilenameIsMatching(ExcludeDirMask,ShortFilename,true)) or (not FilenameIsMatching(ExcludeDirMask,ShortFilename,true))
then begin then begin
Search(Filename+PathDelim); Search(Filename+PathDelim);
if not aContinue then break; if Abort then break;
end else begin end else begin
//DebugLn(['Search DIR MISMATCH ',Filename]); //DebugLn(['Search DIR MISMATCH ',Filename]);
end; end;
@ -657,9 +652,9 @@ var
begin begin
Result:=TStringList.Create; Result:=TStringList.Create;
FileCount:=0; FileCount:=0;
aContinue:=true; Abort:=false;
Search(CleanAndExpandDirectory(Directory)); Search(CleanAndExpandDirectory(Directory));
if not aContinue then FreeAndNil(Result); if Abort then FreeAndNil(Result);
end; end;
procedure ReadMakefileFPC(const Filename: string; List: TStrings); procedure ReadMakefileFPC(const Filename: string; List: TStrings);