mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-05 16:52:38 +02:00
2251 lines
78 KiB
ObjectPascal
2251 lines
78 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
TFindDeclarationTool enhances the TPascalParserTool with the ability
|
|
to find the source position or code tree node of a declaration.
|
|
|
|
|
|
ToDo:
|
|
- many things, search for 'ToDo'
|
|
|
|
- Difficulties:
|
|
1. Searching recursively
|
|
- ParentNodes
|
|
- Ancestor Classes/Objects/Interfaces
|
|
- with statements
|
|
- operators: '.', '()', 'A()', '^', 'inherited'
|
|
2. Searching enums must be searched in sub nodes
|
|
-> all classes node trees must be built
|
|
3. Searching in used units (interface USES and implementation USES)
|
|
4. Searching forward for pointer types e.g. ^Tralala
|
|
5. Mass Search: searching a compatible proc will result
|
|
in searching every parameter type of every reachable proc
|
|
(implementation section + interface section
|
|
+ used interface sections + class and ancestor methods)
|
|
How can this be achieved in good time?
|
|
-> Caching
|
|
- Caching:
|
|
Where:
|
|
For each section node (Interface, Implementation, ...)
|
|
For each BeginBlock
|
|
Entries: (What, Declaration Pos)
|
|
What: Identifier -> Ansistring (to reduce memory usage,
|
|
maintain a list of all identifier ansistrings)
|
|
Pos: Code+SrcPos
|
|
1. Source: TCodeTreeNode
|
|
2. PPU, PPW, DCU, ...
|
|
}
|
|
unit FindDeclarationTool;
|
|
|
|
{$ifdef FPC}{$mode objfpc}{$endif}{$H+}
|
|
|
|
interface
|
|
|
|
{$I codetools.inc}
|
|
|
|
{ $DEFINE CTDEBUG}
|
|
{ $DEFINE ShowTriedFiles}
|
|
{ $DEFINE ShowTriedContexts}
|
|
|
|
uses
|
|
{$IFDEF MEM_CHECK}
|
|
MemCheck,
|
|
{$ENDIF}
|
|
Classes, SysUtils, CodeTree, CodeAtom, CustomCodeTool, SourceLog,
|
|
KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache, AVL_Tree, TypInfo,
|
|
PascalParserTool, FileProcs, DefineTemplates;
|
|
|
|
type
|
|
TFindDeclarationTool = class;
|
|
|
|
// searchpath delimiter is semicolon
|
|
TOnGetSearchPath = function(Sender: TObject): string of object;
|
|
TOnGetCodeToolForBuffer = function(Sender: TObject;
|
|
Code: TCodeBuffer): TFindDeclarationTool of object;
|
|
|
|
|
|
TFindDeclarationFlag = (
|
|
fdfSearchInParentNodes, // if identifier not found in current context,
|
|
// proceed in prior nodes on same lvl and parents
|
|
fdfSearchInAncestors, // if context is a class, search also in
|
|
// ancestors/interfaces
|
|
fdfIgnoreCurContextNode,// skip context and proceed in prior/parent context
|
|
fdfExceptionOnNotFound, // raise exception if identifier not found
|
|
fdfIgnoreUsedUnits, // stay in current source
|
|
fdfSearchForward, // instead of searching in prior nodes, search in
|
|
// next nodes (successors)
|
|
fdfIgnoreClassVisibility,//find inaccessible private+protected fields
|
|
fdfClassPublished,fdfClassPublic,fdfClassProtected,fdfClassPrivate);
|
|
TFindDeclarationFlags = set of TFindDeclarationFlag;
|
|
|
|
TFindDeclarationInput = record
|
|
Flags: TFindDeclarationFlags;
|
|
Identifier: PChar;
|
|
ContextNode: TCodeTreeNode;
|
|
end;
|
|
|
|
TFindDeclarationParams = class;
|
|
|
|
TFindContext = record
|
|
Node: TCodeTreeNode;
|
|
Tool: TFindDeclarationTool;
|
|
end;
|
|
|
|
TFindDeclarationParams = class(TObject)
|
|
public
|
|
Flags: TFindDeclarationFlags;
|
|
Identifier: PChar;
|
|
ContextNode: TCodeTreeNode;
|
|
NewNode: TCodeTreeNode;
|
|
NewCleanPos: integer;
|
|
NewCodeTool: TFindDeclarationTool;
|
|
NewPos: TCodeXYPosition;
|
|
NewTopLine: integer;
|
|
constructor Create;
|
|
procedure Clear;
|
|
procedure Save(var Input: TFindDeclarationInput);
|
|
procedure Load(var Input: TFindDeclarationInput);
|
|
procedure SetResult(AFindContext: TFindContext);
|
|
procedure SetResult(ANewCodeTool: TFindDeclarationTool;
|
|
ANewNode: TCodeTreeNode);
|
|
procedure SetResult(ANewCodeTool: TFindDeclarationTool;
|
|
ANewNode: TCodeTreeNode; ANewCleanPos: integer);
|
|
procedure ConvertResultCleanPosToCaretPos;
|
|
procedure ClearResult;
|
|
procedure ClearInput;
|
|
end;
|
|
|
|
TFindDeclarationTool = class(TPascalParserTool)
|
|
private
|
|
FOnGetUnitSourceSearchPath: TOnGetSearchPath;
|
|
FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
|
|
{$IFDEF CTDEBUG}
|
|
DebugPrefix: string;
|
|
procedure IncPrefix;
|
|
procedure DecPrefix;
|
|
{$ENDIF}
|
|
function FindDeclarationInUsesSection(UsesNode: TCodeTreeNode;
|
|
CleanPos: integer;
|
|
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
|
function IsIncludeDirectiveAtPos(CleanPos, CleanCodePosInFront: integer;
|
|
var IncludeCode: TCodeBuffer): boolean;
|
|
function FindEnumInContext(Params: TFindDeclarationParams): boolean;
|
|
// sub methods for FindIdentifierInContext
|
|
function FindIdentifierInProcContext(ProcContextNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams): boolean;
|
|
function FindIdentifierInClassOfMethod(ProcContextNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams): boolean;
|
|
function FindIdentifierInWithVarContext(WithVarNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams): boolean;
|
|
function FindIdentifierInAncestors(ClassNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams): boolean;
|
|
function FindIdentifierInUsesSection(UsesNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams): boolean;
|
|
function FindIdentifierInHiddenUsedUnits(
|
|
Params: TFindDeclarationParams): boolean;
|
|
function FindIdentifierInUsedUnit(const AnUnitName: string;
|
|
Params: TFindDeclarationParams): boolean;
|
|
protected
|
|
function FindDeclarationOfIdentifier(
|
|
Params: TFindDeclarationParams): boolean;
|
|
function FindContextNodeAtCursor(
|
|
Params: TFindDeclarationParams): TFindContext;
|
|
function FindIdentifierInContext(Params: TFindDeclarationParams): boolean;
|
|
function FindBaseTypeOfNode(Params: TFindDeclarationParams;
|
|
Node: TCodeTreeNode): TFindContext;
|
|
function FindClassOfMethod(ProcNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams; FindClassContext: boolean): boolean;
|
|
function FindAncestorOfClass(ClassNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams; FindClassContext: boolean): boolean;
|
|
function FindForwardIdentifier(Params: TFindDeclarationParams;
|
|
var IsForward: boolean): boolean;
|
|
function FindExpressionResultType(Params: TFindDeclarationParams;
|
|
StartPos, EndPos: integer): TFindContext;
|
|
function FindCodeToolForUsedUnit(UnitNameAtom,
|
|
UnitInFileAtom: TAtomPosition;
|
|
ExceptionOnNotFound: boolean): TFindDeclarationTool;
|
|
function FindIdentifierInInterface(AskingTool: TFindDeclarationTool;
|
|
Params: TFindDeclarationParams): boolean;
|
|
function CompareNodeIdentifier(Node: TCodeTreeNode;
|
|
Params: TFindDeclarationParams): boolean;
|
|
function GetInterfaceNode: TCodeTreeNode;
|
|
public
|
|
function FindDeclaration(CursorPos: TCodeXYPosition;
|
|
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
|
function FindUnitSource(const AnUnitName,
|
|
AnUnitInFilename: string): TCodeBuffer;
|
|
property OnGetUnitSourceSearchPath: TOnGetSearchPath
|
|
read FOnGetUnitSourceSearchPath write FOnGetUnitSourceSearchPath;
|
|
property OnGetCodeToolForBuffer: TOnGetCodeToolForBuffer
|
|
read FOnGetCodeToolForBuffer write FOnGetCodeToolForBuffer;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
const
|
|
fdfAllClassVisibilities = [fdfClassPublished,fdfClassPublic,fdfClassProtected,
|
|
fdfClassPrivate];
|
|
fdfGlobals = [fdfExceptionOnNotFound, fdfIgnoreUsedUnits];
|
|
|
|
|
|
{ TFindContext }
|
|
|
|
function CreateFindContext(NewTool: TFindDeclarationTool;
|
|
NewNode: TCodeTreeNode): TFindContext;
|
|
begin
|
|
Result.Node:=NewNode;
|
|
Result.Tool:=NewTool;
|
|
end;
|
|
|
|
function CreateFindContext(Params: TFindDeclarationParams): TFindContext;
|
|
begin
|
|
Result.Node:=Params.NewNode;
|
|
Result.Tool:=TFindDeclarationTool(Params.NewCodeTool);
|
|
end;
|
|
|
|
|
|
{ TFindDeclarationTool }
|
|
|
|
function TFindDeclarationTool.FindDeclaration(CursorPos: TCodeXYPosition;
|
|
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
|
var CleanCursorPos: integer;
|
|
CursorNode, ClassNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams;
|
|
begin
|
|
Result:=false;
|
|
// build code tree
|
|
{$IFDEF CTDEBUG}
|
|
writeln(DebugPrefix,'TFindDeclarationTool.FindDeclaration A CursorPos=',CursorPos.X,',',CursorPos.Y);
|
|
{$ENDIF}
|
|
BuildTreeAndGetCleanPos(false,CursorPos,CleanCursorPos);
|
|
{$IFDEF CTDEBUG}
|
|
writeln(DebugPrefix,'TFindDeclarationTool.FindDeclaration C CleanCursorPos=',CleanCursorPos);
|
|
{$ENDIF}
|
|
// find CodeTreeNode at cursor
|
|
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
|
if IsIncludeDirectiveAtPos(CleanCursorPos,CursorNode.StartPos,NewPos.Code)
|
|
then begin
|
|
NewPos.X:=1;
|
|
NewPos.Y:=1;
|
|
NewTopLine:=1;
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsString(CursorNode.Desc));
|
|
{$ENDIF}
|
|
if CursorNode.Desc=ctnUsesSection then begin
|
|
// find used unit
|
|
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 and ctnsForwardDeclaration)=0 then begin
|
|
// parse class and build CodeTreeNodes for all properties/methods
|
|
BuildSubTreeForClass(ClassNode);
|
|
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
|
end;
|
|
end;
|
|
if CursorNode.Desc=ctnBeginBlock then begin
|
|
BuildSubTreeForBeginBlock(CursorNode);
|
|
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
|
end;
|
|
MoveCursorToCleanPos(CleanCursorPos);
|
|
while (CurPos.StartPos>1) and (IsIdentChar[Src[CurPos.StartPos-1]]) do
|
|
dec(CurPos.StartPos);
|
|
if (CurPos.StartPos>=1) and (IsIdentStartChar[Src[CurPos.StartPos]]) then
|
|
begin
|
|
CurPos.EndPos:=CurPos.StartPos;
|
|
while (CurPos.EndPos<=SrcLen) and IsIdentChar[Src[CurPos.EndPos]] do
|
|
inc(CurPos.EndPos);
|
|
// find declaration of identifier
|
|
Params:=TFindDeclarationParams.Create;
|
|
try
|
|
Params.ContextNode:=CursorNode;
|
|
Params.Identifier:=@Src[CurPos.StartPos];
|
|
Params.Flags:=[fdfSearchInAncestors,fdfSearchInParentNodes,
|
|
fdfExceptionOnNotFound];
|
|
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
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindDeclarationInUsesSection(
|
|
UsesNode: TCodeTreeNode; CleanPos: integer;
|
|
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
|
var UnitName, UnitInFilename: string;
|
|
UnitNamePos, UnitInFilePos: TAtomPosition;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TFindDeclarationTool.FindDeclarationInUsesSection A');
|
|
{$ENDIF}
|
|
// reparse uses section
|
|
MoveCursorToNodeStart(UsesNode);
|
|
ReadNextAtom;
|
|
if not UpAtomIs('USES') then
|
|
RaiseException('expected uses, but '+GetAtom+' found');
|
|
repeat
|
|
ReadNextAtom; // read name
|
|
if CurPos.StartPos>CleanPos then break;
|
|
if AtomIsChar(';') then break;
|
|
AtomIsIdentifier(true);
|
|
UnitNamePos:=CurPos;
|
|
ReadNextAtom;
|
|
if UpAtomIs('IN') then begin
|
|
ReadNextAtom;
|
|
if not AtomIsStringConstant then
|
|
RaiseException(
|
|
'string constant expected, but '+GetAtom+' found');
|
|
UnitInFilePos:=CurPos;
|
|
ReadNextAtom;
|
|
end else
|
|
UnitInFilePos.StartPos:=-1;
|
|
if CleanPos<UnitNamePos.EndPos then begin
|
|
// cursor is on a unitname -> try to locate it
|
|
UnitName:=copy(Src,UnitNamePos.StartPos,
|
|
UnitNamePos.EndPos-UnitNamePos.StartPos);
|
|
if UnitInFilePos.StartPos>=1 then
|
|
UnitInFilename:=copy(Src,UnitInFilePos.StartPos,
|
|
UnitInFilePos.EndPos-UnitInFilePos.StartPos)
|
|
else
|
|
UnitInFilename:='';
|
|
NewPos.Code:=FindUnitSource(UnitName,UnitInFilename);
|
|
if NewPos.Code=nil then
|
|
RaiseException('unit not found: '+UnitName);
|
|
NewPos.X:=1;
|
|
NewPos.Y:=1;
|
|
NewTopLine:=1;
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
if AtomIsChar(';') then break;
|
|
if not AtomIsChar(',') then
|
|
RaiseException('; expected, but '+GetAtom+' found')
|
|
until (CurPos.StartPos>SrcLen);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TFindDeclarationTool.FindDeclarationInUsesSection END cursor not on unitname');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindUnitSource(const AnUnitName,
|
|
AnUnitInFilename: string): TCodeBuffer;
|
|
|
|
function LoadFile(const ExpandedFilename: string;
|
|
var NewCode: TCodeBuffer): boolean;
|
|
begin
|
|
{$IFDEF ShowTriedFiles}
|
|
writeln('TFindDeclarationTool.FindUnitSource.LoadFile ',ExpandedFilename);
|
|
{$ENDIF}
|
|
NewCode:=TCodeBuffer(Scanner.OnLoadSource(Self,ExpandedFilename));
|
|
Result:=NewCode<>nil;
|
|
end;
|
|
|
|
function SearchUnitFileInDir(const ADir, AnUnitName: string): TCodeBuffer;
|
|
var APath: string;
|
|
begin
|
|
APath:=ADir;
|
|
if (APath<>'') and (APath[length(APath)]<>PathDelim) then
|
|
APath:=APath+PathDelim;
|
|
{$IFNDEF win32}
|
|
if LoadFile(ADir+lowercase(AnUnitName)+'.pp',Result) then exit;
|
|
if LoadFile(ADir+lowercase(AnUnitName)+'.pas',Result) then exit;
|
|
{$ENDIF}
|
|
if LoadFile(ADir+AnUnitName+'.pp',Result) then exit;
|
|
if LoadFile(ADir+AnUnitName+'.pas',Result) then exit;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function SearchUnitFileInPath(const APath, TheUnitName: string): TCodeBuffer;
|
|
var PathStart, PathEnd: integer;
|
|
ADir: string;
|
|
begin
|
|
PathStart:=1;
|
|
while PathStart<=length(APath) do begin
|
|
PathEnd:=PathStart;
|
|
while (PathEnd<=length(APath)) and (APath[PathEnd]<>';') do inc(PathEnd);
|
|
if PathEnd>PathStart then begin
|
|
ADir:=copy(APath,PathStart,PathEnd-PathStart);
|
|
if (ADir<>'') and (ADir[length(ADir)]<>PathDelim) then
|
|
ADir:=ADir+PathDelim;
|
|
if not FilenameIsAbsolute(ADir) then
|
|
ADir:=ExtractFilePath(TCodeBuffer(Scanner.MainCode).Filename)+ADir;
|
|
Result:=SearchUnitFileInDir(ADir,TheUnitName);
|
|
if Result<>nil then exit;
|
|
end;
|
|
PathStart:=PathEnd+1;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function SearchFileInPath(const APath, RelativeFilename: string): TCodeBuffer;
|
|
var PathStart, PathEnd: integer;
|
|
ADir: string;
|
|
begin
|
|
PathStart:=1;
|
|
while PathStart<=length(APath) do begin
|
|
PathEnd:=PathStart;
|
|
while (PathEnd<=length(APath)) and (APath[PathEnd]<>';') do inc(PathEnd);
|
|
if PathEnd>PathStart then begin
|
|
ADir:=copy(APath,PathStart,PathEnd-PathStart);
|
|
if (ADir<>'') and (ADir[length(ADir)]<>PathDelim) then
|
|
ADir:=ADir+PathDelim;
|
|
if not FilenameIsAbsolute(ADir) then
|
|
ADir:=ExtractFilePath(TCodeBuffer(Scanner.MainCode).Filename)+ADir;
|
|
if LoadFile(ADir+RelativeFilename,Result) then exit;
|
|
end;
|
|
PathStart:=PathEnd+1;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function SearchUnitInUnitLinks(const TheUnitName: string): TCodeBuffer;
|
|
var UnitLinks, CurFilename: string;
|
|
UnitLinkStart, UnitLinkEnd: integer;
|
|
begin
|
|
Result:=nil;
|
|
UnitLinks:=Scanner.Values[ExternalMacroStart+'UnitLinks'];
|
|
{$IFDEF ShowTriedFiles}
|
|
//writeln('TFindDeclarationTool.FindUnitSource.SearchUnitInUnitLinks');
|
|
{$ENDIF}
|
|
UnitLinkStart:=1;
|
|
while UnitLinkStart<=length(UnitLinks) do begin
|
|
while (UnitLinkStart<=length(UnitLinks))
|
|
and (UnitLinks[UnitLinkStart] in [#10,#13]) do
|
|
inc(UnitLinkStart);
|
|
UnitLinkEnd:=UnitLinkStart;
|
|
while (UnitLinkEnd<=length(UnitLinks)) and (UnitLinks[UnitLinkEnd]<>' ')
|
|
do
|
|
inc(UnitLinkEnd);
|
|
if UnitLinkEnd>UnitLinkStart then begin
|
|
{$IFDEF ShowTriedFiles}
|
|
//writeln(' unit "',copy(UnitLinks,UnitLinkStart,UnitLinkEnd-UnitLinkStart),'"');
|
|
{$ENDIF}
|
|
if AnsiCompareText(TheUnitName,
|
|
copy(UnitLinks,UnitLinkStart,UnitLinkEnd-UnitLinkStart))=0
|
|
then begin
|
|
// unit found -> parse filename
|
|
UnitLinkStart:=UnitLinkEnd+1;
|
|
UnitLinkEnd:=UnitLinkStart;
|
|
while (UnitLinkEnd<=length(UnitLinks))
|
|
and (not (UnitLinks[UnitLinkEnd] in [#10,#13])) do
|
|
inc(UnitLinkEnd);
|
|
if UnitLinkEnd>UnitLinkStart then begin
|
|
CurFilename:=copy(UnitLinks,UnitLinkStart,UnitLinkEnd-UnitLinkStart);
|
|
LoadFile(CurFilename,Result);
|
|
exit;
|
|
end;
|
|
end else begin
|
|
UnitLinkStart:=UnitLinkEnd+1;
|
|
while (UnitLinkStart<=length(UnitLinks))
|
|
and (not (UnitLinks[UnitLinkStart] in [#10,#13])) do
|
|
inc(UnitLinkStart);
|
|
end;
|
|
end else
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
|
|
var CurDir, UnitSrcSearchPath: string;
|
|
MainCodeIsVirtual: boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TFindDeclarationTool.FindUnitSource A AnUnitName=',AnUnitName,' AnUnitInFilename=',AnUnitInFilename);
|
|
{$ENDIF}
|
|
Result:=nil;
|
|
if (AnUnitName='') or (Scanner=nil) or (Scanner.MainCode=nil)
|
|
or (not (TObject(Scanner.MainCode) is TCodeBuffer))
|
|
or (Scanner.OnLoadSource=nil) then
|
|
exit;
|
|
if Assigned(OnGetUnitSourceSearchPath) then
|
|
UnitSrcSearchPath:=OnGetUnitSourceSearchPath(Self)
|
|
else
|
|
UnitSrcSearchPath:=Scanner.Values[ExternalMacroStart+'SrcPath'];
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TFindDeclarationTool.FindUnitSource UnitSrcSearchPath=',UnitSrcSearchPath);
|
|
{$ENDIF}
|
|
//writeln('>>>>>',Scanner.Values.AsString,'<<<<<');
|
|
if AnUnitInFilename<>'' then begin
|
|
// unitname in 'filename'
|
|
if FilenameIsAbsolute(AnUnitInFilename) then begin
|
|
Result:=TCodeBuffer(Scanner.OnLoadSource(Self,AnUnitInFilename));
|
|
end else begin
|
|
// search AnUnitInFilename in searchpath
|
|
Result:=SearchFileInPath(UnitSrcSearchPath,AnUnitInFilename);
|
|
end;
|
|
end else begin
|
|
// normal unit name -> search as the compiler would search
|
|
// first search in current directory (= where the maincode is)
|
|
MainCodeIsVirtual:=TCodeBuffer(Scanner.MainCode).IsVirtual;
|
|
if not MainCodeIsVirtual then begin
|
|
CurDir:=ExtractFilePath(TCodeBuffer(Scanner.MainCode).Filename);
|
|
end else begin
|
|
CurDir:='';
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TFindDeclarationTool.FindUnitSource Search in current dir=',CurDir);
|
|
{$ENDIF}
|
|
Result:=SearchUnitFileInDir(CurDir,AnUnitName);
|
|
if Result=nil then begin
|
|
// search in search path
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TFindDeclarationTool.FindUnitSource Search in search path=',UnitSrcSearchPath);
|
|
{$ENDIF}
|
|
Result:=SearchUnitFileInPath(UnitSrcSearchPath,AnUnitName);
|
|
if Result=nil then begin
|
|
// search in FPC source directory
|
|
Result:=SearchUnitInUnitLinks(AnUnitName);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.IsIncludeDirectiveAtPos(CleanPos,
|
|
CleanCodePosInFront: integer; var IncludeCode: TCodeBuffer): boolean;
|
|
var LinkIndex, CommentStart, CommentEnd: integer;
|
|
SrcLink: TSourceLink;
|
|
begin
|
|
Result:=false;
|
|
if (Scanner=nil) then exit;
|
|
LinkIndex:=Scanner.LinkIndexAtCleanPos(CleanPos);
|
|
if (LinkIndex<0) or (LinkIndex>=Scanner.LinkCount-1) then exit;
|
|
SrcLink:=Scanner.Links[LinkIndex+1];
|
|
if (SrcLink.Code=nil) or (SrcLink.Code=Scanner.Links[LinkIndex].Code) then
|
|
exit;
|
|
if CleanPosIsInComment(CleanPos,CleanCodePosInFront,CommentStart,CommentEnd)
|
|
and (CommentEnd=SrcLink.CleanedPos) then begin
|
|
IncludeCode:=TCodeBuffer(SrcLink.Code);
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindDeclarationOfIdentifier(
|
|
Params: TFindDeclarationParams): boolean;
|
|
{ searches an identifier in clean code, parses code in front and after the
|
|
identifier
|
|
|
|
Params:
|
|
Identifier in clean source
|
|
ContextNode // = DeepestNode at Cursor
|
|
|
|
Result:
|
|
true, if NewPos+NewTopLine valid
|
|
|
|
For example:
|
|
A^.B().C[].Identifier
|
|
}
|
|
var OldContextNode: TCodeTreeNode;
|
|
NewContext: TFindContext;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindDeclarationOfIdentifier] Identifier=',
|
|
GetIdentifier(Params.Identifier),
|
|
' ContextNode=',NodeDescriptionAsString(Params.ContextNode.Desc));
|
|
{$ENDIF}
|
|
Result:=false;
|
|
MoveCursorToCleanPos(Params.Identifier);
|
|
OldContextNode:=Params.ContextNode;
|
|
NewContext:=FindContextNodeAtCursor(Params);
|
|
Params.Flags:=[fdfSearchInAncestors]
|
|
+fdfAllClassVisibilities+(fdfGlobals*Params.Flags);
|
|
if NewContext.Node=OldContextNode then begin
|
|
Params.Flags:=Params.Flags+[fdfSearchInParentNodes,fdfIgnoreCurContextNode];
|
|
end;
|
|
if NewContext.Tool<>Self then begin
|
|
// search in used unit
|
|
Exclude(Params.Flags,fdfClassPrivate);
|
|
if NewContext.Node.Desc=ctnClass then begin
|
|
// ToDo: if context node is not the class of the method the
|
|
// search started, remove fdfClassProtected from Flags
|
|
|
|
end;
|
|
end;
|
|
if (OldContextNode.Desc=ctnTypeDefinition)
|
|
and (OldContextNode.FirstChild<>nil)
|
|
and (OldContextNode.FirstChild.Desc=ctnClass)
|
|
and ((OldContextNode.FirstChild.SubDesc and ctnsForwardDeclaration)>0)
|
|
then
|
|
Include(Params.Flags,fdfSearchForward);
|
|
|
|
Params.ContextNode:=NewContext.Node;
|
|
|
|
Result:=NewContext.Tool.FindIdentifierInContext(Params);
|
|
end;
|
|
|
|
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:
|
|
Identifier
|
|
ContextNode // = DeepestNode at Cursor
|
|
|
|
Result:
|
|
true, if NewPos+NewTopLine valid
|
|
}
|
|
var LastContextNode, StartContextNode, ContextNode: TCodeTreeNode;
|
|
IsForward: boolean;
|
|
begin
|
|
ContextNode:=Params.ContextNode;
|
|
StartContextNode:=ContextNode;
|
|
Result:=false;
|
|
|
|
if (fdfSearchForward in Params.Flags) then begin
|
|
|
|
// ToDo: check for circles
|
|
|
|
end;
|
|
|
|
if ContextNode<>nil then begin
|
|
repeat
|
|
{$IFDEF ShowTriedContexts}
|
|
writeln('[TFindDeclarationTool.FindIdentifierInContext] A Ident=',
|
|
GetIdentifier(Params.Identifier),
|
|
' Context=',ContextNode.DescAsString,' "',copy(Src,ContextNode.StartPos,8),'"',
|
|
' P=',fdfSearchInParentNodes in Params.Flags,
|
|
' A=',fdfSearchInAncestors in Params.Flags,
|
|
' IUU=',fdfIgnoreUsedUnits in Params.Flags
|
|
);
|
|
if (ContextNode.Desc=ctnClass) then
|
|
writeln(' ContextNode.LastChild=',ContextNode.LastChild<>nil);
|
|
{$ENDIF}
|
|
LastContextNode:=ContextNode;
|
|
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,
|
|
ctnParameterList:
|
|
begin
|
|
if ContextNode.Desc=ctnClass then begin
|
|
// just-in-time parsing for class node
|
|
BuildSubTreeForClass(ContextNode);
|
|
end;
|
|
if (ContextNode.LastChild<>nil) then begin
|
|
if not (fdfSearchForward in Params.Flags) then
|
|
ContextNode:=ContextNode.LastChild
|
|
else
|
|
ContextNode:=ContextNode.FirstChild;
|
|
end;
|
|
end;
|
|
|
|
ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition, ctnEnumType:
|
|
begin
|
|
if CompareSrcIdentifiers(ContextNode.StartPos,Params.Identifier)
|
|
then begin
|
|
{$IFDEF ShowTriedContexts}
|
|
writeln(' Definition Identifier found=',GetIdentifier(Params.Identifier));
|
|
{$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;
|
|
|
|
ctnProcedureHead:
|
|
begin
|
|
BuildSubTreeForProcHead(ContextNode);
|
|
if ContextNode.FirstChild<>nil then
|
|
ContextNode:=ContextNode.FirstChild;
|
|
end;
|
|
|
|
ctnProgram, ctnPackage, ctnLibrary, ctnUnit:
|
|
begin
|
|
MoveCursorToNodeStart(ContextNode);
|
|
ReadNextAtom; // read keyword
|
|
ReadNextAtom; // read name
|
|
if CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then
|
|
begin
|
|
// identifier found
|
|
{$IFDEF ShowTriedContexts}
|
|
writeln(' Source Name Identifier found=',GetIdentifier(Params.Identifier));
|
|
{$ENDIF}
|
|
Result:=true;
|
|
Params.SetResult(Self,ContextNode,CurPos.StartPos);
|
|
exit;
|
|
end;
|
|
Result:=FindIdentifierInHiddenUsedUnits(Params);
|
|
if Result then exit;
|
|
end;
|
|
|
|
ctnProperty:
|
|
begin
|
|
if (Params.Identifier[0]<>'[') then begin
|
|
MoveCursorToNodeStart(ContextNode);
|
|
ReadNextAtom; // read keyword 'property'
|
|
ReadNextAtom; // read name
|
|
if CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then
|
|
begin
|
|
// identifier found
|
|
|
|
// ToDo: identifiers after 'read', 'write' are procs with
|
|
// special parameter lists
|
|
|
|
{$IFDEF ShowTriedContexts}
|
|
writeln(' Property Identifier found=',GetIdentifier(Params.Identifier));
|
|
{$ENDIF}
|
|
Result:=true;
|
|
Params.SetResult(Self,ContextNode,CurPos.StartPos);
|
|
exit;
|
|
end;
|
|
end else begin
|
|
// the default property is searched
|
|
Result:=PropertyIsDefault(ContextNode);
|
|
if Result then exit;
|
|
end;
|
|
end;
|
|
|
|
ctnUsesSection:
|
|
begin
|
|
Result:=FindIdentifierInUsesSection(ContextNode,Params);
|
|
if Result then exit;
|
|
end;
|
|
|
|
ctnWithVariable:
|
|
begin
|
|
Result:=FindIdentifierInWithVarContext(ContextNode,Params);
|
|
if Result then exit;
|
|
end;
|
|
|
|
ctnPointerType:
|
|
begin
|
|
// pointer types can be forward definitions
|
|
Params.ContextNode:=ContextNode.Parent;
|
|
Result:=FindForwardIdentifier(Params,IsForward);
|
|
exit;
|
|
end;
|
|
|
|
end;
|
|
end else begin
|
|
Exclude(Params.Flags,fdfIgnoreCurContextNode);
|
|
{$IFDEF ShowTriedContexts}
|
|
writeln('[TFindDeclarationTool.FindIdentifierInContext] IgnoreCurContext');
|
|
{$ENDIF}
|
|
end;
|
|
if LastContextNode=ContextNode then begin
|
|
// 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 (ContextNode.Desc=ctnClass)) then begin
|
|
// even searching in ancestors contexts is not permitted
|
|
// -> there is no prior context accessible any more
|
|
// -> identifier not found
|
|
{$IFDEF ShowTriedContexts}
|
|
writeln('[TFindDeclarationTool.FindIdentifierInContext] no prior node accessible ContextNode=',ContextNode.DescAsString);
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
repeat
|
|
// search for prior node
|
|
{$IFDEF ShowTriedContexts}
|
|
//writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching prior node of ',ContextNode.DescAsString);
|
|
{$ENDIF}
|
|
if (ContextNode.Desc=ctnClass)
|
|
and (fdfSearchInAncestors in Params.Flags) then
|
|
begin
|
|
Result:=FindIdentifierInAncestors(ContextNode,Params);
|
|
if Result then exit;
|
|
end;
|
|
|
|
if ((not (fdfSearchForward in Params.Flags))
|
|
and (ContextNode.PriorBrother<>nil))
|
|
or ((fdfSearchForward in Params.Flags)
|
|
and (ContextNode.NextBrother<>nil)
|
|
and (ContextNode.NextBrother.Desc<>ctnImplementation)) then
|
|
begin
|
|
if not (fdfSearchForward in Params.Flags) then
|
|
ContextNode:=ContextNode.PriorBrother
|
|
else
|
|
ContextNode:=ContextNode.NextBrother;
|
|
{$IFDEF ShowTriedContexts}
|
|
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 ShowTriedContexts}
|
|
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,
|
|
ctnProcedureHead, ctnParameterList:
|
|
// 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, ctnRecordType:
|
|
// do not search again in this node, go on ...
|
|
;
|
|
|
|
ctnProcedure:
|
|
begin
|
|
Result:=FindIdentifierInClassOfMethod(ContextNode,Params);
|
|
if Result then exit;
|
|
end;
|
|
|
|
else
|
|
break;
|
|
end;
|
|
end else begin
|
|
ContextNode:=nil;
|
|
break;
|
|
end;
|
|
until false;
|
|
end;
|
|
until ContextNode=nil;
|
|
end else begin
|
|
// DeepestNode=nil -> ignore
|
|
end;
|
|
if fdfExceptionOnNotFound in Params.Flags then begin
|
|
if IsPCharInSrc(Params.Identifier) then
|
|
MoveCursorToCleanPos(Params.Identifier);
|
|
RaiseException('Identifier not found '+GetIdentifier(Params.Identifier));
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindEnumInContext(
|
|
Params: TFindDeclarationParams): boolean;
|
|
{ search all subnodes for ctnEnumType
|
|
|
|
Params:
|
|
Identifier
|
|
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
|
|
if Params.ContextNode.Desc=ctnClass then
|
|
BuildSubTreeForClass(Params.ContextNode);
|
|
Params.ContextNode:=Params.ContextNode.FirstChild;
|
|
while Params.ContextNode<>nil do begin
|
|
if (Params.ContextNode.Desc in [ctnEnumType])
|
|
and CompareSrcIdentifiers(Params.ContextNode.StartPos,Params.Identifier)
|
|
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): TFindContext;
|
|
{ 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,
|
|
atRead, atWrite);
|
|
const
|
|
AtomTypeNames: array[TAtomType] of string =
|
|
('<None>','Space','Ident','Point','AS','INHERITED','Up^',
|
|
'Bracket(','Bracket)','Bracket[','Bracket]','READ','WRITE');
|
|
|
|
function GetCurrentAtomType: TAtomType;
|
|
begin
|
|
if (CurPos.StartPos=CurPos.EndPos) then
|
|
Result:=atSpace
|
|
else if UpAtomIs('READ') then
|
|
Result:=atRead
|
|
else if UpAtomIs('WRITE') then
|
|
Result:=atWrite
|
|
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, NextAtom: TAtomPosition;
|
|
OldInput: TFindDeclarationInput;
|
|
NextAtomType, CurAtomType: TAtomType;
|
|
ProcNode: TCodeTreeNode;
|
|
begin
|
|
// start parsing the expression from right to left
|
|
NextAtom:=CurPos;
|
|
NextAtomType:=GetCurrentAtomType;
|
|
ReadPriorAtom;
|
|
CurAtom:=CurPos;
|
|
CurAtomType:=GetCurrentAtomType;
|
|
write('[TFindDeclarationTool.FindContextNodeAtCursor] A ',
|
|
' Context=',Params.ContextNode.DescAsString,
|
|
' CurAtom=',AtomTypeNames[CurAtomType],
|
|
' "',copy(Src,CurAtom.StartPos,CurAtom.EndPos-CurAtom.StartPos),'"',
|
|
' NextAtom=',AtomTypeNames[NextAtomType]
|
|
);
|
|
writeln('');
|
|
if not (CurAtomType in [atIdentifier,atPoint,atUp,atAs,atEdgedBracketClose,
|
|
atRoundBracketClose,atRead,atWrite,atINHERITED])
|
|
then begin
|
|
// no special context found -> the context node is the deepest node at
|
|
// cursor, and this should already be in Params.ContextNode
|
|
if (not (NextAtomType in [atSpace,atIdentifier,atRoundBracketOpen,
|
|
atEdgedBracketOpen])) then
|
|
begin
|
|
MoveCursorToCleanPos(NextAtom.StartPos);
|
|
ReadNextAtom;
|
|
RaiseException('identifier expected, but '
|
|
+GetAtom+' found');
|
|
end;
|
|
Result:=CreateFindContext(Self,Params.ContextNode);
|
|
exit;
|
|
end;
|
|
if (CurAtomType in [atRoundBracketClose,atEdgedBracketClose]) then begin
|
|
ReadBackTilBracketClose(true);
|
|
CurAtom.StartPos:=CurPos.StartPos;
|
|
end;
|
|
if (not (CurAtomType in [atAS,atRead,atWrite,atINHERITED]))
|
|
and ((CurAtomType<>atIdentifier) or (NextAtomType<>atIdentifier)) then
|
|
Result:=FindContextNodeAtCursor(Params)
|
|
else
|
|
Result:=CreateFindContext(Self,Params.ContextNode);
|
|
if Result.Node=nil then exit;
|
|
|
|
// 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.Node<>nil then write(Result.Node.DescAsString) else write('NIL');
|
|
writeln('');
|
|
{$ENDIF}
|
|
|
|
case CurAtomType of
|
|
|
|
atIdentifier:
|
|
begin
|
|
// for example 'AnObject[3]'
|
|
if not (NextAtomType in [atSpace,atPoint,atUp,atAS,atRoundBracketOpen,
|
|
atRoundBracketClose,atEdgedBracketOpen,atEdgedBracketClose]) then
|
|
begin
|
|
MoveCursorToCleanPos(NextAtom.StartPos);
|
|
ReadNextAtom;
|
|
RaiseException('illegal qualifier "'+GetAtom+'" found');
|
|
end;
|
|
if (Result.Node=Params.ContextNode) then begin
|
|
if CompareSrcIdentifier(CurAtom.StartPos,'SELF') then begin
|
|
// SELF in a method is the object itself
|
|
// -> check if in a proc
|
|
ProcNode:=Params.ContextNode;
|
|
while (ProcNode<>nil) do begin
|
|
if (ProcNode.Desc=ctnProcedure) then begin
|
|
// in a proc -> find the class context
|
|
if Result.Tool.FindClassOfMethod(ProcNode,Params,true) then begin
|
|
Result:=CreateFindContext(Params);
|
|
exit;
|
|
end;
|
|
end;
|
|
ProcNode:=ProcNode.Parent;
|
|
end;
|
|
end else if CompareSrcIdentifier(CurAtom.StartPos,'RESULT') then begin
|
|
// RESULT has a special meaning in a function
|
|
// -> check if in a function
|
|
ProcNode:=Params.ContextNode;
|
|
while (ProcNode<>nil) do begin
|
|
if (ProcNode.Desc=ctnProcedure) then begin
|
|
Result:=Result.Tool.FindBaseTypeOfNode(Params,ProcNode);
|
|
exit;
|
|
end;
|
|
ProcNode:=ProcNode.Parent;
|
|
end;
|
|
end;
|
|
end;
|
|
// find identifier
|
|
Params.Save(OldInput);
|
|
try
|
|
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound]
|
|
+fdfAllClassVisibilities
|
|
+(fdfGlobals*Params.Flags);
|
|
//writeln(' AAA ',Result.Node=Params.ContextNode,' ',Result.Node.DescAsString,',',Params.ContextNode.DescAsString);
|
|
if Result.Node=Params.ContextNode then begin
|
|
// there is no special context -> also search in parent contexts
|
|
Params.Flags:=Params.Flags
|
|
+[fdfSearchInParentNodes,fdfIgnoreCurContextNode];
|
|
end else
|
|
// special context
|
|
Params.ContextNode:=Result.Node;
|
|
Params.Identifier:=@Src[CurAtom.StartPos];
|
|
Result.Tool.FindIdentifierInContext(Params);
|
|
Result:=CreateFindContext(Params);
|
|
finally
|
|
Params.Load(OldInput);
|
|
end;
|
|
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node);
|
|
end;
|
|
|
|
atPoint:
|
|
begin
|
|
// for example 'A.B'
|
|
if Result.Node=Params.ContextNode then begin
|
|
MoveCursorToCleanPos(CurAtom.StartPos);
|
|
RaiseException('identifier expected, but . found');
|
|
end;
|
|
if (not (NextAtomType in [atSpace,atIdentifier])) then begin
|
|
MoveCursorToCleanPos(NextAtom.StartPos);
|
|
ReadNextAtom;
|
|
RaiseException('identifier expected, but '+GetAtom+' found');
|
|
end;
|
|
if (Result.Node.Desc in AllUsableSoureTypes) then begin
|
|
// identifier in front of the point is a unit name
|
|
if Result.Tool<>Self then begin
|
|
Result.Node:=Result.Tool.GetInterfaceNode;
|
|
end else begin
|
|
Result:=CreateFindContext(Self,Params.ContextNode);
|
|
end;
|
|
end;
|
|
// there is no special left to do, since Result already points to
|
|
// the type context node.
|
|
end;
|
|
|
|
atAS:
|
|
begin
|
|
// for example 'A as B'
|
|
if (not (NextAtomType in [atSpace,atIdentifier])) then begin
|
|
MoveCursorToCleanPos(NextAtom.StartPos);
|
|
ReadNextAtom;
|
|
RaiseException('identifier expected, but '+GetAtom+' found');
|
|
end;
|
|
// 'as' is a type cast, so the left side is irrelevant and was already
|
|
// ignored in the code at the start of this proc
|
|
// -> context is default context
|
|
end;
|
|
|
|
atUP:
|
|
begin
|
|
// for example:
|
|
// 1. 'PInt = ^integer' pointer type
|
|
// 2. a^ dereferencing
|
|
if not (NextAtomType in [atSpace,atPoint,atUp,atAS,atEdgedBracketClose,
|
|
atEdgedBracketOpen,atRoundBracketClose]) then
|
|
begin
|
|
MoveCursorToCleanPos(NextAtom.StartPos);
|
|
ReadNextAtom;
|
|
RaiseException('illegal qualifier "'+GetAtom+'" found');
|
|
end;
|
|
if Result.Node<>Params.ContextNode then begin
|
|
// left side of expression has defined a special context
|
|
// => this '^' is a dereference
|
|
if (not (NextAtomType in [atSpace,atPoint,atAS,atUP])) then begin
|
|
MoveCursorToCleanPos(NextAtom.StartPos);
|
|
ReadNextAtom;
|
|
RaiseException('. expected, but '+GetAtom+' found');
|
|
end;
|
|
if Result.Node.Desc<>ctnPointerType then begin
|
|
MoveCursorToCleanPos(CurAtom.StartPos);
|
|
RaiseException('illegal qualifier ^');
|
|
end;
|
|
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.FirstChild);
|
|
end else if NodeHasParentOfType(Result.Node,ctnPointerType) then begin
|
|
// this is a pointer type definition
|
|
// -> the default context is ok
|
|
end;
|
|
end;
|
|
|
|
atEdgedBracketClose:
|
|
begin
|
|
// for example: a[]
|
|
// this could be:
|
|
// 1. ranged array
|
|
// 2. dynamic array
|
|
// 3. indexed pointer
|
|
// 4. default property
|
|
if not (NextAtomType in [atSpace,atPoint,atAs,atUp,atRoundBracketClose,
|
|
atRoundBracketOpen,atEdgedBracketClose,atEdgedBracketOpen]) then
|
|
begin
|
|
MoveCursorToCleanPos(NextAtom.StartPos);
|
|
ReadNextAtom;
|
|
RaiseException('illegal qualifier');
|
|
end;
|
|
if Result.Node<>Params.ContextNode then begin
|
|
case Result.Node.Desc of
|
|
|
|
ctnArrayType:
|
|
// the array type is the last child node
|
|
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.LastChild);
|
|
|
|
ctnPointerType:
|
|
// the pointer type is the only child node
|
|
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.FirstChild);
|
|
|
|
ctnClass:
|
|
begin
|
|
// search default property in class
|
|
Params.Save(OldInput);
|
|
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound]
|
|
+fdfGlobals*Params.Flags;
|
|
Params.Identifier:='['; // special identifier for default property
|
|
Params.ContextNode:=Result.Node;
|
|
Result.Tool.FindIdentifierInContext(Params);
|
|
Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode);
|
|
Params.Load(OldInput);
|
|
end;
|
|
|
|
// ToDo string, ansistring, widestring, shortstring
|
|
|
|
else
|
|
MoveCursorToCleanPos(CurAtom.StartPos);
|
|
RaiseException('illegal qualifier');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
atRoundBracketClose:
|
|
begin
|
|
{ for example:
|
|
(a+b) expression bracket: the type is the result type of the
|
|
expression.
|
|
a() typecast or function
|
|
}
|
|
if not (NextAtomType in [atSpace,atPoint,atAs,atUp,atRoundBracketClose,
|
|
atRoundBracketOpen,atEdgedBracketClose,atEdgedBracketOpen]) then
|
|
begin
|
|
MoveCursorToCleanPos(NextAtom.StartPos);
|
|
ReadNextAtom;
|
|
RaiseException('illegal qualifier');
|
|
end;
|
|
if Result.Node<>Params.ContextNode then begin
|
|
// typecast or function
|
|
|
|
// ToDo: proc overloading, if parameter types incompatible search next
|
|
|
|
end else begin
|
|
// expression
|
|
Result:=FindExpressionResultType(Params,CurAtom.StartPos+1,
|
|
CurAtom.EndPos-1);
|
|
end;
|
|
end;
|
|
|
|
atINHERITED:
|
|
begin
|
|
// for example: inherited A;
|
|
if not (NextAtomType in [atSpace,atIdentifier]) then begin
|
|
MoveCursorToCleanPos(NextAtom.StartPos);
|
|
ReadNextAtom;
|
|
RaiseException('identifier expected, but '+GetAtom+' found');
|
|
end;
|
|
// find ancestor of class of method
|
|
ProcNode:=Result.Node;
|
|
while (ProcNode<>nil) do begin
|
|
if not (ProcNode.Desc in [ctnProcedure,ctnProcedureHead,ctnBeginBlock,
|
|
ctnAsmBlock,ctnWithVariable,ctnWithStatement,ctnCaseBlock,
|
|
ctnCaseVariable,ctnCaseStatement]) then
|
|
begin
|
|
break;
|
|
end;
|
|
if ProcNode.Desc=ctnProcedure then begin
|
|
Result.Tool.FindClassOfMethod(ProcNode,Params,true);
|
|
// find class ancestor
|
|
Params.NewCodeTool.FindAncestorOfClass(Params.NewNode,Params,true);
|
|
Result:=CreateFindContext(Params);
|
|
exit;
|
|
end;
|
|
ProcNode:=ProcNode.Parent;
|
|
end;
|
|
MoveCursorToCleanPos(CurAtom.StartPos);
|
|
RaiseException('inherited keyword only allowed in methods');
|
|
end;
|
|
|
|
else
|
|
// expression start found
|
|
begin
|
|
if (not (NextAtomType in [atSpace,atIdentifier,atRoundBracketOpen,
|
|
atEdgedBracketOpen])) then
|
|
begin
|
|
MoveCursorToCleanPos(NextAtom.StartPos);
|
|
ReadNextAtom;
|
|
RaiseException('identifier expected, but '+GetAtom+' found');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF CTDEBUG}
|
|
write('[TFindDeclarationTool.FindContextNodeAtCursor] END ',
|
|
Params.ContextNode.DescAsString,' CurAtom=',AtomTypeNames[CurAtomType],
|
|
' NextAtom=',AtomTypeNames[NextAtomType],' Result=');
|
|
if Result.Node<>nil then write(Result.Node.DescAsString) else write('NIL');
|
|
writeln('');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindBaseTypeOfNode(Params: TFindDeclarationParams;
|
|
Node: TCodeTreeNode): TFindContext;
|
|
var OldInput: TFindDeclarationInput;
|
|
ClassIdentNode: TCodeTreeNode;
|
|
begin
|
|
Result.Node:=Node;
|
|
Result.Tool:=Self;
|
|
while (Result.Node<>nil) do begin
|
|
|
|
// ToDo: check for circles
|
|
|
|
{$IFDEF ShowTriedContexts}
|
|
writeln('[TFindDeclarationTool.FindBaseTypeOfNode] A Result=',Result.Node.DescAsString);
|
|
{$ENDIF}
|
|
if (Result.Node.Desc in AllIdentifierDefinitions) then begin
|
|
// instead of variable/const/type definition, return the type
|
|
Result.Node:=FindTypeNodeOfDefinition(Result.Node);
|
|
end else
|
|
if (Result.Node.Desc=ctnClass)
|
|
and ((Result.Node.SubDesc and ctnsForwardDeclaration)>0) then
|
|
begin
|
|
// search the real class
|
|
ClassIdentNode:=Result.Node.Parent;
|
|
if (ClassIdentNode=nil) or (not (ClassIdentNode.Desc=ctnTypeDefinition))
|
|
then begin
|
|
MoveCursorToCleanPos(Result.Node.StartPos);
|
|
RaiseException('[TFindDeclarationTool.FindBaseTypeOfNode] '
|
|
+'forward class node without name');
|
|
end;
|
|
Params.Save(OldInput);
|
|
try
|
|
Params.Identifier:=@Src[ClassIdentNode.StartPos];
|
|
Params.Flags:=[fdfSearchInParentNodes,fdfSearchForward,
|
|
fdfIgnoreUsedUnits,fdfExceptionOnNotFound]
|
|
+(fdfGlobals*Params.Flags);
|
|
Params.ContextNode:=ClassIdentNode;
|
|
FindIdentifierInContext(Params);
|
|
if (Params.NewNode.Desc<>ctnTypeDefinition)
|
|
or (Params.NewCodeTool<>Self) then begin
|
|
MoveCursorToCleanPos(Result.Node.StartPos);
|
|
RaiseException('Forward class definition not resolved: '
|
|
+copy(Src,ClassIdentNode.StartPos,
|
|
ClassIdentNode.EndPos-ClassIdentNode.StartPos));
|
|
end;
|
|
Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode);
|
|
exit;
|
|
finally
|
|
Params.Load(OldInput);
|
|
end;
|
|
end else
|
|
if (Result.Node.Desc=ctnIdentifier) then begin
|
|
// this type is just an alias for another type
|
|
// -> search the basic type
|
|
if Result.Node.Parent=nil then
|
|
break;
|
|
Params.Save(OldInput);
|
|
try
|
|
Params.Identifier:=@Src[Result.Node.StartPos];
|
|
Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound]
|
|
+(fdfGlobals*Params.Flags);
|
|
Params.ContextNode:=Result.Node.Parent;
|
|
if Params.ContextNode.Desc=ctnParameterList then
|
|
Params.ContextNode:=Params.ContextNode.Parent;
|
|
if Params.ContextNode.Desc=ctnProcedureHead then
|
|
Params.ContextNode:=Params.ContextNode.Parent;
|
|
FindIdentifierInContext(Params);
|
|
Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode);
|
|
exit;
|
|
finally
|
|
Params.Load(OldInput);
|
|
end;
|
|
end else
|
|
if (Result.Node.Desc=ctnProperty) then begin
|
|
// this is a property -> search the type definition of the property
|
|
ReadTilTypeOfProperty(Result.Node);
|
|
Params.Save(OldInput);
|
|
try
|
|
Params.Identifier:=@Src[CurPos.StartPos];
|
|
Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound]
|
|
+(fdfGlobals*Params.Flags);
|
|
Params.ContextNode:=Result.Node.Parent;
|
|
FindIdentifierInContext(Params);
|
|
if Result.Node.HasAsParent(Params.NewNode) then
|
|
break;
|
|
Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode);
|
|
exit;
|
|
finally
|
|
Params.Load(OldInput);
|
|
end;
|
|
end else
|
|
if (Result.Node.Desc in [ctnProcedure,ctnProcedureHead]) then begin
|
|
// a proc -> if this is a function return the result type
|
|
if Result.Node.Desc=ctnProcedureHead then
|
|
Result.Node:=Result.Node.Parent;
|
|
MoveCursorToNodeStart(Result.Node);
|
|
ReadNextAtom;
|
|
if UpAtomIs('CLASS') then ReadNextAtom;
|
|
if UpAtomIs('FUNCTION') then begin
|
|
// in a function -> find the result type
|
|
// build nodes for parameter list and result type
|
|
BuildSubTreeForProcHead(Result.Node);
|
|
// a proc node contains has as FirstChild a proc-head node
|
|
// and a proc-head node has as childs the parameterlist and the result
|
|
Result.Node:=Result.Node.FirstChild.FirstChild;
|
|
if Result.Node.Desc=ctnParameterList then
|
|
Result.Node:=Result.Node.NextBrother;
|
|
end else
|
|
break;
|
|
end else
|
|
if (Result.Node.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.Node:=Result.Node.FirstChild;
|
|
end else
|
|
break;
|
|
end;
|
|
if (Result.Node=nil) and (fdfExceptionOnNotFound in Params.Flags) then begin
|
|
MoveCursorToCleanPos(Params.Identifier);
|
|
RaiseException('base type not found');
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
write('[TFindDeclarationTool.FindBaseTypeOfNode] END Node=');
|
|
if Node<>nil then write(Node.DescAsString) else write('NIL');
|
|
write(' Result=');
|
|
if Result.Node<>nil then write(Result.Node.DescAsString) else write('NIL');
|
|
writeln('');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindIdentifierInProcContext(
|
|
ProcContextNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
|
|
{ this function is internally used by FindIdentifierInContext
|
|
}
|
|
var
|
|
NameAtom: TAtomPosition;
|
|
begin
|
|
Result:=false;
|
|
// if proc is a method, search in class
|
|
// -> find class name
|
|
MoveCursorToNodeStart(ProcContextNode);
|
|
ReadNextAtom; // read keyword
|
|
ReadNextAtom; // read name
|
|
NameAtom:=CurPos;
|
|
ReadNextAtom;
|
|
if AtomIsChar('.') then begin
|
|
// proc is a method
|
|
// -> proceed the search normally ...
|
|
end else begin
|
|
// proc is not a method
|
|
if CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier) then
|
|
begin
|
|
// proc identifier found
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc Identifier found=',GetIdentifier(Params.Identifier));
|
|
{$ENDIF}
|
|
Result:=true;
|
|
Params.SetResult(Self,ProcContextNode,NameAtom.StartPos);
|
|
exit;
|
|
end else begin
|
|
// proceed the search normally ...
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindIdentifierInClassOfMethod(
|
|
ProcContextNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
|
|
{ this function is internally used by FindIdentifierInContext
|
|
}
|
|
var
|
|
ClassNameAtom: TAtomPosition;
|
|
OldInput: TFindDeclarationInput;
|
|
ClassContext: TFindContext;
|
|
begin
|
|
Result:=false;
|
|
// if proc is a method, search in class
|
|
// -> find class name
|
|
MoveCursorToNodeStart(ProcContextNode);
|
|
ReadNextAtom; // read keyword
|
|
ReadNextAtom; // read classname
|
|
ClassNameAtom:=CurPos;
|
|
ReadNextAtom;
|
|
if AtomIsChar('.') then begin
|
|
// proc is a method
|
|
if CompareSrcIdentifiers(ClassNameAtom.StartPos,Params.Identifier) 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]
|
|
+(fdfGlobals*Params.Flags)
|
|
+[fdfExceptionOnNotFound,fdfIgnoreUsedUnits];
|
|
Params.ContextNode:=ProcContextNode;
|
|
Params.Identifier:=@Src[ClassNameAtom.StartPos];
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc="',copy(src,ProcContextNode.StartPos,30),'" searching class of method class="',GetIdentifier(ClassNameAtom.StartPos),'"');
|
|
{$ENDIF}
|
|
FindIdentifierInContext(Params);
|
|
ClassContext:=Params.NewCodeTool.FindBaseTypeOfNode(
|
|
Params,Params.NewNode);
|
|
if (ClassContext.Node=nil)
|
|
or (ClassContext.Node.Desc<>ctnClass) then begin
|
|
MoveCursorToCleanPos(ClassNameAtom.StartPos);
|
|
RaiseException('class identifier expected');
|
|
end;
|
|
// class context found
|
|
// 2. -> search identifier in class
|
|
Params.Load(OldInput);
|
|
Params.Flags:=[fdfSearchInAncestors]+fdfAllClassVisibilities
|
|
+(fdfGlobals*Params.Flags)
|
|
-[fdfExceptionOnNotFound];
|
|
Params.ContextNode:=ClassContext.Node;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindIdentifierInProcContext] searching identifier in class of method');
|
|
{$ENDIF}
|
|
Result:=ClassContext.Tool.FindIdentifierInContext(Params);
|
|
if Result then exit;
|
|
finally
|
|
Params.Load(OldInput);
|
|
end;
|
|
end;
|
|
end else begin
|
|
// proc is not a method
|
|
if CompareSrcIdentifiers(ClassNameAtom.StartPos,Params.Identifier) then
|
|
begin
|
|
// proc identifier found
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc Identifier found=',GetIdentifier(Params.Identifier));
|
|
{$ENDIF}
|
|
Result:=true;
|
|
Params.SetResult(Self,ProcContextNode,ClassNameAtom.StartPos);
|
|
exit;
|
|
end else begin
|
|
// proceed the search normally ...
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindClassOfMethod(ProcNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams; FindClassContext: boolean): boolean;
|
|
var
|
|
ClassNameAtom: TAtomPosition;
|
|
OldInput: TFindDeclarationInput;
|
|
ClassContext: TFindContext;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindClassOfMethod] A ');
|
|
{$ENDIF}
|
|
Result:=false;
|
|
MoveCursorToNodeStart(ProcNode);
|
|
ReadNextAtom; // read keyword
|
|
ReadNextAtom; // read classname
|
|
ClassNameAtom:=CurPos;
|
|
ReadNextAtom;
|
|
if AtomIsChar('.') then begin
|
|
// proc is a method
|
|
// -> search the class
|
|
Params.Save(OldInput);
|
|
try
|
|
Params.Flags:=[fdfIgnoreCurContextNode,fdfSearchInParentNodes,
|
|
fdfExceptionOnNotFound,fdfIgnoreUsedUnits]
|
|
+(fdfGlobals*Params.Flags);
|
|
Params.ContextNode:=ProcNode;
|
|
Params.Identifier:=@Src[ClassNameAtom.StartPos];
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindClassOfMethod] searching class of method class="',GetIdentifier(ClassNameAtom.StartPos),'"');
|
|
{$ENDIF}
|
|
FindIdentifierInContext(Params);
|
|
if FindClassContext then begin
|
|
// parse class and return class node
|
|
ClassContext:=FindBaseTypeOfNode(Params,Params.NewNode);
|
|
if (ClassContext.Node=nil)
|
|
or (ClassContext.Node.Desc<>ctnClass) then begin
|
|
MoveCursorToCleanPos(ClassNameAtom.StartPos);
|
|
RaiseException('class identifier expected');
|
|
end;
|
|
// class of method found
|
|
Params.SetResult(ClassContext);
|
|
// parse class and return class node
|
|
|
|
// ToDo: do no JIT parsing for PPU, PPW, DCU files
|
|
|
|
ClassContext.Tool.BuildSubTreeForClass(ClassContext.Node);
|
|
end;
|
|
Result:=true;
|
|
finally
|
|
Params.Load(OldInput);
|
|
end;
|
|
end else begin
|
|
// proc is not a method
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindAncestorOfClass(ClassNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams; FindClassContext: boolean): boolean;
|
|
var AncestorAtom: TAtomPosition;
|
|
OldInput: TFindDeclarationInput;
|
|
AncestorNode, ClassIdentNode: TCodeTreeNode;
|
|
SearchTObject: boolean;
|
|
AncestorContext: TFindContext;
|
|
begin
|
|
if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) then
|
|
RaiseException('[TFindDeclarationTool.FindAncestorOfClass] '
|
|
+' invalid classnode');
|
|
Result:=false;
|
|
// search the ancestor name
|
|
MoveCursorToNodeStart(ClassNode);
|
|
ReadNextAtom; // read keyword 'class', 'object', 'interface', 'dispinterface'
|
|
if UpAtomIs('PACKED') then ReadNextAtom;
|
|
ReadNextAtom;
|
|
if not AtomIsChar('(') then begin
|
|
// no ancestor class specified
|
|
// check class name
|
|
ClassIdentNode:=ClassNode.Parent;
|
|
if (ClassIdentNode=nil) or (ClassIdentNode.Desc<>ctnTypeDefinition) then
|
|
begin
|
|
MoveCursorToNodeStart(ClassNode);
|
|
RaiseException('class without name');
|
|
end;
|
|
// if this class is not TObject, TObject is class ancestor
|
|
SearchTObject:=not CompareSrcIdentifier(ClassIdentNode.StartPos,'TObject');
|
|
if not SearchTObject then exit;
|
|
end else begin
|
|
ReadNextAtom;
|
|
if not AtomIsIdentifier(false) then exit;
|
|
// ancestor name found
|
|
AncestorAtom:=CurPos;
|
|
SearchTObject:=false;
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindAncestorOfClass] ',
|
|
' search ancestor class = ',GetAtom);
|
|
{$ENDIF}
|
|
// search ancestor class context
|
|
CurPos.StartPos:=CurPos.EndPos;
|
|
Params.Save(OldInput);
|
|
try
|
|
Params.Flags:=[fdfSearchInParentNodes,fdfIgnoreCurContextNode,
|
|
fdfExceptionOnNotFound]
|
|
+(fdfGlobals*Params.Flags);
|
|
if not SearchTObject then
|
|
Params.Identifier:=@Src[AncestorAtom.StartPos]
|
|
else begin
|
|
Params.Identifier:='TObject';
|
|
Exclude(Params.Flags,fdfExceptionOnNotFound);
|
|
end;
|
|
Params.ContextNode:=ClassNode;
|
|
if not FindIdentifierInContext(Params) then begin
|
|
MoveCursorToNodeStart(ClassNode);
|
|
//writeln(' AQ2*** ',TCodeBuffer(Scanner.MainCode).Filename,' ',CurPos.StartPos);
|
|
RaiseException('default class ancestor TObject not found');
|
|
end;
|
|
if FindClassContext then begin
|
|
AncestorNode:=Params.NewNode;
|
|
AncestorContext:=Params.NewCodeTool.FindBaseTypeOfNode(Params,
|
|
AncestorNode);
|
|
Params.SetResult(AncestorContext);
|
|
end;
|
|
finally
|
|
Params.Load(OldInput);
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindForwardIdentifier(
|
|
Params: TFindDeclarationParams; var IsForward: boolean): boolean;
|
|
{ first search the identifier in the normal way via FindIdentifierInContext
|
|
then search the other direction }
|
|
var
|
|
OldInput: TFindDeclarationInput;
|
|
begin
|
|
Params.Save(OldInput);
|
|
Exclude(Params.Flags,fdfExceptionOnNotFound);
|
|
Result:=FindIdentifierInContext(Params);
|
|
if not Result then begin
|
|
Params.Load(OldInput);
|
|
Include(Params.Flags,fdfSearchForward);
|
|
Result:=FindIdentifierInContext(Params);
|
|
IsForward:=true;
|
|
end else begin
|
|
IsForward:=false;
|
|
Params.Load(OldInput);
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindIdentifierInWithVarContext(
|
|
WithVarNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
|
|
{ this function is internally used by FindIdentifierInContext
|
|
}
|
|
var
|
|
WithVarContext: TFindContext;
|
|
OldInput: TFindDeclarationInput;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindIdentifierInWithVarContext] ',
|
|
GetIdentifier(Params.Identifier)
|
|
);
|
|
{$ENDIF}
|
|
Result:=false;
|
|
// find the base type of the with variable
|
|
// move cursor to end of with-expression
|
|
if (WithVarNode.FirstChild<>nil) then begin
|
|
// this is the last with-variable
|
|
MoveCursorToCleanPos(WithVarNode.FirstChild.StartPos);
|
|
ReadPriorAtom; // read 'do'
|
|
CurPos.EndPos:=CurPos.StartPos; // make the 'do' unread,
|
|
// because 'do' is not part of the expr
|
|
end else begin
|
|
// this is not the last with variable, so the expr end is equal to node end
|
|
MoveCursorToCleanPos(WithVarNode.EndPos);
|
|
end;
|
|
Params.Save(OldInput);
|
|
Params.ContextNode:=WithVarNode;
|
|
Include(Params.Flags,fdfExceptionOnNotFound);
|
|
WithVarContext:=FindContextNodeAtCursor(Params);
|
|
if (WithVarContext.Node=nil) or (WithVarContext.Node=OldInput.ContextNode)
|
|
or (not (WithVarContext.Node.Desc in [ctnClass,ctnRecordType])) then begin
|
|
MoveCursorToCleanPos(WithVarNode.StartPos);
|
|
RaiseException('expression type must be class or record type');
|
|
end;
|
|
// search identifier in with context
|
|
Params.Load(OldInput);
|
|
Exclude(Params.Flags,fdfExceptionOnNotFound);
|
|
Params.ContextNode:=WithVarContext.Node;
|
|
if WithVarContext.Tool.FindIdentifierInContext(Params) then begin
|
|
// identifier found in with context
|
|
Result:=true;
|
|
end else
|
|
Params.Load(OldInput);
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindIdentifierInAncestors(
|
|
ClassNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
|
|
{ this function is internally used by FindIdentifierInContext
|
|
}
|
|
var AncestorAtom: TAtomPosition;
|
|
OldInput: TFindDeclarationInput;
|
|
AncestorNode, ClassIdentNode: TCodeTreeNode;
|
|
SearchTObject: boolean;
|
|
AncestorContext: TFindContext;
|
|
begin
|
|
if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) then
|
|
RaiseException('[TFindDeclarationTool.FindIdentifierInAncestors] '
|
|
+' invalid classnode');
|
|
Result:=false;
|
|
if not (fdfSearchInAncestors in Params.Flags) then exit;
|
|
// search the ancestor name
|
|
MoveCursorToNodeStart(ClassNode);
|
|
ReadNextAtom; // read keyword 'class', 'object', 'interface', 'dispinterface'
|
|
if UpAtomIs('PACKED') then ReadNextAtom;
|
|
ReadNextAtom;
|
|
if not AtomIsChar('(') then begin
|
|
// no ancestor class specified
|
|
// check class name
|
|
ClassIdentNode:=ClassNode.Parent;
|
|
if (ClassIdentNode=nil) or (ClassIdentNode.Desc<>ctnTypeDefinition) then
|
|
begin
|
|
MoveCursorToNodeStart(ClassNode);
|
|
RaiseException('class without name');
|
|
end;
|
|
// if this class is not TObject, TObject is class ancestor
|
|
SearchTObject:=not CompareSrcIdentifier(ClassIdentNode.StartPos,'TObject');
|
|
if not SearchTObject then exit;
|
|
end else begin
|
|
ReadNextAtom;
|
|
if not AtomIsIdentifier(false) then exit;
|
|
// ancestor name found
|
|
AncestorAtom:=CurPos;
|
|
SearchTObject:=false;
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindIdentifierInAncestors] ',
|
|
' Ident=',GetIdentifier(Params.Identifier),
|
|
' search ancestor class = ',GetAtom);
|
|
{$ENDIF}
|
|
// search ancestor class context
|
|
CurPos.StartPos:=CurPos.EndPos;
|
|
Params.Save(OldInput);
|
|
try
|
|
Params.Flags:=[fdfSearchInParentNodes,fdfIgnoreCurContextNode,
|
|
fdfExceptionOnNotFound]
|
|
+(fdfGlobals*Params.Flags);
|
|
if not SearchTObject then
|
|
Params.Identifier:=@Src[AncestorAtom.StartPos]
|
|
else begin
|
|
Params.Identifier:='TObject';
|
|
Exclude(Params.Flags,fdfExceptionOnNotFound);
|
|
end;
|
|
Params.ContextNode:=ClassNode;
|
|
if not FindIdentifierInContext(Params) then begin
|
|
MoveCursorToNodeStart(ClassNode);
|
|
//writeln(' AQ*** ',TCodeBuffer(Scanner.MainCode).Filename,' ',CurPos.StartPos);
|
|
RaiseException('default class ancestor TObject not found');
|
|
end;
|
|
AncestorNode:=Params.NewNode;
|
|
AncestorContext:=Params.NewCodeTool.FindBaseTypeOfNode(Params,AncestorNode);
|
|
Params.Load(OldInput);
|
|
Exclude(Params.Flags,fdfExceptionOnNotFound);
|
|
Params.ContextNode:=AncestorContext.Node;
|
|
if (AncestorContext.Tool<>Self)
|
|
and (not (fdfIgnoreClassVisibility in Params.Flags)) then
|
|
Params.Flags:=Params.Flags-[fdfClassPrivate];
|
|
Result:=AncestorContext.Tool.FindIdentifierInContext(Params);
|
|
finally
|
|
Params.Load(OldInput);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF CTDEBUG}
|
|
procedure TFindDeclarationTool.DecPrefix;
|
|
begin
|
|
DebugPrefix:=copy(DebugPrefix,1,length(DebugPrefix)-2);
|
|
end;
|
|
|
|
procedure TFindDeclarationTool.IncPrefix;
|
|
begin
|
|
DebugPrefix:=DebugPrefix+' ';
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TFindDeclarationTool.FindExpressionResultType(
|
|
Params: TFindDeclarationParams; StartPos, EndPos: integer): TFindContext;
|
|
begin
|
|
|
|
// ToDo: operators
|
|
// ToDo: operator overloading
|
|
// ToDo: internal types. e.g. String[] is of type char
|
|
|
|
// ToDo: constant types: e.g. 1 is constnumber, #1 is constchar,
|
|
// '1' is conststring, 1.0 is constreal
|
|
// ToDo: set types: [], A * B
|
|
|
|
// This is a quick hack: Just return the type of the last variable.
|
|
MoveCursorToCleanPos(EndPos);
|
|
Result:=FindContextNodeAtCursor(Params);
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindIdentifierInUsesSection(
|
|
UsesNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
|
|
{ this function is internally used by FindIdentifierInContext
|
|
|
|
search backwards through the uses section
|
|
compare first the unit name, then load the unit and search there
|
|
|
|
}
|
|
var InAtom, UnitNameAtom: TAtomPosition;
|
|
NewCodeTool: TFindDeclarationTool;
|
|
OldInput: TFindDeclarationInput;
|
|
begin
|
|
Result:=false;
|
|
if (UsesNode=nil) or (UsesNode.Desc<>ctnUsesSection) then
|
|
RaiseException('[TFindDeclarationTool.FindIdentifierInUsesSection] '
|
|
+'internal error: invalid UsesNode');
|
|
// search backwards through the uses section
|
|
MoveCursorToCleanPos(UsesNode.EndPos);
|
|
ReadPriorAtom; // read ';'
|
|
if not AtomIsChar(';') then
|
|
RaiseException('; expected, but '+GetAtom+' found');
|
|
repeat
|
|
ReadPriorAtom; // read unitname
|
|
if AtomIsStringConstant then begin
|
|
InAtom:=CurPos;
|
|
ReadPriorAtom; // read 'in'
|
|
if not UpAtomIs('IN') then
|
|
RaiseException('keyword "in" expected, but '+GetAtom+' found');
|
|
ReadPriorAtom; // read unitname
|
|
end else
|
|
InAtom.StartPos:=-1;
|
|
AtomIsIdentifier(true);
|
|
UnitNameAtom:=CurPos;
|
|
if (fdfIgnoreUsedUnits in Params.Flags) then begin
|
|
if CompareSrcIdentifiers(UnitNameAtom.StartPos,Params.Identifier) then
|
|
begin
|
|
// the searched identifier was a uses unitname, but since the unit should
|
|
// not be opened, point to identifier in the uses section
|
|
Result:=true;
|
|
Params.SetResult(Self,UsesNode,UnitNameAtom.StartPos);
|
|
exit;
|
|
end else begin
|
|
// identifier not found
|
|
end;
|
|
end else begin
|
|
// open the unit and search the identifier in the interface
|
|
NewCodeTool:=FindCodeToolForUsedUnit(UnitNameAtom,InAtom,false);
|
|
if NewCodeTool=nil then begin
|
|
MoveCursorToCleanPos(UnitNameAtom.StartPos);
|
|
RaiseException('unit not found: '+copy(Src,UnitNameAtom.StartPos,
|
|
UnitNameAtom.EndPos-UnitNameAtom.StartPos));
|
|
end else if NewCodeTool=Self then begin
|
|
MoveCursorToCleanPos(UnitNameAtom.StartPos);
|
|
RaiseException('illegal circle using unit: '+copy(Src,
|
|
UnitNameAtom.StartPos,UnitNameAtom.EndPos-UnitNameAtom.StartPos));
|
|
end;
|
|
// search the identifier in the interface of the used unit
|
|
Params.Save(OldInput);
|
|
Params.Flags:=[fdfIgnoreUsedUnits]+(fdfGlobals*Params.Flags)
|
|
-[fdfExceptionOnNotFound];
|
|
Result:=NewCodeTool.FindIdentifierInInterface(Self,Params);
|
|
if Result then exit;
|
|
Params.Load(OldInput);
|
|
// restore the cursor
|
|
MoveCursorToCleanPos(UnitNameAtom.StartPos);
|
|
end;
|
|
ReadPriorAtom; // read keyword 'uses' or comma
|
|
until not AtomIsChar(',');
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindCodeToolForUsedUnit(UnitNameAtom,
|
|
UnitInFileAtom: TAtomPosition;
|
|
ExceptionOnNotFound: boolean): TFindDeclarationTool;
|
|
var AnUnitName, AnUnitInFilename: string;
|
|
NewCode: TCodeBuffer;
|
|
begin
|
|
Result:=nil;
|
|
if (UnitNameAtom.StartPos<1) or (UnitNameAtom.EndPos<=UnitNameAtom.StartPos)
|
|
or (UnitNameAtom.EndPos>SrcLen+1) then
|
|
RaiseException('[TFindDeclarationTool.FindCodeToolForUsedUnit] '
|
|
+'internal error: invalid UnitNameAtom');
|
|
AnUnitName:=copy(Src,UnitNameAtom.StartPos,
|
|
UnitNameAtom.EndPos-UnitNameAtom.StartPos);
|
|
if UnitInFileAtom.StartPos>=1 then begin
|
|
if (UnitInFileAtom.StartPos<1)
|
|
or (UnitInFileAtom.EndPos<=UnitInFileAtom.StartPos)
|
|
or (UnitInFileAtom.EndPos>SrcLen+1) then
|
|
RaiseException('[TFindDeclarationTool.FindCodeToolForUsedUnit] '
|
|
+'internal error: invalid UnitInFileAtom');
|
|
AnUnitInFilename:=copy(Src,UnitInFileAtom.StartPos,
|
|
UnitInFileAtom.EndPos-UnitInFileAtom.StartPos);
|
|
end else
|
|
AnUnitInFilename:='';
|
|
NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename);
|
|
if (NewCode=nil) then begin
|
|
// no source found
|
|
if ExceptionOnNotFound then
|
|
RaiseException('unit '+AnUnitName+' not found');
|
|
end else begin
|
|
// source found -> get codetool for it
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindCodeToolForUsedUnit] ',
|
|
' This source is=',TCodeBuffer(Scanner.MainCode).Filename,
|
|
' NewCode=',NewCode.Filename);
|
|
{$ENDIF}
|
|
if Assigned(FOnGetCodeToolForBuffer) then
|
|
Result:=FOnGetCodeToolForBuffer(Self,NewCode)
|
|
else if NewCode=TCodeBuffer(Scanner.MainCode) then
|
|
Result:=Self;
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindIdentifierInInterface(
|
|
AskingTool: TFindDeclarationTool; Params: TFindDeclarationParams): boolean;
|
|
var InterfaceNode: TCodeTreeNode;
|
|
SrcIsUsable: boolean;
|
|
OldInput: TFindDeclarationInput;
|
|
begin
|
|
Result:=false;
|
|
// build code tree
|
|
{$IFDEF CTDEBUG}
|
|
writeln(DebugPrefix,'TFindDeclarationTool.FindIdentifierInInterface',
|
|
' Ident=',GetIdentifier(Params.Identifier),
|
|
' IgnoreUsedUnits=',fdfIgnoreUsedUnits in Params.Flags,
|
|
' Self=',TCodeBuffer(Scanner.MainCode).Filename
|
|
);
|
|
{$ENDIF}
|
|
|
|
// ToDo: build codetree for ppu, ppw, dcu files
|
|
|
|
// build tree for pascal source
|
|
BuildTree(true);
|
|
|
|
// check source name
|
|
MoveCursorToNodeStart(Tree.Root);
|
|
ReadNextAtom; // read keyword for source type, e.g. 'unit'
|
|
SrcIsUsable:=UpAtomIs('UNIT');
|
|
if not SrcIsUsable then
|
|
RaiseException('source is not unit');
|
|
ReadNextAtom; // read source name
|
|
if CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then begin
|
|
// identifier is source name
|
|
Params.SetResult(Self,Tree.Root,CurPos.StartPos);
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
|
|
// search identifier in interface
|
|
InterfaceNode:=FindInterfaceNode;
|
|
if InterfaceNode=nil then
|
|
RaiseException('interface section not found');
|
|
Params.Save(OldInput);
|
|
try
|
|
Params.Flags:=(fdfGlobals*Params.Flags)
|
|
-[fdfExceptionOnNotFound,fdfSearchInParentNodes];
|
|
Params.ContextNode:=InterfaceNode;
|
|
Result:=FindIdentifierInContext(Params);
|
|
finally
|
|
Params.Load(OldInput);
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.CompareNodeIdentifier(Node: TCodeTreeNode;
|
|
Params: TFindDeclarationParams): boolean;
|
|
begin
|
|
Result:=false;
|
|
if Node=nil then exit;
|
|
if Node.Desc in AllSourceTypes then begin
|
|
MoveCursorToNodeStart(Node);
|
|
ReadNextAtom;
|
|
ReadNextAtom;
|
|
Result:=CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier);
|
|
end else if (Node.Desc in AllIdentifierDefinitions)
|
|
or (Node.Desc=ctnIdentifier) then begin
|
|
Result:=CompareSrcIdentifiers(Node.StartPos,Params.Identifier);
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.GetInterfaceNode: TCodeTreeNode;
|
|
begin
|
|
Result:=Tree.Root;
|
|
if Result=nil then begin
|
|
CurPos.StartPos:=-1;
|
|
RaiseException('[TFindDeclarationTool.GetInterfaceNode] no code tree found');
|
|
end;
|
|
if not (Tree.Root.Desc in AllUsableSoureTypes) then begin
|
|
CurPos.StartPos:=-1;
|
|
RaiseException('used unit is not an pascal unit');
|
|
end;
|
|
Result:=FindInterfaceNode;
|
|
if Result=nil then begin
|
|
CurPos.StartPos:=-1;
|
|
RaiseException('no interface section found');
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindIdentifierInUsedUnit(
|
|
const AnUnitName: string; Params: TFindDeclarationParams): boolean;
|
|
{ this function is internally used by FindIdentifierInUsesSection
|
|
for hidden used units, like the system unit or the objpas unit
|
|
}
|
|
var
|
|
NewCode: TCodeBuffer;
|
|
NewCodeTool: TFindDeclarationTool;
|
|
OldInput: TFindDeclarationInput;
|
|
begin
|
|
Result:=false;
|
|
// open the unit and search the identifier in the interface
|
|
NewCode:=FindUnitSource(AnUnitName,'');
|
|
if (NewCode=nil) then begin
|
|
// no source found
|
|
CurPos.StartPos:=-1;
|
|
RaiseException('unit '+AnUnitName+' not found');
|
|
end else begin
|
|
// source found -> get codetool for it
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindIdentifierInUsedUnit] ',
|
|
' This source is=',TCodeBuffer(Scanner.MainCode).Filename,
|
|
' NewCode=',NewCode.Filename,' IgnoreUsedUnits=',fdfIgnoreUsedUnits in Params.Flags);
|
|
{$ENDIF}
|
|
if Assigned(FOnGetCodeToolForBuffer) then begin
|
|
NewCodeTool:=FOnGetCodeToolForBuffer(Self,NewCode);
|
|
if NewCodeTool=nil then begin
|
|
CurPos.StartPos:=-1;
|
|
RaiseException('unit '+AnUnitName+' not found');
|
|
end;
|
|
end else if NewCode=TCodeBuffer(Scanner.MainCode) then begin
|
|
NewCodeTool:=Self;
|
|
CurPos.StartPos:=-1;
|
|
RaiseException('illegal circle using unit: '+AnUnitName);
|
|
end;
|
|
// search the identifier in the interface of the used unit
|
|
Params.Save(OldInput);
|
|
Params.Flags:=[fdfIgnoreUsedUnits]+(fdfGlobals*Params.Flags)
|
|
-[fdfExceptionOnNotFound];
|
|
Result:=NewCodeTool.FindIdentifierInInterface(Self,Params);
|
|
if Result then exit;
|
|
Params.Load(OldInput);
|
|
end;
|
|
end;
|
|
|
|
function TFindDeclarationTool.FindIdentifierInHiddenUsedUnits(
|
|
Params: TFindDeclarationParams): boolean;
|
|
const
|
|
sutSystem = 1;
|
|
sutObjPas = 2;
|
|
sutLineInfo = 3;
|
|
sutHeapTrc = 4;
|
|
sutNone = 5;
|
|
var
|
|
OldInput: TFindDeclarationInput;
|
|
SystemUnitName: string;
|
|
SpecialUnitType: integer;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TFindDeclarationTool.FindIdentifierInHiddenUsedUnits] ',
|
|
GetIdentifier(Params.Identifier),' IgnoreUsedUnits=',fdfIgnoreUsedUnits in Params.Flags);
|
|
{$ENDIF}
|
|
if (Tree.Root<>nil) and (not (fdfIgnoreUsedUnits in Params.Flags)) then begin
|
|
// check, if this is a special unit
|
|
MoveCursorToNodeStart(Tree.Root);
|
|
ReadNextAtom;
|
|
ReadNextAtom;
|
|
if Scanner.InitialValues.IsDefined('LINUX') then
|
|
SystemUnitName:='SYSLINUX'
|
|
else
|
|
// ToDo: other OS than linux
|
|
SystemUnitName:='SYSTEM';
|
|
if UpAtomIs(SystemUnitName) then
|
|
SpecialUnitType:=sutSystem
|
|
else if UpAtomIs('OBJPAS') then
|
|
SpecialUnitType:=sutObjPas
|
|
else if UpAtomIs('LINEINFO') then
|
|
SpecialUnitType:=sutLineInfo
|
|
else if UpAtomIs('HEAPTRC') then
|
|
SpecialUnitType:=sutHeapTrc
|
|
else
|
|
SpecialUnitType:=sutNone;
|
|
// try hidden units
|
|
if (SpecialUnitType>sutHeapTrc)
|
|
and Scanner.InitialValues.IsDefined(ExternalMacroStart+'UseHeapTrcUnit')
|
|
then begin
|
|
// try hidden used unit 'heaptrc'
|
|
Result:=FindIdentifierInUsedUnit('HeapTrc',Params);
|
|
if Result then exit;
|
|
end;
|
|
if (SpecialUnitType>sutLineInfo)
|
|
and Scanner.InitialValues.IsDefined(ExternalMacroStart+'UseLineInfo')
|
|
then begin
|
|
// try hidden used unit 'lineinfo'
|
|
Result:=FindIdentifierInUsedUnit('LineInfo',Params);
|
|
if Result then exit;
|
|
end;
|
|
if (SpecialUnitType>sutObjPas)
|
|
and (Scanner.CompilerMode in [cmDELPHI,cmOBJFPC]) then begin
|
|
// try hidden used unit 'objpas'
|
|
Result:=FindIdentifierInUsedUnit('ObjPas',Params);
|
|
if Result then exit;
|
|
end;
|
|
// try hidden used unit 'system'
|
|
if (SpecialUnitType>sutSystem)
|
|
and CompareSrcIdentifiers(Params.Identifier,PChar(SystemUnitName)) then begin
|
|
// the system unit name itself is searched -> rename searched identifier
|
|
Params.Save(OldInput);
|
|
Params.Identifier:=PChar(SystemUnitName);
|
|
Result:=FindIdentifierInUsedUnit(SystemUnitName,Params);
|
|
Params.Load(OldInput);
|
|
end else
|
|
Result:=FindIdentifierInUsedUnit(SystemUnitName,Params);
|
|
if Result then exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TFindDeclarationParams }
|
|
|
|
constructor TFindDeclarationParams.Create;
|
|
begin
|
|
inherited Create;
|
|
Clear;
|
|
end;
|
|
|
|
procedure TFindDeclarationParams.Clear;
|
|
begin
|
|
ClearInput;
|
|
ClearResult;
|
|
end;
|
|
|
|
procedure TFindDeclarationParams.Load(var Input: TFindDeclarationInput);
|
|
begin
|
|
Flags:=Input.Flags;
|
|
Identifier:=Input.Identifier;
|
|
ContextNode:=Input.ContextNode;
|
|
end;
|
|
|
|
procedure TFindDeclarationParams.Save(var Input: TFindDeclarationInput);
|
|
begin
|
|
Input.Flags:=Flags;
|
|
Input.Identifier:=Identifier;
|
|
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: TFindDeclarationTool;
|
|
ANewNode: TCodeTreeNode);
|
|
begin
|
|
ClearResult;
|
|
NewCodeTool:=ANewCodeTool;
|
|
NewNode:=ANewNode;
|
|
end;
|
|
|
|
procedure TFindDeclarationParams.SetResult(ANewCodeTool: TFindDeclarationTool;
|
|
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;
|
|
|
|
procedure TFindDeclarationParams.ClearInput;
|
|
begin
|
|
Flags:=[];
|
|
Identifier:=nil;
|
|
ContextNode:=nil;
|
|
end;
|
|
|
|
procedure TFindDeclarationParams.SetResult(AFindContext: TFindContext);
|
|
begin
|
|
ClearResult;
|
|
NewCodeTool:=AFindContext.Tool;
|
|
NewNode:=AFindContext.Node;
|
|
end;
|
|
|
|
|
|
end.
|
|
|
|
|