mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-01 17:21:03 +02:00
ide: TConvertDelphiProjPack.CheckPackageDep: use cache
This commit is contained in:
parent
ccddf47d02
commit
dd6cb894c8
@ -37,7 +37,7 @@ uses
|
|||||||
// LCL
|
// LCL
|
||||||
Forms, Controls, Dialogs,
|
Forms, Controls, Dialogs,
|
||||||
// CodeTools
|
// CodeTools
|
||||||
CodeToolManager, DefineTemplates, CodeCache, LinkScanner,
|
CodeToolManager, DefineTemplates, CodeCache, LinkScanner, FileProcs,
|
||||||
// LazUtils
|
// LazUtils
|
||||||
LConvEncoding, FileUtil, LazFileUtils, LazUTF8, LazStringUtils, LazLoggerBase,
|
LConvEncoding, FileUtil, LazFileUtils, LazUTF8, LazStringUtils, LazLoggerBase,
|
||||||
AvgLvlTree,
|
AvgLvlTree,
|
||||||
@ -1450,6 +1450,9 @@ var
|
|||||||
PackFile: TPkgFile;
|
PackFile: TPkgFile;
|
||||||
Package: TLazPackage;
|
Package: TLazPackage;
|
||||||
i, Cnt: Integer;
|
i, Cnt: Integer;
|
||||||
|
SearchPath: String;
|
||||||
|
Files: TFilenameToStringTree;
|
||||||
|
FileItem: PStringToStringItem;
|
||||||
begin
|
begin
|
||||||
Result:=False;
|
Result:=False;
|
||||||
PackFile:=PackageGraph.FindUnitInAllPackages(AUnitName, True);
|
PackFile:=PackageGraph.FindUnitInAllPackages(AUnitName, True);
|
||||||
@ -1469,21 +1472,32 @@ begin
|
|||||||
// Try to find the unit from all open packages by their search path.
|
// Try to find the unit from all open packages by their search path.
|
||||||
// Again needed when the unit is not included in a package file.
|
// Again needed when the unit is not included in a package file.
|
||||||
Cnt:=PackageGraph.Count;
|
Cnt:=PackageGraph.Count;
|
||||||
|
Files:=TFilenameToStringTree.Create(false);
|
||||||
|
try
|
||||||
for i:=0 to Cnt-1 do begin
|
for i:=0 to Cnt-1 do begin
|
||||||
Package:=PackageGraph.Packages[i];
|
Package:=PackageGraph.Packages[i];
|
||||||
|
if Package.IsVirtual then
|
||||||
|
continue; // skip unsaved package
|
||||||
if PackageGraph.LazarusBasePackages.IndexOf(Package)>=0 then
|
if PackageGraph.LazarusBasePackages.IndexOf(Package)>=0 then
|
||||||
Continue; // Skip base packages.
|
Continue; // Skip base packages.
|
||||||
if PathHasPascalUnitFile(AUnitName,
|
SearchPath:=Package.CompilerOptions.GetParsedPath(pcosUnitPath,icoNone,false)
|
||||||
Package.CompilerOptions.GetParsedPath(pcosUnitPath,icoNone,false))
|
+';'+Package.SourceDirectories.CreateSearchPathFromAllFiles
|
||||||
or PathHasPascalUnitFile(AUnitName,
|
+';'+Package.Directory;
|
||||||
Package.SourceDirectories.CreateSearchPathFromAllFiles)
|
SearchPath:=TrimSearchPath(SearchPath,'',true);
|
||||||
//or PathHasPascalUnitFile(AUnitName, Package.GetOutputDirectory)
|
Files.Clear;
|
||||||
or PathHasPascalUnitFile(AUnitName, Package.Directory) then
|
CollectFilesInSearchPath(SearchPath,Files);
|
||||||
|
for FileItem in Files do
|
||||||
|
if FilenameIsPascalUnit(FileItem^.Name)
|
||||||
|
and (CompareFilenameOnly(PChar(Pointer(FileItem^.Name)),Length(FileItem^.Name),
|
||||||
|
PChar(Pointer(AUnitName)),Length(AUnitName))=0) then
|
||||||
begin
|
begin
|
||||||
AddDependency(Package.Name);
|
AddDependency(Package.Name);
|
||||||
Exit(True);
|
Exit(True);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
finally
|
||||||
|
Files.Free;
|
||||||
|
end;
|
||||||
// ToDo: Install the required package automatically from a repository...
|
// ToDo: Install the required package automatically from a repository...
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -69,7 +69,6 @@ function FindFPCTool(const Executable, CompilerFilename: string): string;
|
|||||||
procedure ResolveLinksInFileList(List: TStrings; RemoveDanglingLinks: Boolean);
|
procedure ResolveLinksInFileList(List: TStrings; RemoveDanglingLinks: Boolean);
|
||||||
function FindProgram(ProgramName, BaseDirectory: string;
|
function FindProgram(ProgramName, BaseDirectory: string;
|
||||||
WithBaseDirectory: boolean): string;
|
WithBaseDirectory: boolean): string;
|
||||||
function PathHasPascalUnitFile(const AUnitName, ASearchPath: string): Boolean;
|
|
||||||
|
|
||||||
// XMLconfig
|
// XMLconfig
|
||||||
function LoadXMLConfigViaCodeBuffer(Filename: string): TXMLConfig;
|
function LoadXMLConfigViaCodeBuffer(Filename: string): TXMLConfig;
|
||||||
@ -529,45 +528,6 @@ begin
|
|||||||
GetProgramSearchPath,PathSep,Flags);
|
GetProgramSearchPath,PathSep,Flags);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function PathHasPascalUnitFile(const AUnitName, ASearchPath: string): Boolean;
|
|
||||||
// Try to find a file matching AUnitName + Pascal file extension.
|
|
||||||
// ASearchPath can have many ';' separated paths.
|
|
||||||
// Only a file name is compared, not the actual unit name inside a file.
|
|
||||||
var
|
|
||||||
FileInfo: TSearchRec;
|
|
||||||
StartPos, p, l: Integer;
|
|
||||||
CurPath: String;
|
|
||||||
begin
|
|
||||||
Result:=False;
|
|
||||||
// Split search path
|
|
||||||
StartPos:=1;
|
|
||||||
l:=length(ASearchPath);
|
|
||||||
while StartPos<=l do begin
|
|
||||||
p:=StartPos;
|
|
||||||
while (p<=l) and (ASearchPath[p]<>';') do inc(p);
|
|
||||||
CurPath:=TrimFilename(Copy(ASearchPath,StartPos,p-StartPos));
|
|
||||||
if CurPath<>'' then begin
|
|
||||||
// Search files from the separated path.
|
|
||||||
if FindFirstUTF8(AppendPathDelim(CurPath)+AllFilesMask,faAnyFile,FileInfo)=0 then
|
|
||||||
try
|
|
||||||
repeat
|
|
||||||
// Check if special file
|
|
||||||
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
|
|
||||||
Continue;
|
|
||||||
// CaseInsensitive compare Pascal file names. Pointer cast avoids #0 check.
|
|
||||||
if (CompareFilenameOnly(PChar(Pointer(FileInfo.Name)),Length(FileInfo.Name),
|
|
||||||
PChar(Pointer(AUnitName)),Length(AUnitName))=0)
|
|
||||||
and FilenameIsPascalUnit(FileInfo.Name) then
|
|
||||||
Exit(True);
|
|
||||||
until FindNextUTF8(FileInfo)<>0;
|
|
||||||
finally
|
|
||||||
FindCloseUTF8(FileInfo);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
StartPos:=p+1;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function PointToCfgStr(const Point: TPoint): string;
|
function PointToCfgStr(const Point: TPoint): string;
|
||||||
begin
|
begin
|
||||||
Result:=IntToStr(Point.X)+','+IntToStr(Point.Y);
|
Result:=IntToStr(Point.X)+','+IntToStr(Point.Y);
|
||||||
|
@ -273,7 +273,7 @@ begin
|
|||||||
lptDesignTime: Result:=lisPckOptsDesigntime;
|
lptDesignTime: Result:=lisPckOptsDesigntime;
|
||||||
lptRunAndDesignTime: Result:=lisPckOptsDesigntimeAndRuntime;
|
lptRunAndDesignTime: Result:=lisPckOptsDesigntimeAndRuntime;
|
||||||
lptRunTimeOnly: Result:=lisRuntimeOnlyCanNotBeInstalledInIDE;
|
lptRunTimeOnly: Result:=lisRuntimeOnlyCanNotBeInstalledInIDE;
|
||||||
else Result:='?'+IntToStr(ord(t));
|
else Result:='?'+IntToStr(ord(t)){%H-};
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user