diff --git a/components/codetools/laz_xmlcfg.pas b/components/codetools/laz_xmlcfg.pas index 3821cac5ea..1543ca1c9a 100644 --- a/components/codetools/laz_xmlcfg.pas +++ b/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 - ReadXMLFile(doc,AFilename); + if (not fDoNotLoadFromFile) and FileExistsUTF8(AFilename) then + 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; diff --git a/ide/dialogprocs.pas b/ide/dialogprocs.pas index 4f451cd8d5..559039a091 100644 --- a/ide/dialogprocs.pas +++ b/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; diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 214423212b..e325d21686 100644 --- a/ide/lazarusidestrconsts.pas +++ b/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'; diff --git a/ide/main.pp b/ide/main.pp index 45d815b574..33207c9790 100644 --- a/ide/main.pp +++ b/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; diff --git a/ide/project.pp b/ide/project.pp index 7ed85cb7c2..d7f068115d 100644 --- a/ide/project.pp +++ b/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 diff --git a/packager/packagelinks.pas b/packager/packagelinks.pas index 8e4725c717..2c882806df 100644 --- a/packager/packagelinks.pas +++ b/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) - and UserLinkLoadTimeValid and FileExistsUTF8(ConfigFilename) - and (FileAgeUTF8(ConfigFilename)=UserLinkLoadTime) then - exit; - //DebugLn(['TPackageLinks.SaveUserLinks saving ... ',ConfigFilename]); + if not NeedSaveUserLinks(ConfigFilename) then exit; + //DebugLn(['TPackageLinks.SaveUserLinks saving ... ',ConfigFilename,' Modified=',Modified,' UserLinkLoadTimeValid=',UserLinkLoadTimeValid,' ',FileAgeUTF8(ConfigFilename)=UserLinkLoadTime]); 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;