paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-22 10:59:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: global package links: use codetools cache

Browse Source 
git-svn-id: trunk@39976 -
This commit is contained in:
mattias 2013-01-27 11:27:22 +00:00
parent 9ae6ac7874
commit 38ea21f89a
1 changed files with 39 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
packager/packagelinks.pas
View File

@ -152,6 +152,7 @@ type
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure Clear; procedure Clear;
procedure ClearGlobalLinks;
function GetUserLinkFile(WithPath: boolean = true): string; function GetUserLinkFile(WithPath: boolean = true): string;
function GetGlobalLinkDirectory: string; function GetGlobalLinkDirectory: string;
procedure UpdateGlobalLinks; procedure UpdateGlobalLinks;
@ -345,12 +346,18 @@ end;
procedure TPackageLinks.Clear; procedure TPackageLinks.Clear;
begin begin
FGlobalLinks.FreeAndClear; ClearGlobalLinks;
FUserLinksSortID.FreeAndClear; FUserLinksSortID.FreeAndClear;
FUserLinksSortFile.Clear; FUserLinksSortFile.Clear;
FStates:=[plsUserLinksNeedUpdate,plsGlobalLinksNeedUpdate]; FStates:=[plsUserLinksNeedUpdate,plsGlobalLinksNeedUpdate];
end; end;
procedure TPackageLinks.ClearGlobalLinks;
begin
FGlobalLinks.FreeAndClear;
Include(FStates,plsGlobalLinksNeedUpdate);
end;
function TPackageLinks.GetUserLinkFile(WithPath: boolean): string; function TPackageLinks.GetUserLinkFile(WithPath: boolean): string;
begin begin
Result:='packagefiles.xml'; Result:='packagefiles.xml';
@ -417,62 +424,67 @@ procedure TPackageLinks.UpdateGlobalLinks;
var var
GlobalLinksDir: String; GlobalLinksDir: String;
FileInfo: TSearchRec;
NewPkgName: string; NewPkgName: string;
PkgVersion: TPkgVersion; PkgVersion: TPkgVersion;
NewPkgLink: TPackageLink; NewPkgLink: TPackageLink;
sl: TStringListUTF8; sl: TStringListUTF8;
CurFilename: String; LPLFilename: String;
NewFilename: string; LPKFilename: string;
Files: TStrings;
i: Integer;
begin begin
if fUpdateLock>0 then begin if fUpdateLock>0 then begin
Include(FStates,plsGlobalLinksNeedUpdate); Include(FStates,plsGlobalLinksNeedUpdate);
exit; exit;
end; end;
Exclude(FStates,plsGlobalLinksNeedUpdate); Exclude(FStates,plsGlobalLinksNeedUpdate);
{$IFDEF VerboseGlobalPkgLinks}
debugln(['TPackageLinks.UpdateGlobalLinks START']);
{$ENDIF}
FGlobalLinks.FreeAndClear; FGlobalLinks.FreeAndClear;
GlobalLinksDir:=GetGlobalLinkDirectory; GlobalLinksDir:=GetGlobalLinkDirectory;
if FindFirstUTF8(GlobalLinksDir+'*.lpl', faAnyFile, FileInfo)=0 then begin Files:=TStringListUTF8.Create;
try
CodeToolBoss.DirectoryCachePool.GetListing(GlobalLinksDir,Files,false);
PkgVersion:=TPkgVersion.Create; PkgVersion:=TPkgVersion.Create;
repeat for i:=0 to Files.Count-1 do begin
CurFilename:=GlobalLinksDir+FileInfo.Name; LPLFilename:=GlobalLinksDir+Files[i];
//debugln('UpdateGlobalLinks B CurFilename=',CurFilename); if CompareFileExt(LPLFilename,'lpl')<>0 then continue;
if ((FileInfo.Attr and faDirectory)<>0) if (not ParseFilename(Files[i],NewPkgName,PkgVersion))
or (not ParseFilename(FileInfo.Name,NewPkgName,PkgVersion))
then begin then begin
DebugLn('WARNING: suspicious pkg link file found (name): ',CurFilename); DebugLn('WARNING: suspicious pkg link file found (name): ',LPLFilename);
continue; continue;
end; end;
NewFilename:=''; LPKFilename:='';
sl:=TStringListUTF8.Create; sl:=TStringListUTF8.Create;
try try
sl.LoadFromFile(CurFilename); sl.LoadFromFile(LPLFilename);
if sl.Count<=0 then begin if sl.Count<=0 then begin
DebugLn('WARNING: suspicious pkg link file found (content): ',CurFilename); DebugLn('WARNING: pkg link file is empty: ',LPLFilename);
continue; continue;
end; end;
NewFilename:=SetDirSeparators(sl[0]); LPKFilename:=SetDirSeparators(sl[0]);
except except
on E: Exception do begin on E: Exception do begin
DebugLn('ERROR: unable to read pkg link file: ',CurFilename,' : ',E.Message); DebugLn('WARNING: unable to read pkg link file: ',LPLFilename,' : ',E.Message);
end; end;
end; end;
sl.Free; sl.Free;
if NewFilename='' then continue; if LPKFilename='' then continue;
//debugln(['TPackageLinks.UpdateGlobalLinks NewFilename="',NewFilename,'"']); //debugln(['TPackageLinks.UpdateGlobalLinks NewFilename="',LPKFilename,'"']);
NewPkgLink:=TPackageLink.Create; NewPkgLink:=TPackageLink.Create;
NewPkgLink.Reference; NewPkgLink.Reference;
NewPkgLink.Origin:=ploGlobal; NewPkgLink.Origin:=ploGlobal;
NewPkgLink.Name:=NewPkgName; NewPkgLink.Name:=NewPkgName;
NewPkgLink.Version.Assign(PkgVersion); NewPkgLink.Version.Assign(PkgVersion);
IDEMacros.SubstituteMacros(NewFilename); IDEMacros.SubstituteMacros(LPKFilename);
//debugln(['TPackageLinks.UpdateGlobalLinks EnvironmentOptions.LazarusDirectory=',EnvironmentOptions.LazarusDirectory]); //debugln(['TPackageLinks.UpdateGlobalLinks EnvironmentOptions.LazarusDirectory=',EnvironmentOptions.LazarusDirectory]);
NewFilename:=TrimFilename(NewFilename); LPKFilename:=TrimFilename(LPKFilename);
if (FileIsInDirectory(NewFilename,EnvironmentOptions.GetParsedLazarusDirectory)) then if (FileIsInDirectory(LPKFilename,EnvironmentOptions.GetParsedLazarusDirectory)) then
NewFilename:=CreateRelativePath(NewFilename,EnvironmentOptions.GetParsedLazarusDirectory); LPKFilename:=CreateRelativePath(LPKFilename,EnvironmentOptions.GetParsedLazarusDirectory);
NewPkgLink.Filename:=NewFilename; NewPkgLink.Filename:=LPKFilename;
//debugln('TPackageLinks.UpdateGlobalLinks PkgName="',NewPkgLink.Name,'" ', //debugln('TPackageLinks.UpdateGlobalLinks PkgName="',NewPkgLink.Name,'" ',
// ' PkgVersion=',NewPkgLink.Version.AsString, // ' PkgVersion=',NewPkgLink.Version.AsString,
// ' Filename="',NewPkgLink.Filename,'"', // ' Filename="',NewPkgLink.Filename,'"',
@ -481,12 +493,12 @@ begin
FGlobalLinks.Add(NewPkgLink) FGlobalLinks.Add(NewPkgLink)
else else
NewPkgLink.Release; NewPkgLink.Release;
end;
until FindNextUTF8(FileInfo)<>0;
//WriteLinkTree(FGlobalLinks); //WriteLinkTree(FGlobalLinks);
if PkgVersion<>nil then PkgVersion.Free; if PkgVersion<>nil then PkgVersion.Free;
finally
Files.Free;
end; end;
FindCloseUTF8(FileInfo);
end; end;
procedure TPackageLinks.UpdateUserLinks; procedure TPackageLinks.UpdateUserLinks;