paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 14:29:25 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: ExtractProcHead: phpAddParentProcs

Browse Source 
git-svn-id: trunk@52683 -
This commit is contained in:
mattias 2016-07-14 07:42:59 +00:00
parent f98984edfb
commit c2aed806b6
2 changed files with 29 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/codetools/pascalparsertool.pas
View File

@ -52,6 +52,7 @@ type
phpWithStart, // proc keyword e.g. 'function', 'class procedure'
phpWithoutClassKeyword,// without 'class' proc keyword
phpAddClassName, // extract/add 'ClassName.'
phpAddParentProcs, // add 'ProcName.' for nested procs
phpWithoutClassName, // skip classname
phpWithoutName, // skip function name
phpWithoutGenericParams,// skip <> after proc name

32
components/codetools/pascalreadertool.pas
View File

@ -586,8 +586,19 @@ var
IsFunction: Boolean;
IsOperator: Boolean;
EndPos: Integer;
ParentNode: TCodeTreeNode;
const
SemiColon : char = ';';
procedure PrependName(const Prepend: string; var aPath: string);
begin
if Prepend='' then exit;
if aPath<>'' then
aPath:=Prepend+'.'+aPath
else
aPath:=Prepend;
end;
begin
Result:='';
ExtractProcHeadPos:=phepNone;
@ -596,14 +607,27 @@ begin
ProcNode:=ProcNode.Parent;
if ProcNode=nil then exit;
end;
if (ProcNode.Desc<>ctnProcedure) and (ProcNode.Desc<>ctnProcedureType) then
if ProcNode.Desc=ctnProcedure then
IsProcType:=false
else if ProcNode.Desc=ctnProcedureType then
IsProcType:=true
else
exit;
IsProcType:=(ProcNode.Desc=ctnProcedureType);
TheClassName:='';
if (phpAddParentProcs in Attr) and (ProcNode.Parent.Desc=ctnProcedure) then begin
// local proc
ParentNode:=ProcNode.Parent;
while ParentNode.Desc=ctnProcedure do begin
PrependName(ExtractProcName(ParentNode,Attr*[phpInUpperCase]),TheClassName);
ParentNode:=ParentNode.Parent;
end;
end;
// build full class name
TheClassName:='';
if ([phpAddClassname,phpWithoutClassName]*Attr=[phpAddClassName]) then
TheClassName:=ExtractClassName(ProcNode,phpInUpperCase in Attr,true);
PrependName(ExtractClassName(ProcNode,phpInUpperCase in Attr,true),TheClassName);
// reparse the clean source
InitExtraction;