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

implemented replacing package

Browse Source 
git-svn-id: trunk@4057 -
This commit is contained in:
mattias 2003-04-14 08:49:29 +00:00
parent 29fb14b1f9
commit af6fab6c95
4 changed files with 137 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
packager/packagedefs.pas
View File

@ -499,6 +499,8 @@ function FindLowestPkgDependencyWithName(const PkgName: string): TPkgDependency;
function FindLowestPkgDependencyNodeWithName(const PkgName: string): TAVLTreeNode;
function FindNextPkgDependecyNodeWithSameName(Node: TAVLTreeNode): TAVLTreeNode;
function PackageFileNameIsValid(const AFilename: string): boolean;
implementation
@ -667,6 +669,17 @@ begin
Result:=nil;
end;
function PackageFileNameIsValid(const AFilename: string): boolean;
var
PkgName: String;
begin
Result:=false;
if CompareFileExt(AFilename,'.lpk',false)<>0 then exit;
PkgName:=ExtractFileNameOnly(AFilename);
if (PkgName='') or (not IsValidIdent(PkgName)) then exit;
Result:=true;
end;
function FindLowestPkgDependencyWithName(const PkgName: string): TPkgDependency;
var
ANode: TAVLTreeNode;

27
packager/packagelinks.pas
View File

@ -63,6 +63,7 @@ type
public
constructor Create;
destructor Destroy; override;
function MakeSense: boolean;
public
property Origin: TPkgLinkOrigin read FOrigin write SetOrigin;
property Filename: string read FFilename write SetFilename;
@ -190,6 +191,13 @@ begin
inherited Destroy;
end;
function TPackageLink.MakeSense: boolean;
begin
Result:=(Name<>'') and IsValidIdent(Name)
and PackageFileNameIsValid(Filename)
and (AnsiCompareText(Name,ExtractFileNameOnly(Filename))=0);
end;
{ TPackageLinks }
function TPackageLinks.FindLeftMostNode(LinkTree: TAVLTree;
@ -337,7 +345,7 @@ begin
NewPkgLink.Name:=NewPkgName;
NewPkgLink.Version.Assign(PkgVersion);
NewPkgLink.Filename:=NewFilename;
if IsValidIdent(NewPkgLink.Name) then
if NewPkgLink.MakeSense then
FGlobalLinks.Add(NewPkgLink)
else
NewPkgLink.Free;
@ -385,7 +393,8 @@ begin
NewPkgLink.Version.LoadFromXMLConfig(XMLConfig,ItemPath+'Version/',
LazPkgXMLFileVersion);
NewPkgLink.Filename:=XMLConfig.GetValue(ItemPath+'Filename/Value','');
if IsValidIdent(NewPkgLink.Name) then
if NewPkgLink.MakeSense then
FUserLinks.Add(NewPkgLink)
else
NewPkgLink.Free;
@ -575,6 +584,7 @@ var
OldLink: TPackageLink;
NewLink: TPackageLink;
begin
BeginUpdate;
// check if link already exists
OldLink:=FindLinkWithPackageID(APackage);
if (OldLink<>nil) then begin
@ -587,8 +597,12 @@ begin
NewLink:=TPackageLink.Create;
NewLink.AssignID(APackage);
NewLink.Filename:=APackage.Filename;
FUserLinks.Add(NewLink);
Modified:=true;
if NewLink.MakeSense then begin
FUserLinks.Add(NewLink);
Modified:=true;
end else
FUserLinks.Free;
EndUpdate;
end;
procedure TPackageLinks.RemoveLink(APackageID: TLazPackageID);
@ -596,12 +610,14 @@ var
ANode: TAVLTreeNode;
OldLink: TPackageLink;
begin
BeginUpdate;
// remove from user links
ANode:=FUserLinks.Find(APackageID);
if ANode<>nil then begin
OldLink:=TPackageLink(ANode.Data);
FUserLinks.Remove(ANode);
OldLink.Free;
Modified:=true;
end;
// remove from global links
ANode:=FGlobalLinks.Find(APackageID);
@ -609,8 +625,9 @@ begin
OldLink:=TPackageLink(ANode.Data);
FGlobalLinks.Remove(ANode);
OldLink.Free;
Modified:=true;
end;
Modified:=true;
EndUpdate;
end;

62
packager/packagesystem.pas
View File

@ -138,6 +138,7 @@ type
ComponentClasses: array of TComponentClass);
procedure RegistrationError(const Msg: string);
procedure AddPackage(APackage: TLazPackage);
procedure ReplacePackage(OldPackage, NewPackage: TLazPackage);
procedure AddStaticBasePackages;
procedure ClosePackage(APackage: TLazPackage);
procedure MarkNeededPackages;
@ -149,6 +150,7 @@ type
const NewName: string; NewVersion: TPkgVersion): TList;
function CheckIfPackageCanBeClosed(APackage: TLazPackage): boolean;
function PackageIsNeeded(APackage: TLazPackage): boolean;
function PackageCanBeReplaced(OldPackage, NewPackage: TLazPackage): boolean;
procedure RegisterStaticPackages;
procedure AddDependencyToPackage(APackage: TLazPackage;
Dependency: TPkgDependency);
@ -335,7 +337,8 @@ begin
if FUpdateLock=1 then begin
fChanged:=Change;
if Assigned(OnBeginUpdate) then OnBeginUpdate(Self);
end;
end else
fChanged:=fChanged or Change;
end;
procedure TLazPackageGraph.EndUpdate;
@ -816,6 +819,14 @@ begin
EndUpdate;
end;
procedure TLazPackageGraph.ReplacePackage(OldPackage, NewPackage: TLazPackage);
begin
BeginUpdate(true);
Delete(fItems.IndexOf(OldPackage));
AddPackage(NewPackage);
EndUpdate;
end;
procedure TLazPackageGraph.AddStaticBasePackages;
begin
// FCL
@ -865,8 +876,6 @@ begin
// get needed package from stack
dec(StackPtr);
Pkg:=PkgStack[StackPtr];
// mark package as needed
Pkg.Flags:=Pkg.Flags+[lpfNeeded,lpfVisited];
// put all required packages on stack
Dependency:=Pkg.FirstRequiredDependency;
while Dependency<>nil do begin
@ -891,8 +900,9 @@ var
begin
BeginUpdate(false);
MarkNeededPackages;
for i:=FItems.Count-1 downto 0 do
for i:=FItems.Count-1 downto 0 do begin
if not (lpfNeeded in Packages[i].Flags) then Delete(i);
end;
EndUpdate;
end;
@ -970,23 +980,55 @@ begin
end;
function TLazPackageGraph.PackageIsNeeded(APackage: TLazPackage): boolean;
// check if package is currently in use (installed, autoinstall, editor open)
// !!! it does not check if any needed package needs this package
begin
Result:=true;
// check if package is open, installed or will be installed
if (APackage.Installed<>pitNope) or (APackage.AutoInstall<>pitNope)
or ((APackage.Editor<>nil) and (APackage.Editor.Visible)) then
begin
Result:=true;
exit;
end;
// check if package is used
if (APackage.FirstUsedByDependency=nil) then begin
Result:=false;
exit;
end;
Result:=false;
end;
function TLazPackageGraph.PackageCanBeReplaced(
OldPackage, NewPackage: TLazPackage): boolean;
var
Dependency: TPkgDependency;
begin
Result:=false;
if PackageIsNeeded(OldPackage) then exit;
// check all used-by dependencies
Dependency:=OldPackage.FirstUsedByDependency;
if Dependency<>nil then begin
MarkNeededPackages;
while Dependency<>nil do begin
if (not Dependency.IsCompatible(NewPackage)) then begin
// replacing will break this dependency
// -> check if Owner is needed
if (Dependency.Owner=nil) then begin
// dependency has no owner -> can be broken
end else if (Dependency.Owner is TLazPackage) then begin
if lpfNeeded in TLazPackage(Dependency.Owner).Flags then begin
// a needed package needs old package -> can no be broken
exit;
end else begin
// an unneeded package needs old package -> can be broken
end;
end else begin
// an other thing (e.g. a project) needs old package -> can not be broken
exit;
end;
end;
Dependency:=Dependency.NextUsedByDependency;
end;
end;
Result:=true;
end;
procedure TLazPackageGraph.RegisterStaticPackages;
begin
// FCL

59
packager/pkgmanager.pas
View File

@ -277,7 +277,7 @@ end;
procedure TPkgManager.PkgManagerAddPackage(Pkg: TLazPackage);
begin
PkgLinks.AddUserLink(Pkg);
if FileExists(Pkg.FileName) then PkgLinks.AddUserLink(Pkg);
if PackageGraphExplorer<>nil then
PackageGraphExplorer.UpdatePackageAdded(Pkg);
end;
@ -608,15 +608,21 @@ begin
// check if Package with same name is already loaded
ConflictPkg:=PackageGraph.FindAPackageWithName(APackage.Name,nil);
if ConflictPkg<>nil then begin
Result:=MessageDlg('Package Name already loaded',
'There is already a package with the name "'+APackage.Name+'" loaded'#13
+'from file "'+ConflictPkg.Filename+'".',
mtError,[mbCancel,mbAbort],0);
exit;
if not PackageGraph.PackageCanBeReplaced(ConflictPkg,APackage) then begin
Result:=MessageDlg('Package Name already loaded',
'There is already a package with the name "'+APackage.Name+'" loaded'#13
+'from file "'+ConflictPkg.Filename+'".'#13
+'See Components -> Package Graph.',
mtError,[mbCancel,mbAbort],0);
exit;
end;
// replace package
PackageGraph.ReplacePackage(ConflictPkg,APackage);
end else begin
// add to graph
PackageGraph.AddPackage(APackage);
end;
// add to graph
PackageGraph.AddPackage(APackage);
// save package file links
PkgLinks.SaveUserLinks;
@ -670,8 +676,28 @@ function TPkgManager.DoOpenPackageFile(AFilename: string; Flags: TPkgOpenFlags
var
APackage: TLazPackage;
XMLConfig: TXMLConfig;
AlternativePkgName: String;
begin
AFilename:=CleanAndExpandFilename(AFilename);
// check file extension
if CompareFileExt(AFilename,'.lpk',false)<>0 then begin
Result:=MessageDlg('Invalid file extension',
'The file "'+AFilename+'" is not a lazarus package.',
mtError,[mbCancel,mbAbort],0);
exit;
end;
// check filename
AlternativePkgName:=ExtractFileNameOnly(AFilename);
if (AlternativePkgName='') or (not IsValidIdent(AlternativePkgName)) then
begin
Result:=MessageDlg('Invalid package filename',
'The package file name "'+AlternativePkgName+'" in'#13
+'"'+AFilename+'" is not a valid lazarus package name.',
mtError,[mbCancel,mbAbort],0);
exit;
end;
// check if package is already loaded
APackage:=PackageGraph.FindPackageWithFilename(AFilename,true);
@ -692,6 +718,7 @@ begin
Result:=mrCancel;
APackage:=TLazPackage.Create;
try
// load the package file
try
XMLConfig:=TXMLConfig.Create(AFilename);
@ -709,8 +736,22 @@ begin
exit;
end;
end;
// newly loaded is not modified
APackage.Modified:=false;
// check if package name and file name correspond
if (AnsiCompareText(AlternativePkgName,APackage.Name)<>0) then begin
Result:=MessageDlg('Filename differs from Packagename',
'The filename "'+ExtractFileName(AFilename)+'" does not correspond '
+'to the package name "'+APackage.Name+'" in the file.'#13
+'Change package name to "'+AlternativePkgName+'"?',
mtConfirmation,[mbYes,mbCancel,mbAbort],0);
if Result<>mrYes then exit;
APackage.Name:=AlternativePkgName;
end;
// integrate it into the graph
Result:=AddPackageToGraph(APackage);
finally
if Result<>mrOk then APackage.Free;