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

codetools: implemented FindCodeContext for procedures

Browse Source 
git-svn-id: trunk@9296 -
This commit is contained in:
mattias 2006-05-17 00:56:04 +00:00
parent 8bb640c7fd
commit d15d5a84e9
8 changed files with 444 additions and 211 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -64,12 +64,15 @@ components/codetools/examples/finddeclaration.lpi svneol=native#text/plain
components/codetools/examples/finddeclaration.lpr svneol=native#text/plain
components/codetools/examples/fixfilenames.lpi svneol=native#text/plain
components/codetools/examples/fixfilenames.pas svneol=native#text/plain
components/codetools/examples/getcontext.lpi svneol=native#text/plain
components/codetools/examples/getcontext.lpr svneol=native#text/plain
components/codetools/examples/methodjumping.lpi svneol=native#text/plain
components/codetools/examples/methodjumping.pas svneol=native#text/plain
components/codetools/examples/scanexamples/BigLettersUnit.pas svneol=native#text/plain
components/codetools/examples/scanexamples/brokenfilenames.pas svneol=native#text/plain
components/codetools/examples/scanexamples/brokenincfiles.inc svneol=native#text/plain
components/codetools/examples/scanexamples/empty.inc svneol=native#text/plain
components/codetools/examples/scanexamples/getcontextexample.pas svneol=native#text/plain
components/codetools/examples/scanexamples/simpleunit1.pas svneol=native#text/plain
components/codetools/examples/scanexamples/tgeneric2.pas svneol=native#text/plain
components/codetools/expreval.pas svneol=native#text/pascal

2
components/codetools/codecompletiontool.pas
View File

@ -2661,7 +2661,7 @@ var CleanCursorPos, Indent, insertPos: integer;
Params.OnTopLvlIdentifierFound:=@OnTopLvlIdentifierFound;
Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,
fdfTopLvlResolving,fdfFindVariable];
if (not FindDeclarationOfIdentAtCursor(Params))
if (not FindDeclarationOfIdentAtParam(Params))
or (Params.NewNode.Desc<>ctnProperty) then begin
{$IFDEF CTDEBUG}
DebugLn('FindEventTypeAtCursor not a property');

48
components/codetools/examples/getcontext.lpi Normal file
View File

@ -0,0 +1,48 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="5"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
</General>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="2">
<Unit0>
<Filename Value="getcontext.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="GetContext"/>
</Unit0>
<Unit1>
<Filename Value="scanexamples/getcontextexample.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="GetContextExample"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<OtherUnitFiles Value="$(LazarusDir)/components/codetools/units/$(TargetCPU)-$(TargetOS)/;scanexamples/"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

68
components/codetools/examples/getcontext.lpr Normal file
View File

@ -0,0 +1,68 @@
program GetContext;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, CodeCache, CodeToolManager, DefineTemplates,
CodeToolsConfig, GetContextExample, IdentCompletionTool, FindDeclarationTool;
const
ConfigFilename = 'codetools.config';
var
Options: TCodeToolsOptions;
Code: TCodeBuffer;
CodeContexts: TCodeContextInfo;
i: Integer;
ExprType: TExpressionType;
begin
// setup the Options
Options:=TCodeToolsOptions.Create;
// To not parse the FPC sources every time, the options are saved to a file.
if FileExists(ConfigFilename) then
Options.LoadFromFile(ConfigFilename);
// setup your paths
Options.FPCPath:='/usr/bin/ppc386';
Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc');
Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');
// optional: ProjectDir and TestPascalFile exists only to easily test some
// things.
Options.ProjectDir:=GetCurrentDir+'/scanexamples/';
Options.TestPascalFile:=Options.ProjectDir+'getcontextexample.pas';
// init the codetools
if not Options.UnitLinkListValid then
writeln('Scanning FPC sources may take a while ...');
CodeToolBoss.Init(Options);
// save the options and the FPC unit links results.
Options.SaveToFile(ConfigFilename);
// Example: find declaration of 'TObject'
// Step 1: load the file
Code:=CodeToolBoss.LoadFile(Options.TestPascalFile,false,false);
if Code=nil then
raise Exception.Create('loading failed '+Options.TestPascalFile);
// Step 2: find context
if CodeToolBoss.FindCodeContext(Code,7,14,CodeContexts) then
begin
writeln('Contexts found: Count=',CodeContexts.Count);
for i:=0 to CodeContexts.Count-1 do begin
ExprType:=CodeContexts[i];
write('i=',i,' ',ExprTypeToString(ExprType));
if ExprType.Context.Node<>nil then
write(' ',ExprType.Context.Tool.ExtractNode(ExprType.Context.Node,[]));
writeln;
end;
end else begin
writeln('Contexts not found: ',CodeToolBoss.ErrorMessage);
end;
CodeContexts.Free;
Options.Free;
end.

18
components/codetools/examples/scanexamples/getcontextexample.pas Normal file
View File

@ -0,0 +1,18 @@
unit GetContextExample;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
implementation
procedure CallOverloadedProc;
begin
Pos('','');
end;
end.

2
components/codetools/extractproctool.pas
View File

@ -366,7 +366,7 @@ var
{$IFDEF CTDebug}
DebugLn('AddVariableAtCursor Searching ',GetIdentifier(Params.Identifier));
{$ENDIF}
if not FindDeclarationOfIdentAtCursor(Params) then begin
if not FindDeclarationOfIdentAtParam(Params) then begin
{$IFDEF CTDebug}
DebugLn('AddVariableAtCursor B not found');
{$ENDIF}

162
components/codetools/finddeclarationtool.pas
View File

@ -496,23 +496,6 @@ const
AllFindSmartFlags = [fsfIncludeDirective];
type
{ TCodeContextInfo }
TCodeContextInfo = class
private
FItems: PExpressionType;
FCount: integer;
function GetItems(Index: integer): TExpressionType;
public
constructor Create;
destructor Destroy; override;
function Count: integer;
property Items[Index: integer]: TExpressionType read GetItems; default;
function Add(const Context: TExpressionType): integer;
procedure Clear;
end;
//----------------------------------------------------------------------------
ECodeToolUnitNotFound = class(ECodeToolFileNotFound)
end;
@ -617,7 +600,7 @@ type
protected
function CheckSrcIdentifier(Params: TFindDeclarationParams;
const FoundContext: TFindContext): TIdentifierFoundResult;
function FindDeclarationOfIdentAtCursor(
function FindDeclarationOfIdentAtParam(
Params: TFindDeclarationParams): boolean;
function IdentifierIsDefined(IdentAtom: TAtomPosition;
ContextNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
@ -729,8 +712,6 @@ type
function CleanPosIsDeclarationIdentifier(CleanPos: integer;
Node: TCodeTreeNode): boolean;
function FindCodeContext(const CursorPos: TCodeXYPosition;
out CodeContexts: TCodeContextInfo): boolean;
function JumpToNode(ANode: TCodeTreeNode;
var NewPos: TCodeXYPosition; var NewTopLine: integer;
@ -1289,7 +1270,7 @@ begin
fdfTopLvlResolving,fdfSearchInAncestors];
if not DirectSearch then begin
// ToDo: DirtySrc
Result:=FindDeclarationOfIdentAtCursor(Params);
Result:=FindDeclarationOfIdentAtParam(Params);
end else begin
Include(Params.Flags,fdfIgnoreCurContextNode);
if SearchForward then
@ -1881,7 +1862,7 @@ begin
end;
end;
function TFindDeclarationTool.FindDeclarationOfIdentAtCursor(
function TFindDeclarationTool.FindDeclarationOfIdentAtParam(
Params: TFindDeclarationParams): boolean;
{ searches an identifier in clean code, parses code in front and after the
identifier
@ -1902,7 +1883,7 @@ var
ExprType: TExpressionType;
begin
{$IFDEF CTDEBUG}
DebugLn('[TFindDeclarationTool.FindDeclarationOfIdentAtCursor] Identifier=',
DebugLn('[TFindDeclarationTool.FindDeclarationOfIdentAtParam] Identifier=',
'"',GetIdentifier(Params.Identifier),'"',
' ContextNode=',NodeDescriptionAsString(Params.ContextNode.Desc),
' "',copy(Src,Params.ContextNode.StartPos,20),'"');
@ -1927,7 +1908,7 @@ begin
Params.SetResult(CleanFindContext);
end;
{$IFDEF CTDEBUG}
DbgOut('[TFindDeclarationTool.FindDeclarationOfIdentAtCursor] Ident=',
DbgOut('[TFindDeclarationTool.FindDeclarationOfIdentAtParam] Ident=',
'"',GetIdentifier(Params.Identifier),'" ');
if Params.NewNode<>nil then
DebugLn('Node=',Params.NewNode.DescAsString,' ',Params.NewCodeTool.MainFilename)
@ -3279,7 +3260,7 @@ var
if fdfSearchForward in Params.Flags then
Found:=FindIdentifierInContext(Params)
else
Found:=FindDeclarationOfIdentAtCursor(Params);
Found:=FindDeclarationOfIdentAtParam(Params);
except
on E: ECodeToolError do
if not IsComment then raise;
@ -3590,100 +3571,6 @@ begin
end;
end;
function TFindDeclarationTool.FindCodeContext(const CursorPos: TCodeXYPosition;
out CodeContexts: TCodeContextInfo): boolean;
var
CleanCursorPos: integer;
CursorNode: TCodeTreeNode;
Params: TFindDeclarationParams;
procedure AddContext(Tool: TFindDeclarationTool; Node: TCodeTreeNode);
begin
if CodeContexts=nil then
CodeContexts:=TCodeContextInfo.Create;
CodeContexts.Add(CreateExpressionType(xtContext,xtNone,
CreateFindContext(Tool,Node)));
//DebugLn('AddContext ',node.DescAsString,' ',copy(Src,Node.StartPos,Node.EndPos-Node.StartPos));
end;
function CheckContextIsParameter(var Ok: boolean): boolean;
// returns true, on error or context is parameter
// returns false, if no error and context is not parameter
var
VarNameAtom, ProcNameAtom: TAtomPosition;
ParameterIndex: integer;
ParameterNode: TCodeTreeNode;
begin
Result:=false;
//DebugLn('CheckContextIsParameter ');
if not CheckParameterSyntax(CursorNode, CleanCursorPos,
VarNameAtom, ProcNameAtom, ParameterIndex) then exit;
if VarNameAtom.StartPos<1 then exit;
// it is a parameter
Result:=true;
ok:=true;
// find declaration of parameter list
Params.ContextNode:=CursorNode;
Params.SetIdentifier(Self,@Src[ProcNameAtom.StartPos],@CheckSrcIdentifier);
Params.Flags:=fdfGlobals+[fdfSearchInParentNodes,fdfSearchInAncestors,
fdfFindVariable,fdfIgnoreCurContextNode];
//DebugLn('CheckContextIsParameter searching procedure ...');
if not FindIdentifierInContext(Params) then exit;
if Params.NewNode<>nil then begin
//DebugLn('CheckContextIsParameter searching parameter node ...');
ParameterNode:=Params.NewCodeTool.FindNthParameterNode(Params.NewNode,
ParameterIndex);
if ParameterNode<>nil then begin
//DebugLn('CheckContextIsParameter adding parameter node to CodeContexts');
AddContext(Params.NewCodeTool,ParameterNode);
end;
//DebugLn(' CompleteLocalVariableAsParameter Dont know: ',Params.NewNode.DescAsString);
end;
end;
begin
CodeContexts:=nil;
Result:=false;
ActivateGlobalWriteLock;
Params:=TFindDeclarationParams.Create;
try
// build code tree
{$IFDEF CTDEBUG}
DebugLn('TFindDeclarationTool.FindCodeContext A CursorPos=X',dbgs(CursorPos.X),',Y',dbgs(CursorPos.Y));
{$ENDIF}
if DirtySrc<>nil then DirtySrc.Clear;
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
[{$IFNDEF DisableIgnoreErrorAfter}btSetIgnoreErrorPos,{$ENDIF}
btLoadDirtySource,btCursorPosOutAllowed]);
{$IFDEF CTDEBUG}
DebugLn('TFindDeclarationTool.FindCodeContext C CleanCursorPos=',dbgs(CleanCursorPos));
{$ENDIF}
// find CodeTreeNode at cursor
if (Tree.Root<>nil) and (Tree.Root.StartPos<=CleanCursorPos) then begin
CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(Tree.Root,CleanCursorPos,
true);
end else begin
CursorNode:=nil;
end;
if CursorNode<>nil then begin
if CheckContextIsParameter(Result) then exit;
end;
if CodeContexts=nil then begin
// create default
AddContext(Self,CursorNode);
end;
Result:=true;
finally
Params.Free;
DeactivateGlobalWriteLock;
end;
Result:=false;
end;
function TFindDeclarationTool.JumpToNode(ANode: TCodeTreeNode;
var NewPos: TCodeXYPosition; var NewTopLine: integer;
IgnoreJumpCentered: boolean): boolean;
@ -7879,42 +7766,5 @@ begin
end;
{ TCodeContextInfo }
function TCodeContextInfo.GetItems(Index: integer): TExpressionType;
begin
Result:=FItems[Index];
end;
constructor TCodeContextInfo.Create;
begin
end;
destructor TCodeContextInfo.Destroy;
begin
Clear;
inherited Destroy;
end;
function TCodeContextInfo.Count: integer;
begin
Result:=FCount;
end;
function TCodeContextInfo.Add(const Context: TExpressionType): integer;
begin
inc(FCount);
Result:=Count;
ReAllocMem(FItems,SizeOf(TExpressionType)*FCount);
FItems[FCount-1]:=Context;
end;
procedure TCodeContextInfo.Clear;
begin
FCount:=0;
ReAllocMem(FItems,0);
end;
end.

352
components/codetools/identcompletiontool.pas
View File

@ -209,6 +209,32 @@ type
property Capacity: integer read FCapacity write SetCapacity;
end;
//----------------------------------------------------------------------------
{ TCodeContextInfo }
TCodeContextInfo = class
private
FEndPos: integer;
FItems: PExpressionType;
FCount: integer;
FParameterIndex: integer;
FProcName: string;
FStartPos: integer;
function GetItems(Index: integer): TExpressionType;
public
constructor Create;
destructor Destroy; override;
function Count: integer;
property Items[Index: integer]: TExpressionType read GetItems; default;
function Add(const Context: TExpressionType): integer;
procedure Clear;
property ParameterIndex: integer read FParameterIndex write FParameterIndex;// 1 based
property ProcName: string read FProcName write FProcName;
property StartPos: integer read FStartPos write FStartPos;// context is valid from StartPos to EndPos
property EndPos: integer read FEndPos write FEndPos;
end;
//----------------------------------------------------------------------------
// TIdentCompletionTool
@ -221,6 +247,7 @@ type
// property names in source)
protected
CurrentIdentifierList: TIdentifierList;
CurrentContexts: TCodeContextInfo;
function CollectAllIdentifiers(Params: TFindDeclarationParams;
const FoundContext: TFindContext): TIdentifierFoundResult;
procedure GatherPredefinedIdentifiers(CleanPos: integer;
@ -230,10 +257,25 @@ type
procedure GatherUnitnames(CleanPos: integer;
const Context: TFindContext; BeautifyCodeOptions: TBeautifyCodeOptions);
procedure GatherSourceNames(const Context: TFindContext);
procedure InitCollectIdentifiers(const CursorPos: TCodeXYPosition;
var IdentifierList: TIdentifierList);
procedure ParseSourceTillCollectionStart(const CursorPos: TCodeXYPosition;
out CleanCursorPos: integer; out CursorNode: TCodeTreeNode;
out IdentStartPos, IdentEndPos: integer);
procedure FindCollectionContext(Params: TFindDeclarationParams;
IdentStartPos: integer; CursorNode: TCodeTreeNode;
out GatherContext: TFindContext; out ContextExprStartPos: LongInt;
out StartInSubContext: Boolean);
function CollectAllContexts(Params: TFindDeclarationParams;
const FoundContext: TFindContext): TIdentifierFoundResult;
procedure AddCollectionContext(Tool: TFindDeclarationTool;
Node: TCodeTreeNode);
public
function GatherIdentifiers(const CursorPos: TCodeXYPosition;
var IdentifierList: TIdentifierList;
BeautifyCodeOptions: TBeautifyCodeOptions): boolean;
function FindCodeContext(const CursorPos: TCodeXYPosition;
out CodeContexts: TCodeContextInfo): boolean;
end;
const
@ -1087,10 +1129,50 @@ begin
end;
end;
function TIdentCompletionTool.GatherIdentifiers(
const CursorPos: TCodeXYPosition; var IdentifierList: TIdentifierList;
BeautifyCodeOptions: TBeautifyCodeOptions): boolean;
procedure TIdentCompletionTool.InitCollectIdentifiers(
const CursorPos: TCodeXYPosition; var IdentifierList: TIdentifierList);
begin
if IdentifierList=nil then IdentifierList:=TIdentifierList.Create;
CurrentIdentifierList:=IdentifierList;
CurrentIdentifierList.Clear;
LastGatheredIdentParent:=nil;
LastGatheredIdentLevel:=0;
CurrentIdentifierList.StartContextPos:=CursorPos;
CurrentIdentifierList.StartContext.Tool:=Self;
end;
procedure TIdentCompletionTool.ParseSourceTillCollectionStart(
const CursorPos: TCodeXYPosition; out CleanCursorPos: integer;
out CursorNode: TCodeTreeNode; out IdentStartPos, IdentEndPos: integer);
begin
CleanCursorPos:=0;
CursorNode:=nil;
IdentStartPos:=0;
IdentEndPos:=0;
// build code tree
{$IFDEF CTDEBUG}
DebugLn('TIdentCompletionTool.GatherIdentifiers A CursorPos=',dbgs(CursorPos.X),',',dbgs(CursorPos.Y));
{$ENDIF}
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
[{$IFNDEF DisableIgnoreErrorAfter}btSetIgnoreErrorPos{$ENDIF}]);
// find node at position
CursorNode:=FindDeepestExpandedNodeAtPos(CleanCursorPos,true);
if CurrentIdentifierList<>nil then
CurrentIdentifierList.StartContext.Node:=CursorNode;
// get identifier position
GetIdentStartEndAtPosition(Src,CleanCursorPos,IdentStartPos,IdentEndPos);
end;
procedure TIdentCompletionTool.FindCollectionContext(
Params: TFindDeclarationParams; IdentStartPos: integer;
CursorNode: TCodeTreeNode;
out GatherContext: TFindContext;
out ContextExprStartPos: LongInt;
out StartInSubContext: Boolean);
function GetContextExprStartPos(IdentStartPos: integer;
ContextNode: TCodeTreeNode): integer;
begin
@ -1109,45 +1191,83 @@ function TIdentCompletionTool.GatherIdentifiers(
Result:=IdentStartPos;
end;
end;
var
ExprType: TExpressionType;
begin
GatherContext:=CreateFindContext(Self,CursorNode);
ContextExprStartPos:=GetContextExprStartPos(IdentStartPos,CursorNode);
if GatherContext.Node.Desc=ctnWithVariable then
GatherContext.Node:=GatherContext.Node.Parent;
StartInSubContext:=false;
if ContextExprStartPos<IdentStartPos then begin
MoveCursorToCleanPos(IdentStartPos);
Params.ContextNode:=CursorNode;
Params.SetIdentifier(Self,nil,nil);
Params.Flags:=[fdfExceptionOnNotFound,
fdfSearchInParentNodes,fdfSearchInAncestors];
ExprType:=FindExpressionTypeOfVariable(ContextExprStartPos,IdentStartPos,
Params);
if (ExprType.Desc=xtContext) then begin
GatherContext:=ExprType.Context;
StartInSubContext:=true;
end;
end;
end;
function TIdentCompletionTool.CollectAllContexts(
Params: TFindDeclarationParams; const FoundContext: TFindContext
): TIdentifierFoundResult;
begin
Result:=ifrProceedSearch;
if FoundContext.Node=nil then exit;
case FoundContext.Node.Desc of
ctnProcedure:
begin
if (CurrentContexts.ProcName='') then exit;
FoundContext.Tool.MoveCursorToProcName(FoundContext.Node,true);
if not FoundContext.Tool.CompareSrcIdentifier(
FoundContext.Tool.CurPos.StartPos,
CurrentContexts.ProcName) then exit;
end;
else
exit;
end;
AddCollectionContext(FoundContext.Tool,FoundContext.Node);
end;
procedure TIdentCompletionTool.AddCollectionContext(Tool: TFindDeclarationTool;
Node: TCodeTreeNode);
begin
if CurrentContexts=nil then
CurrentContexts:=TCodeContextInfo.Create;
CurrentContexts.Add(CreateExpressionType(xtContext,xtNone,
CreateFindContext(Tool,Node)));
//DebugLn('TIdentCompletionTool.AddCollectionContext ',Node.DescAsString,' ',ExtractNode(Node,[]));
end;
function TIdentCompletionTool.GatherIdentifiers(
const CursorPos: TCodeXYPosition; var IdentifierList: TIdentifierList;
BeautifyCodeOptions: TBeautifyCodeOptions): boolean;
var
CleanCursorPos, IdentStartPos, IdentEndPos: integer;
CursorNode: TCodeTreeNode;
Params: TFindDeclarationParams;
GatherContext: TFindContext;
ExprType: TExpressionType;
ContextExprStartPos: Integer;
StartInSubContext: Boolean;
StartPosOfVariable: LongInt;
begin
Result:=false;
if IdentifierList=nil then IdentifierList:=TIdentifierList.Create;
CurrentIdentifierList:=IdentifierList;
CurrentIdentifierList.Clear;
LastGatheredIdentParent:=nil;
LastGatheredIdentLevel:=0;
CurrentIdentifierList.StartContextPos:=CursorPos;
CurrentIdentifierList.StartContext.Tool:=Self;
ActivateGlobalWriteLock;
Params:=TFindDeclarationParams.Create;
try
// build code tree
{$IFDEF CTDEBUG}
DebugLn('TIdentCompletionTool.GatherIdentifiers A CursorPos=',dbgs(CursorPos.X),',',dbgs(CursorPos.Y));
{$ENDIF}
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
[{$IFNDEF DisableIgnoreErrorAfter}btSetIgnoreErrorPos{$ENDIF}]);
// find node at position
CursorNode:=FindDeepestExpandedNodeAtPos(CleanCursorPos,true);
CurrentIdentifierList.StartContext.Node:=CursorNode;
// find class and ancestors if existing (needed for protected identifiers)
FindContextClassAndAncestors(CursorPos,ClassAndAncestors);
// get identifier position
GetIdentStartEndAtPosition(Src,CleanCursorPos,IdentStartPos,IdentEndPos);
InitCollectIdentifiers(CursorPos,IdentifierList);
ParseSourceTillCollectionStart(CursorPos,CleanCursorPos,CursorNode,
IdentStartPos,IdentEndPos);
// find context
{$IFDEF CTDEBUG}
@ -1162,30 +1282,11 @@ begin
end else if CursorNode.Desc in AllSourceTypes then begin
GatherSourceNames(GatherContext);
end else begin
ContextExprStartPos:=GetContextExprStartPos(IdentStartPos,CursorNode);
if GatherContext.Node.Desc=ctnWithVariable then
GatherContext.Node:=GatherContext.Node.Parent;
// find class and ancestors if existing (needed for protected identifiers)
FindContextClassAndAncestors(CursorPos,ClassAndAncestors);
{$IFDEF CTDEBUG}
DebugLn('TIdentCompletionTool.GatherIdentifiers C',
' ContextExprStartPos=',dbgs(ContextExprStartPos),
' Expr=',StringToPascalConst(copy(Src,ContextExprStartPos,
IdentStartPos-ContextExprStartPos)));
{$ENDIF}
StartInSubContext:=false;
if ContextExprStartPos<IdentStartPos then begin
MoveCursorToCleanPos(IdentStartPos);
Params.ContextNode:=CursorNode;
Params.SetIdentifier(Self,nil,nil);
Params.Flags:=[fdfExceptionOnNotFound,
fdfSearchInParentNodes,fdfSearchInAncestors];
ExprType:=FindExpressionTypeOfVariable(ContextExprStartPos,IdentStartPos,
Params);
if (ExprType.Desc=xtContext) then begin
GatherContext:=ExprType.Context;
StartInSubContext:=true;
end;
end;
FindCollectionContext(Params,IdentStartPos,CursorNode,
GatherContext,ContextExprStartPos,StartInSubContext);
// search and gather identifiers in context
if (GatherContext.Tool<>nil) and (GatherContext.Node<>nil) then begin
@ -1283,12 +1384,120 @@ begin
Params.Free;
ClearIgnoreErrorAfter;
DeactivateGlobalWriteLock;
CurrentIdentifierList:=nil;
end;
{$IFDEF CTDEBUG}
DebugLn('TIdentCompletionTool.GatherIdentifiers END');
{$ENDIF}
end;
function TIdentCompletionTool.FindCodeContext(const CursorPos: TCodeXYPosition;
out CodeContexts: TCodeContextInfo): boolean;
var
CleanCursorPos: integer;
CursorNode: TCodeTreeNode;
Params: TFindDeclarationParams;
function CheckContextIsParameter(var Ok: boolean): boolean;
// returns true, on error or context is parameter
// returns false, if no error and context is not parameter
var
VarNameAtom, ProcNameAtom: TAtomPosition;
ParameterIndex: integer;
GatherContext: TFindContext;
ContextExprStartPos: LongInt;
StartInSubContext: Boolean;
begin
Result:=false;
if (CursorNode.Desc<>ctnBeginBlock)
and (not CursorNode.HasParentOfType(ctnBeginBlock)) then exit;
//DebugLn('CheckContextIsParameter ');
if not CheckParameterSyntax(CursorNode, CleanCursorPos,
VarNameAtom, ProcNameAtom, ParameterIndex) then exit;
if VarNameAtom.StartPos<1 then exit;
//DebugLn('CheckContextIsParameter Variable=',GetAtom(VarNameAtom),' Proc=',GetAtom(ProcNameAtom),' ParameterIndex=',dbgs(ParameterIndex));
// it is a parameter -> save ParameterIndex
Result:=true;
if CurrentContexts=nil then
CurrentContexts:=TCodeContextInfo.Create;
CurrentContexts.ParameterIndex:=ParameterIndex+1;
CurrentContexts.ProcName:=GetAtom(ProcNameAtom);
MoveCursorToAtomPos(ProcNameAtom);
ReadNextAtom; // read opening bracket
CurrentContexts.StartPos:=CurPos.EndPos;
// read closing bracket
if ReadTilBracketClose(false) then
CurrentContexts.EndPos:=CurPos.StartPos
else
CurrentContexts.EndPos:=SrcLen+1;
FindCollectionContext(Params,ProcNameAtom.StartPos,CursorNode,
GatherContext,ContextExprStartPos,StartInSubContext);
// gather declarations of parameter lists
Params.ContextNode:=GatherContext.Node;
Params.SetIdentifier(Self,@Src[ProcNameAtom.StartPos],@CollectAllContexts);
Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable];
if not StartInSubContext then
Include(Params.Flags,fdfSearchInParentNodes);
if Params.ContextNode.Desc in [ctnClass,ctnClassInterface] then
Exclude(Params.Flags,fdfSearchInParentNodes);
CurrentIdentifierList.Context:=GatherContext;
//DebugLn('CheckContextIsParameter searching procedure ...');
GatherContext.Tool.FindIdentifierInContext(Params);
//DebugLn('CheckContextIsParameter END');
Ok:=true;
end;
var
IdentifierList: TIdentifierList;
IdentStartPos, IdentEndPos: integer;
begin
CodeContexts:=nil;
Result:=false;
IdentifierList:=nil;
CurrentContexts:=CodeContexts;
ActivateGlobalWriteLock;
Params:=TFindDeclarationParams.Create;
try
InitCollectIdentifiers(CursorPos,IdentifierList);
ParseSourceTillCollectionStart(CursorPos,CleanCursorPos,CursorNode,
IdentStartPos,IdentEndPos);
// find class and ancestors if existing (needed for protected identifiers)
FindContextClassAndAncestors(CursorPos,ClassAndAncestors);
if CursorNode<>nil then begin
if CheckContextIsParameter(Result) then exit;
end;
if CodeContexts=nil then begin
// create default
AddCollectionContext(Self,CursorNode);
end;
Result:=true;
finally
if Result then begin
CodeContexts:=CurrentContexts;
CurrentContexts:=nil;
end else begin
FreeAndNil(CurrentContexts);
end;
FreeListOfPFindContext(ClassAndAncestors);
FreeAndNil(FoundPublicProperties);
Params.Free;
ClearIgnoreErrorAfter;
DeactivateGlobalWriteLock;
FreeAndNil(CurrentIdentifierList);
end;
Result:=false;
end;
{ TIdentifierListItem }
function TIdentifierListItem.GetParamList: string;
@ -1553,6 +1762,43 @@ begin
Result:=FItems.Count;
end;
{ TCodeContextInfo }
function TCodeContextInfo.GetItems(Index: integer): TExpressionType;
begin
Result:=FItems[Index];
end;
constructor TCodeContextInfo.Create;
begin
end;
destructor TCodeContextInfo.Destroy;
begin
Clear;
inherited Destroy;
end;
function TCodeContextInfo.Count: integer;
begin
Result:=FCount;
end;
function TCodeContextInfo.Add(const Context: TExpressionType): integer;
begin
inc(FCount);
Result:=Count;
ReAllocMem(FItems,SizeOf(TExpressionType)*FCount);
FItems[FCount-1]:=Context;
end;
procedure TCodeContextInfo.Clear;
begin
FCount:=0;
ReAllocMem(FItems,0);
end;
initialization
IdentifierListItemMemManager:=TIdentifierListItemMemManager.Create;