mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-27 11:00:37 +02:00
codetools: code completion: support class constructors/destructors, patch #25130 from Ondrej Pokorny
git-svn-id: trunk@49996 -
This commit is contained in:
mattias
parent
70eed01820
commit
b605c39631
@ -88,7 +88,7 @@ uses
|
||||
FileProcs, CodeToolsStrConsts, StdCodeTools,
|
||||
CodeTree, CodeAtom, CodeCache, CustomCodeTool, PascalParserTool, MethodJumpTool,
|
||||
FindDeclarationTool, KeywordFuncLists, CodeToolsStructs, BasicCodeTools,
|
||||
LinkScanner, SourceChanger, CodeGraph,
|
||||
LinkScanner, SourceChanger, CodeGraph, PascalReaderTool,
|
||||
{$IFDEF EnableCodeCompleteTemplates}
|
||||
CodeCompletionTemplater,
|
||||
{$ENDIF}
|
||||
@ -140,7 +140,7 @@ type
|
||||
FSetPropertyVariablename: string;
|
||||
FSetPropertyVariableIsPrefix: Boolean;
|
||||
FSetPropertyVariableUseConst: Boolean;
|
||||
FJumpToProcName: string;
|
||||
FJumpToProcHead: TPascalMethodHeader;
|
||||
NewClassSectionIndent: array[TPascalClassSection] of integer;
|
||||
NewClassSectionInsertPos: array[TPascalClassSection] of integer;
|
||||
fFullTopLvlName: string;// used by OnTopLvlIdentifierFound
|
||||
@ -457,13 +457,13 @@ begin
|
||||
end;
|
||||
// ToDo: check ancestor procs too
|
||||
// search in current class
|
||||
Result:=(FindProcNode(FCompletingFirstEntryNode,NameAndParamsUpCase,[phpInUpperCase])<>nil);
|
||||
Result:=(FindProcNode(FCompletingFirstEntryNode,NameAndParamsUpCase,mgMethod,[phpInUpperCase])<>nil);
|
||||
end;
|
||||
|
||||
procedure TCodeCompletionCodeTool.SetCodeCompleteClassNode(const AClassNode: TCodeTreeNode);
|
||||
begin
|
||||
FreeClassInsertionList;
|
||||
FJumpToProcName:='';
|
||||
FJumpToProcHead.Name:='';
|
||||
FCodeCompleteClassNode:=AClassNode;
|
||||
if CodeCompleteClassNode=nil then begin
|
||||
FCompletingFirstEntryNode:=nil;
|
||||
@ -1500,7 +1500,8 @@ begin
|
||||
MemSizeString(FSetPropertyVariablename)
|
||||
+PtrUInt(SizeOf(FSetPropertyVariableIsPrefix))
|
||||
+PtrUInt(SizeOf(FSetPropertyVariableUseConst))
|
||||
+MemSizeString(FJumpToProcName)
|
||||
+MemSizeString(FJumpToProcHead.Name)
|
||||
+PtrUInt(SizeOf(FJumpToProcHead.Group))
|
||||
+length(NewClassSectionIndent)*SizeOf(integer)
|
||||
+length(NewClassSectionInsertPos)*SizeOf(integer)
|
||||
+MemSizeString(fFullTopLvlName));
|
||||
@ -8349,8 +8350,9 @@ procedure TCodeCompletionCodeTool.GuessProcDefBodyMapping(ProcDefNodes,
|
||||
NewNodeExt.Node:=ProcNode;
|
||||
NewNodeExt.Txt:=ExtractProcName(ProcNode,[phpWithoutClassName]);
|
||||
NewNodeExt.Data:=NodeExt;
|
||||
NewNodeExt.Flags:=Integer(ExtractProcedureGroup(ProcNode));
|
||||
if Result=nil then
|
||||
Result:=TAVLTree.Create(@CompareCodeTreeNodeExt);
|
||||
Result:=TAVLTree.Create(@CompareCodeTreeNodeExtMethodHeaders);
|
||||
Result.Add(NewNodeExt);
|
||||
end;
|
||||
AVLNodeExt:=NodeExtTree.FindSuccessor(AVLNodeExt);
|
||||
@ -8544,15 +8546,16 @@ var
|
||||
{$ENDIF}
|
||||
ProcCode:=Beauty.BeautifyProc(ProcCode,Indent,ANodeExt.ExtTxt3='');
|
||||
FSourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,ProcCode);
|
||||
if FJumpToProcName='' then begin
|
||||
if FJumpToProcHead.Name='' then begin
|
||||
// remember one proc body to jump to after the completion
|
||||
FJumpToProcName:=ANodeExt.Txt;
|
||||
if System.Pos('.',FJumpToProcName)<1 then
|
||||
FJumpToProcName:=TheClassName+'.'+FJumpToProcName;
|
||||
if FJumpToProcName[length(FJumpToProcName)]<>';' then
|
||||
FJumpToProcName:=FJumpToProcName+';';
|
||||
FJumpToProcHead.Name:=ANodeExt.Txt;
|
||||
FJumpToProcHead.Group:=TPascalMethodGroup(ANodeExt.Flags);
|
||||
if System.Pos('.',FJumpToProcHead.Name)<1 then
|
||||
FJumpToProcHead.Name:=TheClassName+'.'+FJumpToProcHead.Name;
|
||||
if FJumpToProcHead.Name[length(FJumpToProcHead.Name)]<>';' then
|
||||
FJumpToProcHead.Name:=FJumpToProcHead.Name+';';
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('CreateMissingClassProcBodies FJumpToProcName="',FJumpToProcName,'"');
|
||||
DebugLn('CreateMissingClassProcBodies FJumpToProcHead.Name="',FJumpToProcHead.Name,'"');
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
@ -8615,7 +8618,9 @@ var
|
||||
if NextAVLNode<>nil then begin
|
||||
ANodeExt:=TCodeTreeNodeExtension(AnAVLNode.Data);
|
||||
ANodeExt2:=TCodeTreeNodeExtension(NextAVLNode.Data);
|
||||
if CompareTextIgnoringSpace(ANodeExt.Txt,ANodeExt2.Txt,false)=0 then
|
||||
if SameMethodHeaders(ANodeExt.Txt, TPascalMethodGroup(ANodeExt.Flags),
|
||||
ANodeExt2.Txt, TPascalMethodGroup(ANodeExt2.Flags))
|
||||
then
|
||||
begin
|
||||
// proc redefined -> error
|
||||
if ANodeExt.Node.StartPos>ANodeExt2.Node.StartPos then begin
|
||||
@ -8937,7 +8942,7 @@ begin
|
||||
begin
|
||||
// search alphabetically nearest proc body
|
||||
ExistingNode:=ProcBodyNodes.FindNearest(MissingNode.Data);
|
||||
cmp:=CompareCodeTreeNodeExt(ExistingNode.Data,MissingNode.Data);
|
||||
cmp:=CompareCodeTreeNodeExtMethodHeaders(ExistingNode.Data,MissingNode.Data);
|
||||
if (cmp<0) then begin
|
||||
AnAVLNode:=ProcBodyNodes.FindSuccessor(ExistingNode);
|
||||
if AnAVLNode<>nil then begin
|
||||
@ -9043,9 +9048,9 @@ begin
|
||||
FreeClassInsertionList;
|
||||
end;
|
||||
|
||||
if FJumpToProcName<>'' then begin
|
||||
if FJumpToProcHead.Name<>'' then begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Jump to new proc body ... "',FJumpToProcName,'"');
|
||||
DebugLn('TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Jump to new proc body ... "',FJumpToProcHead.Name,'"');
|
||||
{$ENDIF}
|
||||
// there was a new proc body
|
||||
// -> find it and jump to
|
||||
@ -9061,9 +9066,9 @@ begin
|
||||
FCodeCompleteClassNode:=FindClassNode(CursorNode,CurClassName,true,false);
|
||||
if CodeCompleteClassNode=nil then
|
||||
RaiseException('oops, I lost your class');
|
||||
ProcNode:=FindProcNode(CursorNode,FJumpToProcName,[phpInUpperCase,phpIgnoreForwards]);
|
||||
ProcNode:=FindProcNode(CursorNode,FJumpToProcHead,[phpInUpperCase,phpIgnoreForwards]);
|
||||
if ProcNode=nil then begin
|
||||
debugln(['TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Proc="',FJumpToProcName,'"']);
|
||||
debugln(['TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Proc="',FJumpToProcHead.Name,'"']);
|
||||
RaiseException(ctsNewProcBodyNotFound);
|
||||
end;
|
||||
Result:=FindJumpPointInProcNode(ProcNode,NewPos,NewTopLine);
|
||||
|
||||
@ -43,7 +43,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, math, FileProcs, CodeToolsStrConsts, CodeTree, CodeAtom,
|
||||
CodeCache, CustomCodeTool,
|
||||
CodeCache, CustomCodeTool, PascalReaderTool,
|
||||
PascalParserTool, CodeCompletionTool, KeywordFuncLists, BasicCodeTools,
|
||||
LinkScanner, AVL_Tree, SourceChanger,
|
||||
FindDeclarationTool;
|
||||
@ -843,7 +843,7 @@ var
|
||||
else
|
||||
ProcHead:='';
|
||||
ProcHead:=ProcHead+ProcName+BaseParamList;
|
||||
ConflictProcNode:=FindProcNode(ContextNode,ProcHead,
|
||||
ConflictProcNode:=FindProcNode(ContextNode,ProcHead,mgMethod,
|
||||
ShortProcFormat+[phpIgnoreForwards]);
|
||||
Result:=ConflictProcNode<>nil;
|
||||
if Result then begin
|
||||
|
||||
@ -9517,6 +9517,12 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
if FoundContext.Tool.NodeIsClassConstructorOrDestructor(FoundContext.Node) then
|
||||
begin
|
||||
Result:=ifrProceedSearch;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if (not (fdfCollect in Params.Flags))
|
||||
and CallHasEmptyParamsAndFoundProcFits then begin
|
||||
// call has brackets without params (e.g. writeln() )
|
||||
|
||||
@ -1171,6 +1171,8 @@ begin
|
||||
Ident:=@FoundContext.Tool.Src[FoundContext.Node.StartPos];
|
||||
|
||||
ctnProcedure,ctnProcedureHead:
|
||||
//do not list class constructors and destructors
|
||||
if not FoundContext.Tool.NodeIsClassConstructorOrDestructor(FoundContext.Node) then
|
||||
begin
|
||||
Ident:=FoundContext.Tool.GetProcNameIdentifier(FoundContext.Node);
|
||||
NewItem := CurrentIdentifierList.FindIdentifier(Ident,true);
|
||||
|
||||
@ -42,7 +42,7 @@ uses
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, FileProcs, LazFileUtils, CodeTree, PascalParserTool,
|
||||
StdCodeTools, KeywordFuncLists, BasicCodeTools,
|
||||
LinkScanner, CodeCache, AVL_Tree;
|
||||
LinkScanner, CodeCache, PascalReaderTool, AVL_Tree;
|
||||
|
||||
|
||||
type
|
||||
@ -274,16 +274,16 @@ const
|
||||
// search for a proc node with same name and jump to difference in param list
|
||||
// returns true on jumped, false if no target proc found
|
||||
var
|
||||
SearchedProcHead: string;
|
||||
SearchedProcHead: TPascalMethodHeader;
|
||||
ProcNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
if SearchForProcNode=nil then exit;
|
||||
SearchedProcHead:=ExtractProcHead(SearchForProcNode,SearchForProcAttr);
|
||||
SearchedProcHead:=ExtractProcHeadWithGroup(SearchForProcNode,SearchForProcAttr);
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Searching ',SearchForProcNode.DescAsString,' "',SearchedProcHead,'" ',ProcHeadAttributesToStr(SearchForProcAttr));
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Searching ',SearchForProcNode.DescAsString,' "',SearchedProcHead.Head,'" ',ProcHeadAttributesToStr(SearchForProcAttr));
|
||||
{$ENDIF}
|
||||
if SearchedProcHead='' then exit;
|
||||
if SearchedProcHead.Name='' then exit;
|
||||
ProcNode:=FindProcNode(StartNode,SearchedProcHead,SearchInProcAttr);
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Found:',dbgs(ProcNode<>nil));
|
||||
@ -301,11 +301,11 @@ const
|
||||
phpWithComments];
|
||||
SearchForProcAttr:=SearchForProcAttr+[phpWithoutBrackets,
|
||||
phpWithoutParamList];
|
||||
SearchedProcHead:=ExtractProcHead(SearchForProcNode,SearchForProcAttr);
|
||||
SearchedProcHead:=ExtractProcHeadWithGroup(SearchForProcNode,SearchForProcAttr);
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Searching without params "',SearchedProcHead,'"');
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Searching without params "',SearchedProcHead.Name,'"');
|
||||
{$ENDIF}
|
||||
if SearchedProcHead='' then exit;
|
||||
if SearchedProcHead.Name='' then exit;
|
||||
ProcNode:=FindProcNode(StartNode,SearchedProcHead,SearchForProcAttr);
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Found:',dbgs(ProcNode<>nil));
|
||||
@ -789,7 +789,7 @@ var CurProcName: string;
|
||||
CurClassName: String;
|
||||
begin
|
||||
//debugln(['TMethodJumpingCodeTool.GatherProcNodes START']);
|
||||
Result:=TAVLTree.Create(@CompareCodeTreeNodeExt);
|
||||
Result:=TAVLTree.Create(@CompareCodeTreeNodeExtMethodHeaders);
|
||||
if (StartNode=nil) or (StartNode.Parent=nil) then exit;
|
||||
ANode:=StartNode;
|
||||
while (ANode<>nil) do begin
|
||||
@ -825,6 +825,7 @@ begin
|
||||
with NewNodeExt do begin
|
||||
Node:=ANode;
|
||||
Txt:=CurProcName;
|
||||
Flags:=Ord(ExtractProcedureGroup(ANode));
|
||||
end;
|
||||
Result.Add(NewNodeExt);
|
||||
end;
|
||||
@ -961,7 +962,7 @@ function TMethodJumpingCodeTool.FindSubProcPath(SubProcPath: TStrings;
|
||||
Result:=nil;
|
||||
if (PathIndex>SubProcPath.Count) or (StartNode=nil) then exit;
|
||||
ProcHead:=SubProcPath[PathIndex];
|
||||
ProcNode:=FindProcNode(StartNode,ProcHead,Attr);
|
||||
ProcNode:=FindProcNode(StartNode,ProcHead,mgMethod,Attr);
|
||||
//DebugLn('TMethodJumpingCodeTool.SearchSubProcPath A ProcHead="',ProcHead,'" Found=',dbgs(ProcNode<>nil));
|
||||
if ProcNode=nil then exit;
|
||||
if PathIndex=SubProcPath.Count-1 then begin
|
||||
|
||||
@ -57,6 +57,15 @@ type
|
||||
epriInDirective
|
||||
);
|
||||
|
||||
//the scope groups of pascal methods.
|
||||
//please note that Destructor is principally a method and thus is not listed here -> you cannot define "procedure Destroy;" and "destructor Destroy" in one class
|
||||
TPascalMethodGroup = (mgMethod, mgConstructor, mgClassConstructor, mgClassDestructor);
|
||||
|
||||
TPascalMethodHeader = record
|
||||
Name: string;
|
||||
Group: TPascalMethodGroup;
|
||||
end;
|
||||
|
||||
TOnEachPRIdentifier = procedure(Sender: TPascalParserTool;
|
||||
IdentifierCleanPos: integer; Range: TEPRIRange;
|
||||
Node: TCodeTreeNode; Data: Pointer; var Abort: boolean) of object;
|
||||
@ -121,6 +130,8 @@ type
|
||||
Attr: TProcHeadAttributes): string;
|
||||
function ExtractProcHead(ProcNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes): string;
|
||||
function ExtractProcHeadWithGroup(ProcNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes): TPascalMethodHeader;
|
||||
function ExtractProcedureHeader(CursorPos: TCodeXYPosition;
|
||||
Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
|
||||
function ExtractClassNameOfProcNode(ProcNode: TCodeTreeNode;
|
||||
@ -129,7 +140,10 @@ type
|
||||
ProcSpec: TProcedureSpecifier): boolean;
|
||||
function GetProcNameIdentifier(ProcNode: TCodeTreeNode): PChar;
|
||||
function FindProcNode(StartNode: TCodeTreeNode; const AProcHead: string;
|
||||
Attr: TProcHeadAttributes): TCodeTreeNode;
|
||||
AProcSpecType: TPascalMethodGroup;
|
||||
Attr: TProcHeadAttributes): TCodeTreeNode; overload;
|
||||
function FindProcNode(StartNode: TCodeTreeNode; const AProcHead: TPascalMethodHeader;
|
||||
Attr: TProcHeadAttributes): TCodeTreeNode; overload;
|
||||
function FindCorrespondingProcNode(ProcNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes = [phpWithoutClassKeyword,phpWithoutClassName]
|
||||
): TCodeTreeNode;
|
||||
@ -138,6 +152,7 @@ type
|
||||
): TCodeTreeNode;
|
||||
function FindProcBody(ProcNode: TCodeTreeNode): TCodeTreeNode;
|
||||
function ProcBodyIsEmpty(ProcNode: TCodeTreeNode): boolean;
|
||||
function ExtractProcedureGroup(ProcNode: TCodeTreeNode): TPascalMethodGroup;
|
||||
procedure MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode);
|
||||
function MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
|
||||
ProcSpec: TProcedureSpecifier): boolean;
|
||||
@ -156,6 +171,7 @@ type
|
||||
function NodeIsMethodBody(ProcNode: TCodeTreeNode): boolean;
|
||||
function GetMethodOfBody(Node: TCodeTreeNode): TCodeTreeNode;
|
||||
function NodeIsFunction(ProcNode: TCodeTreeNode): boolean;
|
||||
function NodeIsClassConstructorOrDestructor(ProcNode: TCodeTreeNode): boolean;
|
||||
function NodeIsConstructor(ProcNode: TCodeTreeNode): boolean;
|
||||
function NodeIsDestructor(ProcNode: TCodeTreeNode): boolean;
|
||||
function NodeIsForwardProc(ProcNode: TCodeTreeNode): boolean;
|
||||
@ -267,8 +283,54 @@ type
|
||||
procedure CalcMemSize(Stats: TCTMemStats); override;
|
||||
end;
|
||||
|
||||
function CompareMethodHeaders(const Method1Name: string; Method1Group: TPascalMethodGroup;
|
||||
const Method2Name: string; Method2Group: TPascalMethodGroup): Integer; overload;
|
||||
function CompareMethodHeaders(const Method1Head: TPascalMethodHeader; const Method2Head: TPascalMethodHeader): Integer; overload;
|
||||
function SameMethodHeaders(const Method1Name: string; Method1Group: TPascalMethodGroup;
|
||||
const Method2Name: string; Method2Group: TPascalMethodGroup): Boolean; overload;
|
||||
function SameMethodHeaders(const Method1Head: TPascalMethodHeader; const Method2Head: TPascalMethodHeader): Boolean; overload;
|
||||
function CompareCodeTreeNodeExtMethodHeaders(NodeData1, NodeData2: pointer): integer;
|
||||
|
||||
implementation
|
||||
|
||||
function CompareMethodHeaders(const Method1Name: string;
|
||||
Method1Group: TPascalMethodGroup; const Method2Name: string;
|
||||
Method2Group: TPascalMethodGroup): Integer;
|
||||
begin
|
||||
Result := (Ord(Method1Group) - Ord(Method2Group));
|
||||
if Result <> 0 then exit;
|
||||
Result := CompareTextIgnoringSpace(Method1Name,Method2Name,false);
|
||||
end;
|
||||
|
||||
function CompareMethodHeaders(const Method1Head: TPascalMethodHeader;
|
||||
const Method2Head: TPascalMethodHeader): Integer;
|
||||
begin
|
||||
Result := CompareMethodHeaders(Method1Head.Name, Method1Head.Group,
|
||||
Method2Head.Name, Method2Head.Group);
|
||||
end;
|
||||
|
||||
function SameMethodHeaders(const Method1Name: string;
|
||||
Method1Group: TPascalMethodGroup; const Method2Name: string;
|
||||
Method2Group: TPascalMethodGroup): Boolean;
|
||||
begin
|
||||
Result := CompareMethodHeaders(Method1Name, Method1Group, Method2Name, Method2Group) = 0;
|
||||
end;
|
||||
|
||||
function SameMethodHeaders(const Method1Head: TPascalMethodHeader;
|
||||
const Method2Head: TPascalMethodHeader): Boolean;
|
||||
begin
|
||||
Result := CompareMethodHeaders(Method1Head, Method2Head) = 0;
|
||||
end;
|
||||
|
||||
function CompareCodeTreeNodeExtMethodHeaders(NodeData1, NodeData2: pointer): integer;
|
||||
var
|
||||
NodeExt1: TCodeTreeNodeExtension absolute NodeData1;
|
||||
NodeExt2: TCodeTreeNodeExtension absolute NodeData2;
|
||||
begin
|
||||
Result:=CompareMethodHeaders(NodeExt1.Txt,TPascalMethodGroup(NodeExt1.Flags),NodeExt2.Txt,TPascalMethodGroup(NodeExt2.Flags));
|
||||
end;
|
||||
|
||||
|
||||
{ TPascalReaderTool }
|
||||
|
||||
procedure TPascalReaderTool.RaiseStrConstExpected;
|
||||
@ -667,6 +729,13 @@ begin
|
||||
Result:=Result+';';
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.ExtractProcHeadWithGroup(ProcNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes): TPascalMethodHeader;
|
||||
begin
|
||||
Result.Name := ExtractProcHead(ProcNode, Attr);
|
||||
Result.Group := ExtractProcedureGroup(ProcNode);
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.ExtractProcedureHeader(CursorPos: TCodeXYPosition;
|
||||
Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
|
||||
var
|
||||
@ -842,14 +911,15 @@ begin
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.FindProcNode(StartNode: TCodeTreeNode;
|
||||
const AProcHead: string; Attr: TProcHeadAttributes): TCodeTreeNode;
|
||||
const AProcHead: TPascalMethodHeader; Attr: TProcHeadAttributes): TCodeTreeNode;
|
||||
// search in all next brothers for a Procedure Node with the Name ProcName
|
||||
// if there are no further brothers and the parent is a section node
|
||||
// ( e.g. 'interface', 'implementation', ...) or a class visibility node
|
||||
// (e.g. 'public', 'private', ...) then the search will continue in the next
|
||||
// section
|
||||
var CurProcHead: string;
|
||||
var
|
||||
InClass: Boolean;
|
||||
CurProcHead: TPascalMethodHeader;
|
||||
begin
|
||||
Result:=StartNode;
|
||||
InClass:=FindClassOrInterfaceNode(StartNode)<>nil;
|
||||
@ -860,10 +930,11 @@ begin
|
||||
and (not ((phpIgnoreProcsWithBody in Attr)
|
||||
and (FindProcBody(Result)<>nil))) then
|
||||
begin
|
||||
CurProcHead:=ExtractProcHead(Result,Attr);
|
||||
CurProcHead:=ExtractProcHeadWithGroup(Result,Attr);
|
||||
//DebugLn(['TPascalReaderTool.FindProcNode B "',CurProcHead,'" =? "',AProcHead,'" Result=',CompareTextIgnoringSpace(CurProcHead,AProcHead,false)]);
|
||||
if (CurProcHead<>'')
|
||||
and (CompareTextIgnoringSpace(CurProcHead,AProcHead,false)=0) then
|
||||
if (CurProcHead.Name<>'') and
|
||||
SameMethodHeaders(AProcHead, CurProcHead)
|
||||
then
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
@ -875,12 +946,23 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.FindProcNode(StartNode: TCodeTreeNode;
|
||||
const AProcHead: string; AProcSpecType: TPascalMethodGroup;
|
||||
Attr: TProcHeadAttributes): TCodeTreeNode;
|
||||
var
|
||||
ProcHead: TPascalMethodHeader;
|
||||
begin
|
||||
ProcHead.Name := AProcHead;
|
||||
ProcHead.Group := AProcSpecType;
|
||||
Result := FindProcNode(StartNode, ProcHead, Attr);
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.FindCorrespondingProcNode(ProcNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes): TCodeTreeNode;
|
||||
var
|
||||
ClassNode: TCodeTreeNode;
|
||||
StartNode: TCodeTreeNode;
|
||||
ProcHead: String;
|
||||
ProcHead: TPascalMethodHeader;
|
||||
begin
|
||||
Result:=nil;
|
||||
// get ctnProcedure
|
||||
@ -924,7 +1006,7 @@ begin
|
||||
end;
|
||||
if StartNode=nil then exit;
|
||||
|
||||
ProcHead:=ExtractProcHead(ProcNode,Attr);
|
||||
ProcHead:=ExtractProcHeadWithGroup(ProcNode,Attr);
|
||||
//debugln('TPascalReaderTool.FindCorrespondingProcNode StartNode=',StartNode.DescAsString,' ProcHead=',dbgstr(ProcHead),' ',dbgs(Attr),' ',StartNode.DescAsString);
|
||||
Result:=FindProcNode(StartNode,ProcHead,Attr);
|
||||
if Result=ProcNode then begin
|
||||
@ -2405,6 +2487,28 @@ begin
|
||||
Result:=ctnNone;
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.ExtractProcedureGroup(ProcNode: TCodeTreeNode
|
||||
): TPascalMethodGroup;
|
||||
begin
|
||||
Result:=mgMethod;
|
||||
if (ProcNode=nil) then exit;
|
||||
if ProcNode.Desc=ctnProcedureHead then
|
||||
ProcNode:=ProcNode.Parent;
|
||||
if ProcNode.Desc<>ctnProcedure then exit;
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('CLASS') then
|
||||
begin
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('CONSTRUCTOR') then
|
||||
Result := mgClassConstructor;
|
||||
if UpAtomIs('DESTRUCTOR') then
|
||||
Result := mgClassDestructor;
|
||||
end else
|
||||
if UpAtomIs('CONSTRUCTOR') then
|
||||
Result := mgConstructor
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.PositionInSourceName(CleanPos: integer): boolean;
|
||||
var
|
||||
NamePos: TAtomPosition;
|
||||
@ -2733,6 +2837,12 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.NodeIsClassConstructorOrDestructor(
|
||||
ProcNode: TCodeTreeNode): boolean;
|
||||
begin
|
||||
Result := ExtractProcedureGroup(ProcNode) in [mgClassConstructor, mgClassDestructor];
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.NodeIsForwardType(TypeNode: TCodeTreeNode): boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user