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

IDE: reducing codetool overhead when searching for forms and interfaces in lpr

Browse Source 
git-svn-id: trunk@21855 -
This commit is contained in:
mattias 2009-09-25 08:56:47 +00:00
parent 937fddda70
commit 6971bea343
1 changed files with 22 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
ide/projectresources.pas
View File

@ -51,7 +51,7 @@ type
FModified: Boolean; FModified: Boolean;
FOnModified: TNotifyEvent; FOnModified: TNotifyEvent;
FInModified: Boolean; FInModified: Boolean;
FCanHaveLrsInclude: Boolean; FLrsIncludeAllowed: Boolean;
FSystemResources: TStringList; FSystemResources: TStringList;
FLazarusResources: TStringList; FLazarusResources: TStringList;
@ -70,7 +70,7 @@ type
procedure EmbeddedObjectModified(Sender: TObject); procedure EmbeddedObjectModified(Sender: TObject);
function Update: Boolean; function Update: Boolean;
function UpdateMainSourceFile(const AFileName: string): Boolean; function UpdateMainSourceFile(const AFileName: string): Boolean;
procedure UpdateCanHaveLrsInclude(const AFileName: string); procedure UpdateFlagLrsIncludeAllowed(const AFileName: string);
function Save: Boolean; function Save: Boolean;
procedure UpdateCodeBuffers; procedure UpdateCodeBuffers;
procedure DeleteLastCodeBuffers; procedure DeleteLastCodeBuffers;
@ -163,7 +163,7 @@ begin
inherited Create; inherited Create;
FInModified := False; FInModified := False;
FCanHaveLrsInclude := False; FLrsIncludeAllowed := False;
FSystemResources := TStringList.Create; FSystemResources := TStringList.Create;
FLazarusResources := TStringList.Create; FLazarusResources := TStringList.Create;
@ -241,7 +241,7 @@ begin
LastLrsFileName := lrsFileName; LastLrsFileName := lrsFileName;
SetFileNames(MainFileName); SetFileNames(MainFileName);
UpdateCanHaveLrsInclude(MainFileName); UpdateFlagLrsIncludeAllowed(MainFileName);
try try
// update resources (FLazarusResources, FSystemResources, ...) // update resources (FLazarusResources, FSystemResources, ...)
@ -348,7 +348,7 @@ begin
// update LResources uses // update LResources uses
if CodeToolBoss.FindUnitInAllUsesSections(CodeBuf, LazResourcesUnit, NamePos, InPos) then if CodeToolBoss.FindUnitInAllUsesSections(CodeBuf, LazResourcesUnit, NamePos, InPos) then
begin begin
if not (FCanHaveLrsInclude and HasLazarusResources) then if not (FLrsIncludeAllowed and HasLazarusResources) then
begin begin
if not CodeToolBoss.RemoveUnitFromAllUsesSections(CodeBuf, LazResourcesUnit) then if not CodeToolBoss.RemoveUnitFromAllUsesSections(CodeBuf, LazResourcesUnit) then
begin begin
@ -360,7 +360,7 @@ begin
end; end;
end end
else else
if FCanHaveLrsInclude and HasLazarusResources then if FLrsIncludeAllowed and HasLazarusResources then
begin begin
if not CodeToolBoss.AddUnitToMainUsesSection(CodeBuf, LazResourcesUnit,'') then if not CodeToolBoss.AddUnitToMainUsesSection(CodeBuf, LazResourcesUnit,'') then
begin begin
@ -407,8 +407,8 @@ begin
NewTopLine, Filename, false) then NewTopLine, Filename, false) then
begin begin
// there is a resource directive in the source // there is a resource directive in the source
//debugln(['TProjectResources.UpdateMainSourceFile include directive found: FCanHaveLrsInclude=',FCanHaveLrsInclude,' HasLazarusResources=',HasLazarusResources]); //debugln(['TProjectResources.UpdateMainSourceFile include directive found: FCanHaveLrsInclude=',FLrsIncludeAllowed,' HasLazarusResources=',HasLazarusResources]);
if not (FCanHaveLrsInclude and HasLazarusResources) then if not (FLrsIncludeAllowed and HasLazarusResources) then
begin begin
if not CodeToolBoss.RemoveDirective(NewCode, NewX, NewY, true) then if not CodeToolBoss.RemoveDirective(NewCode, NewX, NewY, true) then
begin begin
@ -421,9 +421,9 @@ begin
end; end;
end end
else else
if FCanHaveLrsInclude and HasLazarusResources then if FLrsIncludeAllowed and HasLazarusResources then
begin begin
//debugln(['TProjectResources.UpdateMainSourceFile include directive not found: FCanHaveLrsInclude=',FCanHaveLrsInclude,' HasLazarusResources=',HasLazarusResources]); //debugln(['TProjectResources.UpdateMainSourceFile include directive not found: FCanHaveLrsInclude=',FLrsIncludeAllowed,' HasLazarusResources=',HasLazarusResources]);
if not CodeToolBoss.AddIncludeDirective(CodeBuf, if not CodeToolBoss.AddIncludeDirective(CodeBuf,
Filename,'') then Filename,'') then
begin begin
@ -436,12 +436,12 @@ begin
end; end;
end; end;
procedure TProjectResources.UpdateCanHaveLrsInclude(const AFileName: string); procedure TProjectResources.UpdateFlagLrsIncludeAllowed(const AFileName: string);
var var
CodeBuf: TCodeBuffer; CodeBuf: TCodeBuffer;
NamePos, InPos: Integer; NamePos, InPos: Integer;
begin begin
FCanHaveLrsInclude := False; FLrsIncludeAllowed := False;
CodeBuf := CodeToolBoss.LoadFile(AFileName, False, False); CodeBuf := CodeToolBoss.LoadFile(AFileName, False, False);
if CodeBuf = nil then if CodeBuf = nil then
@ -449,9 +449,14 @@ begin
// Check that .lpr contains Forms and Interfaces in the uses section. If it does not // Check that .lpr contains Forms and Interfaces in the uses section. If it does not
// we cannot add LResources (it is not a lazarus application) // we cannot add LResources (it is not a lazarus application)
FCanHaveLrsInclude := CodeToolBoss.ActivateWriteLock;
CodeToolBoss.FindUnitInAllUsesSections(CodeBuf, 'Forms', NamePos, InPos, True) and try
CodeToolBoss.FindUnitInAllUsesSections(CodeBuf, 'Interfaces', NamePos, InPos, True); FLrsIncludeAllowed :=
CodeToolBoss.FindUnitInAllUsesSections(CodeBuf, 'Forms', NamePos, InPos, True) and
CodeToolBoss.FindUnitInAllUsesSections(CodeBuf, 'Interfaces', NamePos, InPos, True);
finally
CodeToolBoss.DeactivateWriteLock;
end;
end; end;
function TProjectResources.RenameDirectives(const CurFileName, function TProjectResources.RenameDirectives(const CurFileName,
@ -481,7 +486,7 @@ begin
newLrsFileName := ExtractFileName(lrsFileName); newLrsFileName := ExtractFileName(lrsFileName);
// update resources (FLazarusResources, FSystemResources, ...) // update resources (FLazarusResources, FSystemResources, ...)
UpdateCanHaveLrsInclude(CurFileName); UpdateFlagLrsIncludeAllowed(CurFileName);
if not Update then if not Update then
Exit; Exit;
// update codebuffers of new .lrs and .rc files // update codebuffers of new .lrs and .rc files
@ -585,7 +590,7 @@ procedure TProjectResources.UpdateCodeBuffers;
begin begin
if HasSystemResources then if HasSystemResources then
UpdateCodeBuffer(rcFileName, FSystemResources.Text); UpdateCodeBuffer(rcFileName, FSystemResources.Text);
if FCanHaveLrsInclude and HasLazarusResources then if FLrsIncludeAllowed and HasLazarusResources then
UpdateCodeBuffer(lrsFileName, FLazarusResources.Text); UpdateCodeBuffer(lrsFileName, FLazarusResources.Text);
end; end;