paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 01:49:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

ide+codetools: simplified check disk changes and fixed lfm check

Browse Source
This commit is contained in:
mattias 2023-04-23 19:00:25 +02:00
parent 41a4de2d72
commit 2766b200c2
6 changed files with 295 additions and 183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
components/codetools/codecache.pas
View File

@ -90,14 +90,14 @@ type
function FileDateOnDisk: longint;
function FileNeedsUpdate(IgnoreModifiedFlag: Boolean = False): boolean; // needs loading
function FileOnDiskNeedsUpdate: boolean;
function FileOnDiskHasChanged(IgnoreModifiedFlag: Boolean = False): boolean;
function FileOnDiskIsEqual: boolean;
function AutoRevertFromDisk: boolean;
function FileOnDiskHasChanged: boolean;
function FileOnDiskIsEqual: boolean; // only checking properties, not checking content
function AutoRevertFromDisk: boolean; // true if not locked by LockAutoDiskRevert
procedure LockAutoDiskRevert;
procedure UnlockAutoDiskRevert;
procedure IncrementRefCount;
procedure ReleaseRefCount;
procedure MakeFileDateValid;
procedure MakeFileDateValid; // Note: if file does not exist, LoadDate becomes -1
procedure InvalidateLoadDate;
function SourceIsText: boolean;
public
@ -109,7 +109,7 @@ type
property IsVirtual: boolean read FIsVirtual;
property LastIncludedByFile: string read GetLastIncludedByFile
write FLastIncludedByFile;
property LoadDate: longint read FLoadDate;
property LoadDate: longint read FLoadDate; // Note: can be -1 (file does not exist) even if LoadDateValid=true
property LoadDateValid: boolean read FLoadDateValid;
property FileChangeStep: integer read FFileChangeStep; // last loaded/saved changestep, only valid if LoadDateValid=true
property OnSetFilename: TNotifyEvent read FOnSetFilename write FOnSetFilename;
@ -1430,7 +1430,7 @@ procedure TCodeBuffer.MakeFileDateValid;
begin
FFileChangeStep:=ChangeStep;
FLoadDateValid:=true;
FLoadDate:=FileAgeCached(Filename);
FLoadDate:=FileAgeCached(Filename); // can be -1 if not exist
end;
procedure TCodeBuffer.InvalidateLoadDate;
@ -1484,14 +1484,17 @@ begin
or (not FileExistsCached(Filename));
end;
function TCodeBuffer.FileOnDiskHasChanged(IgnoreModifiedFlag: Boolean): boolean;
function TCodeBuffer.FileOnDiskHasChanged: boolean;
// file on disk has changed since last load/save
begin
Result:=false;
if IsVirtual then exit;
// LoadDateValid is set to false after edit
if (IgnoreModifiedFlag or LoadDateValid) and FileExistsCached(Filename) then
Result:=(FileDateOnDisk<>LoadDate);
if LoadDateValid then begin
// Note: FileDateOnDisk and/or LoadDate can be -1 for file does not exist
// see MakeFileDateValid
Result:=FileDateOnDisk<>LoadDate;
end;
if Result then
DebugLn(['TCodeBuffer.FileOnDiskHasChanged ',Filename,' LoadDate=',LoadDate]);
end;
@ -1502,12 +1505,15 @@ begin
exit(true);
if IsDeleted then
exit(not FileExistsCached(Filename));
if (not LoadDateValid)
or Modified or (FFileChangeStep<>ChangeStep)
or (not FileExistsCached(Filename))
or (FileDateOnDisk<>LoadDate)
then
exit(false);
if (not LoadDateValid) then
exit(false);// not loaded, so cannot be equal (not checking content)
// LoadDateValid=true
if Modified or (FFileChangeStep<>ChangeStep) then
exit(false); // file modified in memory
if FileDateOnDisk<>LoadDate then
exit(false); // this covers the case that the file does not exist anymore
Result:=true;
end;

2
components/lazutils/lazfileutils.pas
View File

@ -108,7 +108,7 @@ function FindPathInSearchPath(const APath, SearchPath: string): integer; overloa
// file operations
function FileExistsUTF8(const Filename: string): boolean;
function FileAgeUTF8(const FileName: string): Longint;
function FileAgeUTF8(const FileName: string): Longint; // -1 if not exists
function DirectoryExistsUTF8(const Directory: string): Boolean;
function ExpandFileNameUTF8(const FileName: string; {const} BaseDir: string = ''): string;
function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint;

247
ide/diskdiffsdialog.pas
View File

@ -35,7 +35,7 @@ uses
// CodeTools
FileProcs, CodeCache,
// LazUtils
LazFileUtils, UITypes,
LazFileUtils, UITypes, LazFileCache,
// IdeIntf
IDEImagesIntf,
// SynEdit
@ -70,9 +70,11 @@ type
private
FIgnoreList: TFPList;
FPackageList: TStringList;
FUnitList: TFPList;
FCodeList: TFPList;
FHasLocalModifications: Boolean;
FHasExistingFiles: Boolean;
FCachedDiffs: TFPList; // List of PDiffItem
function ShortenFilename(const aFilename: string): string;
procedure AddFile2Box(AInfo: TObject; AFileName: string; AModified: Boolean);
procedure FillFilesListBox;
procedure ApplyChecks;
@ -80,15 +82,17 @@ type
function GetCachedDiff(FileOwner: TObject; AltFilename: string): PDiffItem;
procedure ClearCache;
public
property UnitList: TFPList read FUnitList write FUnitList; // list of TUnitInfo
property PackageList: TStringList read FPackageList write FPackageList; // list of alternative filename and TLazPackage
property IgnoreList: TFPList read FIgnoreList write FIgnoreList;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
property CodeList: TFPList read FCodeList write FCodeList; // list of TCodeBuffer
property PackageList: TStringList read FPackageList write FPackageList; // list of alternative filename and TLazPackage
property IgnoreList: TFPList read FIgnoreList write FIgnoreList; // TCodeBuffer of TLazPackage
end;
function ShowDiskDiffsDialog(AnUnitList: TFPList;
APackageList: TStringList; AnIgnoreList: TFPList): TModalResult;
function ShowDiskDiffsDialog(
ACodeList: TFPList; // list of TCodeBuffer
APackageList: TStringList; // list of TLazPackage
AnIgnoreList: TFPList): TModalResult;
implementation
@ -97,75 +101,83 @@ implementation
var
DiskDiffsDlg: TDiskDiffsDlg = nil;
// Procedures used by ShowDiskDiffsDialog
procedure CheckUnits(ACodeList, AnIgnoreList: TFPList);
function AddChangedBuffer(Code: TCodeBuffer): boolean;
var
fs: TFileStream;
s, DiskEncoding, MemEncoding, aFilename: string;
begin
if (Code=nil) or Code.IsVirtual then
exit(false);
aFilename:=Code.Filename;
if EnvironmentOptions.CheckDiskChangesWithLoading then
begin
// load and compare
try
fs := TFileStream.Create(aFilename, fmOpenRead or fmShareDenyNone);
try
SetLength(s{%H-}, fs.Size);
if s <> '' then
fs.Read(s[1], length(s));
DiskEncoding := '';
MemEncoding := '';
Code.CodeCache.OnDecodeLoaded(Code,aFilename,
s,DiskEncoding,MemEncoding);
//debugln(['CheckUnitsWithLoading ',aFilename,
// ' ',length(s),'=',Code.SourceLength]);
if (MemEncoding=Code.MemEncoding)
and (DiskEncoding=Code.DiskEncoding)
and (length(s)=Code.SourceLength)
and (s=Code.Source) then begin
// same content -> no need to bother user
exit(false);
end;
finally
fs.Free;
end;
except
// unable to load, e.g. no longer exists or permission denied
end;
end;
// file has changed
Result:=true;
end;
procedure CheckUnitsWithLoading(AnUnitList: TFPList);
var
i: Integer;
CurUnit: TUnitInfo;
CodeOk: Boolean;
MemCode: TCodeBuffer;
s, DiskEncoding, MemEncoding: String;
fs: TFileStream;
begin
for i:=AnUnitList.Count-1 downto 0 do
for i:=ACodeList.Count-1 downto 0 do
begin
CurUnit:=TUnitInfo(AnUnitList[i]);
MemCode:=CurUnit.Source;
CodeOk:=false;
try
fs := TFileStream.Create(MemCode.Filename, fmOpenRead or fmShareDenyNone);
try
SetLength(s{%H-}, fs.Size);
if s <> '' then
fs.Read(s[1], length(s));
DiskEncoding := '';
MemEncoding := '';
MemCode.CodeCache.OnDecodeLoaded(MemCode,MemCode.Filename,
s,DiskEncoding,MemEncoding);
//debugln(['CheckUnitsWithLoading ',MemCode.Filename,
// ' ',length(s),'=',MemCode.SourceLength]);
if (MemEncoding=MemCode.MemEncoding)
and (DiskEncoding=MemCode.DiskEncoding)
and (length(s)=MemCode.SourceLength)
and (s=MemCode.Source) then begin
CodeOk:=true;
end;
finally
fs.Free;
end;
except
// unable to load
end;
if CodeOk then begin
if CurUnit.Source<>nil then
CurUnit.Source.MakeFileDateValid;
AnUnitList.Delete(i);
end;
if not AddChangedBuffer(TCodeBuffer(ACodeList[i])) then
AnIgnoreList.Add(ACodeList[i]);
end;
end;
procedure CheckPackagesWithLoading(APackageList: TStringList);
procedure CheckPackages(APackageList: TStringList; AnIgnoreList: TFPList);
var
i: Integer;
CurPackage: TLazPackage;
PackageOk: Boolean;
fs: TFileStream;
CurSource, DiskSource: string;
AltFilename: String;
AltFilename, LPKFilename: String;
begin
for i:=APackageList.Count-1 downto 0 do
begin
AltFilename:=APackageList[i];
CurPackage:=TLazPackage(APackageList.Objects[i]);
LPKFilename:=CurPackage.Filename;
PackageOk:=false;
if CurPackage.LPKSource=nil then
continue; // this package was not loaded/saved
if CompareFilenames(CurPackage.Filename,AltFilename)<>0 then
if CompareFilenames(LPKFilename,AltFilename)<>0 then
continue; // lpk has vanished, an alternative lpk was found => show
try
CurPackage.SaveToString(CurSource);
fs:=TFileStream.Create(CurPackage.Filename,fmOpenRead);
fs:=TFileStream.Create(LPKFilename,fmOpenRead);
try
if fs.Size=length(CurSource) then begin
// size has not changed => load to see difference
@ -183,41 +195,52 @@ begin
DebugLn(['CheckPackagesWithLoading Filename=',CurPackage.Filename,' Error=',E.Message]);
end;
if PackageOk then
APackageList.Delete(i);
AnIgnoreList.Add(CurPackage);
end;
end;
function ShowDiskDiffsDialog(AnUnitList: TFPList; APackageList: TStringList;
function ShowDiskDiffsDialog(ACodeList: TFPList; APackageList: TStringList;
AnIgnoreList: TFPList): TModalResult;
function ListsAreEmpty: boolean;
var
i: Integer;
begin
Result:=((AnUnitList=nil) or (AnUnitList.Count=0))
and ((APackageList=nil) or (APackageList.Count=0));
if ACodeList<>nil then
for i:=0 to ACodeList.Count-1 do
if AnIgnoreList.IndexOf(ACodeList[i])<0 then
exit(false);
if APackageList<>nil then
for i:=0 to APackageList.Count-1 do
if AnIgnoreList.IndexOf(APackageList.Objects[i])<0 then
exit(false);
Result:=true;
end;
begin
if (DiskDiffsDlg<>nil) or ListsAreEmpty then
exit(mrIgnore);
if EnvironmentOptions.CheckDiskChangesWithLoading then begin
if Assigned(AnUnitList) then
CheckUnitsWithLoading(AnUnitList);
if Assigned(APackageList) then
CheckPackagesWithLoading(APackageList);
if ListsAreEmpty then exit(mrIgnore);
end;
if Assigned(ACodeList) then
CheckUnits(ACodeList,AnIgnoreList);
if Assigned(APackageList) then
CheckPackages(APackageList,AnIgnoreList);
if ListsAreEmpty then
exit(mrIgnore);
DiskDiffsDlg:=TDiskDiffsDlg.Create(nil);
DiskDiffsDlg.UnitList:=AnUnitList;
DiskDiffsDlg.PackageList:=APackageList;
DiskDiffsDlg.IgnoreList:=AnIgnoreList;
DiskDiffsDlg.FillFilesListBox;
Result:=DiskDiffsDlg.ShowModal;
case Result of
mrOK : DiskDiffsDlg.ApplyChecks;
mrCancel : Result:=mrIgnore;
try
DiskDiffsDlg.CodeList:=ACodeList;
DiskDiffsDlg.PackageList:=APackageList;
DiskDiffsDlg.IgnoreList:=AnIgnoreList;
DiskDiffsDlg.FillFilesListBox;
Result:=DiskDiffsDlg.ShowModal;
case Result of
mrOK : DiskDiffsDlg.ApplyChecks;
mrCancel : Result:=mrIgnore;
end;
finally
DiskDiffsDlg.Free;
DiskDiffsDlg:=nil;
end;
DiskDiffsDlg.Free;
DiskDiffsDlg:=nil;
Assert(Result in [mrOK,mrIgnore], 'ShowDiskDiffsDialog: Invalid result '+IntToStr(Result));
end;
@ -245,6 +268,11 @@ begin
IDEImages.Images_16.DrawForPPI(paintbx.Canvas, 0, 0, imgIndex, 16, ppi, GetCanvasScaleFactor);
end;
function TDiskDiffsDlg.ShortenFilename(const aFilename: string): string;
begin
Result:=Project1.RemoveProjectPathFromFilename(aFilename);
end;
procedure TDiskDiffsDlg.AddFile2Box(AInfo: TObject; AFileName: string; AModified: Boolean);
var
i: Integer;
@ -261,47 +289,81 @@ end;
procedure TDiskDiffsDlg.FillFilesListBox;
var
i: integer;
UInfo: TUnitInfo;
CurUnit: TUnitInfo;
APackage: TLazPackage;
aCode: TCodeBuffer;
aFilename, AltFilename: String;
CurModified: Boolean;
begin
FHasLocalModifications:=False;
FHasExistingFiles:=False;
FilesListBox.Items.BeginUpdate;
FilesListBox.Items.Clear;
if UnitList<>nil then
if CodeList<>nil then
begin
for i:=0 to UnitList.Count-1 do begin
UInfo:=TUnitInfo(UnitList[i]);
AddFile2Box(UInfo, UInfo.ShortFilename, UInfo.Modified);
for i:=0 to CodeList.Count-1 do begin
aCode:=TCodeBuffer(CodeList[i]);
if IgnoreList.IndexOf(aCode)>=0 then continue;
aFilename:=aCode.Filename;
CurUnit:=Project1.UnitInfoWithFilename(aFilename);
if CurUnit=nil then
CurUnit:=Project1.UnitInfoWithLFMFilename(aFilename);
CurModified:=(CurUnit<>nil) and CurUnit.Modified;
AddFile2Box(aCode, ShortenFilename(aFilename), CurModified);
if (not FHasExistingFiles) and FileExistsCached(aFilename) then
FHasExistingFiles:=true;
end;
end;
if PackageList<>nil then
begin
for i:=0 to PackageList.Count-1 do begin
APackage:=TLazPackage(PackageList.Objects[i]);
if IgnoreList.IndexOf(APackage)>=0 then continue;
AddFile2Box(APackage, APackage.Filename, APackage.Modified);
AltFilename:=PackageList[i];
if not FHasExistingFiles then
begin
if FileExistsCached(APackage.Filename)
or ((CompareFilenames(AltFilename,APackage.Filename)<>0)
and FileExistsCached(AltFilename)) then
FHasExistingFiles:=true;
end;
end;
end;
FilesListBox.Items.EndUpdate;
WarnImage.Visible:=FHasLocalModifications;
WarnLabel.Visible:=FHasLocalModifications;
BtnPanel.OkButton.Visible:=FHasExistingFiles;
end;
procedure TDiskDiffsDlg.ShowDiff;
var
i: integer;
DiffItem: PDiffItem;
AInfo: TObject;
aFilename: String;
aCode: TCodeBuffer;
begin
i:=FilesListBox.ItemIndex;
DiffItem:=nil;
if (i>=0) and (UnitList<>nil) then begin
if i<UnitList.Count then
DiffItem:=GetCachedDiff(TUnitInfo(UnitList[i]),'');
dec(i,UnitList.Count);
end;
if (i>=0) and (PackageList<>nil) then begin
if i<PackageList.Count then
DiffItem:=GetCachedDiff(TLazPackage(PackageList.Objects[i]),PackageList[i]);
dec(i,PackageList.Count);
i:=FilesListBox.ItemIndex;
if i>=0 then
begin
aFilename:=FilesListBox.Items[i];
if aFilename[1]='*' then
Delete(aFilename,1,1);
AInfo:=FilesListBox.Items.Objects[i];
if AInfo is TCodeBuffer then
begin
aCode:=TCodeBuffer(AInfo);
DiffItem:=GetCachedDiff(aCode,'');
end else if AInfo is TLazPackage then begin
for i:=0 to PackageList.Count-1 do
if PackageList.Objects[i]=AInfo then
begin
DiffItem:=GetCachedDiff(TLazPackage(AInfo),PackageList[i]);
break;
end;
end;
end;
if DiffItem<>nil then begin
DiffSynEdit.Lines.Text:=DiffItem^.Diff;
@ -316,10 +378,10 @@ var
i: integer;
fs: TFileStream;
Filename: String;
AnUnitInfo: TUnitInfo;
APackage: TLazPackage;
Source: String;
DiffOutput: TDiffOutput;
Code: TCodeBuffer;
begin
if FCachedDiffs=nil then
FCachedDiffs:=TFPList.Create;
@ -330,11 +392,11 @@ begin
New(Result);
Result^.Owner:=FileOwner;
try
if FileOwner is TUnitInfo then begin
if FileOwner is TCodeBuffer then begin
// compare disk and codetools
AnUnitInfo:=TUnitInfo(FileOwner);
Filename:=AnUnitInfo.Source.Filename;
Source:=AnUnitInfo.Source.Source;
Code:=TCodeBuffer(FileOwner);
Filename:=Code.Filename;
Source:=Code.Source;
end else if FileOwner is TLazPackage then begin
// compare disk and package
APackage:=TLazPackage(FileOwner);
@ -414,7 +476,6 @@ procedure TDiskDiffsDlg.ApplyChecks;
var
i: Integer;
begin
FIgnoreList.Clear;
for i := 0 to FilesListBox.Count-1 do
if not FilesListBox.Checked[i] then
FIgnoreList.Add(FilesListBox.Items.Objects[i]);

59
ide/main.pp
View File

@ -8668,10 +8668,11 @@ end;
function TMainIDE.DoCheckFilesOnDisk(Instantaneous: boolean): TModalResult;
var
AnUnitList, AIgnoreList: TFPList; // list of TUnitInfo
BufferList, AIgnoreList, LFMLoaded: TFPList; // list of TCodeBuffer
APackageList: TStringList; // list of alternative lpkfilename and TLazPackage
i: integer;
CurUnit: TUnitInfo;
CurCode: TCodeBuffer;
begin
Result:=mrOk;
if not CheckFilesOnDiskEnabled then exit;
@ -8685,11 +8686,11 @@ begin
Exclude(FIdleIdeActions, iiaCheckFilesOnDisk);
CheckFilesOnDiskEnabled:=False;
AnUnitList:=nil;
BufferList:=nil;
APackageList:=nil;
AIgnoreList:=nil;
LFMLoaded:=nil;
try
AIgnoreList := TFPList.Create;
InvalidateFileStateCache;
if Project1.HasProjectInfoFileChangedOnDisk then begin
@ -8704,26 +8705,37 @@ begin
exit(mrOk);
end;
Project1.GetUnitsChangedOnDisk(AnUnitList, True);
AIgnoreList := TFPList.Create;
Project1.GetSourcesChangedOnDisk(BufferList);
PkgBoss.GetPackagesChangedOnDisk(APackageList, True);
if (AnUnitList=nil) and (APackageList=nil) then exit;
Result:=ShowDiskDiffsDialog(AnUnitList,APackageList,AIgnoreList);
if (BufferList=nil) and (APackageList=nil) then exit;
Result:=ShowDiskDiffsDialog(BufferList,APackageList,AIgnoreList);
// reload units
if AnUnitList<>nil then begin
for i:=0 to AnUnitList.Count-1 do begin
CurUnit:=TUnitInfo(AnUnitList[i]);
if BufferList<>nil then begin
LFMLoaded:=TFPList.Create;
// revert units and associated forms
for i:=0 to BufferList.Count-1 do begin
CurCode:=TCodeBuffer(BufferList[i]);
CurUnit:=Project1.UnitInfoWithFilename(CurCode.Filename);
if CurUnit=nil then continue;
if (Result=mrOk)
and (AIgnoreList.IndexOf(CurUnit)<0) then // ignore current
and (AIgnoreList.IndexOf(CurUnit)<0) then
begin
// revert
if CurUnit.OpenEditorInfoCount > 0 then
begin
// Revert one Editor-View, the others follow
Result:=OpenEditorFile(CurUnit.Filename, CurUnit.OpenEditorInfo[0].PageIndex,
CurUnit.OpenEditorInfo[0].WindowID, nil, [ofRevert], True);
// Reload the form file in designer if there is one
if Assigned(CurUnit.Component) then
if Assigned(CurUnit.Component) and (AIgnoreList.IndexOf(CurUnit.SourceLFM)<0) then
begin
LFMLoaded.Add(CurUnit.SourceLFM);
LoadLFM(CurUnit,[ofOnlyIfExists,ofRevert],[]);
end;
end else if CurUnit.IsMainUnit then
begin
Result:=RevertMainUnit;
@ -8732,6 +8744,7 @@ begin
Result:=mrIgnore;
if Result=mrAbort then exit;
end else begin
// keep memory file
//DebugLn(['DoCheckFilesOnDisk IgnoreCurrentFileDateOnDisk']);
CurUnit.IgnoreCurrentFileDateOnDisk;
CurUnit.Modified:=True;
@ -8739,6 +8752,23 @@ begin
CurUnit.OpenEditorInfo[0].EditorComponent.Modified:=True;
end;
end;
// revert lfm, where the pascal source has not changed or should be kept
for i:=0 to BufferList.Count-1 do begin
CurCode:=TCodeBuffer(BufferList[i]);
if LFMLoaded.IndexOf(CurCode)>=0 then continue;
CurUnit:=Project1.UnitInfoWithLFMFilename(CurCode.Filename);
if CurUnit=nil then continue;
// designer form
if (Result=mrOk)
and Assigned(CurUnit.Component)
and (AIgnoreList.IndexOf(CurUnit.SourceLFM)<0) then
begin
LFMLoaded.Add(CurUnit.SourceLFM);
LoadLFM(CurUnit,[ofOnlyIfExists,ofRevert],[]);
end;
CurCode.MakeFileDateValid;
end;
end;
// reload packages
@ -8754,7 +8784,8 @@ begin
Result:=mrOk;
finally
CheckFilesOnDiskEnabled:=True;
AnUnitList.Free;
LFMLoaded.Free;
BufferList.Free;
APackageList.Free;
AIgnoreList.Free;
end;
@ -8899,7 +8930,7 @@ begin
AnUnitInfo:=Project1.FirstUnitWithComponent;
while AnUnitInfo<>nil do begin
NextUnitInfo:=AnUnitInfo.NextUnitWithComponent;
if not AnUnitInfo.NeedsSaveToDisk then
if not AnUnitInfo.NeedsSaveToDisk(true) then
CloseUnitComponent(AnUnitInfo,[]);
AnUnitInfo:=NextUnitInfo;
end;
@ -11673,7 +11704,7 @@ var
begin
ADesigner:=TDesigner(Sender);
GetDesignerUnit(ADesigner,ASrcEdit,AnUnitInfo);
if AnUnitInfo.NeedsSaveToDisk
if AnUnitInfo.NeedsSaveToDisk(true)
then begin
case IDEQuestionDialog(lisSaveChanges,
Format(lisSaveFileBeforeClosingForm,

127
ide/project.pp
View File

@ -273,7 +273,6 @@ type
this attribute contains the component name,
even if the unit is not loaded, or the designer form is not created.
A component can be for example a TForm or a TDataModule }
fComponentLFMLoadDate: longint; // Load time of associated LFM form file.
fComponentResourceName: string;
FComponentLastBinStreamSize: TStreamSeekType;
FComponentLastLFMStreamSize: TStreamSeekType;
@ -285,8 +284,6 @@ type
FFirstUsedByComponent: TUnitComponentDependency;
FFlags: TUnitInfoFlags;
fHasResources: boolean; // source has resource file
FIgnoreFileDateOnDiskValid: boolean;
FIgnoreFileDateOnDisk: longint;
fLoaded: Boolean; // loaded in the source editor, needed to restore open files
fLoadedDesigner: Boolean; // has a visible designer, needed to restore open designers
FLoadingComponent: boolean;
@ -300,6 +297,7 @@ type
FRunFileIfActive: boolean;
FSessionModified: boolean;
fSource: TCodeBuffer;
FSourceLFM: TCodeBuffer;
fUsageCount: extended;
fUserReadOnly: Boolean;
fSourceChangeStep: LongInt;
@ -339,6 +337,7 @@ type
procedure SetRunFileIfActive(const AValue: boolean);
procedure SetSessionModified(const AValue: boolean);
procedure SetSource(ABuffer: TCodeBuffer);
procedure SetSourceLFM(const AValue: TCodeBuffer);
procedure SetTimeStamps;
procedure SetUserReadOnly(const NewValue: boolean);
protected
@ -357,7 +356,7 @@ type
function GetFileOwner: TObject; override;
function GetFileOwnerName: string; override;
function ChangedOnDisk(CompareOnlyLoadSaveTime: boolean; IgnoreModifiedFlag: boolean = False): boolean;
function IsChangedOnDisk(CheckLFM: boolean): boolean;
function IsAutoRevertLocked: boolean;
function IsReverting: boolean;
function IsMainUnit: boolean;
@ -365,7 +364,7 @@ type
function GetDirectory: string;
function GetFullFilename: string; override;
function GetShortFilename(UseUp: boolean): string; override;
function NeedsSaveToDisk: boolean;
function NeedsSaveToDisk(CheckLFM: boolean): boolean;
function ReadOnly: boolean;
function ReadUnitSource(ReadUnitName,Revert:boolean): TModalResult;
function ShortFilename: string;
@ -481,6 +480,7 @@ type
property Project: TProject read FProject write SetProject;
property RunFileIfActive: boolean read FRunFileIfActive write SetRunFileIfActive;
property Source: TCodeBuffer read fSource write SetSource;
property SourceLFM: TCodeBuffer read FSourceLFM write SetSourceLFM;
property DefaultSyntaxHighlighter: TLazSyntaxHighlighter
read FDefaultSyntaxHighlighter write SetDefaultSyntaxHighlighter;
property UserReadOnly: Boolean read fUserReadOnly write SetUserReadOnly;
@ -933,7 +933,7 @@ type
function SomeDataModified(Verbose: boolean = false): boolean;
function SomeSessionModified(Verbose: boolean = false): boolean;
procedure MainSourceFilenameChanged;
procedure GetUnitsChangedOnDisk(var AnUnitList: TFPList; IgnoreModifiedFlag: boolean = False);
procedure GetSourcesChangedOnDisk(var ACodeBufferList: TFPList);
function HasProjectInfoFileChangedOnDisk: boolean;
procedure IgnoreProjectInfoFileOnDisk;
function ReadProject(const NewProjectInfoFile: string;
@ -980,6 +980,7 @@ type
function IndexOfFilename(const AFilename: string): integer;
function IndexOfFilename(const AFilename: string;
SearchFlags: TProjectFileSearchFlags): integer;
function IndexOfLFMFilename(const AFilename: string): integer; // only currently open lfm (SourceLFM<>nil)
function ProjectUnitWithFilename(const AFilename: string): TUnitInfo;
function ProjectUnitWithShortFilename(const ShortFilename: string): TUnitInfo;
function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo;
@ -999,6 +1000,7 @@ type
function UnitInfoWithFilename(const AFilename: string;
SearchFlags: TProjectFileSearchFlags): TUnitInfo;
function UnitWithUnitname(const AnUnitname: string): TUnitInfo;
function UnitInfoWithLFMFilename(const AFilename: string): TUnitInfo; // only currently open lfm (SourceLFM<>nil)
function AllEditorsInfoCount: Integer;
property AllEditorsInfo[Index: Integer]: TUnitEditorInfo read GetAllEditorsInfo;
function EditorInfoWithEditorComponent(AEditor:TSourceEditorInterface): TUnitEditorInfo;
@ -1645,15 +1647,14 @@ begin
if Result=mrAbort then exit;
end;
repeat
if not fSource.Save then begin
if fSource.Save then begin
Result:=mrOk;
end else begin
ACaption:=lisCodeToolsDefsWriteError;
AText:=Format(lisUnableToWriteFile2, [Filename]);
Result:=IDEMessageDialog(ACaption,AText,mtError,mbAbortRetryIgnore);
if Result=mrAbort then exit;
if Result=mrIgnore then Result:=mrOk;
end else begin
Result:=mrOk;
FIgnoreFileDateOnDiskValid:=true;
end;
until Result<>mrRetry;
Result:=mrOk;
@ -1702,7 +1703,6 @@ begin
exit;
end else begin
Source:=NewSource;
FIgnoreFileDateOnDiskValid:=true;
Result:=mrOk;
end;
until Result<>mrRetry;
@ -1778,7 +1778,6 @@ begin
fFilename := '';
fFileReadOnly := false;
fHasResources := false;
FIgnoreFileDateOnDiskValid := false;
fAutoReferenceSourceDir := true;
inherited SetIsPartOfProject(false);
Modified := false;
@ -1803,6 +1802,7 @@ procedure TUnitInfo.ClearComponentDependencies;
begin
while FFirstRequiredComponent<>nil do FFirstRequiredComponent.Free;
while FFirstUsedByComponent<>nil do FFirstUsedByComponent.Free;
SourceLFM:=nil;
end;
procedure TUnitInfo.WriteDebugReportUnitComponentDependencies(Prefix: string);
@ -2198,53 +2198,35 @@ end;
function TUnitInfo.ComponentLFMOnDiskHasChanged: boolean;
// Associated LFM resource file on disk has changed since last load/save
var
ResFilename: String;
begin
if fComponentLFMLoadDate=0 then Exit(false); // 0 means there is no LFM file.
ResFilename:=UnitResourceFileformat.GetUnitResourceFilename(Filename,true);
Result:=fComponentLFMLoadDate<>FileAgeCached(ResFilename);
if Result then
DebugLn(['TUnitInfo.ComponentLFMOnDiskHasChanged ', ResFilename, ' changed on disk.']);
if SourceLFM=nil then Exit(false);
if SourceLFM.FileOnDiskHasChanged then exit(true);
end;
procedure TUnitInfo.SetTimeStamps;
var
ResFilename: String;
begin
if FSource<>nil then
fSourceChangeStep:=FSource.ChangeStep // Indicates any change is source
else
fSourceChangeStep:=CTInvalidChangeStamp;
// Associated LFM resource file timestamp
//if Component=nil then exit; <- Component is here always nil for some reason.
if UnitResourceFileformat=nil then exit; // Happens with LazBuild
ResFilename:=UnitResourceFileformat.GetUnitResourceFilename(Filename,true);
if FileExistsCached(ResFilename) then
fComponentLFMLoadDate:=FileAgeCached(ResFilename);
end;
function TUnitInfo.ChangedOnDisk(CompareOnlyLoadSaveTime: boolean;
IgnoreModifiedFlag: boolean): boolean;
function TUnitInfo.IsChangedOnDisk(CheckLFM: boolean): boolean;
begin
Result:=(Source<>nil) and Source.FileOnDiskHasChanged(IgnoreModifiedFlag);
if not Result then
Result:=ComponentLFMOnDiskHasChanged;
if Result
and (not CompareOnlyLoadSaveTime)
and FIgnoreFileDateOnDiskValid
and (FIgnoreFileDateOnDisk=Source.FileDateOnDisk) then
Result:=false;
Result:=(Source<>nil) and Source.FileOnDiskHasChanged;
if (not Result) and CheckLFM and (Component<>nil) and (SourceLFM<>nil) then
Result:=SourceLFM.FileOnDiskHasChanged;
FileReadOnly:=(not IsVirtual) and FileExistsCached(Filename)
and not FileIsWritableCached(Filename);
end;
procedure TUnitInfo.IgnoreCurrentFileDateOnDisk;
begin
if Source<>nil then begin
FIgnoreFileDateOnDiskValid:=true;
FIgnoreFileDateOnDisk:=Source.FileDateOnDisk;
end
if Source<>nil then
Source.MakeFileDateValid;
if SourceLFM<>nil then
SourceLFM.MakeFileDateValid;
end;
function TUnitInfo.ShortFilename: string;
@ -2255,15 +2237,13 @@ begin
Result:=Filename;
end;
function TUnitInfo.NeedsSaveToDisk: boolean;
function TUnitInfo.NeedsSaveToDisk(CheckLFM: boolean): boolean;
begin
Result:=IsVirtual or Modified or ChangedOnDisk(true);
Result:=IsVirtual or Modified or IsChangedOnDisk(CheckLFM);
//DebugLn(['TUnitInfo.NeedsSaveToDisk ',filename,' Result=',Result,' Modified=',Modified]);
if Result then Exit;
if Source<>nil then
Result:=Source.FileOnDiskNeedsUpdate
else
Result:=not FileExistsUTF8(Filename);
Result:=Source.ChangeStep<>fSourceChangeStep;
end;
procedure TUnitInfo.UpdateUsageCount(Min, IfBelowThis, IncIfBelow: extended);
@ -2478,7 +2458,6 @@ begin
if (fSource<>nil) and IsAutoRevertLocked then
fSource.UnlockAutoDiskRevert;
fSource:=ABuffer;
FIgnoreFileDateOnDiskValid:=false;
if (fSource<>nil) then begin
SetTimeStamps;
if IsAutoRevertLocked then
@ -2489,6 +2468,12 @@ begin
end;
end;
procedure TUnitInfo.SetSourceLFM(const AValue: TCodeBuffer);
begin
if FSourceLFM=AValue then Exit;
FSourceLFM:=AValue;
end;
procedure TUnitInfo.SetUserReadOnly(const NewValue: boolean);
begin
fUserReadOnly:=NewValue;
@ -2638,7 +2623,6 @@ begin
fFileReadOnly:=AValue;
if fSource<>nil then
fSource.ReadOnly:=ReadOnly;
SessionModified:=true;
end;
procedure TUnitInfo.SetComponent(const AValue: TComponent);
@ -4801,20 +4785,25 @@ begin
ExtendPath(SrcPathMacroName,CompilerOptions.SrcPath);
end;
procedure TProject.GetUnitsChangedOnDisk(var AnUnitList: TFPList;
IgnoreModifiedFlag: boolean);
procedure TProject.GetSourcesChangedOnDisk(var ACodeBufferList: TFPList);
procedure Add(aCode: TCodeBuffer);
begin
if aCode=nil then exit;
if not aCode.FileOnDiskHasChanged then exit;
if ACodeBufferList=nil then
ACodeBufferList:=TFPList.Create;
if ACodeBufferList.IndexOf(aCode)<0 then
ACodeBufferList.Add(aCode);
end;
var
AnUnitInfo: TUnitInfo;
begin
AnUnitList:=nil;
AnUnitInfo:=fFirst[uilAutoRevertLocked];
while (AnUnitInfo<>nil) do begin
if (AnUnitInfo.Source<>nil)
and AnUnitInfo.ChangedOnDisk(false, IgnoreModifiedFlag) then begin
if AnUnitList=nil then
AnUnitList:=TFPList.Create;
AnUnitList.Add(AnUnitInfo);
end;
Add(AnUnitInfo.Source);
Add(AnUnitInfo.SourceLFM);
AnUnitInfo:=AnUnitInfo.fNext[uilAutoRevertLocked];
end;
end;
@ -5969,6 +5958,17 @@ begin
Result:=nil;
end;
function TProject.UnitInfoWithLFMFilename(const AFilename: string): TUnitInfo;
var
i: Integer;
begin
i:=IndexOfLFMFilename(AFilename);
if i>=0 then
Result:=Units[i]
else
Result:=nil;
end;
function TProject.AllEditorsInfoCount: Integer;
begin
Result := FAllEditorsInfoList.Count;
@ -6172,6 +6172,19 @@ begin
end;
end;
function TProject.IndexOfLFMFilename(const AFilename: string): integer;
var
CurUnit: TUnitInfo;
begin
Result:=UnitCount-1;
while (Result>=0) do begin
CurUnit:=Units[Result];
if (CurUnit.SourceLFM<>nil)
and (CompareFilenames(AFilename,CurUnit.SourceLFM.Filename)=0) then exit;
dec(Result);
end;
end;
function TProject.ProjectUnitWithFilename(const AFilename: string): TUnitInfo;
begin
Result:=fFirst[uilPartOfProject];

7
ide/sourcefilemanager.pas
View File

@ -2488,7 +2488,7 @@ begin
// if nothing modified then a simple Save can be skipped
//debugln(['SaveEditorFile A ',AnUnitInfo.Filename,' ',AnUnitInfo.NeedsSaveToDisk]);
if ([sfSaveToTestDir,sfSaveAs]*Flags=[]) and (not AnUnitInfo.NeedsSaveToDisk) then
if ([sfSaveToTestDir,sfSaveAs]*Flags=[]) and (not AnUnitInfo.NeedsSaveToDisk(true)) then
begin
if AEditor.Modified then
begin
@ -2570,7 +2570,7 @@ begin
exit(mrCancel);
end else
begin
if AnUnitInfo.Modified or (MainIDE.CheckFilesOnDiskEnabled and AnUnitInfo.NeedsSaveToDisk) then
if AnUnitInfo.Modified or (MainIDE.CheckFilesOnDiskEnabled and AnUnitInfo.NeedsSaveToDisk(false)) then
begin
// save source to file
DestFilename := AnUnitInfo.Filename;
@ -6041,6 +6041,7 @@ begin
// someone created a .lfm file -> Update HasResources
AnUnitInfo.HasResources:=true;
AnUnitInfo.SourceLFM:=LFMBuf;
// find the classname of the LFM, and check for inherited form
AnUnitInfo.UnitResourceFileformat.QuickCheckResourceBuffer(
@ -7886,7 +7887,7 @@ begin
end else
begin
// not loaded in source editor (hidden)
SaveMainSrc := (sfSaveToTestDir in Flags) or MainUnitInfo.NeedsSaveToDisk;
SaveMainSrc := (sfSaveToTestDir in Flags) or MainUnitInfo.NeedsSaveToDisk(false);
if SaveMainSrc and (MainUnitInfo.Source<>nil) then
begin
Result := SaveCodeBufferToFile(MainUnitInfo.Source, DestFilename);