codetools: implemented FindCodeContext for procedures

git-svn-id: trunk@9296 -

.gitattributes

@@ -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

components/codetools/codecompletiontool.pas

@@ -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');

components/codetools/examples/getcontext.lpi

@@ -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>

components/codetools/examples/getcontext.lpr

@@ -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.
+

components/codetools/examples/scanexamples/getcontextexample.pas

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

components/codetools/extractproctool.pas

@@ -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}

components/codetools/finddeclarationtool.pas

@@ -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.
 

components/codetools/identcompletiontool.pas

@@ -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,9 +1129,49 @@ begin
   end;
 end;
 
-function TIdentCompletionTool.GatherIdentifiers(
+procedure TIdentCompletionTool.InitCollectIdentifiers(
-  const CursorPos: TCodeXYPosition; var IdentifierList: TIdentifierList;
+  const CursorPos: TCodeXYPosition; var IdentifierList: TIdentifierList);
-  BeautifyCodeOptions: TBeautifyCodeOptions): boolean;
+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;
@@ -1111,67 +1193,14 @@ function TIdentCompletionTool.GatherIdentifiers(
   end;
 
 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);
-    
-    // find context
-    {$IFDEF CTDEBUG}
-    DebugLn('TIdentCompletionTool.GatherIdentifiers B',
-      ' CleanCursorPos=',dbgs(CleanCursorPos),
-      ' IdentStartPos=',dbgs(IdentStartPos),' IdentEndPos=',dbgs(IdentEndPos),
-      ' Ident=',copy(Src,IdentStartPos,IdentEndPos-IdentStartPos));
-    {$ENDIF}
   GatherContext:=CreateFindContext(Self,CursorNode);
-    if CursorNode.Desc=ctnUsesSection then begin
+
-      GatherUnitNames(IdentStartPos,GatherContext,BeautifyCodeOptions);
-    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;
 
-      {$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);
@@ -1186,6 +1215,78 @@ begin
       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;
+  ContextExprStartPos: Integer;
+  StartInSubContext: Boolean;
+  StartPosOfVariable: LongInt;
+begin
+  Result:=false;
+
+  ActivateGlobalWriteLock;
+  Params:=TFindDeclarationParams.Create;
+  try
+    InitCollectIdentifiers(CursorPos,IdentifierList);
+    ParseSourceTillCollectionStart(CursorPos,CleanCursorPos,CursorNode,
+                                   IdentStartPos,IdentEndPos);
+    
+    // find context
+    {$IFDEF CTDEBUG}
+    DebugLn('TIdentCompletionTool.GatherIdentifiers B',
+      ' CleanCursorPos=',dbgs(CleanCursorPos),
+      ' IdentStartPos=',dbgs(IdentStartPos),' IdentEndPos=',dbgs(IdentEndPos),
+      ' Ident=',copy(Src,IdentStartPos,IdentEndPos-IdentStartPos));
+    {$ENDIF}
+    GatherContext:=CreateFindContext(Self,CursorNode);
+    if CursorNode.Desc=ctnUsesSection then begin
+      GatherUnitNames(IdentStartPos,GatherContext,BeautifyCodeOptions);
+    end else if CursorNode.Desc in AllSourceTypes then begin
+      GatherSourceNames(GatherContext);
+    end else begin
+      // find class and ancestors if existing (needed for protected identifiers)
+      FindContextClassAndAncestors(CursorPos,ClassAndAncestors);
+
+      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;