IDE: find overloads: scanning project sources

git-svn-id: trunk@19760 -

components/codetools/finddeclarationcache.pas

@@ -65,7 +65,7 @@ type
   TInterfaceIdentifierCache = class
   private
     FComplete: boolean;
-    FItems: TAVLTree; // tree of TInterfaceIdentCacheEntry
+    FItems: TAVLTree; // tree of PInterfaceIdentCacheEntry
     FTool: TPascalParserTool;
     function FindAVLNode(Identifier: PChar): TAVLTreeNode;
     procedure SetComplete(const AValue: boolean);

components/codetools/finddeclarationtool.pas

@@ -5198,37 +5198,49 @@ function TFindDeclarationTool.BuildInterfaceIdentifierCache(
     end;
   end;
 
+  procedure ScanChilds(ParentNode: TCodeTreeNode); forward;
+
+  procedure ScanNode(Node: TCodeTreeNode);
+  begin
+    case Node.Desc of
+    ctnTypeSection,ctnConstSection,ctnVarSection,ctnResStrSection:
+      ScanChilds(Node);
+    ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition:
+      begin
+        FInterfaceIdentifierCache.Add(@Src[Node.StartPos],Node,Node.StartPos);
+        ScanForEnums(Node);
+      end;
+    ctnGenericType:
+      if Node.FirstChild<>nil then begin
+        FInterfaceIdentifierCache.Add(@Src[Node.FirstChild.StartPos],Node,Node.StartPos);
+        ScanForEnums(Node);
+      end;
+    ctnProperty:
+      begin
+        MoveCursorToPropName(Node);
+        FInterfaceIdentifierCache.Add(@Src[CurPos.StartPos],Node,Node.StartPos);
+      end;
+    ctnProcedure:
+      if (Node.FirstChild<>nil) and (not NodeIsOperator(Node)) then
+        FInterfaceIdentifierCache.Add(@Src[Node.FirstChild.StartPos],Node,
+                                      Node.FirstChild.StartPos);
+    end;
+  end;
+
   procedure ScanChilds(ParentNode: TCodeTreeNode);
   var
     Node: TCodeTreeNode;
   begin
     Node:=ParentNode.FirstChild;
     while Node<>nil do begin
-      case Node.Desc of
-      ctnTypeSection,ctnConstSection,ctnVarSection,ctnResStrSection:
-        ScanChilds(Node);
-      ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition:
-        FInterfaceIdentifierCache.Add(@Src[Node.StartPos],Node,Node.StartPos);
-      ctnGenericType:
-        if Node.FirstChild<>nil then
-          FInterfaceIdentifierCache.Add(@Src[Node.FirstChild.StartPos],Node,Node.StartPos);
-      ctnProperty:
-        begin
-          MoveCursorToPropName(Node);
-          FInterfaceIdentifierCache.Add(@Src[CurPos.StartPos],Node,Node.StartPos);
-        end;
-      ctnProcedure:
-        if (Node.FirstChild<>nil) and (not NodeIsOperator(Node)) then
-          FInterfaceIdentifierCache.Add(@Src[Node.FirstChild.StartPos],Node,
-                                        Node.FirstChild.StartPos);
-      end;
-      ScanForEnums(Node);
+      ScanNode(Node);
       Node:=Node.NextBrother;
     end;
   end;
 
 var
   InterfaceNode: TCodeTreeNode;
+  Node: TCodeTreeNode;
 begin
   // build tree for pascal source
   BuildTree(true);
@@ -5243,8 +5255,7 @@ begin
       if not UpAtomIs('UNIT') then
         RaiseException(ctsSourceIsNotUnit);
       RaiseException(ctsInterfaceSectionNotFound);
-    end else
-      exit(true);
+    end;
   end;
 
   // create tree
@@ -5264,7 +5275,17 @@ begin
   FInterfaceIdentifierCache.Add(@Src[CurPos.StartPos],Tree.Root,CurPos.StartPos);
 
   // create nodes
-  ScanChilds(InterfaceNode);
+  if InterfaceNode<>nil then
+    // scan interface
+    ScanChilds(InterfaceNode)
+  else begin
+    // scan program
+    Node:=Tree.Root;
+    while Node<>nil do begin
+      ScanNode(Node);
+      Node:=Node.NextBrother;
+    end;
+  end;
 
   //DebugLn(['TFindDeclarationTool.BuildInterfaceIdentifierCache ',MainFilename,' ',FInterfaceIdentifierCache.Items.Count,' ',GlobalIdentifierTree.Count]);
   Result:=true;

components/codetools/findoverloads.pas

@@ -31,7 +31,7 @@ interface
 
 uses
   Classes, SysUtils, FileProcs, BasicCodeTools, CodeAtom, CodeTree, CodeGraph,
-  CodeCache, FindDeclarationTool;
+  CodeCache, FindDeclarationTool, AVL_Tree, FindDeclarationCache, StdCodeTools;
 
 type
 
@@ -78,6 +78,8 @@ type
     destructor Destroy; override;
     procedure Clear;
     function Init(Code: TCodeBuffer; X,Y: integer): Boolean;
+    procedure ScanToolForIdentifier(Tool: TStandardCodeTool;
+                                    OnlyInterface: boolean);
     property Identifier: string read FIdentifier;
     property Graph: TCodeGraph read FGraph;
     property StartCode: TCodeBuffer read FStartCode;
@@ -115,7 +117,7 @@ begin
   Result:=TOverloadsGraphNode(Graph.GetGraphNode(CodeNode,false));
   if Result<>nil then exit;
   // add new node
-  DebugLn(['TDeclarationOverloadsGraph.AddContext ',Tool.MainFilename,' ',CodeNode.DescAsString,' "',dbgstr(copy(Tool.Src,CodeNode.StartPos,20)),'"']);
+  //DebugLn(['TDeclarationOverloadsGraph.AddContext ',Tool.MainFilename,' ',CodeNode.DescAsString,' "',dbgstr(copy(Tool.Src,CodeNode.StartPos,20)),'"']);
   Result:=TOverloadsGraphNode(Graph.GetGraphNode(CodeNode,true));
   Result.Tool:=Tool;
   if CodeNode.Desc in AllIdentifierDefinitions then
@@ -180,7 +182,7 @@ begin
   if (CodeNode.Desc=ctnTypeDefinition)
   and (CodeNode.FirstChild<>nil)
   and (CodeNode.FirstChild.Desc=ctnIdentifier) then begin
-    DebugLn(['TDeclarationOverloadsGraph.AddContext alias']);
+    //DebugLn(['TDeclarationOverloadsGraph.AddContext alias']);
     Params:=TFindDeclarationParams.Create;
     try
       try
@@ -215,7 +217,7 @@ begin
   // create new edge
   Result:=TOverloadsGraphEdge(Graph.GetEdge(FromNode,ToNode,true));
   Result.Typ:=Typ;
-  DebugLn(['TDeclarationOverloadsGraph.AddEdge ',Result.AsDebugString]);
+  //DebugLn(['TDeclarationOverloadsGraph.AddEdge ',Result.AsDebugString]);
 end;
 
 constructor TDeclarationOverloadsGraph.Create;
@@ -253,12 +255,75 @@ begin
     exit(false);
   end;
   CodeNode:=Tool.FindDeepestNodeAtPos(CleanPos,true);
-  DebugLn(['TDeclarationOverloadsGraph.Init Add start context']);
+  //DebugLn(['TDeclarationOverloadsGraph.Init Add start context']);
   AddContext(Tool,CodeNode);
 
+  fIdentifier:='';
+  if CodeNode.Desc in AllIdentifierDefinitions+[ctnEnumIdentifier] then
+    fIdentifier:=GetIdentifier(@Tool.Src[CodeNode.StartPos]);
+
   Result:=true;
 end;
 
+procedure TDeclarationOverloadsGraph.ScanToolForIdentifier(
+  Tool: TStandardCodeTool; OnlyInterface: boolean);
+var
+  Entry: PInterfaceIdentCacheEntry;
+  Node: TCodeTreeNode;
+begin
+  if Identifier='' then exit;
+  if OnlyInterface then begin
+    // use interface cache
+    try
+      Tool.BuildInterfaceIdentifierCache(false);
+    except
+    end;
+    if Tool.InterfaceIdentifierCache<>nil then begin
+      Entry:=Tool.InterfaceIdentifierCache.FindIdentifier(PChar(Identifier));
+      while Entry<>nil do begin
+        if CompareIdentifiers(Entry^.Identifier,PChar(Identifier))=0 then
+          AddContext(Tool,Entry^.Node);
+        Entry:=Entry^.NextEntry;
+      end;
+    end;
+  end else begin
+    // scan whole unit/program
+    try
+      Tool.Explore(false);
+    except
+    end;
+    if Tool.Tree=nil then exit;
+    Node:=Tool.Tree.Root;
+    while Node<>nil do begin
+      case Node.Desc of
+
+      ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition,ctnGenericType,
+      ctnEnumIdentifier:
+        if CompareIdentifiers(@Tool.Src[Node.StartPos],PChar(Identifier))=0
+        then
+          AddContext(Tool,Node);
+
+      ctnProcedure:
+        begin
+          Tool.MoveCursorToProcName(Node,true);
+          if CompareIdentifiers(@Tool.Src[Tool.CurPos.StartPos],PChar(Identifier))=0
+          then
+            AddContext(Tool,Node);
+        end;
+
+      ctnProperty:
+        begin
+          Tool.MoveCursorToPropName(Node);
+          if CompareIdentifiers(@Tool.Src[Tool.CurPos.StartPos],PChar(Identifier))=0
+          then
+            AddContext(Tool,Node);
+        end;
+      end;
+      Node:=Node.Next;
+    end;
+  end;
+end;
+
 { TOverloadsGraphNode }
 
 function TOverloadsGraphNode.AsDebugString: string;

ide/findoverloadsdlg.pas

@@ -45,6 +45,7 @@ type
   private
     FCode: TCodeBuffer;
     FFilename: string;
+    FOnlyInterface: boolean;
     FScanned: boolean;
     procedure SetCode(const AValue: TCodeBuffer);
     procedure SetScanned(const AValue: boolean);
@@ -52,6 +53,7 @@ type
     constructor Create(const TheFilename: string);
     destructor Destroy; override;
     property Filename: string read FFilename;
+    property OnlyInterface: boolean read FOnlyInterface write FOnlyInterface;
     property Scanned: boolean read FScanned write SetScanned;
     property Code: TCodeBuffer read FCode write SetCode;
   end;
@@ -82,7 +84,9 @@ type
     procedure CollectOtherSourceFiles;
     procedure ScanSomeFiles;
     procedure ScanFile(AFile: TFOWFile);
+    procedure CollectStartSource;
   public
+    StartSourceScanned: boolean;
     Scopes: TFindOverloadsScopes;
     CompletedScopes: TFindOverloadsScopes;
     Graph: TDeclarationOverloadsGraph;
@@ -272,6 +276,7 @@ end;
 constructor TFOWFile.Create(const TheFilename: string);
 begin
   FFilename:=TheFilename;
+  FOnlyInterface:=true;
 end;
 
 destructor TFOWFile.Destroy;
@@ -327,13 +332,62 @@ begin
 end;
 
 procedure TFindOverloadsWorker.ScanFile(AFile: TFOWFile);
+var
+  Tool: TCodeTool;
+  Filename: String;
+  MainFile: TFOWFile;
+  Code: TCodeBuffer;
 begin
   FScanFiles.Remove(AFile);
   if AFile.Scanned then exit;
   AFile.Scanned:=true;
-  DebugLn(['TFindOverloadsWorker.ScanFile ',AFile.Filename]);
-
+  //DebugLn(['TFindOverloadsWorker.ScanFile File=',AFile.Filename]);
+  // get codetool
+  Filename:=TrimFilename(AFile.Filename);
+  Code:=CodeToolBoss.LoadFile(Filename,true,false);
+  if Code=nil then begin
+    DebugLn(['TFindOverloadsWorker.ScanFile file not readable: ',Filename]);
+    exit;
+  end;
+  Tool:=TCodeTool(CodeToolBoss.GetCodeToolForSource(Code,true,false));
+  if Tool=nil then begin
+    DebugLn(['TFindOverloadsWorker.ScanFile file not in a unit: ',Filename]);
+    exit;
+  end;
+  // check if AFile is an include file
+  Filename:=Tool.MainFilename;
+  MainFile:=FindFile(Filename);
+  // get unit
+  if MainFile=nil then begin
+    MainFile:=TFOWFile.Create(Filename);
+    FFiles.Add(MainFile);
+  end;
+  if (MainFile<>AFile) and MainFile.Scanned then begin
+    //DebugLn(['TFindOverloadsWorker.ScanFile already scanned: ',Filename]);
+    exit;
+  end;
+  // scan unit
+  FScanFiles.Remove(MainFile);
+  MainFile.Scanned:=true;
+  if not AFile.OnlyInterface then
+    MainFile.OnlyInterface:=false;
+  //DebugLn(['TFindOverloadsWorker.ScanFile scanning: ',Tool.MainFilename]);
+  Graph.ScanToolForIdentifier(Tool,MainFile.OnlyInterface);
+end;
 
+procedure TFindOverloadsWorker.CollectStartSource;
+var
+  Filename: String;
+  aFile: TFOWFile;
+begin
+  Filename:=Graph.StartCode.Filename;
+  aFile:=FindFile(Filename);
+  if aFile=nil then begin
+    aFile:=TFOWFile.Create(Filename);
+    aFile.OnlyInterface:=false;
+    FFiles.Add(aFile);
+    FScanFiles.Add(aFile);
+  end;
 end;
 
 function TFindOverloadsWorker.AddFileToScan(const Filename: string;
@@ -382,6 +436,7 @@ begin
   FStageTitle:='Finished';
   FStagePosition:=0;
   FStagePosMax:=100;
+  StartSourceScanned:=false;
 end;
 
 procedure TFindOverloadsWorker.Work;
@@ -391,25 +446,32 @@ begin
     // scan files
     ScanSomeFiles;
   end
+  else if not StartSourceScanned then
+  begin
+    StageTitle:='Scanning start source ...';
+    StagePosition:=10;
+    StartSourceScanned:=true;
+    CollectStartSource;
+  end
   else if (fosProject in Scopes) and not (fosProject in CompletedScopes) then
   begin
     // collect project files
     StageTitle:='Scanning project ...';
-    StagePosition:=1;
+    StagePosition:=20;
     CollectProjectFiles;
   end
   else if (fosPackages in Scopes) and not (fosPackages in CompletedScopes) then
   begin
     // collect package files
     StageTitle:='Scanning packages ...';
-    StagePosition:=10;
+    StagePosition:=40;
     CollectPackageFiles;
   end
   else if (fosOtherSources in Scopes) and not (fosOtherSources in CompletedScopes)
   then begin
     // collect other sources
     StageTitle:='Scanning other sources ...';
-    StagePosition:=30;
+    StagePosition:=60;
     CollectOtherSourceFiles;
   end else begin
     StageTitle:='Finished';