mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-27 16:20:35 +02:00
implemented package links, automatic package loading
git-svn-id: trunk@4056 -
This commit is contained in:
mattias
parent
ce4dc4943a
commit
29fb14b1f9
@ -62,14 +62,20 @@ type
|
||||
function Find(Data: Pointer): TAVLTreeNode;
|
||||
function FindKey(Key: Pointer;
|
||||
OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
|
||||
function FindNearest(Data: Pointer): TAVLTreeNode;
|
||||
function FindPointer(Data: Pointer): TAVLTreeNode;
|
||||
function FindLeftMost(Data: Pointer): TAVLTreeNode;
|
||||
function FindRightMost(Data: Pointer): TAVLTreeNode;
|
||||
function FindSuccessor(ANode: TAVLTreeNode): TAVLTreeNode;
|
||||
function FindPrecessor(ANode: TAVLTreeNode): TAVLTreeNode;
|
||||
function FindLowest: TAVLTreeNode;
|
||||
function FindHighest: TAVLTreeNode;
|
||||
function FindNearest(Data: Pointer): TAVLTreeNode;
|
||||
function FindPointer(Data: Pointer): TAVLTreeNode;
|
||||
function FindLeftMost(Data: Pointer): TAVLTreeNode;
|
||||
function FindRightMost(Data: Pointer): TAVLTreeNode;
|
||||
function FindLeftMostKey(Key: Pointer;
|
||||
OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
|
||||
function FindRightMostKey(Key: Pointer;
|
||||
OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
|
||||
function FindLeftMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;
|
||||
function FindRightMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;
|
||||
procedure Add(ANode: TAVLTreeNode);
|
||||
function Add(Data: Pointer): TAVLTreeNode;
|
||||
procedure Delete(ANode: TAVLTreeNode);
|
||||
@ -146,7 +152,7 @@ begin
|
||||
inc(FCount);
|
||||
if Root<>nil then begin
|
||||
InsertPos:=FindInsertPos(ANode.Data);
|
||||
InsertComp:=OnCompare(ANode.Data,InsertPos.Data);
|
||||
InsertComp:=fOnCompare(ANode.Data,InsertPos.Data);
|
||||
ANode.Parent:=InsertPos;
|
||||
if InsertComp<0 then begin
|
||||
// insert to the left
|
||||
@ -641,7 +647,7 @@ var Comp: integer;
|
||||
begin
|
||||
Result:=Root;
|
||||
while (Result<>nil) do begin
|
||||
Comp:=OnCompare(Data,Result.Data);
|
||||
Comp:=fOnCompare(Data,Result.Data);
|
||||
if Comp=0 then exit;
|
||||
if Comp<0 then begin
|
||||
Result:=Result.Left
|
||||
@ -667,12 +673,60 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAVLTree.FindLeftMostKey(Key: Pointer;
|
||||
OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
|
||||
begin
|
||||
Result:=FindLeftMostSameKey(FindKey(Key,OnCompareKeyWithData));
|
||||
end;
|
||||
|
||||
function TAVLTree.FindRightMostKey(Key: Pointer;
|
||||
OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
|
||||
begin
|
||||
Result:=FindRightMostSameKey(FindKey(Key,OnCompareKeyWithData));
|
||||
end;
|
||||
|
||||
function TAVLTree.FindLeftMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;
|
||||
var
|
||||
LeftNode: TAVLTreeNode;
|
||||
Data: Pointer;
|
||||
begin
|
||||
if ANode<>nil then begin
|
||||
Data:=ANode.Data;
|
||||
Result:=ANode;
|
||||
repeat
|
||||
LeftNode:=FindPrecessor(Result);
|
||||
if (LeftNode=nil) or (fOnCompare(Data,LeftNode.Data)<>0) then break;
|
||||
Result:=LeftNode;
|
||||
until false;
|
||||
end else begin
|
||||
Result:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAVLTree.FindRightMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;
|
||||
var
|
||||
RightNode: TAVLTreeNode;
|
||||
Data: Pointer;
|
||||
begin
|
||||
if ANode<>nil then begin
|
||||
Data:=ANode.Data;
|
||||
Result:=ANode;
|
||||
repeat
|
||||
RightNode:=FindSuccessor(Result);
|
||||
if (RightNode=nil) or (fOnCompare(Data,RightNode.Data)<>0) then break;
|
||||
Result:=RightNode;
|
||||
until false;
|
||||
end else begin
|
||||
Result:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAVLTree.FindNearest(Data: Pointer): TAVLTreeNode;
|
||||
var Comp: integer;
|
||||
begin
|
||||
Result:=Root;
|
||||
while (Result<>nil) do begin
|
||||
Comp:=OnCompare(Data,Result.Data);
|
||||
Comp:=fOnCompare(Data,Result.Data);
|
||||
if Comp=0 then exit;
|
||||
if Comp<0 then begin
|
||||
if Result.Left<>nil then
|
||||
@ -694,7 +748,7 @@ begin
|
||||
while (Result<>nil) do begin
|
||||
if Result.Data=Data then break;
|
||||
Result:=FindSuccessor(Result);
|
||||
if OnCompare(Data,Result.Data)<>0 then Result:=nil;
|
||||
if fOnCompare(Data,Result.Data)<>0 then Result:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -705,7 +759,7 @@ begin
|
||||
Result:=Find(Data);
|
||||
while (Result<>nil) do begin
|
||||
Left:=FindPrecessor(Result);
|
||||
if (Left=nil) or (OnCompare(Data,Left.Data)<>0) then break;
|
||||
if (Left=nil) or (fOnCompare(Data,Left.Data)<>0) then break;
|
||||
Result:=Left;
|
||||
end;
|
||||
end;
|
||||
@ -717,7 +771,7 @@ begin
|
||||
Result:=Find(Data);
|
||||
while (Result<>nil) do begin
|
||||
Right:=FindSuccessor(Result);
|
||||
if (Right=nil) or (OnCompare(Data,Right.Data)<>0) then break;
|
||||
if (Right=nil) or (fOnCompare(Data,Right.Data)<>0) then break;
|
||||
Result:=Right;
|
||||
end;
|
||||
end;
|
||||
@ -727,7 +781,7 @@ var Comp: integer;
|
||||
begin
|
||||
Result:=Root;
|
||||
while (Result<>nil) do begin
|
||||
Comp:=OnCompare(Data,Result.Data);
|
||||
Comp:=fOnCompare(Data,Result.Data);
|
||||
if Comp<0 then begin
|
||||
if Result.Left<>nil then
|
||||
Result:=Result.Left
|
||||
@ -820,7 +874,7 @@ var RealCount: integer;
|
||||
if ANode.Left.Parent<>ANode then begin
|
||||
Result:=-2; exit;
|
||||
end;
|
||||
if OnCompare(ANode.Left.Data,ANode.Data)>0 then begin
|
||||
if fOnCompare(ANode.Left.Data,ANode.Data)>0 then begin
|
||||
writeln('CCC-3 ',HexStr(Cardinal(ANode.Data),8),' ',HexStr(Cardinal(ANode.Left.Data),8));
|
||||
Result:=-3; exit;
|
||||
end;
|
||||
@ -832,7 +886,7 @@ var RealCount: integer;
|
||||
if ANode.Right.Parent<>ANode then begin
|
||||
Result:=-4; exit;
|
||||
end;
|
||||
if OnCompare(ANode.Data,ANode.Right.Data)>0 then begin
|
||||
if fOnCompare(ANode.Data,ANode.Right.Data)>0 then begin
|
||||
writeln('CCC-5 ',HexStr(Cardinal(ANode.Data),8),' ',HexStr(Cardinal(ANode.Right.Data),8));
|
||||
Result:=-5; exit;
|
||||
end;
|
||||
|
||||
@ -362,6 +362,7 @@ var
|
||||
XMLConfig: TXMLConfig;
|
||||
begin
|
||||
try
|
||||
ClearFile(FFilename,true);
|
||||
XMLConfig:=TXMLConfig.Create(FFileName);
|
||||
XMLConfig.SetDeleteValue('InputHistory/Version/Value',
|
||||
InputHistoryVersion,0);
|
||||
@ -369,8 +370,9 @@ begin
|
||||
XMLConfig.Flush;
|
||||
XMLConfig.Free;
|
||||
except
|
||||
// ToDo
|
||||
writeln('[TEnvironmentOptions.Save] error writing "',FFilename,'"');
|
||||
on E: Exception do begin
|
||||
writeln('[TEnvironmentOptions.Save] error writing "',FFilename,'" ',E.Message);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -49,7 +49,7 @@ uses
|
||||
type
|
||||
TPkgSaveFlag = (
|
||||
psfSaveAs,
|
||||
pfAskBeforeSaving
|
||||
psfAskBeforeSaving
|
||||
);
|
||||
TPkgSaveFlags = set of TPkgSaveFlag;
|
||||
|
||||
|
||||
@ -266,6 +266,7 @@ type
|
||||
function IDAsString: string;
|
||||
function StringToID(const s: string): boolean;
|
||||
function Compare(PackageID2: TLazPackageID): integer;
|
||||
procedure AssignID(Source: TLazPackageID); virtual;
|
||||
public
|
||||
property Name: string read FName write SetName;
|
||||
property Version: TPkgVersion read FVersion;
|
||||
@ -371,6 +372,7 @@ type
|
||||
function IsVirtual: boolean;
|
||||
function HasDirectory: boolean;
|
||||
procedure CheckInnerDependencies;
|
||||
function MakeSense: boolean;
|
||||
procedure ShortenFilename(var ExpandedFilename: string);
|
||||
procedure LongenFilename(var AFilename: string);
|
||||
function GetResolvedFilename: string;
|
||||
@ -433,8 +435,7 @@ type
|
||||
property Installed: TPackageInstallType read FInstalled write SetInstalled;
|
||||
property Registered: boolean read FRegistered write SetRegistered;
|
||||
property Modified: boolean read GetModified write SetModified;
|
||||
property PackageType: TLazPackageType
|
||||
read FPackageType write SetPackageType;
|
||||
property PackageType: TLazPackageType read FPackageType write SetPackageType;
|
||||
property ReadOnly: boolean read FReadOnly write SetReadOnly;
|
||||
property RemovedFilesCount: integer read GetRemovedCount;
|
||||
property RemovedFiles[Index: integer]: TPkgFile read GetRemovedFiles;
|
||||
@ -1511,6 +1512,7 @@ begin
|
||||
FAddDependCompilerOptions.LoadFromXMLConfig(
|
||||
XMLConfig,Path+'AddDependCompilerOptions/');
|
||||
LoadRect(XMLConfig,Path+'EditorRect/',fEditorRect);
|
||||
Modified:=false;
|
||||
UnlockModified;
|
||||
end;
|
||||
|
||||
@ -1589,6 +1591,14 @@ begin
|
||||
// ToDo: make some checks like deactivating double requirements
|
||||
end;
|
||||
|
||||
function TLazPackage.MakeSense: boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
if (Name='') or (not IsValidIdent(Name)) then exit;
|
||||
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TLazPackage.ShortenFilename(var ExpandedFilename: string);
|
||||
var
|
||||
PkgDir: String;
|
||||
@ -1998,6 +2008,12 @@ begin
|
||||
Result:=Version.Compare(PackageID2.Version);
|
||||
end;
|
||||
|
||||
procedure TLazPackageID.AssignID(Source: TLazPackageID);
|
||||
begin
|
||||
Name:=Source.Name;
|
||||
Version.Assign(Source.Version);
|
||||
end;
|
||||
|
||||
{ TPkgCompilerOptions }
|
||||
|
||||
procedure TPkgCompilerOptions.SetLazPackage(const AValue: TLazPackage);
|
||||
|
||||
@ -723,7 +723,6 @@ begin
|
||||
FLazPackage.Editor:=Self;
|
||||
// find a nice position for the editor
|
||||
ARect:=FLazPackage.EditorRect;
|
||||
writeln('');
|
||||
if (ARect.Bottom<ARect.Top+50) or (ARect.Right<ARect.Left+50) then
|
||||
ARect:=CreateNiceWindowPosition(500,400);
|
||||
SetBounds(ARect.Left,ARect.Top,
|
||||
|
||||
@ -80,6 +80,7 @@ type
|
||||
TPackageLinks = class
|
||||
private
|
||||
FGlobalLinks: TAVLTree; // tree of TPackageLink
|
||||
FModified: boolean;
|
||||
FUserLinks: TAVLTree; // tree of TPackageLink
|
||||
fUpdateLock: integer;
|
||||
FStates: TPkgLinksStates;
|
||||
@ -89,20 +90,32 @@ type
|
||||
const PkgName: string): TPackageLink;
|
||||
function FindLinkWithDependencyInTree(LinkTree: TAVLTree;
|
||||
Dependency: TPkgDependency): TPackageLink;
|
||||
function FindLinkWithPackageIDInTree(LinkTree: TAVLTree;
|
||||
APackageID: TLazPackageID): TPackageLink;
|
||||
procedure IteratePackagesInTree(LinkTree: TAVLTree;
|
||||
Event: TIteratePackagesEvent);
|
||||
procedure SetModified(const AValue: boolean);
|
||||
public
|
||||
UserLinkLoadTime: longint;
|
||||
UserLinkLoadTimeValid: boolean;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
function GetUserLinkFile: string;
|
||||
procedure UpdateGlobalLinks;
|
||||
procedure UpdateUserLinks;
|
||||
procedure UpdateAll;
|
||||
procedure BeginUpdate;
|
||||
procedure EndUpdate;
|
||||
procedure SaveUserLinks;
|
||||
function FindLinkWithPkgName(const PkgName: string): TPackageLink;
|
||||
function FindLinkWithDependency(Dependency: TPkgDependency): TPackageLink;
|
||||
function FindLinkWithPackageID(APackageID: TLazPackageID): TPackageLink;
|
||||
procedure IteratePackages(Event: TIteratePackagesEvent);
|
||||
procedure AddUserLink(APackage: TLazPackage);
|
||||
procedure RemoveLink(APackageID: TLazPackageID);
|
||||
public
|
||||
property Modified: boolean read FModified write SetModified;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -125,6 +138,20 @@ begin
|
||||
Result:=Link1.Compare(Link2);
|
||||
end;
|
||||
|
||||
function ComparePackageIDAndLink(Key, Data: Pointer): integer;
|
||||
var
|
||||
Link: TPackageLink;
|
||||
PkgID: TLazPackageID;
|
||||
begin
|
||||
if Key=nil then
|
||||
Result:=-1
|
||||
else begin
|
||||
PkgID:=TLazPackageID(Key);
|
||||
Link:=TPackageLink(Data);
|
||||
Result:=PkgID.Compare(Link);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ComparePkgNameAndLink(Key, Data: Pointer): integer;
|
||||
var
|
||||
PkgName: String;
|
||||
@ -150,7 +177,7 @@ end;
|
||||
procedure TPackageLink.SetFilename(const AValue: string);
|
||||
begin
|
||||
if FFilename=AValue then exit;
|
||||
FFilename:=AValue;
|
||||
FFilename:=CleanAndExpandFilename(AValue);
|
||||
end;
|
||||
|
||||
constructor TPackageLink.Create;
|
||||
@ -188,6 +215,7 @@ end;
|
||||
|
||||
constructor TPackageLinks.Create;
|
||||
begin
|
||||
UserLinkLoadTimeValid:=false;
|
||||
FGlobalLinks:=TAVLTree.Create(@ComparePackageLinks);
|
||||
FUserLinks:=TAVLTree.Create(@ComparePackageLinks);
|
||||
end;
|
||||
@ -207,6 +235,11 @@ begin
|
||||
FStates:=[plsUserLinksNeedUpdate,plsGlobalLinksNeedUpdate];
|
||||
end;
|
||||
|
||||
function TPackageLinks.GetUserLinkFile: string;
|
||||
begin
|
||||
Result:=AppendPathDelim(GetPrimaryConfigPath)+'packagefiles.xml';
|
||||
end;
|
||||
|
||||
procedure TPackageLinks.UpdateGlobalLinks;
|
||||
|
||||
function ParseFilename(const Filename: string;
|
||||
@ -304,8 +337,7 @@ begin
|
||||
NewPkgLink.Name:=NewPkgName;
|
||||
NewPkgLink.Version.Assign(PkgVersion);
|
||||
NewPkgLink.Filename:=NewFilename;
|
||||
if IsValidIdent(NewPkgLink.Name) and FileExists(NewPkgLink.Filename)
|
||||
then
|
||||
if IsValidIdent(NewPkgLink.Name) then
|
||||
FGlobalLinks.Add(NewPkgLink)
|
||||
else
|
||||
NewPkgLink.Free;
|
||||
@ -331,16 +363,21 @@ begin
|
||||
exit;
|
||||
end;
|
||||
Exclude(FStates,plsUserLinksNeedUpdate);
|
||||
|
||||
// check if file has changed
|
||||
ConfigFilename:=GetUserLinkFile;
|
||||
if UserLinkLoadTimeValid and FileExists(ConfigFilename)
|
||||
and (FileAge(ConfigFilename)=UserLinkLoadTime) then
|
||||
exit;
|
||||
|
||||
FUserLinks.FreeAndClear;
|
||||
ConfigFilename:=AppendPathDelim(GetPrimaryConfigPath)+'packagefiles.xml';
|
||||
XMLConfig:=nil;
|
||||
try
|
||||
XMLConfig:=TXMLConfig.Create(ConfigFilename);
|
||||
|
||||
Path:='UserPkgLinks/';
|
||||
LinkCount:=XMLConfig.GetValue(Path+'Count',0);
|
||||
for i:=0 to LinkCount-1 do begin
|
||||
for i:=1 to LinkCount do begin
|
||||
ItemPath:=Path+'Item'+IntToStr(i)+'/';
|
||||
NewPkgLink:=TPackageLink.Create;
|
||||
NewPkgLink.Origin:=ploUser;
|
||||
@ -348,19 +385,22 @@ begin
|
||||
NewPkgLink.Version.LoadFromXMLConfig(XMLConfig,ItemPath+'Version/',
|
||||
LazPkgXMLFileVersion);
|
||||
NewPkgLink.Filename:=XMLConfig.GetValue(ItemPath+'Filename/Value','');
|
||||
if IsValidIdent(NewPkgLink.Name) and FileExists(NewPkgLink.Filename)
|
||||
then
|
||||
if IsValidIdent(NewPkgLink.Name) then
|
||||
FUserLinks.Add(NewPkgLink)
|
||||
else
|
||||
NewPkgLink.Free;
|
||||
end;
|
||||
XMLConfig.Free;
|
||||
|
||||
UserLinkLoadTime:=FileAge(ConfigFilename);
|
||||
UserLinkLoadTimeValid:=true;
|
||||
except
|
||||
on E: Exception do begin
|
||||
writeln('WARNING: unable to read ',ConfigFilename);
|
||||
writeln('NOTE: unable to read ',ConfigFilename,' ',E.Message);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
if XMLConfig<>nil then XMLConfig.Free;
|
||||
Modified:=false;
|
||||
end;
|
||||
|
||||
procedure TPackageLinks.UpdateAll;
|
||||
@ -382,6 +422,57 @@ begin
|
||||
if (plsUserLinksNeedUpdate in FStates) then UpdateUserLinks;
|
||||
end;
|
||||
|
||||
procedure TPackageLinks.SaveUserLinks;
|
||||
var
|
||||
ConfigFilename: String;
|
||||
Path: String;
|
||||
CurPkgLink: TPackageLink;
|
||||
XMLConfig: TXMLConfig;
|
||||
ANode: TAVLTreeNode;
|
||||
ItemPath: String;
|
||||
i: Integer;
|
||||
begin
|
||||
ConfigFilename:=GetUserLinkFile;
|
||||
|
||||
// check if file need saving
|
||||
if (not Modified)
|
||||
and UserLinkLoadTimeValid and FileExists(ConfigFilename)
|
||||
and (FileAge(ConfigFilename)=UserLinkLoadTime) then
|
||||
exit;
|
||||
|
||||
XMLConfig:=nil;
|
||||
try
|
||||
ClearFile(ConfigFilename,true);
|
||||
XMLConfig:=TXMLConfig.Create(ConfigFilename);
|
||||
|
||||
Path:='UserPkgLinks/';
|
||||
ANode:=FUserLinks.FindLowest;
|
||||
i:=0;
|
||||
while ANode<>nil do begin
|
||||
inc(i);
|
||||
ItemPath:=Path+'Item'+IntToStr(i)+'/';
|
||||
CurPkgLink:=TPackageLink(ANode.Data);
|
||||
XMLConfig.SetDeleteValue(ItemPath+'Name/Value',CurPkgLink.Name,'');
|
||||
CurPkgLink.Version.SaveToXMLConfig(XMLConfig,ItemPath+'Version/');
|
||||
XMLConfig.SetDeleteValue(ItemPath+'Filename/Value',CurPkgLink.Filename,'');
|
||||
ANode:=FUserLinks.FindSuccessor(ANode);
|
||||
end;
|
||||
XMLConfig.SetDeleteValue(Path+'Count',FUserLinks.Count,0);
|
||||
|
||||
XMLConfig.Flush;
|
||||
XMLConfig.Free;
|
||||
|
||||
UserLinkLoadTime:=FileAge(ConfigFilename);
|
||||
UserLinkLoadTimeValid:=true;
|
||||
except
|
||||
on E: Exception do begin
|
||||
writeln('NOTE: unable to read ',ConfigFilename,' ',E.Message);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
Modified:=false;
|
||||
end;
|
||||
|
||||
function TPackageLinks.FindLinkWithPkgNameInTree(LinkTree: TAVLTree;
|
||||
const PkgName: string): TPackageLink;
|
||||
// find left most link with PkgName
|
||||
@ -420,6 +511,18 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPackageLinks.FindLinkWithPackageIDInTree(LinkTree: TAVLTree;
|
||||
APackageID: TLazPackageID): TPackageLink;
|
||||
var
|
||||
ANode: TAVLTreeNode;
|
||||
begin
|
||||
ANode:=LinkTree.FindKey(APackageID,@ComparePackageIDAndLink);
|
||||
if ANode<>nil then
|
||||
Result:=TPackageLink(ANode.Data)
|
||||
else
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
procedure TPackageLinks.IteratePackagesInTree(LinkTree: TAVLTree;
|
||||
Event: TIteratePackagesEvent);
|
||||
var
|
||||
@ -432,6 +535,12 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPackageLinks.SetModified(const AValue: boolean);
|
||||
begin
|
||||
if FModified=AValue then exit;
|
||||
FModified:=AValue;
|
||||
end;
|
||||
|
||||
function TPackageLinks.FindLinkWithPkgName(const PkgName: string): TPackageLink;
|
||||
begin
|
||||
Result:=FindLinkWithPkgNameInTree(FUserLinks,PkgName);
|
||||
@ -447,12 +556,63 @@ begin
|
||||
Result:=FindLinkWithDependencyInTree(FGlobalLinks,Dependency);
|
||||
end;
|
||||
|
||||
function TPackageLinks.FindLinkWithPackageID(APackageID: TLazPackageID
|
||||
): TPackageLink;
|
||||
begin
|
||||
Result:=FindLinkWithPackageIDInTree(FUserLinks,APackageID);
|
||||
if Result=nil then
|
||||
Result:=FindLinkWithPackageIDInTree(FGlobalLinks,APackageID);
|
||||
end;
|
||||
|
||||
procedure TPackageLinks.IteratePackages(Event: TIteratePackagesEvent);
|
||||
begin
|
||||
IteratePackagesInTree(FUserLinks,Event);
|
||||
IteratePackagesInTree(FGlobalLinks,Event);
|
||||
end;
|
||||
|
||||
procedure TPackageLinks.AddUserLink(APackage: TLazPackage);
|
||||
var
|
||||
OldLink: TPackageLink;
|
||||
NewLink: TPackageLink;
|
||||
begin
|
||||
// check if link already exists
|
||||
OldLink:=FindLinkWithPackageID(APackage);
|
||||
if (OldLink<>nil) then begin
|
||||
// link exists -> check if it is already the right value
|
||||
if (OldLink.Compare(APackage)=0)
|
||||
and (OldLink.Filename=APackage.Filename) then exit;
|
||||
RemoveLink(APackage);
|
||||
end;
|
||||
// add user link
|
||||
NewLink:=TPackageLink.Create;
|
||||
NewLink.AssignID(APackage);
|
||||
NewLink.Filename:=APackage.Filename;
|
||||
FUserLinks.Add(NewLink);
|
||||
Modified:=true;
|
||||
end;
|
||||
|
||||
procedure TPackageLinks.RemoveLink(APackageID: TLazPackageID);
|
||||
var
|
||||
ANode: TAVLTreeNode;
|
||||
OldLink: TPackageLink;
|
||||
begin
|
||||
// remove from user links
|
||||
ANode:=FUserLinks.Find(APackageID);
|
||||
if ANode<>nil then begin
|
||||
OldLink:=TPackageLink(ANode.Data);
|
||||
FUserLinks.Remove(ANode);
|
||||
OldLink.Free;
|
||||
end;
|
||||
// remove from global links
|
||||
ANode:=FGlobalLinks.Find(APackageID);
|
||||
if ANode<>nil then begin
|
||||
OldLink:=TPackageLink(ANode.Data);
|
||||
FGlobalLinks.Remove(ANode);
|
||||
OldLink.Free;
|
||||
end;
|
||||
Modified:=true;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
PkgLinks:=nil;
|
||||
|
||||
@ -45,7 +45,7 @@ uses
|
||||
{$IFDEF IDE_MEM_CHECK}
|
||||
MemCheck,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, AVL_Tree, FileCtrl, Forms, Controls, Dialogs,
|
||||
Classes, SysUtils, AVL_Tree, Laz_XMLCfg, FileCtrl, Forms, Controls, Dialogs,
|
||||
LazarusIDEStrConsts, IDEProcs, PackageLinks, PackageDefs, LazarusPackageIntf,
|
||||
ComponentReg, RegisterLCL, RegisterFCL;
|
||||
|
||||
@ -97,6 +97,8 @@ type
|
||||
procedure SetAbortRegistration(const AValue: boolean);
|
||||
procedure SetRegistrationPackage(const AValue: TLazPackage);
|
||||
procedure UpdateBrokenDependenciesToPackage(APackage: TLazPackage);
|
||||
function OpenDependencyWithPackageLink(Dependency: TPkgDependency;
|
||||
PkgLink: TPackageLink): boolean;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
@ -128,7 +130,7 @@ type
|
||||
IgnorePackage: TLazPackage): boolean;
|
||||
function CreateUniquePkgName(const Prefix: string;
|
||||
IgnorePackage: TLazPackage): string;
|
||||
function NewPackage(const Prefix: string): TLazPackage;
|
||||
function CreateNewPackage(const Prefix: string): TLazPackage;
|
||||
procedure ConsistencyCheck;
|
||||
procedure RegisterUnitHandler(const TheUnitName: string;
|
||||
RegisterProc: TRegisterProc);
|
||||
@ -250,6 +252,37 @@ begin
|
||||
EndUpdate;
|
||||
end;
|
||||
|
||||
function TLazPackageGraph.OpenDependencyWithPackageLink(
|
||||
Dependency: TPkgDependency; PkgLink: TPackageLink): boolean;
|
||||
var
|
||||
AFilename: String;
|
||||
NewPackage: TLazPackage;
|
||||
XMLConfig: TXMLConfig;
|
||||
begin
|
||||
Result:=false;
|
||||
BeginUpdate(false);
|
||||
AFilename:=PkgLink.Filename;
|
||||
if not FileExists(AFilename) then exit;
|
||||
try
|
||||
XMLConfig:=TXMLConfig.Create(AFilename);
|
||||
NewPackage:=TLazPackage.Create;
|
||||
NewPackage.Filename:=AFilename;
|
||||
NewPackage.LoadFromXMLConfig(XMLConfig,'Package/');
|
||||
XMLConfig.Free;
|
||||
except
|
||||
on E: Exception do begin
|
||||
writeln('unable to read file "'+AFilename+'" ',E.Message);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
if not NewPackage.MakeSense then exit;
|
||||
if PkgLink.Compare(NewPackage)<>0 then exit;
|
||||
// ok
|
||||
AddPackage(NewPackage);
|
||||
EndUpdate;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
constructor TLazPackageGraph.Create;
|
||||
begin
|
||||
FTree:=TAVLTree.Create(@CompareLazPackageID);
|
||||
@ -543,7 +576,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLazPackageGraph.NewPackage(const Prefix: string): TLazPackage;
|
||||
function TLazPackageGraph.CreateNewPackage(const Prefix: string): TLazPackage;
|
||||
begin
|
||||
BeginUpdate(true);
|
||||
Result:=TLazPackage.Create;
|
||||
@ -1004,25 +1037,28 @@ var
|
||||
begin
|
||||
if Dependency.LoadPackageResult=lprUndefined then begin
|
||||
BeginUpdate(false);
|
||||
// search in opened packages
|
||||
// search compatible package in opened packages
|
||||
ANode:=FindNodeOfDependency(Dependency,fpfSearchPackageEverywhere);
|
||||
if (APackage=nil) then begin
|
||||
// package not yet open
|
||||
PkgLinks.UpdateAll;
|
||||
PkgLink:=PkgLinks.FindLinkWithDependency(Dependency);
|
||||
if PkgLink<>nil then begin
|
||||
|
||||
// ToDo
|
||||
|
||||
end;
|
||||
end;
|
||||
// save result
|
||||
if ANode<>nil then begin
|
||||
if (ANode<>nil) then begin
|
||||
Dependency.RequiredPackage:=TLazPackage(ANode.Data);
|
||||
Dependency.LoadPackageResult:=lprSuccess;
|
||||
end else begin
|
||||
end;
|
||||
if Dependency.LoadPackageResult=lprUndefined then begin
|
||||
// compatible package not yet open
|
||||
Dependency.RequiredPackage:=nil;
|
||||
Dependency.LoadPackageResult:=lprNotFound;
|
||||
if FindAPackageWithName(Dependency.PackageName,nil)=nil then begin
|
||||
// no package with same name open
|
||||
// -> try package links
|
||||
repeat
|
||||
PkgLink:=PkgLinks.FindLinkWithDependency(Dependency);
|
||||
if (PkgLink=nil) then break;
|
||||
if OpenDependencyWithPackageLink(Dependency,PkgLink) then break;
|
||||
PkgLinks.RemoveLink(PkgLink);
|
||||
until false;
|
||||
end else begin
|
||||
// there is already a package with this name open
|
||||
end;
|
||||
end;
|
||||
fChanged:=true;
|
||||
EndUpdate;
|
||||
|
||||
@ -277,6 +277,7 @@ end;
|
||||
|
||||
procedure TPkgManager.PkgManagerAddPackage(Pkg: TLazPackage);
|
||||
begin
|
||||
PkgLinks.AddUserLink(Pkg);
|
||||
if PackageGraphExplorer<>nil then
|
||||
PackageGraphExplorer.UpdatePackageAdded(Pkg);
|
||||
end;
|
||||
@ -511,6 +512,7 @@ begin
|
||||
IDEComponentPalette:=TIDEComponentPalette.Create;
|
||||
|
||||
PkgLinks:=TPackageLinks.Create;
|
||||
PkgLinks.UpdateAll;
|
||||
|
||||
PackageGraph:=TLazPackageGraph.Create;
|
||||
PackageGraph.OnChangePackageName:=@PackageGraphChangePackageName;
|
||||
@ -616,6 +618,9 @@ begin
|
||||
// add to graph
|
||||
PackageGraph.AddPackage(APackage);
|
||||
|
||||
// save package file links
|
||||
PkgLinks.SaveUserLinks;
|
||||
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
@ -630,7 +635,7 @@ var
|
||||
CurEditor: TPackageEditorForm;
|
||||
begin
|
||||
// create a new package with standard dependencies
|
||||
NewPackage:=PackageGraph.NewPackage('NewPackage');
|
||||
NewPackage:=PackageGraph.CreateNewPackage('NewPackage');
|
||||
NewPackage.AddRequiredDependency(
|
||||
PackageGraph.FCLPackage.CreateDependencyForThisPkg);
|
||||
NewPackage.Modified:=false;
|
||||
@ -711,7 +716,7 @@ begin
|
||||
if Result<>mrOk then APackage.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Result:=DoOpenPackage(APackage);
|
||||
end;
|
||||
|
||||
@ -737,7 +742,7 @@ begin
|
||||
end;
|
||||
|
||||
// ask user if package should be saved
|
||||
if pfAskBeforeSaving in Flags then begin
|
||||
if psfAskBeforeSaving in Flags then begin
|
||||
Result:=MessageDlg('Save package?',
|
||||
'Package "'+APackage.IDAsString+'" changed. Save?',
|
||||
mtConfirmation,[mbYes,mbNo,mbAbort],0);
|
||||
@ -768,6 +773,8 @@ begin
|
||||
try
|
||||
XMLConfig.Clear;
|
||||
APackage.SaveToXMLConfig(XMLConfig,'Package/');
|
||||
PkgLinks.AddUserLink(APackage);
|
||||
PkgLinks.SaveUserLinks;
|
||||
XMLConfig.Flush;
|
||||
finally
|
||||
XMLConfig.Free;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user