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

codetools: added AddUnitWarnDirective

Browse Source 
git-svn-id: trunk@51769 -
This commit is contained in:
mattias 2016-03-01 14:30:10 +00:00
parent a6cd2fe67f
commit 6365797a00
2 changed files with 95 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
components/codetools/codetoolmanager.pas
View File

@ -394,6 +394,8 @@ type
const NewSrc: string = ''): boolean; deprecated;
function AddIncludeDirectiveForInit(Code: TCodeBuffer; const Filename: string;
const NewSrc: string = ''): boolean;
function AddUnitWarnDirective(Code: TCodeBuffer; aParam: string;
TurnOn: boolean): boolean;
function RemoveDirective(Code: TCodeBuffer; NewX, NewY: integer;
RemoveEmptyIFs: boolean): boolean;
function FixIncludeFilenames(Code: TCodeBuffer; Recursive: boolean;
@ -3281,6 +3283,21 @@ begin
end;
end;
function TCodeToolManager.AddUnitWarnDirective(Code: TCodeBuffer;
aParam: string; TurnOn: boolean): boolean;
begin
Result:=false;
{$IFDEF CTDEBUG}
DebugLn(['TCodeToolManager.AddUnitWarnDirective A ',Code.Filename,' aParam="',aParam,'" TurnOn=',TurnOn]);
{$ENDIF}
if not InitCurCodeTool(Code) then exit;
try
Result:=FCurCodeTool.AddUnitWarnDirective(aParam,TurnOn,SourceChangeCache);
except
on e: Exception do Result:=HandleException(e);
end;
end;
function TCodeToolManager.RemoveDirective(Code: TCodeBuffer; NewX,
NewY: integer; RemoveEmptyIFs: boolean): boolean;
var

78
components/codetools/stdcodetools.pas
View File

@ -280,6 +280,8 @@ type
function AddIncludeDirectiveForInit(const Filename: string;
SourceChangeCache: TSourceChangeCache; const NewSrc: string = ''
): boolean;
function AddUnitWarnDirective(WarnID: string; TurnOn: boolean;
SourceChangeCache: TSourceChangeCache): boolean;
function FixIncludeFilenames(Code: TCodeBuffer;
SourceChangeCache: TSourceChangeCache;
out FoundIncludeFiles: TStrings;
@ -6481,6 +6483,82 @@ begin
Result:=true;
end;
function TStandardCodeTool.AddUnitWarnDirective(WarnID: string;
TurnOn: boolean; SourceChangeCache: TSourceChangeCache): boolean;
const
DirectiveFlagValue: array[boolean] of string = ('on','off');
var
ACleanPos, DirEndPos, InsertStartPos,
MaxPos: Integer;
Node: TCodeTreeNode;
p, IDStartPos, IDEndPos, ParamPos: PChar;
NewCode: String;
begin
Result:=false;
if WarnID='' then
raise Exception.Create('TStandardCodeTool.AddUnitWarnDirective missing WarnID');
InsertStartPos:=0;
BuildTree(lsrMainUsesSectionStart);
SourceChangeCache.MainScanner:=Scanner;
MaxPos:=0;
Node:=Tree.Root.NextBrother;
if Node<>nil then
MaxPos:=Node.StartPos
else
MaxPos:=SrcLen;
// find existing directive for replacement
ACleanPos:=1;
repeat
ACleanPos:=FindNextCompilerDirective(Src,ACleanPos,Scanner.NestedComments);
if (ACleanPos<1) or (ACleanPos>MaxPos) then
break;
DirEndPos:=FindCommentEnd(Src,ACleanPos,Scanner.NestedComments)+1;
p:=@Src[ACleanPos+2];
if CompareIdentifiers(p,'warn')=0 then begin
IDStartPos:=p+4;
while IDStartPos^ in [' ',#9,#10,#13] do
inc(IDStartPos);
IDEndPos:=IDStartPos;
while IDEndPos^ in ['0'..'9','A'..'Z','a'..'z','_'] do
inc(IDEndPos);
if CompareText(PChar(Pointer(WarnID)),length(WarnID),
IDStartPos,IDEndPos-IDStartPos,false)=0
then begin
// warn directive found
p:=IDEndPos;
while p^ in [' ',#9,#10,#13] do
inc(p);
ParamPos:=p;
while p^ in ['+','-','a'..'z','A'..'Z'] do
inc(p);
if not SourceChangeCache.Replace(gtSpace,gtNone,
ParamPos-PChar(Src)+1,p-PChar(Src)+1,DirectiveFlagValue[TurnOn])
then
exit;
Result:=SourceChangeCache.Apply;
exit;
end;
end else if (CompareIdentifiers(p,'i')=0) or (CompareIdentifiers(p,'include')=0)
then begin
// insert before include file
if MaxPos>ACleanPos then MaxPos:=ACleanPos;
break;
end;
ACleanPos:=DirEndPos;
until ACleanPos>MaxPos;
// there was no such directive yet -> find nice insert pos
InsertStartPos:=FindLineEndOrCodeInFrontOfPosition(MaxPos,true,true);
NewCode:='{$WARN '+WarnID+' '+DirectiveFlagValue[TurnOn]+'}';
if not SourceChangeCache.Replace(gtNewLine,gtNewLine,
InsertStartPos,InsertStartPos,NewCode)
then
exit;
Result:=SourceChangeCache.Apply;
end;
function TStandardCodeTool.FixIncludeFilenames(Code: TCodeBuffer;
SourceChangeCache: TSourceChangeCache;
out FoundIncludeFiles: TStrings;