mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-13 18:29:12 +02:00
MG: find declaration of sections, methods, class parts, records, enums
git-svn-id: trunk@595 -
This commit is contained in:
lazarus
parent
56813f345e
commit
30c48a15fe
@ -64,7 +64,6 @@ const
|
||||
|
||||
ctnBeginBlock = 20;
|
||||
ctnAsmBlock = 21;
|
||||
ctnWithBlock = 22;
|
||||
|
||||
ctnProgram = 30;
|
||||
ctnPackage = 31;
|
||||
@ -114,6 +113,14 @@ const
|
||||
[ctnClassPublic,ctnClassPublished,ctnClassPrivate,ctnClassProtected];
|
||||
AllDefinitionSections =
|
||||
[ctnTypeSection,ctnVarSection,ctnConstSection,ctnResStrSection];
|
||||
AllIdentifierDefinitions =
|
||||
[ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition];
|
||||
AllPascalTypes =
|
||||
[ctnClass,
|
||||
ctnIdentifier,ctnArrayType,ctnRecordType,ctnRecordCase,ctnRecordVariant,
|
||||
ctnProcedureType,ctnSetType,ctnRangeType,ctnEnumType,ctnLabelType,
|
||||
ctnTypeType,ctnFileType,ctnPointerType,ctnClassOfType];
|
||||
|
||||
|
||||
// CodeTreeNodeSubDescriptors
|
||||
ctnsNone = 0;
|
||||
@ -129,6 +136,8 @@ type
|
||||
Cache: TObject;
|
||||
function Next: TCodeTreeNode;
|
||||
function Prior: TCodeTreeNode;
|
||||
function HasAsParent(Node: TCodeTreeNode): boolean;
|
||||
function DescAsString: string;
|
||||
procedure Clear;
|
||||
constructor Create;
|
||||
function ConsistencyCheck: integer; // 0 = ok
|
||||
@ -242,7 +251,6 @@ begin
|
||||
|
||||
ctnBeginBlock: Result:='BeginBlock';
|
||||
ctnAsmBlock: Result:='AsmBlock';
|
||||
ctnWithBlock: Result:='WithBlock';
|
||||
|
||||
ctnProgram: Result:='Program';
|
||||
ctnPackage: Result:='Package';
|
||||
@ -365,6 +373,26 @@ begin
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
function TCodeTreeNode.HasAsParent(Node: TCodeTreeNode): boolean;
|
||||
var CurNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
if Node=nil then exit;
|
||||
CurNode:=Parent;
|
||||
while (CurNode<>nil) do begin
|
||||
if CurNode=Node then begin
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
CurNode:=CurNode.Parent;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeTreeNode.DescAsString: string;
|
||||
begin
|
||||
Result:=NodeDescriptionAsString(Desc);
|
||||
end;
|
||||
|
||||
{ TCodeTree }
|
||||
|
||||
constructor TCodeTree.Create;
|
||||
|
||||
@ -201,63 +201,7 @@ end;
|
||||
|
||||
function TCustomCodeTool.NodeDescToStr(Desc: integer): string;
|
||||
begin
|
||||
case Desc of
|
||||
// CodeTreeNodeDescriptors
|
||||
ctnNone : Result:='None';
|
||||
|
||||
ctnClass : Result:='Class';
|
||||
ctnClassPublished : Result:='Published';
|
||||
ctnClassPrivate : Result:='Private';
|
||||
ctnClassProtected : Result:='Protected';
|
||||
ctnClassPublic : Result:='Public';
|
||||
|
||||
ctnProcedure : Result:='Method';
|
||||
ctnProcedureHead : Result:='Method Head';
|
||||
ctnParameterList : Result:='Param List';
|
||||
|
||||
ctnBeginBlock : Result:='Begin';
|
||||
ctnAsmBlock : Result:='Asm';
|
||||
ctnWithBlock : Result:='With';
|
||||
|
||||
ctnProgram : Result:='Program';
|
||||
ctnPackage : Result:='Package';
|
||||
ctnLibrary : Result:='Library';
|
||||
ctnUnit : Result:='Unit';
|
||||
ctnInterface : Result:='Interface';
|
||||
ctnImplementation : Result:='Implementation';
|
||||
ctnInitialization : Result:='Initialization';
|
||||
ctnFinalization : Result:='Finalization';
|
||||
|
||||
ctnTypeSection : Result:='Type Section';
|
||||
ctnVarSection : Result:='Var Section';
|
||||
ctnConstSection : Result:='Const Section';
|
||||
ctnResStrSection : Result:='Resource String Section';
|
||||
ctnUsesSection : Result:='Uses Section';
|
||||
|
||||
ctnTypeDefinition : Result:='Type Definition';
|
||||
ctnVarDefinition : Result:='Variable Definition';
|
||||
ctnConstDefinition : Result:='Const Definition';
|
||||
|
||||
ctnProperty : Result:='Property';
|
||||
|
||||
ctnIdentifier : Result:='Identifier';
|
||||
ctnArrayType : Result:='Array Type';
|
||||
ctnRecordType : Result:='Record Type';
|
||||
ctnRecordCase : Result:='Record Case';
|
||||
ctnRecordVariant : Result:='Record Variant';
|
||||
ctnProcedureType : Result:='Procedure Type';
|
||||
ctnSetType : Result:='Set Type';
|
||||
ctnRangeType : Result:='Subrange Type';
|
||||
ctnEnumType : Result:='Enumeration Type';
|
||||
ctnLabelType : Result:='Label Type';
|
||||
ctnTypeType : Result:='''Type'' Type';
|
||||
ctnFileType : Result:='File Type';
|
||||
ctnPointerType : Result:='Pointer ''^'' Type';
|
||||
ctnClassOfType : Result:='Class Of Type';
|
||||
|
||||
else
|
||||
Result:='(unknown descriptor '+IntToStr(Desc)+')';
|
||||
end;
|
||||
Result:=NodeDescriptionAsString(Desc);
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.NodeSubDescToStr(Desc, SubDesc: integer): string;
|
||||
|
||||
@ -26,6 +26,7 @@
|
||||
|
||||
|
||||
ToDo:
|
||||
- many things, search for 'ToDo'
|
||||
}
|
||||
unit FindDeclarationTool;
|
||||
|
||||
@ -48,6 +49,40 @@ uses
|
||||
type
|
||||
// searchpath delimiter is semicolon
|
||||
TOnGetSearchPath = function(Sender: TObject): string;
|
||||
|
||||
TFindDeclarationFlag = (fdfSearchInParentNodes,fdfSearchInAncestors,
|
||||
fdfIgnoreCurContextNode,
|
||||
fdfClassPublished,fdfClassPublic,fdfClassProtected,fdfClassPrivate);
|
||||
TFindDeclarationFlags = set of TFindDeclarationFlag;
|
||||
|
||||
TFindDeclarationInput = record
|
||||
Flags: TFindDeclarationFlags;
|
||||
IdentifierStartPos: integer;
|
||||
IdentifierEndPos: integer;
|
||||
ContextNode: TCodeTreeNode;
|
||||
end;
|
||||
|
||||
TFindDeclarationParams = class(TObject)
|
||||
public
|
||||
Flags: TFindDeclarationFlags;
|
||||
IdentifierStartPos: integer;
|
||||
IdentifierEndPos: integer;
|
||||
ContextNode: TCodeTreeNode;
|
||||
NewNode: TCodeTreeNode;
|
||||
NewCleanPos: integer;
|
||||
NewCodeTool: TCustomCodeTool;
|
||||
NewPos: TCodeXYPosition;
|
||||
NewTopLine: integer;
|
||||
constructor Create;
|
||||
procedure Clear;
|
||||
procedure Save(var Input: TFindDeclarationInput);
|
||||
procedure Load(var Input: TFindDeclarationInput);
|
||||
procedure SetResult(ANewCodeTool: TCustomCodeTool; ANewNode: TCodeTreeNode);
|
||||
procedure SetResult(ANewCodeTool: TCustomCodeTool; ANewNode: TCodeTreeNode;
|
||||
ANewCleanPos: integer);
|
||||
procedure ConvertResultCleanPosToCaretPos;
|
||||
procedure ClearResult;
|
||||
end;
|
||||
|
||||
TFindDeclarationTool = class(TPascalParserTool)
|
||||
private
|
||||
@ -57,13 +92,15 @@ type
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
function IsIncludeDirectiveAtPos(CleanPos, CleanCodePosInFront: integer;
|
||||
var IncludeCode: TCodeBuffer): boolean;
|
||||
function FindDeclarationOfIdentifier(DeepestNode: TCodeTreeNode;
|
||||
IdentifierStartPos, IdentifierEndPos: integer;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
function FindIdentifierInContext(IdentifierStartPos,
|
||||
IdentifierEndPos: integer; ContextNode: TCodeTreeNode;
|
||||
SearchInParentNodes: boolean;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
function FindDeclarationOfIdentifier(
|
||||
Params: TFindDeclarationParams): boolean;
|
||||
function FindContextNodeAtCursor(Params: TFindDeclarationParams): TCodeTreeNode;
|
||||
function FindIdentifierInContext(Params: TFindDeclarationParams): boolean;
|
||||
function FindEnumInContext(Params: TFindDeclarationParams): boolean;
|
||||
function FindBaseTypeOfNode(Params: TFindDeclarationParams;
|
||||
Node: TCodeTreeNode): TCodeTreeNode;
|
||||
function FindIdentifierInProcContext(ProcContextNode: TCodeTreeNode;
|
||||
Params: TFindDeclarationParams): boolean;
|
||||
public
|
||||
function FindDeclaration(CursorPos: TCodeXYPosition;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
@ -73,16 +110,21 @@ type
|
||||
read FOnGetUnitSourceSearchPath write FOnGetUnitSourceSearchPath;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
const
|
||||
fdfAllClassVisibilities = [fdfClassPublished,fdfClassPublic,fdfClassProtected,
|
||||
fdfClassPrivate];
|
||||
|
||||
{ TFindDeclarationTool }
|
||||
|
||||
function TFindDeclarationTool.FindDeclaration(CursorPos: TCodeXYPosition;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
var CleanCursorPos: integer;
|
||||
CursorNode: TCodeTreeNode;
|
||||
CursorNode, ClassNode: TCodeTreeNode;
|
||||
Params: TFindDeclarationParams;
|
||||
begin
|
||||
Result:=false;
|
||||
// build code tree
|
||||
@ -113,21 +155,43 @@ writeln('TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsSt
|
||||
Result:=FindDeclarationInUsesSection(CursorNode,CleanCursorPos,
|
||||
NewPos,NewTopLine);
|
||||
end else begin
|
||||
// first test if in a class
|
||||
ClassNode:=CursorNode;
|
||||
while (ClassNode<>nil) and (ClassNode.Desc<>ctnClass) do
|
||||
ClassNode:=ClassNode.Parent;
|
||||
if ClassNode<>nil then begin
|
||||
// cursor is in class/object definition
|
||||
if ClassNode.SubDesc<>ctnsForwardDeclaration then begin
|
||||
// parse class and build CodeTreeNodes for all properties/methods
|
||||
BuildSubTreeForClass(ClassNode);
|
||||
end;
|
||||
end;
|
||||
if CursorNode.Desc=ctnBeginBlock then
|
||||
BuildSubTreeForBeginBlock(CursorNode);
|
||||
MoveCursorToCleanPos(CleanCursorPos);
|
||||
while (CurPos.StartPos>1) and (IsIdentChar[Src[CurPos.StartPos-1]]) do
|
||||
dec(CurPos.StartPos);
|
||||
writeln('AAA ',CurPos.StartPos,',',Src[CurPos.StartPos]);
|
||||
if (CurPos.StartPos>=1) and (IsIdentStartChar[Src[CurPos.StartPos]]) then
|
||||
begin
|
||||
writeln('AAA2');
|
||||
CurPos.EndPos:=CurPos.StartPos;
|
||||
while (CurPos.EndPos<=SrcLen) and IsIdentChar[Src[CurPos.EndPos]] do
|
||||
inc(CurPos.EndPos);
|
||||
// find declaration of identifier
|
||||
Result:=FindDeclarationOfIdentifier(CursorNode,
|
||||
CurPos.StartPos,CurPos.EndPos,NewPos,NewTopLine);
|
||||
Params:=TFindDeclarationParams.Create;
|
||||
try
|
||||
Params.ContextNode:=CursorNode;
|
||||
Params.IdentifierStartPos:=CurPos.StartPos;
|
||||
Params.IdentifierEndPos:=CurPos.EndPos;
|
||||
Params.Flags:=[fdfSearchInAncestors,fdfSearchInParentNodes];
|
||||
Result:=FindDeclarationOfIdentifier(Params);
|
||||
if Result then begin
|
||||
Params.ConvertResultCleanPosToCaretPos;
|
||||
NewPos:=Params.NewPos;
|
||||
NewTopLine:=Params.NewTopLine;
|
||||
end;
|
||||
finally
|
||||
Params.Free;
|
||||
end;
|
||||
end else begin
|
||||
// find declaration of not identifier
|
||||
|
||||
@ -388,39 +452,36 @@ begin
|
||||
end;
|
||||
|
||||
function TFindDeclarationTool.FindDeclarationOfIdentifier(
|
||||
DeepestNode: TCodeTreeNode; IdentifierStartPos, IdentifierEndPos: integer;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
{ searches an identifier in clean code, parses code in front of identifier
|
||||
Params: TFindDeclarationParams): boolean;
|
||||
{ searches an identifier in clean code, parses code in front and after the
|
||||
identifier
|
||||
|
||||
Params:
|
||||
IdentifierStartPos, IdentifierEndPos
|
||||
ContextNode // = DeepestNode at Cursor
|
||||
|
||||
Result:
|
||||
true, if NewPos+NewTopLine valid
|
||||
|
||||
For example:
|
||||
A^.B().C[].Identifier
|
||||
}
|
||||
var NewContextNode, OldContextNode: TCodeTreeNode;
|
||||
begin
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('[TFindDeclarationTool.FindDeclarationOfIdentifier] Identifier=',
|
||||
copy(Src,IdentifierStartPos,IdentifierEndPos-IdentifierStartPos),
|
||||
' DeepestNode=',NodeDescriptionAsString(DeepestNode.Desc));
|
||||
copy(Src,Params.IdentifierStartPos,Params.IdentifierEndPos-Params.IdentifierStartPos),
|
||||
' ContextNode=',NodeDescriptionAsString(Params.ContextNode.Desc));
|
||||
{$ENDIF}
|
||||
Result:=false;
|
||||
MoveCursorToCleanPos(IdentifierStartPos);
|
||||
ReadPriorAtom;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('[TFindDeclarationTool.FindDeclarationOfIdentifier] B PriorAtom=',GetAtom);
|
||||
{$ENDIF}
|
||||
if AtomIsChar('.') then begin
|
||||
// first search context, then search in context
|
||||
|
||||
// ToDo
|
||||
|
||||
end else if UpAtomIs('INHERITED') then begin
|
||||
// first search ancestor, then search in ancestor
|
||||
|
||||
// ToDo
|
||||
|
||||
end else begin
|
||||
// context is DeepestNode
|
||||
Result:=FindIdentifierInContext(IdentifierStartPos,IdentifierEndPos,
|
||||
DeepestNode,true,NewPos,NewTopLine);
|
||||
end;
|
||||
MoveCursorToCleanPos(Params.IdentifierStartPos);
|
||||
OldContextNode:=Params.ContextNode;
|
||||
NewContextNode:=FindContextNodeAtCursor(Params);
|
||||
Params.Flags:=[fdfSearchInAncestors]+fdfAllClassVisibilities;
|
||||
if NewContextNode=OldContextNode then
|
||||
Include(Params.Flags,fdfSearchInParentNodes);
|
||||
Params.ContextNode:=NewContextNode;
|
||||
Result:=FindIdentifierInContext(Params);
|
||||
{ ToDo:
|
||||
|
||||
- Difficulties:
|
||||
@ -450,67 +511,620 @@ writeln('[TFindDeclarationTool.FindDeclarationOfIdentifier] B PriorAtom=',GetAto
|
||||
1. Source: TCodeTreeNode
|
||||
2. PPU, PPW, DFU, ...:
|
||||
}
|
||||
|
||||
end;
|
||||
|
||||
function TFindDeclarationTool.FindIdentifierInContext(IdentifierStartPos,
|
||||
IdentifierEndPos: integer; ContextNode: TCodeTreeNode;
|
||||
SearchInParentNodes: boolean;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
function TFindDeclarationTool.FindIdentifierInContext(
|
||||
Params: TFindDeclarationParams): boolean;
|
||||
{ searches an identifier in context node
|
||||
It does not care about code in front of the identifier like 'a.Identifer'.
|
||||
|
||||
Params:
|
||||
IdentifierStartPos, IdentifierEndPos
|
||||
ContextNode // = DeepestNode at Cursor
|
||||
|
||||
Result:
|
||||
true, if NewPos+NewTopLine valid
|
||||
}
|
||||
var LastContextNode: TCodeTreeNode;
|
||||
var LastContextNode, StartContextNode, ContextNode: TCodeTreeNode;
|
||||
begin
|
||||
ContextNode:=Params.ContextNode;
|
||||
StartContextNode:=ContextNode;
|
||||
Result:=false;
|
||||
|
||||
// ToDo: identifier 'SELF'
|
||||
|
||||
if ContextNode<>nil then begin
|
||||
repeat
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('[TFindDeclarationTool.FindIdentifierInContext] ',NodeDescriptionAsString(ContextNode.Desc));
|
||||
writeln('[TFindDeclarationTool.FindIdentifierInContext] A Ident=',
|
||||
copy(Src,Params.IdentifierStartPos,Params.IdentifierEndPos-Params.IdentifierStartPos),
|
||||
' Context=',ContextNode.DescAsString,
|
||||
' ParentsAllowed=',fdfSearchInParentNodes in Params.Flags,
|
||||
' AncestorsAllowed=',fdfSearchInAncestors in Params.Flags
|
||||
);
|
||||
if (ContextNode.Desc=ctnClass) then
|
||||
writeln(' ContextNode.LastChild=',ContextNode.LastChild<>nil);
|
||||
{$ENDIF}
|
||||
LastContextNode:=ContextNode;
|
||||
case ContextNode.Desc of
|
||||
|
||||
ctnTypeSection, ctnVarSection, ctnConstSection, ctnResStrSection:
|
||||
begin
|
||||
if not (fdfIgnoreCurContextNode in Params.Flags) then begin
|
||||
case ContextNode.Desc of
|
||||
|
||||
ctnTypeSection, ctnVarSection, ctnConstSection, ctnResStrSection,
|
||||
ctnInterface, ctnImplementation,
|
||||
ctnClassPublic, ctnClassPrivate, ctnClassProtected, ctnClassPublished,
|
||||
ctnClass,
|
||||
ctnRecordType, ctnRecordCase, ctnRecordVariant:
|
||||
if ContextNode.LastChild<>nil then
|
||||
ContextNode:=ContextNode.LastChild;
|
||||
end;
|
||||
|
||||
ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition:
|
||||
begin
|
||||
if CompareSrcIdentifiers(IdentifierStartPos,ContextNode.StartPos) then
|
||||
begin
|
||||
// identifier found
|
||||
Result:=CleanPosToCaretAndTopLine(ContextNode.StartPos,
|
||||
NewPos,NewTopLine);
|
||||
exit;
|
||||
end;
|
||||
// search for enums
|
||||
|
||||
// ToDo
|
||||
|
||||
end;
|
||||
|
||||
ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition, ctnEnumType:
|
||||
begin
|
||||
if CompareSrcIdentifiers(Params.IdentifierStartPos,
|
||||
ContextNode.StartPos) then
|
||||
begin
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln(' Definition Identifier found=',copy(Src,ContextNode.StartPos,Params.IdentifierEndPos-Params.IdentifierStartPos));
|
||||
{$ENDIF}
|
||||
// identifier found
|
||||
Result:=true;
|
||||
Params.SetResult(Self,ContextNode);
|
||||
exit;
|
||||
end;
|
||||
// search for enums
|
||||
Params.ContextNode:=ContextNode;
|
||||
Result:=FindEnumInContext(Params);
|
||||
if Result then exit;
|
||||
end;
|
||||
|
||||
ctnProcedure:
|
||||
begin
|
||||
Result:=FindIdentifierInProcContext(ContextNode,Params);
|
||||
if Result then exit;
|
||||
end;
|
||||
|
||||
ctnProgram, ctnPackage, ctnLibrary, ctnUnit:
|
||||
begin
|
||||
MoveCursorToNodeStart(ContextNode);
|
||||
ReadNextAtom; // read keyword
|
||||
ReadNextAtom; // read name
|
||||
if CompareSrcIdentifiers(Params.IdentifierStartPos,CurPos.StartPos)
|
||||
then begin
|
||||
// identifier found
|
||||
Result:=true;
|
||||
Params.SetResult(Self,ContextNode,CurPos.StartPos);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
ctnProperty:
|
||||
begin
|
||||
MoveCursorToNodeStart(ContextNode);
|
||||
ReadNextAtom; // read keyword 'property'
|
||||
ReadNextAtom; // read name
|
||||
if CompareSrcIdentifiers(Params.IdentifierStartPos,CurPos.StartPos)
|
||||
then begin
|
||||
// identifier found
|
||||
Result:=true;
|
||||
Params.SetResult(Self,ContextNode,CurPos.StartPos);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
ctnUsesSection:
|
||||
begin
|
||||
// search backwards through the uses section
|
||||
// compare first the unit name then load the unit and search there
|
||||
|
||||
// ToDo:
|
||||
|
||||
end;
|
||||
|
||||
ctnWithVariable:
|
||||
begin
|
||||
|
||||
// ToDo:
|
||||
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
end else begin
|
||||
Exclude(Params.Flags,fdfIgnoreCurContextNode);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('[TFindDeclarationTool.FindIdentifierInContext] IgnoreCurContext');
|
||||
{$ENDIF}
|
||||
end;
|
||||
if LastContextNode=ContextNode then begin
|
||||
// same context -> search in higher context
|
||||
if not SearchInParentNodes then exit;
|
||||
if ContextNode.PriorBrother<>nil then
|
||||
ContextNode:=ContextNode.PriorBrother
|
||||
else if ContextNode.Parent<>nil then
|
||||
ContextNode:=ContextNode.Parent
|
||||
else
|
||||
break;
|
||||
// same context -> search in prior context
|
||||
if (not ContextNode.HasAsParent(StartContextNode)) then begin
|
||||
// searching in a prior node, will leave the start context
|
||||
if (not (fdfSearchInParentNodes in Params.Flags)) then begin
|
||||
// searching in any parent context is not permitted
|
||||
if not ((fdfSearchInAncestors in Params.Flags)
|
||||
and (NodeHasParentOfType(ContextNode,ctnClass))) then begin
|
||||
// even searching in ancestors contexts is not permitted
|
||||
// -> there is no prior context accessible any more
|
||||
// -> identifier not found
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('[TFindDeclarationTool.FindIdentifierInContext] no prior node accessible ContextNode=',ContextNode.DescAsString);
|
||||
{$ENDIF}
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
repeat
|
||||
// search for prior node
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching prior node of ',ContextNode.DescAsString);
|
||||
{$ENDIF}
|
||||
if ContextNode.PriorBrother<>nil then begin
|
||||
ContextNode:=ContextNode.PriorBrother;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in PriorBrother ContextNode=',ContextNode.DescAsString);
|
||||
{$ENDIF}
|
||||
// it is not always allowed to search in every node on the same lvl:
|
||||
|
||||
// -> test if class visibility valid
|
||||
case ContextNode.Desc of
|
||||
ctnClassPublished: if (fdfClassPublished in Params.Flags) then break;
|
||||
ctnClassPublic: if (fdfClassPublic in Params.Flags) then break;
|
||||
ctnClassProtected: if (fdfClassProtected in Params.Flags) then break;
|
||||
ctnClassPrivate: if (fdfClassPrivate in Params.Flags) then break;
|
||||
else
|
||||
break;
|
||||
end;
|
||||
end else if ContextNode.Parent<>nil then begin
|
||||
ContextNode:=ContextNode.Parent;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in Parent ContextNode=',ContextNode.DescAsString);
|
||||
{$ENDIF}
|
||||
case ContextNode.Desc of
|
||||
|
||||
ctnTypeSection, ctnVarSection, ctnConstSection, ctnResStrSection,
|
||||
ctnInterface, ctnImplementation,
|
||||
ctnClassPublished,ctnClassPublic,ctnClassProtected, ctnClassPrivate,
|
||||
ctnRecordCase, ctnRecordVariant:
|
||||
// these codetreenodes build a parent-child-relationship, but
|
||||
// for pascal it is only a range, hence after searching in the
|
||||
// childs of the last node, it must be searched next in the childs
|
||||
// of the prior node
|
||||
;
|
||||
|
||||
ctnClass:
|
||||
begin
|
||||
// the prior search space of a class is its ancestors + interfaces
|
||||
|
||||
// ToDo: search in the ancestors and interfaces
|
||||
|
||||
// search in the parent (no code needed) ...
|
||||
end;
|
||||
|
||||
ctnRecordType:
|
||||
// do not search again in this node, go on ...
|
||||
;
|
||||
|
||||
else
|
||||
break;
|
||||
end;
|
||||
end else begin
|
||||
ContextNode:=nil;
|
||||
break;
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
until ContextNode=nil;
|
||||
end else begin
|
||||
// DeepestNode=nil
|
||||
// DeepestNode=nil -> ignore
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFindDeclarationTool.FindEnumInContext(
|
||||
Params: TFindDeclarationParams): boolean;
|
||||
{ search all subnodes for ctnEnumType
|
||||
|
||||
Params:
|
||||
IdentifierStartPos, IdentifierEndPos
|
||||
ContextNode // = DeepestNode at Cursor
|
||||
|
||||
Result:
|
||||
true, if NewPos+NewTopLine valid
|
||||
}
|
||||
var OldContextNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
if Params.ContextNode=nil then exit;
|
||||
OldContextNode:=Params.ContextNode;
|
||||
try
|
||||
Params.ContextNode:=Params.ContextNode.FirstChild;
|
||||
while Params.ContextNode<>nil do begin
|
||||
if (Params.ContextNode.Desc in [ctnEnumType])
|
||||
and CompareSrcIdentifiers(Params.IdentifierStartPos,
|
||||
Params.ContextNode.StartPos)
|
||||
then begin
|
||||
// identifier found
|
||||
Result:=true;
|
||||
Params.SetResult(Self,Params.ContextNode);
|
||||
exit;
|
||||
end;
|
||||
Result:=FindEnumInContext(Params);
|
||||
if Result then exit;
|
||||
Params.ContextNode:=Params.ContextNode.NextBrother;
|
||||
end;
|
||||
finally
|
||||
Params.ContextNode:=OldContextNode;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFindDeclarationTool.FindContextNodeAtCursor(
|
||||
Params: TFindDeclarationParams): TCodeTreeNode;
|
||||
{ searches for the context node for a specific cursor pos
|
||||
Params.Context should contain the deepest node at cursor
|
||||
if there is no special context, then result is equal to Params.Context
|
||||
|
||||
|
||||
Examples:
|
||||
|
||||
1. A.B - CleanPos points to B: if A is a class, the context node will be
|
||||
the class node (ctnRecordType).
|
||||
2. A().B - same as above
|
||||
|
||||
3. inherited A - CleanPos points to A: if in a method, the context node will
|
||||
be the class node (ctnClass) of the current method.
|
||||
|
||||
4. A[]. - CleanPos points to '.': if A is an array, the context node will
|
||||
be the array type node (ctnArrayType).
|
||||
|
||||
5. A[].B - CleanPos points to B: if A is an array of record, the context
|
||||
node will be the record type node (ctnRecordType).
|
||||
|
||||
6. A^. - CleanPos points to '.': if A is a pointer of record, the context
|
||||
node will be the record type node (ctnRecordType).
|
||||
|
||||
7. (A). - CleanPos points to '.': if A is a class, the context node will be
|
||||
the class node (ctnClass).
|
||||
|
||||
8. (A as B) - CleanPos points to ')': if B is a classtype, the context node
|
||||
will be the class node (ctnClass)
|
||||
|
||||
}
|
||||
type
|
||||
TAtomType = (atNone, atSpace, atIdentifier, atPoint, atAS, atINHERITED, atUp,
|
||||
atRoundBracketOpen, atRoundBracketClose,
|
||||
atEdgedBracketOpen, atEdgedBracketClose);
|
||||
const
|
||||
AtomTypeNames: array[TAtomType] of string =
|
||||
('<None>','Space','Ident','Point','AS','INHERITED','Up^',
|
||||
'Bracket(','Bracket)','Bracket[','Bracket]');
|
||||
|
||||
function GetCurrentAtomType: TAtomType;
|
||||
begin
|
||||
if (CurPos.StartPos=CurPos.EndPos) then
|
||||
Result:=atSpace
|
||||
else if AtomIsIdentifier(false) then
|
||||
Result:=atIdentifier
|
||||
else if (CurPos.StartPos>=1) and (CurPos.StartPos<=SrcLen)
|
||||
and (CurPos.StartPos=CurPos.EndPos-1) then begin
|
||||
case Src[CurPos.StartPos] of
|
||||
'.': Result:=atPoint;
|
||||
'^': Result:=atUp;
|
||||
'(': Result:=atRoundBracketOpen;
|
||||
')': Result:=atRoundBracketClose;
|
||||
'[': Result:=atEdgedBracketOpen;
|
||||
']': Result:=atEdgedBracketClose;
|
||||
else Result:=atNone;
|
||||
end;
|
||||
end else if UpAtomIs('INHERITED') then
|
||||
Result:=atINHERITED
|
||||
else if UpAtomIs('AS') then
|
||||
Result:=atAS
|
||||
else
|
||||
Result:=atNone;
|
||||
end;
|
||||
|
||||
|
||||
var CurAtom: TAtomPosition;
|
||||
OldInput: TFindDeclarationInput;
|
||||
NextAtomType, CurAtomType: TAtomType;
|
||||
begin
|
||||
// start parsing the expression from right to left
|
||||
NextAtomType:=GetCurrentAtomType;
|
||||
ReadPriorAtom;
|
||||
CurAtom:=CurPos;
|
||||
CurAtomType:=GetCurrentAtomType;
|
||||
if CurAtomType=atNone then begin
|
||||
// no special context found -> the context node is the deepest node at
|
||||
// cursor, and this should already be in Params.ContextNode
|
||||
Result:=Params.ContextNode;
|
||||
exit;
|
||||
end;
|
||||
Result:=FindContextNodeAtCursor(Params);
|
||||
|
||||
// coming back the left side has been parsed and
|
||||
// now the parsing goes from left to right
|
||||
|
||||
{$IFDEF CTDEBUG}
|
||||
write('[TFindDeclarationTool.FindContextNodeAtCursor] B ',
|
||||
' Context=',Params.ContextNode.DescAsString,
|
||||
' CurAtom=',AtomTypeNames[CurAtomType],
|
||||
' "',copy(Src,CurAtom.StartPos,CurAtom.EndPos-CurAtom.StartPos),'"',
|
||||
' NextAtom=',AtomTypeNames[NextAtomType],
|
||||
' Result=');
|
||||
if Result<>nil then write(Result.DescAsString) else write('NIL');
|
||||
writeln('');
|
||||
{$ENDIF}
|
||||
|
||||
case CurAtomType of
|
||||
|
||||
atIdentifier:
|
||||
begin
|
||||
if not (NextAtomType in [atSpace,atPoint,atUp,atAS,atRoundBracketOpen,
|
||||
atEdgedBracketOpen]) then
|
||||
begin
|
||||
ReadNextAtom;
|
||||
RaiseException('syntax error: "'+GetAtom+'" found');
|
||||
end;
|
||||
Params.Save(OldInput);
|
||||
try
|
||||
Params.Flags:=[fdfSearchInAncestors]+fdfAllClassVisibilities;
|
||||
//writeln(' ',Result=Params.ContextNode,' ',Result.DescAsString,',',Params.ContextNode.DescAsString);
|
||||
if Result=Params.ContextNode then begin
|
||||
// there is no special context -> also search in parent contexts
|
||||
Include(Params.Flags,fdfSearchInParentNodes);
|
||||
end else
|
||||
Params.ContextNode:=Result;
|
||||
Params.IdentifierStartPos:=CurAtom.StartPos;
|
||||
Params.IdentifierEndPos:=CurAtom.EndPos;
|
||||
if FindIdentifierInContext(Params) then
|
||||
Result:=Params.NewNode
|
||||
else
|
||||
Result:=nil;
|
||||
finally
|
||||
Params.Load(OldInput);
|
||||
end;
|
||||
end;
|
||||
|
||||
atPoint:
|
||||
begin
|
||||
if (not (NextAtomType in [atSpace,atIdentifier])) then begin
|
||||
ReadNextAtom;
|
||||
RaiseException('syntax error: identifier expected, but '
|
||||
+GetAtom+' found');
|
||||
end;
|
||||
end;
|
||||
|
||||
else
|
||||
Result:=Params.ContextNode;
|
||||
end;
|
||||
|
||||
// try to get the base type of the found context
|
||||
Result:=FindBaseTypeOfNode(Params,Result);
|
||||
|
||||
{$IFDEF CTDEBUG}
|
||||
write('[TFindDeclarationTool.FindContextNodeAtCursor] END ',
|
||||
Params.ContextNode.DescAsString,' CurAtom=',AtomTypeNames[CurAtomType],
|
||||
' NextAtom=',AtomTypeNames[NextAtomType],' Result=');
|
||||
if Result<>nil then write(Result.DescAsString) else write('NIL');
|
||||
writeln('');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TFindDeclarationTool.FindBaseTypeOfNode(Params: TFindDeclarationParams;
|
||||
Node: TCodeTreeNode): TCodeTreeNode;
|
||||
var OldInput: TFindDeclarationInput;
|
||||
begin
|
||||
Result:=Node;
|
||||
while (Result<>nil) do begin
|
||||
if (Result.Desc in AllIdentifierDefinitions) then begin
|
||||
// instead of variable/const/type definition, return the type
|
||||
Result:=FindTypeNodeOfDefinition(Result);
|
||||
end else
|
||||
if (Result.Desc=ctnClass) and (Result.SubDesc=ctnsForwardDeclaration) then
|
||||
begin
|
||||
// search the real class
|
||||
|
||||
// ToDo
|
||||
|
||||
end else
|
||||
if (Result.Desc=ctnTypeType) then begin
|
||||
// a TypeType is for example 'MyInt = type integer;'
|
||||
// the context is not the 'type' keyword, but the identifier after it.
|
||||
Result:=Result.FirstChild;
|
||||
end else
|
||||
if (Result.Desc=ctnIdentifier) then begin
|
||||
// this type is just an alias for another type
|
||||
// -> search the basic type
|
||||
if Result.Parent=nil then
|
||||
break;
|
||||
Params.Save(OldInput);
|
||||
try
|
||||
Params.IdentifierStartPos:=Result.StartPos;
|
||||
Params.IdentifierEndPos:=Result.EndPos;
|
||||
Params.Flags:=[fdfSearchInParentNodes];
|
||||
Params.ContextNode:=Result.Parent;
|
||||
if FindIdentifierInContext(Params) then begin
|
||||
if Result.HasAsParent(Params.NewNode) then
|
||||
break
|
||||
else
|
||||
Result:=Params.NewNode;
|
||||
end else
|
||||
break;
|
||||
finally
|
||||
Params.Load(OldInput);
|
||||
end;
|
||||
end else
|
||||
break;
|
||||
end;
|
||||
{$IFDEF CTDEBUG}
|
||||
write('[TFindDeclarationTool.FindBaseTypeOfNode] END Node=');
|
||||
if Node<>nil then write(Node.DescAsString) else write('NIL');
|
||||
write(' Result=');
|
||||
if Result<>nil then write(Result.DescAsString) else write('NIL');
|
||||
writeln('');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TFindDeclarationTool.FindIdentifierInProcContext(
|
||||
ProcContextNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
|
||||
{ this function is internally used by FindIdentifierInContext
|
||||
}
|
||||
var
|
||||
ClassNameAtom: TAtomPosition;
|
||||
OldInput: TFindDeclarationInput;
|
||||
ClassContextNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
MoveCursorToNodeStart(ProcContextNode);
|
||||
ReadNextAtom; // read keyword
|
||||
ReadNextAtom; // read classname
|
||||
ClassNameAtom:=CurPos;
|
||||
ReadNextAtom;
|
||||
if AtomIsChar('.') then begin
|
||||
// proc is a method
|
||||
if CompareSrcIdentifiers(ClassNameAtom.StartPos,
|
||||
Params.IdentifierStartPos) then
|
||||
begin
|
||||
// the class itself is searched
|
||||
// -> proceed the search normally ...
|
||||
end else begin
|
||||
// search the identifier in the class first
|
||||
// 1. search the class
|
||||
Params.Save(OldInput);
|
||||
try
|
||||
Params.Flags:=[fdfIgnoreCurContextNode,fdfSearchInParentNodes];
|
||||
Params.ContextNode:=ProcContextNode;
|
||||
Params.IdentifierStartPos:=ClassNameAtom.StartPos;
|
||||
Params.IdentifierEndPos:=ClassNameAtom.EndPos;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln(' searching class of method class="',copy(Src,ClassNameAtom.StartPos,ClassNameAtom.EndPos-ClassNameAtom.StartPos),'"');
|
||||
{$ENDIF}
|
||||
if FindIdentifierInContext(Params) then begin
|
||||
Params.NewNode:=FindBaseTypeOfNode(Params,Params.NewNode);
|
||||
if (Params.NewNode=nil)
|
||||
or (Params.NewNode.Desc<>ctnClass) then begin
|
||||
MoveCursorToCleanPos(ClassNameAtom.StartPos);
|
||||
RaiseException('class identifier expected');
|
||||
end;
|
||||
// class of method found
|
||||
// -> find class type node
|
||||
BuildSubTreeForClass(Params.NewNode);
|
||||
ClassContextNode:=FindTypeNodeOfDefinition(Params.NewNode);
|
||||
if Params.ContextNode<>nil then begin
|
||||
// class context found -> search identifier
|
||||
Params.Load(OldInput);
|
||||
Params.Flags:=[fdfSearchInAncestors]+fdfAllClassVisibilities;
|
||||
Params.ContextNode:=ClassContextNode;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln(' searching identifier in class of method');
|
||||
{$ENDIF}
|
||||
Result:=FindIdentifierInContext(Params);
|
||||
if Result then exit;
|
||||
end else begin
|
||||
// class context not found -> cancel the search
|
||||
MoveCursorToCleanPos(Params.NewNode.StartPos);
|
||||
RaiseException('class context not found');
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
// class not found -> cancel the search
|
||||
MoveCursorToCleanPos(ClassNameAtom.StartPos);
|
||||
RaiseException('class not found');
|
||||
exit;
|
||||
end;
|
||||
finally
|
||||
Params.Load(OldInput);
|
||||
end;
|
||||
end;
|
||||
end else begin
|
||||
// proc is not a method
|
||||
if CompareSrcIdentifiers(ClassNameAtom.StartPos,
|
||||
Params.IdentifierStartPos) then
|
||||
begin
|
||||
// proc identifier found
|
||||
Result:=true;
|
||||
Params.SetResult(Self,ProcContextNode);
|
||||
exit;
|
||||
end else begin
|
||||
// proceed the search normally ...
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TFindDeclarationParams }
|
||||
|
||||
constructor TFindDeclarationParams.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Clear;
|
||||
end;
|
||||
|
||||
procedure TFindDeclarationParams.Clear;
|
||||
begin
|
||||
Flags:=[];
|
||||
IdentifierStartPos:=-1;
|
||||
IdentifierEndPos:=-1;
|
||||
ContextNode:=nil;
|
||||
ClearResult;
|
||||
end;
|
||||
|
||||
procedure TFindDeclarationParams.Load(var Input: TFindDeclarationInput);
|
||||
begin
|
||||
Flags:=Input.Flags;
|
||||
IdentifierStartPos:=Input.IdentifierStartPos;
|
||||
IdentifierEndPos:=Input.IdentifierEndPos;
|
||||
ContextNode:=Input.ContextNode;
|
||||
end;
|
||||
|
||||
procedure TFindDeclarationParams.Save(var Input: TFindDeclarationInput);
|
||||
begin
|
||||
Input.Flags:=Flags;
|
||||
Input.IdentifierStartPos:=IdentifierStartPos;
|
||||
Input.IdentifierEndPos:=IdentifierEndPos;
|
||||
Input.ContextNode:=ContextNode;
|
||||
end;
|
||||
|
||||
procedure TFindDeclarationParams.ClearResult;
|
||||
begin
|
||||
NewPos.Code:=nil;
|
||||
NewPos.X:=-1;
|
||||
NewPos.Y:=-1;
|
||||
NewTopLine:=-1;
|
||||
NewNode:=nil;
|
||||
NewCleanPos:=-1;
|
||||
NewCodeTool:=nil;
|
||||
end;
|
||||
|
||||
procedure TFindDeclarationParams.SetResult(ANewCodeTool: TCustomCodeTool;
|
||||
ANewNode: TCodeTreeNode);
|
||||
begin
|
||||
ClearResult;
|
||||
NewCodeTool:=ANewCodeTool;
|
||||
NewNode:=ANewNode;
|
||||
end;
|
||||
|
||||
procedure TFindDeclarationParams.SetResult(ANewCodeTool: TCustomCodeTool;
|
||||
ANewNode: TCodeTreeNode; ANewCleanPos: integer);
|
||||
begin
|
||||
ClearResult;
|
||||
NewCodeTool:=ANewCodeTool;
|
||||
NewNode:=ANewNode;
|
||||
NewCleanPos:=ANewCleanPos;
|
||||
end;
|
||||
|
||||
procedure TFindDeclarationParams.ConvertResultCleanPosToCaretPos;
|
||||
begin
|
||||
NewPos.Code:=nil;
|
||||
if NewCodeTool<>nil then begin
|
||||
if (NewCleanPos>=1) then
|
||||
NewCodeTool.CleanPosToCaretAndTopLine(NewCleanPos,
|
||||
NewPos,NewTopLine)
|
||||
else if (NewNode<>nil) then
|
||||
NewCodeTool.CleanPosToCaretAndTopLine(NewNode.StartPos,
|
||||
NewPos,NewTopLine);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -181,10 +181,8 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint B');
|
||||
if CleanCursorPos>=LastAtomEnd then CleanCursorPos:=LastAtomEnd-1;
|
||||
// find CodeTreeNode at cursor
|
||||
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos);
|
||||
if CursorNode=nil then begin
|
||||
WriteDebugTreeReport;
|
||||
if CursorNode=nil then
|
||||
RaiseException('no node found at cursor');
|
||||
end;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint C ',NodeDescriptionAsString(CursorNode.Desc));
|
||||
{$ENDIF}
|
||||
@ -199,7 +197,7 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint C ',NodeDescriptionAsString(Cursor
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint C2 ',NodeDescriptionAsString(ClassNode.Desc));
|
||||
{$ENDIF}
|
||||
if CursorNode.SubDesc=ctnsForwardDeclaration then exit;
|
||||
if ClassNode.SubDesc=ctnsForwardDeclaration then exit;
|
||||
// parse class and build CodeTreeNodes for all properties/methods
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint D ',CleanCursorPos,', |',copy(Src,CleanCursorPos,8));
|
||||
|
||||
@ -118,7 +118,7 @@ type
|
||||
function KeyWordFuncTypeRecord: boolean;
|
||||
function KeyWordFuncTypeDefault: boolean;
|
||||
// procedures/functions/methods
|
||||
function KeyWordFuncMethod: boolean;
|
||||
function KeyWordFuncProc: boolean;
|
||||
function KeyWordFuncBeginEnd: boolean;
|
||||
// class/object elements
|
||||
function KeyWordFuncClassSection: boolean;
|
||||
@ -161,6 +161,7 @@ type
|
||||
CreateNodes: boolean): boolean;
|
||||
function ReadWithStatement(ExceptionOnError,
|
||||
CreateNodes: boolean): boolean;
|
||||
procedure ReadVariableType;
|
||||
public
|
||||
CurSection: TCodeTreeNodeDesc;
|
||||
|
||||
@ -202,6 +203,8 @@ type
|
||||
function FindImplementationNode: TCodeTreeNode;
|
||||
function FindInitializationNode: TCodeTreeNode;
|
||||
function FindMainBeginEndNode: TCodeTreeNode;
|
||||
function FindTypeNodeOfDefinition(
|
||||
DefinitionNode: TCodeTreeNode): TCodeTreeNode;
|
||||
function GetSourceType: TCodeTreeNodeDesc;
|
||||
function NodeHasParentOfType(ANode: TCodeTreeNode;
|
||||
NodeDesc: TCodeTreeNodeDesc): boolean;
|
||||
@ -336,12 +339,12 @@ begin
|
||||
Add('CONST',{$ifdef FPC}@{$endif}KeyWordFuncConst);
|
||||
Add('RESOURCESTRING',{$ifdef FPC}@{$endif}KeyWordFuncResourceString);
|
||||
|
||||
Add('PROCEDURE',{$ifdef FPC}@{$endif}KeyWordFuncMethod);
|
||||
Add('FUNCTION',{$ifdef FPC}@{$endif}KeyWordFuncMethod);
|
||||
Add('CONSTRUCTOR',{$ifdef FPC}@{$endif}KeyWordFuncMethod);
|
||||
Add('DESTRUCTOR',{$ifdef FPC}@{$endif}KeyWordFuncMethod);
|
||||
Add('OPERATOR',{$ifdef FPC}@{$endif}KeyWordFuncMethod);
|
||||
Add('CLASS',{$ifdef FPC}@{$endif}KeyWordFuncMethod);
|
||||
Add('PROCEDURE',{$ifdef FPC}@{$endif}KeyWordFuncProc);
|
||||
Add('FUNCTION',{$ifdef FPC}@{$endif}KeyWordFuncProc);
|
||||
Add('CONSTRUCTOR',{$ifdef FPC}@{$endif}KeyWordFuncProc);
|
||||
Add('DESTRUCTOR',{$ifdef FPC}@{$endif}KeyWordFuncProc);
|
||||
Add('OPERATOR',{$ifdef FPC}@{$endif}KeyWordFuncProc);
|
||||
Add('CLASS',{$ifdef FPC}@{$endif}KeyWordFuncProc);
|
||||
|
||||
Add('BEGIN',{$ifdef FPC}@{$endif}KeyWordFuncBeginEnd);
|
||||
Add('ASM',{$ifdef FPC}@{$endif}KeyWordFuncBeginEnd);
|
||||
@ -532,6 +535,9 @@ begin
|
||||
if ClassNode.FirstChild<>nil then
|
||||
// class already parsed
|
||||
exit;
|
||||
if ClassNode.Desc<>ctnClass then
|
||||
RaiseException('[TPascalParserTool.BuildSubTreeForClass] ClassNode.Desc='
|
||||
+ClassNode.DescAsString);
|
||||
// set CursorPos after class head
|
||||
MoveCursorToNodeStart(ClassNode);
|
||||
// parse
|
||||
@ -691,7 +697,9 @@ begin
|
||||
end;
|
||||
if not AtomIsChar(':') then
|
||||
RaiseException('syntax error: : expected, but '+GetAtom+' found');
|
||||
ReadNextAtom;
|
||||
// read type
|
||||
ReadVariableType;
|
||||
{ ReadNextAtom;
|
||||
if (CurPos.StartPos>SrcLen) then
|
||||
RaiseException('syntax error: variable type definition not found');
|
||||
// create type body node
|
||||
@ -726,7 +734,7 @@ begin
|
||||
EndChildNode;
|
||||
// end variable definition
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
EndChildNode;}
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
@ -1479,7 +1487,7 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncMethod: boolean;
|
||||
function TPascalParserTool.KeyWordFuncProc: boolean;
|
||||
// procedure, function, constructor, destructor, operator
|
||||
var ChildCreated: boolean;
|
||||
IsFunction, HasForwardModifier, IsClassProc: boolean;
|
||||
@ -1491,7 +1499,7 @@ begin
|
||||
'syntax error: identifier expected, but '+GetAtom+' found');
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('PROCEDURE') or UpAtomIs('FUNCTION') then
|
||||
IsClassProc:=true
|
||||
IsClassProc:=true
|
||||
else
|
||||
RaiseException(
|
||||
'syntax error: "procedure" expected, but '+GetAtom+' found');
|
||||
@ -1776,6 +1784,40 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TPascalParserTool.ReadVariableType;
|
||||
// creates nodes for variable type
|
||||
begin
|
||||
ReadNextAtom;
|
||||
TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
|
||||
CurPos.EndPos-CurPos.StartPos);
|
||||
if UpAtomIs('ABSOLUTE') then begin
|
||||
ReadNextAtom;
|
||||
ReadConstant(true,false,[]);
|
||||
end;
|
||||
if AtomIsChar('=') then begin
|
||||
// read constant
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
if AtomIsChar('(') or AtomIsChar('[') then
|
||||
ReadTilBracketClose(true);
|
||||
if AtomIsWord and (not IsKeyWordInConstAllowed.DoItUppercase(UpperSrc,
|
||||
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos))
|
||||
and (UpAtomIs('END') or AtomIsKeyWord) then
|
||||
RaiseException('syntax error: ; expected, but '+GetAtom+' found');
|
||||
until AtomIsChar(';');
|
||||
end;
|
||||
// read ;
|
||||
if not AtomIsChar(';') then
|
||||
RaiseException('syntax error: ; expected, but '+GetAtom+' found');
|
||||
if not ReadNextUpAtomIs('CVAR') then
|
||||
UndoReadNextAtom
|
||||
else
|
||||
if not ReadNextAtomIsChar(';') then
|
||||
RaiseException('syntax error: ; expected, but '+GetAtom+' found');
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncBeginEnd: boolean;
|
||||
// Keyword: begin, asm
|
||||
var BeginKeyWord: shortstring;
|
||||
@ -1897,35 +1939,7 @@ begin
|
||||
if not AtomIsChar(':') then
|
||||
RaiseException('syntax error: : expected, but '+GetAtom+' found');
|
||||
// read type
|
||||
ReadNextAtom;
|
||||
TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
|
||||
CurPos.EndPos-CurPos.StartPos);
|
||||
if UpAtomIs('ABSOLUTE') then begin
|
||||
ReadNextAtom;
|
||||
ReadConstant(true,false,[]);
|
||||
end;
|
||||
if AtomIsChar('=') then begin
|
||||
// read constant
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
if AtomIsChar('(') or AtomIsChar('[') then
|
||||
ReadTilBracketClose(true);
|
||||
if AtomIsWord and (not IsKeyWordInConstAllowed.DoItUppercase(UpperSrc,
|
||||
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos))
|
||||
and (UpAtomIs('END') or AtomIsKeyWord) then
|
||||
RaiseException('syntax error: ; expected, but '+GetAtom+' found');
|
||||
until AtomIsChar(';');
|
||||
end;
|
||||
// read ;
|
||||
if not AtomIsChar(';') then
|
||||
RaiseException('syntax error: ; expected, but '+GetAtom+' found');
|
||||
if not ReadNextUpAtomIs('CVAR') then
|
||||
UndoReadNextAtom
|
||||
else
|
||||
if not ReadNextAtomIsChar(';') then
|
||||
RaiseException('syntax error: ; expected, but '+GetAtom+' found');
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
ReadVariableType;
|
||||
end else begin
|
||||
UndoReadNextAtom;
|
||||
break;
|
||||
@ -3024,6 +3038,23 @@ begin
|
||||
RaiseException('cursor pos outside of code');
|
||||
end;
|
||||
|
||||
function TPascalParserTool.FindTypeNodeOfDefinition(
|
||||
DefinitionNode: TCodeTreeNode): TCodeTreeNode;
|
||||
// for example: 'var a,b,c: integer;' only c has a type child
|
||||
begin
|
||||
Result:=DefinitionNode;
|
||||
while (Result<>nil)
|
||||
and (Result.Desc in AllIdentifierDefinitions) do begin
|
||||
if (Result.FirstChild<>nil) then begin
|
||||
Result:=Result.FirstChild;
|
||||
if (Result<>nil) and (not (Result.Desc in AllPascalTypes)) then
|
||||
Result:=nil;
|
||||
exit;
|
||||
end;
|
||||
Result:=Result.NextBrother;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user