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

MG: started file access monitoring for loaded files

Browse Source 
git-svn-id: trunk@1810 -
This commit is contained in:
lazarus 2002-08-01 14:10:30 +00:00
parent f451b0d701
commit 2ffb183638
5 changed files with 519 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -154,6 +154,7 @@ ide/compileroptions.pp svneol=native#text/pascal
ide/compreg.pp svneol=native#text/pascal
ide/customformeditor.pp svneol=native#text/pascal
ide/debugmanager.pas svneol=native#text/pascal
ide/diskdiffsdialog.pas svneol=native#text/pascal
ide/editdefinetree.pas svneol=native#text/pascal
ide/editoroptions.lrs svneol=native#text/pascal
ide/editoroptions.pp svneol=native#text/pascal

194
ide/diskdiffsdialog.pas Normal file
View File

@ -0,0 +1,194 @@
{ $Id$ }
{
/***************************************************************************
diskdiffsdialog.pas
- form for showing the diffs of editor files changed on disk
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit DiskDiffsDialog;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, IDEProcs, Forms, Controls, Buttons, ExtCtrls, StdCtrls,
LResources, Project, SynEdit;
type
TDiskDiffsDlg = class(TForm)
MainGroupBox: TGroupBox;
FilesListBox: TListBox;
DiffSynEdit: TSynEdit;
RevertAllButton: TButton;
IgnoreDiskChangesButton: TButton;
procedure DiskDiffsDlgResize(Sender: TObject);
private
FUnitList: TList;
procedure FillFilesListBox;
procedure SetUnitList(const AValue: TList);
public
property UnitList: TList read FUnitList write SetUnitList; // list of TUnitInfo
constructor Create(TheOwner: TComponent); override;
end;
var DiskDiffsDlg: TDiskDiffsDlg;
function ShowDiskDiffsDialog(AnUnitList: TList): TModalResult;
implementation
function ShowDiskDiffsDialog(AnUnitList: TList): TModalResult;
begin
if DiskDiffsDlg<>nil then begin
Result:=mrIgnore;
exit;
end;
DiskDiffsDlg:=TDiskDiffsDlg.Create(Application);
DiskDiffsDlg.UnitList:=AnUnitList;
Result:=DiskDiffsDlg.ShowModal;
DiskDiffsDlg.Free;
DiskDiffsDlg:=nil;
end;
{ TDiskDiffsDlg }
procedure TDiskDiffsDlg.DiskDiffsDlgResize(Sender: TObject);
begin
with MainGroupBox do begin
Width:=Self.ClientWidth-2*Left;
Height:=Self.ClientHeight-50-Top;
end;
with DiffSynEdit do begin
Width:=MainGroupBox.ClientWidth;
Height:=MainGroupBox.ClientHeight-Top;
end;
with RevertAllButton do begin
Top:=Self.ClientHeight-40;
end;
with IgnoreDiskChangesButton do begin
Left:=RevertAllButton.Left+RevertAllButton.Width+10;
Top:=RevertAllButton.Top;
end;
end;
procedure TDiskDiffsDlg.FillFilesListBox;
var i: integer;
begin
FilesListBox.Items.BeginUpdate;
FilesListBox.Items.Clear;
for i:=0 to UnitList.Count-1 do
FilesListBox.Items.Add(TUnitInfo(UnitList[i]).ShortFilename);
FilesListBox.Items.EndUpdate;
end;
procedure TDiskDiffsDlg.SetUnitList(const AValue: TList);
begin
FUnitList:=AValue;
FillFilesListBox;
end;
constructor TDiskDiffsDlg.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
if LazarusResources.Find(ClassName)=nil then begin
Caption:='Some files have changed on disk:';
Position:=poScreenCenter;
Width:=600;
Height:=300;
MainGroupBox:=TGroupBox.Create(Self);
with MainGroupBox do begin
Name:='MainGroupBox';
Parent:=Self;
Left:=5;
Top:=5;
Width:=Self.ClientWidth-2*Left;
Height:=Self.ClientHeight-50-Top;
Caption:='Changed files:';
Visible:=true;
end;
FilesListBox:=TListBox.Create(Self);
with FilesListBox do begin
Name:='FilesListBox';
Parent:=MainGroupBox;
Left:=0;
Top:=0;
Height:=60;
Align:=alTop;
Visible:=true;
end;
DiffSynEdit:=TSynEdit.Create(Self);
with DiffSynEdit do begin
Name:='DiffSynEdit';
Parent:=MainGroupBox;
Left:=0;
Top:=FilesListBox.Height+2;
Width:=MainGroupBox.ClientWidth;
Height:=MainGroupBox.ClientHeight-Top;
Lines.Text:='Diff not implemented yet.';
Visible:=true;
end;
RevertAllButton:=TButton.Create(Self);
with RevertAllButton do begin
Name:='RevertAllButton';
Parent:=Self;
Left:=50;
Top:=Self.ClientHeight-40;
Width:=150;
Caption:='Revert All';
ModalResult:=mrYesToAll;
Visible:=true;
end;
IgnoreDiskChangesButton:=TButton.Create(Self);
with IgnoreDiskChangesButton do begin
Name:='IgnoreDiskChangesButton';
Parent:=Self;
Left:=RevertAllButton.Left+RevertAllButton.Width+10;
Top:=RevertAllButton.Top;
Width:=150;
Caption:='Ignore disk changes';
ModalResult:=mrIgnore;
Visible:=true;
end;
OnResize:=@DiskDiffsDlgResize;
end;
end;
initialization
DiskDiffsDlg:=nil;
end.

75
ide/main.pp
View File

@ -53,7 +53,7 @@ uses
RunParamsOpts, ExtToolDialog, MacroPromptDlg, LMessages, ProjectDefs,
Watchesdlg, BreakPointsdlg, ColumnDlg, OutputFilter, BuildLazDialog,
MiscOptions, EditDefineTree, CodeToolsOptions, TypInfo, IDEOptionDefs,
CodeToolsDefines, LocalsDlg, DebuggerDlg, InputHistory,
CodeToolsDefines, LocalsDlg, DebuggerDlg, InputHistory, DiskDiffsDialog,
// main ide
BaseDebugManager, DebugManager, MainBar;
@ -339,6 +339,7 @@ type
function DoOpenFileAtCursor(Sender: TObject): TModalResult;
function DoSaveAll: TModalResult;
function DoOpenMainUnit(ProjectLoading: boolean): TModalResult;
function DoRevertMainUnit: TModalResult;
function DoViewUnitsAndForms(OnlyForms: boolean): TModalResult;
// project(s)
@ -365,18 +366,21 @@ type
function DoRunExternalTool(Index: integer): TModalResult;
function DoBuildLazarus: TModalResult;
// useful methods
// useful information methods
procedure GetCurrentUnit(var ActiveSourceEditor:TSourceEditor;
var ActiveUnitInfo:TUnitInfo); override;
procedure DoSwitchToFormSrc(var ActiveSourceEditor:TSourceEditor;
var ActiveUnitInfo:TUnitInfo);
procedure GetUnitWithPageIndex(PageIndex:integer;
procedure GetUnitWithPageIndex(PageIndex:integer;
var ActiveSourceEditor:TSourceEditor; var ActiveUnitInfo:TUnitInfo);
function GetSourceEditorForUnitInfo(AnUnitInfo: TUnitInfo): TSourceEditor;
procedure UpdateDefaultPascalFileExtensions;
function CreateSrcEditPageName(const AnUnitName, AFilename: string;
IgnorePageIndex: integer): string;
// useful file methods
function FindUnitFile(const AFilename: string): string; override;
function DoSaveStreamToFile(AStream:TStream; const Filename:string;
function DoSaveStreamToFile(AStream:TStream; const Filename:string;
IsPartOfProject:boolean): TModalResult;
function DoLoadMemoryStreamFromFile(MemStream: TMemoryStream;
function DoLoadMemoryStreamFromFile(MemStream: TMemoryStream;
const AFilename:string): TModalResult;
function DoSaveCodeBufferToFile(ABuffer: TCodeBuffer;
const AFilename: string; IsPartOfProject:boolean): TModalResult;
@ -384,10 +388,12 @@ type
const AFilename: string; Flags: TLoadBufferFlags): TModalResult;
function DoBackupFile(const Filename:string;
IsPartOfProject:boolean): TModalResult;
function DoCheckFilesOnDisk: TModalResult; override;
// useful frontend methods
procedure DoSwitchToFormSrc(var ActiveSourceEditor:TSourceEditor;
var ActiveUnitInfo:TUnitInfo);
procedure UpdateCaption;
procedure UpdateDefaultPascalFileExtensions;
function CreateSrcEditPageName(const AnUnitName, AFilename: string;
IgnorePageIndex: integer): string;
function DoConvertDFMFileToLFMFile(const DFMFilename: string): TModalResult;
// methods for codetools
@ -3838,6 +3844,7 @@ begin
Result:=DoOpenMainUnit(ofProjectLoading in Flags);
exit;
end;
// check if the project knows this file
if (not (ofRevert in Flags)) then begin
UnitIndex:=Project1.IndexOfFilename(AFilename);
@ -3963,6 +3970,20 @@ begin
{$ENDIF}
end;
function TMainIDE.DoRevertMainUnit: TModalResult;
begin
Result:=mrOk;
if Project1.MainUnit<0 then exit;
if Project1.MainUnitInfo.EditorIndex>=0 then
// main unit is loaded, so we can just revert
Result:=DoOpenEditorFile('',Project1.MainUnitInfo.EditorIndex,[ofRevert])
else begin
// main unit is only loaded in background
// -> just reload the source and update the source name
Result:=Project1.MainUnitInfo.ReadUnitSource(true);
end;
end;
function TMainIDE.DoViewUnitsAndForms(OnlyForms: boolean): TModalResult;
var UnitList: TList;
i: integer;
@ -4754,6 +4775,7 @@ begin
end else begin
DoJumpToCompilerMessage(-1,true);
end;
DoCheckFilesOnDisk;
finally
ToolStatus:=itNone;
end;
@ -4883,6 +4905,7 @@ function TMainIDE.DoRunExternalTool(Index: integer): TModalResult;
begin
SourceNotebook.ClearErrorLines;
Result:=EnvironmentOptions.ExternalTools.Run(Index,MacroList);
DoCheckFilesOnDisk;
end;
function TMainIDE.DoBuildLazarus: TModalResult;
@ -4890,6 +4913,7 @@ begin
SourceNotebook.ClearErrorLines;
Result:=BuildLazarus(MiscellaneousOptions.BuildLazOpts,
EnvironmentOptions.ExternalTools,MacroList);
DoCheckFilesOnDisk;
end;
function TMainIDE.DoConvertDFMtoLFM: TModalResult;
@ -4919,6 +4943,7 @@ begin
finally
OpenDialog.Free;
end;
DoCheckFilesOnDisk;
end;
function TMainIDE.DoCheckSyntax: TModalResult;
@ -5216,6 +5241,33 @@ begin
until Result<>mrRetry;
end;
function TMainIDE.DoCheckFilesOnDisk: TModalResult;
var
AnUnitList: TList; // list of TUnitInfo
i: integer;
CurUnit: TUnitInfo;
begin
Result:=mrOk;
Project1.GetUnitsChangedOnDisk(AnUnitList);
if AnUnitList=nil then exit;
Result:=ShowDiskDiffsDialog(AnUnitList);
if Result in [mrYesToAll] then begin
for i:=0 to AnUnitList.Count-1 do begin
CurUnit:=TUnitInfo(AnUnitList[i]);
writeln('AAA1 REVERTING ',CurUnit.Filename);
if CurUnit.EditorIndex>=0 then begin
Result:=DoOpenEditorFile('',CurUnit.EditorIndex,[ofRevert]);
end else if CurUnit.IsMainUnit then begin
Result:=DoRevertMainUnit;
end else
Result:=mrIgnore;
if Result=mrAbort then exit;
end;
Result:=mrOk;
end;
AnUnitList.Free;
end;
procedure TMainIDE.UpdateCaption;
var NewCaption:string;
begin
@ -6803,6 +6855,9 @@ end.
{ =============================================================================
$Log$
Revision 1.332 2002/08/01 14:10:28 lazarus
MG: started file access monitoring for loaded files
Revision 1.331 2002/08/01 08:06:25 lazarus
MG: reduced output

1
ide/mainbar.pas
View File

@ -221,6 +221,7 @@ type
Flags: TOpenFlags): TModalResult; virtual; abstract;
function DoInitProjectRun: TModalResult; virtual; abstract;
function DoCheckFilesOnDisk: TModalResult; virtual; abstract;
end;
var

290
ide/project.pp
View File

@ -69,6 +69,7 @@ type
TUnitInfo = class(TObject)
private
{ Variables }
fAutoRevertLockCount: integer;
fBreakpoints: TProjectBreakPointList;
fCursorPos: TPoint;
fCustomHighlighter: boolean; // do not change highlighter on file extension change
@ -79,6 +80,7 @@ type
// this attribute contains the formname even if the unit is not loaded
fHasResources: boolean; // source has resource file
fIsPartOfProject: boolean;
fLastCheckedFileAge: longint;
fLoaded: Boolean; // loaded in the source editor
fModified: boolean;
fOnFileBackup: TOnFileBackup;
@ -106,8 +108,14 @@ type
PrevUnitWithEditorIndex: TUnitInfo;
NextUnitWithForm: TUnitInfo;
PrevUnitWithForm: TUnitInfo;
NextLoadedUnit: TUnitInfo;
PrevLoadedUnit: TUnitInfo;
NextAutoRevertLockedUnit: TUnitInfo;
PrevAutoRevertLockedUnit: TUnitInfo;
procedure UpdateEditorIndexList;
procedure UpdateFormList;
procedure UpdateLoadedList;
procedure UpdateAutoRevertLockedList;
public
constructor Create(ACodeBuffer: TCodeBuffer);
destructor Destroy; override;
@ -122,6 +130,12 @@ type
procedure CreateStartCode(NewUnitType: TNewUnitType;
const NewUnitName: string);
function IsVirtual: boolean;
function IsMainUnit: boolean;
procedure IncreaseAutoRevertLock;
procedure DecreaseAutoRevertLock;
function IsAutoRevertLocked: boolean;
function ChangedOnDisk: boolean;
function ShortFilename: string;
{ Properties }
property Breakpoints: TProjectBreakPointList
@ -170,6 +184,8 @@ type
fActiveEditorIndexAtStart: integer;
fBookmarks: TProjectBookmarkList;
fCompilerOptions: TCompilerOptions;
fFirstAutoRevertLockedUnit: TUnitInfo; // units with IsAutoRevertLocked=true
fFirstLoadedUnit: TUnitInfo; // units with Loaded=true
fFirstUnitWithEditorIndex: TUnitInfo;// units with EditorIndex>=0
fFirstUnitWithForm: TUnitInfo; // units with Form<>nil
fIconPath: String;
@ -191,14 +207,15 @@ type
function GetMainUnitInfo: TUnitInfo;
function GetProjectInfoFile: string;
function GetTargetFilename: string;
function GetUnits(Index:integer):TUnitInfo;
function GetUnits(Index: integer): TUnitInfo;
procedure SetFlags(const AValue: TProjectFlags);
procedure SetMainUnit(const AValue: Integer);
procedure SetUnits(Index:integer; AUnitInfo: TUnitInfo);
procedure SetProjectInfoFile(const NewFilename:string);
procedure SetProjectInfoFile(const NewFilename: string);
procedure SetTargetFilename(const NewTargetFilename: string);
procedure OnLoadSaveFilename(var AFilename:string; Load:boolean);
function OnUnitFileBackup(const Filename:string;
IsPartOfProject:boolean):TModalResult;
procedure OnLoadSaveFilename(var AFilename: string; Load: boolean);
function OnUnitFileBackup(const Filename: string;
IsPartOfProject:boolean): TModalResult;
procedure OnUnitNameChange(AnUnitInfo: TUnitInfo;
const OldUnitName, NewUnitName: string; CheckIfAllowed: boolean;
var Allowed: boolean);
@ -210,6 +227,10 @@ type
procedure RemoveFromEditorWithIndexList(AnUnitInfo: TUnitInfo);
procedure AddToFormList(AnUnitInfo: TUnitInfo);
procedure RemoveFromFormList(AnUnitInfo: TUnitInfo);
procedure AddToLoadedList(AnUnitInfo: TUnitInfo);
procedure RemoveFromLoadedList(AnUnitInfo: TUnitInfo);
procedure AddToAutoRevertLockedList(AnUnitInfo: TUnitInfo);
procedure RemoveFromAutoRevertLockedList(AnUnitInfo: TUnitInfo);
public
constructor Create(TheProjectType: TProjectType);
destructor Destroy; override;
@ -219,13 +240,13 @@ type
property Units[Index: integer]:TUnitInfo read GetUnits write SetUnits;
function UnitCount:integer;
function NewUniqueUnitName(NewUnitType:TNewUnitType):string;
function NewUniqueFormName(NewUnitType:TNewUnitType):string;
procedure AddUnit(AUnit: TUnitInfo; AddToProjectFile:boolean);
procedure RemoveUnit(Index:integer);
function IndexOf(AUnitInfo: TUnitInfo):integer;
function IndexOfUnitWithName(const AnUnitName:string;
OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo):integer;
function NewUniqueUnitName(NewUnitType:TNewUnitType): string;
function NewUniqueFormName(NewUnitType:TNewUnitType): string;
procedure AddUnit(AUnit: TUnitInfo; AddToProjectFile: boolean);
procedure RemoveUnit(Index: integer);
function IndexOf(AUnitInfo: TUnitInfo): integer;
function IndexOfUnitWithName(const AnUnitName: string;
OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo): integer;
function IndexOfUnitWithForm(AForm: TComponent;
OnlyProjectUnits:boolean):integer;
function IndexOfFilename(const AFilename: string): integer;
@ -236,6 +257,8 @@ type
procedure InsertEditorIndex(EditorIndex:integer);
procedure AddToOrRemoveFromEditorWithIndexList(AnUnitInfo: TUnitInfo);
procedure AddToOrRemoveFromFormList(AnUnitInfo: TUnitInfo);
procedure AddToOrRemoveFromLoadedList(AnUnitInfo: TUnitInfo);
procedure AddToOrRemoveFromAutoRevertLockedList(AnUnitInfo: TUnitInfo);
procedure Clear;
function SomethingModified: boolean;
@ -250,6 +273,8 @@ type
function RemoveProjectPathFromFilename(const AFilename: string): string;
function ProjectDirectory: string;
function FileIsInProjectDir(const AFilename: string): boolean;
procedure GetUnitsChangedOnDisk(var AnUnitList: TList);
property ActiveEditorIndexAtStart: integer
read fActiveEditorIndexAtStart write fActiveEditorIndexAtStart;
@ -261,7 +286,7 @@ type
property JumpHistory: TProjectJumpHistory
read fJumpHistory write fJumpHistory;
property MainUnit: Integer //this is the unit index of the program file
read fMainUnit write fMainUnit;
read fMainUnit write SetMainUnit;
property MainUnitInfo: TUnitInfo read GetMainUnitInfo;
property Modified: boolean read fModified write fModified;
property OnFileBackup: TOnFileBackup read fOnFileBackup write fOnFileBackup;
@ -368,6 +393,7 @@ end;
------------------------------------------------------------------------------}
destructor TUnitInfo.Destroy;
begin
Source:=nil;
fBreakPoints.Free;
Project:=nil;
inherited Destroy;
@ -533,7 +559,7 @@ begin
fFormName:=XMLConfig.GetValue(Path+'FormName/Value','');
HasResources:=XMLConfig.GetValue(Path+'HasResources/Value',false);
fIsPartOfProject:=XMLConfig.GetValue(Path+'IsPartOfProject/Value',false);
fLoaded:=XMLConfig.GetValue(Path+'Loaded/Value',false);
Loaded:=XMLConfig.GetValue(Path+'Loaded/Value',false);
fReadOnly:=XMLConfig.GetValue(Path+'ReadOnly/Value',false);
AFilename:=XMLConfig.GetValue(Path+'ResourceFilename/Value','');
if Assigned(fOnLoadSaveFilename) then
@ -585,6 +611,26 @@ begin
end;
end;
procedure TUnitInfo.UpdateLoadedList;
begin
if Project<>nil then begin
Project.AddToOrRemoveFromLoadedList(Self);
end else begin
NextLoadedUnit:=nil;
PrevLoadedUnit:=nil;
end;
end;
procedure TUnitInfo.UpdateAutoRevertLockedList;
begin
if Project<>nil then begin
Project.AddToOrRemoveFromAutoRevertLockedList(Self);
end else begin
NextAutoRevertLockedUnit:=nil;
PrevAutoRevertLockedUnit:=nil;
end;
end;
function TUnitInfo.GetFileName: string;
begin
if fSource<>nil then Result:=fSource.Filename
@ -599,16 +645,67 @@ begin
Result:=(fFileName<>ExpandFileName(fFileName));
end;
function TUnitInfo.IsMainUnit: boolean;
begin
Result:=(Project<>nil) and (Project.MainUnitInfo=Self);
end;
procedure TUnitInfo.IncreaseAutoRevertLock;
begin
inc(fAutoRevertLockCount);
if (fAutoRevertLockCount=1) then begin
// activate lock
if (Source<>nil) then
Source.LockAutoDiskRevert;
if Project<>nil then
Project.AddToOrRemoveFromAutoRevertLockedList(Self);
end;
end;
procedure TUnitInfo.DecreaseAutoRevertLock;
begin
dec(fAutoRevertLockCount);
if (fAutoRevertLockCount=0) then begin
// deactivate lock
if (Source<>nil) then
Source.LockAutoDiskRevert;
if Project<>nil then
Project.AddToOrRemoveFromAutoRevertLockedList(Self);
end;
end;
function TUnitInfo.IsAutoRevertLocked: boolean;
begin
Result:=fAutoRevertLockCount>0;
end;
function TUnitInfo.ChangedOnDisk: boolean;
begin
Result:=(Source<>nil) and (Source.FileOnDiskHasChanged)
and (fLastCheckedFileAge<>Source.FileDateOnDisk);
if Result then
fLastCheckedFileAge:=Source.FileDateOnDisk;
end;
function TUnitInfo.ShortFilename: string;
begin
if Project<>nil then begin
Result:=Project.RemoveProjectPathFromFilename(Filename);
end else begin
Result:=Filename;
end;
end;
procedure TUnitInfo.SetSource(ABuffer: TCodeBuffer);
begin
if fSource=ABuffer then exit;
if (ABuffer<>nil) and Loaded then
ABuffer.UnlockAutoDiskRevert;
if (fSource<>nil) and IsAutoRevertLocked then
fSource.UnlockAutoDiskRevert;
fSource:=ABuffer;
if (fSource<>nil) then begin
if Loaded then
if IsAutoRevertLocked then
fSource.LockAutoDiskRevert;
fFileName:=ABuffer.FileName;
fFileName:=fSource.FileName;
end;
end;
@ -720,16 +817,21 @@ begin
UpdateFormList;
end;
{-------------------------------------------------------------------------------
procedure TUnitInfo.SetLoaded(const AValue: Boolean);
Loaded is a flag, that is set, when a unit has finished loading into the
editor. It is saved to the project info file and a loaded unit will be
reloaded, when the project is opened.
-------------------------------------------------------------------------------}
procedure TUnitInfo.SetLoaded(const AValue: Boolean);
begin
if fLoaded=AValue then exit;
fLoaded:=AValue;
if fSource<>nil then begin
if fLoaded then
fSource.LockAutoDiskRevert
else
fSource.UnlockAutoDiskRevert;
end;
if fLoaded then
IncreaseAutoRevertLock
else
DecreaseAutoRevertLock;
end;
procedure TUnitInfo.SetProject(const AValue: TProject);
@ -738,10 +840,14 @@ begin
if AValue=nil then begin
Project.RemoveFromEditorWithIndexList(Self);
Project.RemoveFromFormList(Self);
Project.RemoveFromLoadedList(Self);
Project.RemoveFromAutoRevertLockedList(Self);
end;
FProject:=AValue;
UpdateEditorIndexList;
UpdateFormList;
UpdateLoadedList;
UpdateAutoRevertLockedList;
end;
@ -820,7 +926,7 @@ begin
Add('end.');
Add('');
end;
Units[MainUnit].Source.Assign(NewSource);
MainUnitInfo.Source.Assign(NewSource);
end;
end;
NewSource.Free;
@ -1030,20 +1136,27 @@ end;
TProject AddUnit
------------------------------------------------------------------------------}
procedure TProject.AddUnit(AUnit: TUnitInfo; AddToProjectFile:boolean);
var ShortUnitName:string;
var
ShortUnitName:string;
NewIndex: integer;
begin
if (AUnit = nil) then exit;
NewIndex:=UnitCount;
fUnitList.Add(AUnit);
AUnit.Project:=Self;
AUnit.OnFileBackup:=@OnUnitFileBackup;
AUnit.OnLoadSaveFilename:=@OnLoadSaveFilename;
AUnit.OnUnitNameChange:=@OnUnitNameChange;
// check if this is the new Main Unit
if MainUnit=NewIndex then
MainUnitInfo.IncreaseAutoRevertLock;
if AddToProjectFile and (MainUnit>=0) then begin
if AddToProjectFile and (MainUnit>=0) and (MainUnit<>NewIndex) then begin
// add unit to uses section
ShortUnitName:=AUnit.UnitName;
if (ShortUnitName<>'') and (not UnitIsUsed(ShortUnitName)) then
CodeToolBoss.AddUnitToMainUsesSection(Units[MainUnit].Source,
CodeToolBoss.AddUnitToMainUsesSection(MainUnitInfo.Source,
ShortUnitName,'');
end;
Modified:=true;
@ -1065,7 +1178,7 @@ begin
OldUnitInfo:=Units[Index];
Modified:=true;
if MainUnit>=0 then begin
if (MainUnit>=0) then begin
// remove unit from uses section and from createforms in program file
if (OldUnitInfo.IsPartOfProject) then begin
if (OldUnitInfo.UnitName<>'') then
@ -1128,6 +1241,18 @@ begin
FFlags:=AValue;
end;
procedure TProject.SetMainUnit(const AValue: Integer);
begin
if fMainUnit=AValue then exit;
if (fMainUnit>=0) and (fMainUnit<UnitCount) then begin
MainUnitInfo.DecreaseAutoRevertLock;
end;
fMainUnit:=AValue;
if (fMainUnit>=0) and (fMainUnit<UnitCount) then begin
MainUnitInfo.IncreaseAutoRevertLock;
end;
end;
procedure TProject.SetUnits(Index:integer; AUnitInfo: TUnitInfo);
begin
if AUnitInfo<>TUnitInfo(fUnitList[Index]) then begin
@ -1343,15 +1468,16 @@ end;
procedure TProject.CloseEditorIndex(EditorIndex:integer);
var i:integer;
AnUnitInfo: TUnitInfo;
AnUnitInfo, NextUnitInfo: TUnitInfo;
begin
AnUnitInfo:=fFirstUnitWithEditorIndex;
while AnUnitInfo<>nil do begin
NextUnitInfo:=AnUnitInfo.NextUnitWithEditorIndex;
if AnUnitInfo.EditorIndex=EditorIndex then
AnUnitInfo.EditorIndex:=-1
else if AnUnitInfo.EditorIndex>EditorIndex then
AnUnitInfo.EditorIndex:=AnUnitInfo.EditorIndex-1;
AnUnitInfo:=AnUnitInfo.NextUnitWithEditorIndex;
AnUnitInfo:=NextUnitInfo;
end;
i:=Bookmarks.Count-1;
while (i>=0) do begin
@ -1401,6 +1527,24 @@ begin
end;
end;
procedure TProject.AddToOrRemoveFromLoadedList(AnUnitInfo: TUnitInfo);
begin
if not AnUnitInfo.Loaded then begin
RemoveFromLoadedList(AnUnitInfo);
end else begin
AddToLoadedList(AnUnitInfo);
end;
end;
procedure TProject.AddToOrRemoveFromAutoRevertLockedList(AnUnitInfo: TUnitInfo);
begin
if not AnUnitInfo.IsAutoRevertLocked then begin
RemoveFromAutoRevertLockedList(AnUnitInfo);
end else begin
AddToAutoRevertLockedList(AnUnitInfo);
end;
end;
function TProject.GetTargetFilename: string;
begin
Result:=fCompilerOptions.TargetFilename;
@ -1419,7 +1563,10 @@ end;
function TProject.GetMainUnitInfo: TUnitInfo;
begin
if MainUnit>=0 then Result:=Units[MainUnit] else Result:=nil;
if (MainUnit>=0) and (MainUnit<UnitCount) then
Result:=Units[MainUnit]
else
Result:=nil;
end;
function TProject.GetProjectInfoFile:string;
@ -1503,6 +1650,22 @@ begin
Result:=true;
end;
procedure TProject.GetUnitsChangedOnDisk(var AnUnitList: TList);
var
AnUnitInfo: TUnitInfo;
begin
AnUnitList:=nil;
AnUnitInfo:=fFirstAutoRevertLockedUnit;
while (AnUnitInfo<>nil) do begin
if AnUnitInfo.ChangedOnDisk then begin
if AnUnitList=nil then
AnUnitList:=TList.Create;
AnUnitList.Add(AnUnitInfo);
end;
AnUnitInfo:=AnUnitInfo.NextAutoRevertLockedUnit;
end;
end;
procedure TProject.OnUnitNameChange(AnUnitInfo: TUnitInfo;
const OldUnitName, NewUnitName: string; CheckIfAllowed: boolean;
var Allowed: boolean);
@ -1573,6 +1736,7 @@ begin
and (AnUnitInfo.NextUnitWithEditorIndex=nil)
and (AnUnitInfo.PrevUnitWithEditorIndex=nil) then begin
AnUnitInfo.NextUnitWithEditorIndex:=fFirstUnitWithEditorIndex;
AnUnitInfo.PrevUnitWithEditorIndex:=nil;
fFirstUnitWithEditorIndex:=AnUnitInfo;
if AnUnitInfo.NextUnitWithEditorIndex<>nil then
AnUnitInfo.NextUnitWithEditorIndex.PrevUnitWithEditorIndex:=AnUnitInfo;
@ -1601,6 +1765,7 @@ begin
and (AnUnitInfo.NextUnitWithForm=nil)
and (AnUnitInfo.PrevUnitWithForm=nil) then begin
AnUnitInfo.NextUnitWithForm:=fFirstUnitWithForm;
AnUnitInfo.PrevUnitWithForm:=nil;
fFirstUnitWithForm:=AnUnitInfo;
if AnUnitInfo.NextUnitWithForm<>nil then
AnUnitInfo.NextUnitWithForm.PrevUnitWithForm:=AnUnitInfo;
@ -1622,6 +1787,64 @@ begin
AnUnitInfo.PrevUnitWithForm:=nil;
end;
procedure TProject.AddToLoadedList(AnUnitInfo: TUnitInfo);
begin
// add to list if AnUnitInfo is not in list
if (fFirstLoadedUnit<>AnUnitInfo)
and (AnUnitInfo.NextLoadedUnit=nil)
and (AnUnitInfo.PrevLoadedUnit=nil) then begin
AnUnitInfo.NextLoadedUnit:=fFirstLoadedUnit;
AnUnitInfo.PrevLoadedUnit:=nil;
fFirstLoadedUnit:=AnUnitInfo;
if AnUnitInfo.NextLoadedUnit<>nil then
AnUnitInfo.NextLoadedUnit.PrevLoadedUnit:=AnUnitInfo;
end;
end;
procedure TProject.RemoveFromLoadedList(AnUnitInfo: TUnitInfo);
begin
// remove from list if AnUnitInfo is in list
if fFirstLoadedUnit=AnUnitInfo then
fFirstLoadedUnit:=AnUnitInfo.NextUnitWithForm;
if AnUnitInfo.NextLoadedUnit<>nil then
AnUnitInfo.NextLoadedUnit.PrevLoadedUnit:=
AnUnitInfo.PrevLoadedUnit;
if AnUnitInfo.PrevLoadedUnit<>nil then
AnUnitInfo.PrevLoadedUnit.NextLoadedUnit:=
AnUnitInfo.NextLoadedUnit;
AnUnitInfo.NextLoadedUnit:=nil;
AnUnitInfo.PrevLoadedUnit:=nil;
end;
procedure TProject.AddToAutoRevertLockedList(AnUnitInfo: TUnitInfo);
begin
// add to list if AnUnitInfo is not in list
if (fFirstAutoRevertLockedUnit<>AnUnitInfo)
and (AnUnitInfo.NextAutoRevertLockedUnit=nil)
and (AnUnitInfo.PrevAutoRevertLockedUnit=nil) then begin
AnUnitInfo.NextAutoRevertLockedUnit:=fFirstAutoRevertLockedUnit;
AnUnitInfo.PrevAutoRevertLockedUnit:=nil;
fFirstAutoRevertLockedUnit:=AnUnitInfo;
if AnUnitInfo.NextAutoRevertLockedUnit<>nil then
AnUnitInfo.NextAutoRevertLockedUnit.PrevAutoRevertLockedUnit:=AnUnitInfo;
end;
end;
procedure TProject.RemoveFromAutoRevertLockedList(AnUnitInfo: TUnitInfo);
begin
// remove from list if AnUnitInfo is in list
if fFirstAutoRevertLockedUnit=AnUnitInfo then
fFirstAutoRevertLockedUnit:=AnUnitInfo.NextAutoRevertLockedUnit;
if AnUnitInfo.NextAutoRevertLockedUnit<>nil then
AnUnitInfo.NextAutoRevertLockedUnit.PrevAutoRevertLockedUnit:=
AnUnitInfo.PrevAutoRevertLockedUnit;
if AnUnitInfo.PrevAutoRevertLockedUnit<>nil then
AnUnitInfo.PrevAutoRevertLockedUnit.NextAutoRevertLockedUnit:=
AnUnitInfo.NextAutoRevertLockedUnit;
AnUnitInfo.NextAutoRevertLockedUnit:=nil;
AnUnitInfo.PrevAutoRevertLockedUnit:=nil;
end;
end.
@ -1629,6 +1852,9 @@ end.
{
$Log$
Revision 1.70 2002/08/01 14:10:30 lazarus
MG: started file access monitoring for loaded files
Revision 1.69 2002/08/01 08:03:03 lazarus
MG: accelerated searches in project