implemented replacing package

git-svn-id: trunk@4057 -

packager/packagedefs.pas

@@ -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;

packager/packagelinks.pas

@@ -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);
+  if NewLink.MakeSense then begin
-  Modified:=true;
+    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;
 
 

packager/packagesystem.pas

@@ -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

packager/pkgmanager.pas

@@ -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',
+    if not PackageGraph.PackageCanBeReplaced(ConflictPkg,APackage) then begin
-      'There is already a package with the name "'+APackage.Name+'" loaded'#13
+      Result:=MessageDlg('Package Name already loaded',
-      +'from file "'+ConflictPkg.Filename+'".',
+        'There is already a package with the name "'+APackage.Name+'" loaded'#13
-      mtError,[mbCancel,mbAbort],0);
+        +'from file "'+ConflictPkg.Filename+'".'#13
-    exit;
+        +'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;