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

extended codetools for method jumping in generic classes

Browse Source 
git-svn-id: trunk@8368 -
This commit is contained in:
mattias 2005-12-26 00:52:10 +00:00
parent 52ebb7d2a7
commit 10bbedf011
3 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/codetools/examples/methodjumping.pas
View File

@ -32,17 +32,17 @@ var
NewCode: TCodeBuffer; NewCode: TCodeBuffer;
NewX, NewY, NewTopLine: integer; NewX, NewY, NewTopLine: integer;
RevertableJump: boolean; RevertableJump: boolean;
Tool: TCustomCodeTool; //Tool: TCustomCodeTool;
begin begin
ExpandedFilename:=ExpandFileName('tgeneric2.pp'); ExpandedFilename:=ExpandFileName('tgeneric2.pp');
CodeBuf:=CodeToolBoss.LoadFile(ExpandedFilename,true,false); CodeBuf:=CodeToolBoss.LoadFile(ExpandedFilename,true,false);
if CodeToolBoss.JumpToMethod(CodeBuf,10,8,NewCode,NewX,NewY,NewTopLine, if CodeToolBoss.JumpToMethod(CodeBuf,3,15,NewCode,NewX,NewY,NewTopLine,
RevertableJump) RevertableJump)
then then
writeln(NewCode.Filename,' ',NewX,',',NewY,' TopLine=',NewTopLine,' RevertableJump=',RevertableJump) writeln(NewCode.Filename,' ',NewX,',',NewY,' TopLine=',NewTopLine,' RevertableJump=',RevertableJump)
else else
writeln('Method body not found.'); writeln('Method body not found.');
Tool:=CodeToolBoss.FindCodeToolForSource(CodeBuf); //Tool:=CodeToolBoss.FindCodeToolForSource(CodeBuf);
Tool.WriteDebugTreeReport; //Tool.WriteDebugTreeReport;
end. end.

8
components/codetools/methodjumptool.pas
View File

@ -271,9 +271,10 @@ const
ProcNode: TCodeTreeNode; ProcNode: TCodeTreeNode;
begin begin
Result:=false; Result:=false;
if SearchForProcNode=nil then exit;
SearchedProcHead:=ExtractProcHead(SearchForProcNode,SearchForProcAttr); SearchedProcHead:=ExtractProcHead(SearchForProcNode,SearchForProcAttr);
{$IFDEF CTDEBUG} {$IFDEF CTDEBUG}
DebugLn('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Searching ',dbgs(ProcNode<>nil),' "',SearchedProcHead,'"'); DebugLn('TMethodJumpingCodeTool.FindJumpPoint.FindBestProcNode Searching ',SearchForProcNode.DescAsString,' "',SearchedProcHead,'" ',ProcHeadAttributesToStr(SearchForProcAttr));
{$ENDIF} {$ENDIF}
if SearchedProcHead='' then exit; if SearchedProcHead='' then exit;
ProcNode:=FindProcNode(StartNode,SearchedProcHead,SearchInProcAttr); ProcNode:=FindProcNode(StartNode,SearchedProcHead,SearchInProcAttr);
@ -353,10 +354,7 @@ begin
DebugLn('TMethodJumpingCodeTool.FindJumpPoint E ',dbgs(CleanCursorPos),', |',copy(Src,CleanCursorPos,8)); DebugLn('TMethodJumpingCodeTool.FindJumpPoint E ',dbgs(CleanCursorPos),', |',copy(Src,CleanCursorPos,8));
{$ENDIF} {$ENDIF}
BuildSubTreeForClass(ClassNode); BuildSubTreeForClass(ClassNode);
TypeSectionNode:=ClassNode.Parent; TypeSectionNode:=ClassNode.GetNodeOfType(ctnTypeSection);
if (TypeSectionNode<>nil) and (TypeSectionNode.Parent<>nil)
and (TypeSectionNode.Parent.Desc=ctnTypeSection) then
TypeSectionNode:=TypeSectionNode.Parent;
// search the method node under the cursor // search the method node under the cursor
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true). CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true).
GetNodeOfType(ctnProcedure); GetNodeOfType(ctnProcedure);

23
components/codetools/pascalreadertool.pas
View File

@ -326,7 +326,7 @@ end;
function TPascalReaderTool.ExtractProcHead(ProcNode: TCodeTreeNode; function TPascalReaderTool.ExtractProcHead(ProcNode: TCodeTreeNode;
Attr: TProcHeadAttributes): string; Attr: TProcHeadAttributes): string;
var var
GrandPaNode: TCodeTreeNode; TypeDefNode: TCodeTreeNode;
TheClassName, s: string; TheClassName, s: string;
HasClassName, IsProcType: boolean; HasClassName, IsProcType: boolean;
IsProcedure: Boolean; IsProcedure: Boolean;
@ -344,13 +344,17 @@ begin
exit; exit;
IsProcType:=(ProcNode.Desc=ctnProcedureType); IsProcType:=(ProcNode.Desc=ctnProcedureType);
if (phpAddClassname in Attr) then begin if (phpAddClassname in Attr) then begin
GrandPaNode:=ProcNode.Parent; TypeDefNode:=ProcNode.Parent;
if GrandPaNode=nil then exit; if TypeDefNode=nil then exit;
GrandPaNode:=GrandPaNode.Parent; TypeDefNode:=TypeDefNode.Parent;
if (GrandPaNode=nil) or (GrandPaNode.Desc<>ctnClass) then exit; if (TypeDefNode=nil) or (TypeDefNode.Desc<>ctnClass) then exit;
GrandPaNode:=GrandPaNode.Parent; TypeDefNode:=TypeDefNode.Parent;
if GrandPaNode.Desc<>ctnTypeDefinition then exit; if TypeDefNode.Desc=ctnGenericType then begin
MoveCursorToCleanPos(GrandPaNode.StartPos); TypeDefNode:=TypeDefNode.Parent;
if TypeDefNode=nil then exit;
end;
if TypeDefNode.Desc<>ctnTypeDefinition then exit;
MoveCursorToCleanPos(TypeDefNode.StartPos);
ReadNextAtom; ReadNextAtom;
if not AtomIsIdentifier(false) then exit; if not AtomIsIdentifier(false) then exit;
TheClassName:=GetAtom; TheClassName:=GetAtom;
@ -365,7 +369,6 @@ begin
ExtractNextAtom((phpWithStart in Attr) ExtractNextAtom((phpWithStart in Attr)
and not (phpWithoutClassKeyword in Attr),Attr); and not (phpWithoutClassKeyword in Attr),Attr);
IsProcedure:=UpAtomIs('PROCEDURE'); IsProcedure:=UpAtomIs('PROCEDURE');
IsProcedure:=UpAtomIs('PROCEDURE');
IsFunction:=(not IsProcedure) and UpAtomIs('FUNCTION'); IsFunction:=(not IsProcedure) and UpAtomIs('FUNCTION');
IsOperator:=(not IsProcedure) and (not IsFunction) and UpAtomIs('OPERATOR'); IsOperator:=(not IsProcedure) and (not IsFunction) and UpAtomIs('OPERATOR');
if IsProcedure or IsFunction or IsOperator if IsProcedure or IsFunction or IsOperator
@ -1056,6 +1059,8 @@ begin
if Result<>nil then exit; if Result<>nil then exit;
end else if ANode.Desc=ctnTypeDefinition then begin end else if ANode.Desc=ctnTypeDefinition then begin
CurClassNode:=ANode.FirstChild; CurClassNode:=ANode.FirstChild;
if (CurClassNode<>nil) and (CurClassNode.Desc=ctnGenericType) then
CurClassNode:=CurClassNode.FirstChild;
if (CurClassNode<>nil) and (CurClassNode.Desc=ctnClass) then begin if (CurClassNode<>nil) and (CurClassNode.Desc=ctnClass) then begin
if (not (IgnoreForwards if (not (IgnoreForwards
and ((CurClassNode.SubDesc and ctnsForwardDeclaration)>0))) and ((CurClassNode.SubDesc and ctnsForwardDeclaration)>0)))