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

IDE: Prevent unneeded .lrs creation. Issue #21122, patch from Anton

Browse Source 
git-svn-id: trunk@40917 -
This commit is contained in:
juha 2013-04-28 20:39:33 +00:00
parent 2166765d19
commit 8abb03126b
1 changed files with 36 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
ide/projectresources.pas
View File

@ -110,8 +110,6 @@ type
property ProjectIcon: TProjectIcon read GetProjectIcon; property ProjectIcon: TProjectIcon read GetProjectIcon;
end; end;
procedure ParseResourceType(const Src: string; NestedComments: boolean;
out HasLRSIncludeDirective, HasRDirective: boolean);
function GuessResourceType(Code: TCodeBuffer; out Typ: TResourceType): boolean; function GuessResourceType(Code: TCodeBuffer; out Typ: TResourceType): boolean;
const const
@ -136,13 +134,34 @@ begin
Result := rtLRS; Result := rtLRS;
end; end;
procedure ParseResourceType(const Src: string; NestedComments: boolean; procedure ParseResourceType(Code: TCodeBuffer; NestedComments: boolean;
out HasLRSIncludeDirective, HasRDirective: boolean); out HasLRSIncludeDirective, HasRDirective: boolean);
function ExtractDirectiveFileName(ds: PChar): string;
var i: Integer;
begin
while IsIdentChar[ds^] do Inc(ds);
while ds^ in [' ',#9] do Inc(ds);
if ds^ = '''' then
begin
Inc(ds);
i := IndexChar(ds^, -1, '''');
SetLength(Result, i);
Move(ds^, Result[1], i);
end else begin
i := IndexChar(ds^, -1, '}');
SetLength(Result, i);
Move(ds^, Result[1], i);
Result := TrimRight(Result);
end;
end;
var var
p: Integer; p: Integer;
d: PChar; d: PChar;
PointPos: PChar; Src, dFileName: string;
begin begin
Src := Code.Source;
HasLRSIncludeDirective := False; HasLRSIncludeDirective := False;
HasRDirective := False; HasRDirective := False;
p:=1; p:=1;
@ -154,29 +173,22 @@ begin
if (d[0]='{') and (d[1]='$') then if (d[0]='{') and (d[1]='$') then
begin begin
inc(d, 2); inc(d, 2);
if (d[0] in ['r','R']) and (not IsIdentChar[d[1]]) then if (d[0] in ['r','R']) and not (HasRDirective or IsIdentChar[d[1]]) then
begin begin
// using resources // using resources
HasRDirective := True; dFileName := ExtractDirectiveFileName(d);
HasRDirective := SameText(dFileName, '*.lfm') or
SameText(dFileName, ExtractFileNameOnly(Code.Filename) + '.lfm');
end end
else else
if (d[0] in ['i','I']) and ((d[1] in [' ',#9]) or if (d[0] in ['i','I']) and not HasLRSIncludeDirective
(CompareIdentifiers(@d[0],'include')=0)) then and ((d[1] in [' ',#9]) or (CompareIdentifiers(@d[0],'include')=0)) then
begin begin
PointPos := nil; // using include directive with lrs file
while not (d^ in [#0,#10,#13,'}']) do dFileName := ExtractDirectiveFileName(d);
begin HasLRSIncludeDirective :=
if d^ = '.' then SameText(dFileName, ExtractFileNameOnly(Code.Filename) + '.lrs') or
PointPos := d; SameText(dFileName, '*.lrs');
inc(d);
end;
if (PointPos<>nil) and (d-PointPos=4) and (PointPos[1]='l') and
(PointPos[2]='r') and (PointPos[3]='s') then
begin
//DebugLn(['ParseResourceType ',copy(Src,p,PointPos-@Src[p]+3)]);
// using include directive with lrs file
HasLRSIncludeDirective := True;
end;
end; end;
end; end;
p := FindCommentEnd(Src, p, NestedComments); p := FindCommentEnd(Src, p, NestedComments);
@ -263,7 +275,7 @@ begin
Tree.Add(Item); Tree.Add(Item);
end; end;
Item.CodeStamp := Code.ChangeStep; Item.CodeStamp := Code.ChangeStep;
ParseResourceType(Code.Source, ParseResourceType(Code,
CodeToolBoss.GetNestedCommentsFlagForFile(Code.Filename), CodeToolBoss.GetNestedCommentsFlagForFile(Code.Filename),
Item.HasLRSIncludeDirective, Item.HasRDirective); Item.HasLRSIncludeDirective, Item.HasRDirective);
HasLRSIncludeDirective := Item.HasLRSIncludeDirective; HasLRSIncludeDirective := Item.HasLRSIncludeDirective;
@ -575,7 +587,7 @@ begin
begin begin
Result := False; Result := False;
Messages.Add(Format(lisCouldNotRemoveFromMainSource, ['"',LazResourcesUnit,'"'])); Messages.Add(Format(lisCouldNotRemoveFromMainSource, ['"',LazResourcesUnit,'"']));
debugln(['TProjectResources.UpdateMainSourceFile adding LResources to main source failed']); debugln(['TProjectResources.UpdateMainSourceFile removing LResources from all uses sections failed']);
end; end;
end; end;
end end