IDE: check i lpi file changes on disk

git-svn-id: trunk@22980 -

components/codetools/laz_xmlcfg.pas

@@ -54,13 +54,15 @@ type
   protected
     doc: TXMLDocument;
     FModified: Boolean;
-    fDoNotLoad: boolean;
+    fDoNotLoadFromFile: boolean;
+    fAutoLoadFromSource: string;
     procedure Loaded; override;
     function ExtendedToStr(const e: extended): string;
     function StrToExtended(const s: string; const ADefault: extended): extended;
   public
     constructor Create(const AFilename: String); overload;
     constructor CreateClean(const AFilename: String);
+    constructor CreateWithSource(const AFilename, Source: String);
     destructor Destroy; override;
     procedure Clear;
     procedure Flush;    // Writes the XML file
@@ -109,11 +111,21 @@ constructor TXMLConfig.CreateClean(const AFilename: String);
 begin
   //DebugLn(['TXMLConfig.CreateClean ',AFilename]);
   inherited Create(nil);
-  fDoNotLoad:=true;
+  fDoNotLoadFromFile:=true;
   SetFilename(AFilename);
   FModified:=FileExistsCached(AFilename);
 end;
 
+constructor TXMLConfig.CreateWithSource(const AFilename, Source: String);
+begin
+  fAutoLoadFromSource:=Source;
+  try
+    CreateClean(AFilename);
+  finally
+    fAutoLoadFromSource:='';
+  end;
+end;
+
 destructor TXMLConfig.Destroy;
 begin
   if Assigned(doc) then
@@ -143,6 +155,7 @@ procedure TXMLConfig.Flush;
 begin
   if Modified and (Filename<>'') then
   begin
+    DebugLn(['TXMLConfig.Flush ',Filename]);
     WriteXMLFile(doc, Filename);
     FModified := False;
   end;
@@ -429,6 +442,7 @@ end;
 procedure TXMLConfig.SetFilename(const AFilename: String);
 var
   cfg: TDOMElement;
+  ms: TMemoryStream;
 begin
   {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename A '+AFilename);{$ENDIF}
   if FFilename = AFilename then exit;
@@ -444,8 +458,18 @@ begin
   end;
 
   doc:=nil;
-  if FileExistsUTF8(AFilename) and (not fDoNotLoad) then
+  if (not fDoNotLoadFromFile) and FileExistsUTF8(AFilename) then
-    ReadXMLFile(doc,AFilename);
+    ReadXMLFile(doc,AFilename)
+  else if fAutoLoadFromSource<>'' then begin
+    ms:=TMemoryStream.Create;
+    try
+      ms.Write(fAutoLoadFromSource[1],length(fAutoLoadFromSource));
+      ms.Position:=0;
+      ReadXMLFile(doc,ms);
+    finally
+      ms.Free;
+    end;
+  end;
 
   if not Assigned(doc) then
     doc := TXMLDocument.Create;

ide/dialogprocs.pas

@@ -391,7 +391,7 @@ begin
       break;
     end else begin
       Result:=IDEMessageDialog(lisUnableToWriteFile,
-        Format(lisUnableToWriteFile2, ['"', Buffer.Filename, '"']),
+        Format(lisUnableToWriteToFile, ['"', Buffer.Filename, '"']),
         mtError,ErrorButtons+[mbCancel]);
       if Result<>mrRetry then exit;
     end;
@@ -450,7 +450,7 @@ begin
     end;
   except
     Result:=IDEMessageDialog(lisUnableToWriteFile,
-      Format(lisUnableToWriteFilename, ['"', AFilename, '"']), mtError, [
+      Format(lisUnableToWriteToFile, ['"', AFilename, '"']), mtError, [
         mbCancel, mbAbort]);
     exit;
   end;
@@ -479,7 +479,7 @@ begin
   Result:=mrOk;
   while not FileIsWritable(Filename) do begin
     Result:=IDEMessageDialog(lisFileIsNotWritable,
-      Format(lisUnableToWriteToFile2, ['"', Filename, '"']),
+      Format(lisUnableToWriteToFile, ['"', Filename, '"']),
       mtError,ErrorButtons+[mbCancel]);
     if Result<>mrRetry then exit;
   end;

ide/lazarusidestrconsts.pas

@@ -531,6 +531,11 @@ resourcestring
   lisFileNotText = 'File not text';
   lisUnableToRenameFile = 'Unable to rename file';
   lisUnableToCopyFile = 'Unable to copy file';
+  lisWriteError = 'Write Error';
+  lisFileDoesNotLookLikeATextFileOpenItAnyway2 = 'File %s%s%s%sdoes not look '
+    +'like a text file.%sOpen it anyway?';
+  lisUnableToCreateBackupDirectory =
+    'Unable to create backup directory %s%s%s.';
   lisSourceAndDestinationAreTheSame =
     'Source and Destination are the same:%s%s';
   lisUnableToRenameFileTo2 = 'Unable to rename file %s%s%s%sto %s%s%s.';
@@ -588,12 +593,6 @@ resourcestring
     +'file.';
   lisUnableToReadTheProjectInfoFile2 = 'Unable to read the project info file%'
     +'s%s%s%s.';
-  lisWriteError = 'Write Error';
-  lisUnableToWriteToFile = 'Unable to write to file %s%s%s!';
-  lisFileDoesNotLookLikeATextFileOpenItAnyway2 = 'File %s%s%s%sdoes not look '
-    +'like a text file.%sOpen it anyway?';
-  lisUnableToCreateBackupDirectory =
-    'Unable to create backup directory %s%s%s.';
   lisAmbiguousUnitFound2 = 'Ambiguous unit found';
   lisTheUnitExistsTwiceInTheUnitPathOfThe = 'The unit %s exists twice in the '
     +'unit path of the %s:';
@@ -2956,10 +2955,8 @@ resourcestring
     +'yet in the unit path.%sAdd it?';
   lisUnableToCreateFilename = 'Unable to create file %s%s%s.';
   lisUnableToWriteFile = 'Unable to write file';
-  lisUnableToWriteFile2 = 'Unable to write file %s%s%s';
+  lisUnableToWriteToFile = 'Unable to write to file %s%s%s.';
   lisFileIsNotWritable = 'File is not writable';
-  lisUnableToWriteToFile2 = 'Unable to write to file %s%s%s';
-  lisUnableToWriteFilename = 'Unable to write file %s%s%s.';
   lisUnableToReadFile = 'Unable to read file';
   lisUnableToReadFilename = 'Unable to read file %s%s%s.';
   lisErrorDeletingFile = 'Error deleting file';
@@ -4345,6 +4342,10 @@ resourcestring
     +'default compiler. e.g. ppc386 ppcx64 ppcppc etc. default is stored in '
     +'environmentoptions.xml';
   lisNo = 'No';
+  lisProjectChangedOnDisk = 'Project changed on disk';
+  lisTheProjectInformationFileHasChangedOnDisk = 'The project information '
+    +'file %s%s%s%shas changed on disk.';
+  lisReopenProject = 'Reopen project';
   rsOk = 'ok';
   rsScanners = 'Scanners';
   rsAvailableScanners = 'Available scanners';

ide/main.pp

@@ -11245,6 +11245,21 @@ begin
   APackageList:=nil;
   try
     InvalidateFileStateCache;
+
+    if Project1.HasProjectInfoFileChangedOnDisk then begin
+      if QuestionDlg(lisProjectChangedOnDisk,
+        Format(lisTheProjectInformationFileHasChangedOnDisk, ['"',
+          Project1.ProjectInfoFile, '"', #13]), mtConfirmation, [mrYes,
+            lisReopenProject, mrIgnore], '')
+        =mrYes
+      then begin
+        DoOpenProjectFile(Project1.ProjectInfoFile,[]);
+      end else begin
+        Project1.IgnoreProjectInfoFileOnDisk;
+      end;
+      exit(mrOk);
+    end;
+
     Project1.GetUnitsChangedOnDisk(AnUnitList);
     PkgBoss.GetPackagesChangedOnDisk(APackageList);
     if (AnUnitList=nil) and (APackageList=nil) then exit;

ide/project.pp

@@ -609,6 +609,8 @@ type
     fProjectDirectory: string;
     fProjectDirectoryReferenced: string;
     fProjectInfoFile: String;  // the lpi filename
+    fProjectInfoFileBuffer: TCodeBuffer;
+    fProjectInfoFileDate: LongInt;
     FPublishOptions: TPublishProjectOptions;
     FResources: TProjectResources;
     FRevertLockCount: integer;
@@ -693,6 +695,8 @@ type
     function SomethingModified(CheckData, CheckSession: boolean): boolean;
     procedure MainSourceFilenameChanged;
     procedure GetUnitsChangedOnDisk(var AnUnitList: TFPList);
+    function HasProjectInfoFileChangedOnDisk: boolean;
+    procedure IgnoreProjectInfoFileOnDisk;
     function ReadProject(const NewProjectInfoFile: string): TModalResult;
     function WriteProject(ProjectWriteFlags: TProjectWriteFlags;
                           const OverrideProjectInfoFile: string): TModalResult;
@@ -2171,10 +2175,18 @@ begin
       Result:=mrOk;
     except
       on E: Exception do begin
-        Result:=MessageDlg('Write error','Unable to write to file "'+CfgFilename+'".',
+        Result:=MessageDlg(lisCodeToolsDefsWriteError, Format(
+          lisUnableToWriteToFile, ['"', CfgFilename, '"']),
           mtError,[mbRetry,mbAbort],0);
       end;
     end;
+    if CompareFilenames(ProjectInfoFile,xmlconfig.Filename)=0 then begin
+      fProjectInfoFileBuffer:=CodeToolBoss.LoadFile(ProjectInfoFile,true,true);
+      try
+        fProjectInfoFileDate:=FileAgeUTF8(ProjectInfoFile);
+      except
+      end;
+    end;
     try
       xmlconfig.Free;
     except
@@ -2489,9 +2501,15 @@ begin
     Clear;
 
     ProjectInfoFile:=NewProjectInfoFile;
+    fProjectInfoFileBuffer:=CodeToolBoss.LoadFile(ProjectInfoFile,true,true);
     try
+      fProjectInfoFileDate:=FileAgeUTF8(ProjectInfoFile);
       {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject A reading lpi');{$ENDIF}
-      xmlconfig := TXMLConfig.Create(ProjectInfoFile);
+      if fProjectInfoFileBuffer=nil then
+        xmlconfig := TXMLConfig.CreateClean(ProjectInfoFile)
+      else
+        xmlconfig := TXMLConfig.CreateWithSource(ProjectInfoFile,
+                                                 fProjectInfoFileBuffer.Source);
       {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject B done lpi');{$ENDIF}
     except
       MessageDlg(Format(lisUnableToReadTheProjectInfoFile, [#13, '"',
@@ -2591,6 +2609,7 @@ begin
       {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject freeing xml');{$ENDIF}
       fPathDelimChanged:=false;
       try
+        xmlconfig.Modified:=false;
         xmlconfig.Free;
       except
       end;
@@ -2633,6 +2652,7 @@ begin
 
         fPathDelimChanged:=false;
         try
+          xmlconfig.Modified:=false;
           xmlconfig.Free;
         except
         end;
@@ -3628,6 +3648,37 @@ begin
   end;
 end;
 
+function TProject.HasProjectInfoFileChangedOnDisk: boolean;
+var
+  AnUnitInfo: TUnitInfo;
+begin
+  Result:=false;
+  if IsVirtual or Modified then exit;
+  AnUnitInfo:=UnitInfoWithFilename(ProjectInfoFile,[pfsfOnlyEditorFiles]);
+  if (AnUnitInfo<>nil) then begin
+    // users is editing the lpi file in source editor
+    exit;
+  end;
+  AnUnitInfo:=fFirst[uilAutoRevertLocked];
+  while (AnUnitInfo<>nil) do begin
+    if CompareFilenames(AnUnitInfo.Filename,ProjectInfoFile)=0 then begin
+      // revert locked
+      exit;
+    end;
+    AnUnitInfo:=AnUnitInfo.fNext[uilAutoRevertLocked];
+  end;
+
+  if not FileExistsCached(ProjectInfoFile) then exit;
+  if fProjectInfoFileDate=FileAgeUTF8(ProjectInfoFile) then exit;
+  //DebugLn(['TProject.HasProjectInfoFileChangedOnDisk ',ProjectInfoFile,' fProjectInfoFileDate=',fProjectInfoFileDate,' ',FileAgeUTF8(ProjectInfoFile)]);
+  Result:=true;
+end;
+
+procedure TProject.IgnoreProjectInfoFileOnDisk;
+begin
+  fProjectInfoFileDate:=FileAgeUTF8(ProjectInfoFile);
+end;
+
 procedure TProject.SetBookmark(AnUnitInfo: TUnitInfo; X, Y, ID: integer);
 begin
   if AnUnitInfo.EditorIndex>=0 then

packager/packagelinks.pas

@@ -151,6 +151,7 @@ type
     procedure BeginUpdate;
     procedure EndUpdate;
     procedure SaveUserLinks;
+    function NeedSaveUserLinks(const ConfigFilename: string): boolean;
     procedure WriteLinkTree(LinkTree: TAVLTree);
     function FindLinkWithPkgName(const PkgName: string): TPackageLink;
     function FindLinkWithDependency(Dependency: TPkgDependency): TPackageLink;
@@ -531,6 +532,7 @@ begin
       end else
         NewPkgLink.Free;
     end;
+    XMLConfig.Modified:=false;
     XMLConfig.Free;
     
     UserLinkLoadTime:=FileAgeUTF8(ConfigFilename);
@@ -608,11 +610,8 @@ begin
   ConfigFilename:=GetUserLinkFile;
   
   // check if file needs saving
-  if (not Modified)
+  if not NeedSaveUserLinks(ConfigFilename) then exit;
-  and UserLinkLoadTimeValid and FileExistsUTF8(ConfigFilename)
+  //DebugLn(['TPackageLinks.SaveUserLinks saving ... ',ConfigFilename,' Modified=',Modified,' UserLinkLoadTimeValid=',UserLinkLoadTimeValid,' ',FileAgeUTF8(ConfigFilename)=UserLinkLoadTime]);
-  and (FileAgeUTF8(ConfigFilename)=UserLinkLoadTime) then
-    exit;
-  //DebugLn(['TPackageLinks.SaveUserLinks saving ... ',ConfigFilename]);
 
   LazSrcDir:=EnvironmentOptions.LazarusDirectory;
 
@@ -621,6 +620,7 @@ begin
     XMLConfig:=TXMLConfig.CreateClean(ConfigFilename);
 
     Path:='UserPkgLinks/';
+    XMLConfig.SetValue(Path+'Version',PkgLinksFileVersion);
     ANode:=FUserLinksSortID.FindLowest;
     i:=0;
     while ANode<>nil do begin
@@ -665,6 +665,14 @@ begin
   Modified:=false;
 end;
 
+function TPackageLinks.NeedSaveUserLinks(const ConfigFilename: string): boolean;
+begin
+  Result:=Modified
+          or (not UserLinkLoadTimeValid)
+          or (not FileExistsUTF8(ConfigFilename))
+          or (FileAgeUTF8(ConfigFilename)<>UserLinkLoadTime);
+end;
+
 procedure TPackageLinks.WriteLinkTree(LinkTree: TAVLTree);
 var
   ANode: TAVLTreeNode;