codetools: find overloads: add parent-child edges

git-svn-id: trunk@19752 -

components/codetools/codetoolmanager.pas

@@ -2133,6 +2133,7 @@ begin
   if not InitCurCodeTool(Code) then exit;
   try
     Graph:=TDeclarationOverloadsGraph.Create;
+    Graph.OnGetCodeToolForBuffer:=@OnGetCodeToolForBuffer;
     Result:=Graph.Init(NewCode,NewX,NewY);
   except
     on e: Exception do Result:=HandleException(e);
@@ -4886,9 +4887,10 @@ function TCodeToolManager.OnGetCodeToolForBuffer(Sender: TObject;
   Code: TCodeBuffer; GoToMainCode: boolean): TFindDeclarationTool;
 begin
   {$IFDEF CTDEBUG}
-  DebugLn('[TCodeToolManager.OnGetCodeToolForBuffer]'
+  DbgOut('[TCodeToolManager.OnGetCodeToolForBuffer]');
-    ,' Sender=',TCustomCodeTool(Sender).MainFilename
+  if Sender is TCustomCodeTool then
-    ,' Code=',Code.Filename);
+    DbgOut(' Sender=',TCustomCodeTool(Sender).MainFilename);
+  debugln(' Code=',Code.Filename);
   {$ENDIF}
   Result:=TFindDeclarationTool(GetCodeToolForSource(Code,GoToMainCode,true));
 end;

components/codetools/codetree.pas

@@ -142,9 +142,12 @@ const
 
 
   // combined values
-  AllCodeSections =
+  AllSourceTypes =
-     [ctnProgram, ctnPackage, ctnLibrary, ctnUnit, ctnInterface,
+     [ctnProgram,ctnPackage,ctnLibrary,ctnUnit];
-      ctnImplementation, ctnInitialization, ctnFinalization];
+  AllUsableSourceTypes =
+     [ctnUnit];
+  AllCodeSections = AllSourceTypes
+     + [ctnInterface, ctnImplementation, ctnInitialization, ctnFinalization];
   AllClassBaseSections =
      [ctnClassPublic,ctnClassPublished,ctnClassPrivate,ctnClassProtected];
   AllClassTypeSections =
@@ -173,10 +176,6 @@ const
       ctnClassOfType,ctnVariantType,ctnConstant];
   AllPascalStatements = [ctnBeginBlock,ctnWithStatement,ctnWithVariable,
                          ctnOnBlock,ctnOnIdentifier,ctnOnStatement];
-  AllSourceTypes =
-     [ctnProgram,ctnPackage,ctnLibrary,ctnUnit];
-  AllUsableSourceTypes =
-     [ctnUnit];
   AllFindContextDescs = AllIdentifierDefinitions + AllCodeSections +
      [ctnClass,ctnClassInterface,ctnProcedure];
 

components/codetools/findoverloads.pas

@@ -30,19 +30,22 @@ unit FindOverloads;
 interface
 
 uses
-  Classes, SysUtils, CodeGraph, CodeCache;
+  Classes, SysUtils, FileProcs, CodeAtom, CodeTree, CodeGraph, CodeCache,
+  FindDeclarationTool;
 
 type
   TOverloadsGraphNode = class(TCodeGraphNode)
   public
     Identifier: string;
+    Tool: TFindDeclarationTool;
   end;
 
   TOverloadsGraphEdgeType = (
-    ogetParent,
+    ogetParentChild,
-    ogetAncestor,
+    ogetAncestorInherited,
-    ogetInterface
+    ogetInterfaceInherited
     );
+  TOverloadsGraphEdgeTypes = set of TOverloadsGraphEdgeType;
 
   TOverloadsGraphEdge = class(TCodeGraphEdge)
   public
@@ -55,9 +58,14 @@ type
   private
     FGraph: TCodeGraph;
     FIdentifier: string;
+    FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
     FStartCode: TCodeBuffer;
     FStartX: integer;
     FStartY: integer;
+    function AddContext(Tool: TFindDeclarationTool;
+                        CodeNode: TCodeTreeNode): TOverloadsGraphNode;
+    function AddEdge(Typ: TOverloadsGraphEdgeType;
+                     FromNode, ToNode: TCodeTreeNode): TOverloadsGraphEdge;
   public
     constructor Create;
     destructor Destroy; override;
@@ -68,12 +76,75 @@ type
     property StartCode: TCodeBuffer read FStartCode;
     property StartX: integer read FStartX;
     property StartY: integer read FStartY;
+    property OnGetCodeToolForBuffer: TOnGetCodeToolForBuffer
+                     read FOnGetCodeToolForBuffer write FOnGetCodeToolForBuffer;
   end;
 
+const
+  OverloadsGraphEdgeTypeNames: array[TOverloadsGraphEdgeType] of string = (
+    'Parent-Child',
+    'Ancestor-Inherited',
+    'Interface-Inherited'
+    );
+
 implementation
 
 { TDeclarationOverloadsGraph }
 
+function TDeclarationOverloadsGraph.AddContext(Tool: TFindDeclarationTool;
+  CodeNode: TCodeTreeNode): TOverloadsGraphNode;
+var
+  ParentCodeNode: TCodeTreeNode;
+  ParentGraphNode: TOverloadsGraphNode;
+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)),'"']);
+  Result:=TOverloadsGraphNode(Graph.GetGraphNode(CodeNode,true));
+  Result.Tool:=Tool;
+
+  // add parent nodes to graph
+  ParentCodeNode:=CodeNode.Parent;
+  while ParentCodeNode<>nil do begin
+    DebugLn(['TDeclarationOverloadsGraph.AddContext ',ParentCodeNode.DescAsString]);
+    if ParentCodeNode.Desc in
+      AllSourceTypes+[ctnClass,ctnClassInterface,ctnRecordType]
+    then begin
+      DebugLn(['TDeclarationOverloadsGraph.AddContext ADD parent']);
+      ParentGraphNode:=AddContext(Tool,ParentCodeNode);
+      AddEdge(ogetParentChild,ParentGraphNode.Node,Result.Node);
+      break;
+    end;
+    if ParentCodeNode.Parent<>nil then
+      ParentCodeNode:=ParentCodeNode.Parent
+    else
+      ParentCodeNode:=ParentCodeNode.PriorBrother;
+  end;
+
+  // ToDo: add ancestors, interfaces
+
+
+  // ToDo: add alias
+
+
+end;
+
+function TDeclarationOverloadsGraph.AddEdge(Typ: TOverloadsGraphEdgeType;
+  FromNode, ToNode: TCodeTreeNode): TOverloadsGraphEdge;
+begin
+  Result:=TOverloadsGraphEdge(Graph.GetEdge(FromNode,ToNode,false));
+  if (Result<>nil) then begin
+    if Result.Typ<>Typ then
+      RaiseCatchableException('TDeclarationOverloadsGraph.AddEdge Typ conflict');
+    exit;
+  end;
+  // create new edge
+  Result:=TOverloadsGraphEdge(Graph.GetEdge(FromNode,ToNode,true));
+  Result.Typ:=Typ;
+  DebugLn(['TDeclarationOverloadsGraph.AddEdge ',OverloadsGraphEdgeTypeNames[Typ]]);
+end;
+
 constructor TDeclarationOverloadsGraph.Create;
 begin
   FGraph:=TCodeGraph.Create(TOverloadsGraphNode,TOverloadsGraphEdge);
@@ -93,13 +164,24 @@ end;
 
 function TDeclarationOverloadsGraph.Init(Code: TCodeBuffer; X, Y: integer
   ): Boolean;
+var
+  Tool: TFindDeclarationTool;
+  CleanPos: integer;
+  CodeNode: TCodeTreeNode;
 begin
   Result:=false;
   FStartCode:=Code;
   FStartX:=X;
   FStartY:=Y;
 
-
+  Tool:=OnGetCodeToolForBuffer(Self,Code,true);
+  if Tool.CaretToCleanPos(CodeXYPosition(X,Y,Code),CleanPos)<>0 then begin
+    DebugLn(['TDeclarationOverloadsGraph.Init Tool.CaretToCleanPos failed']);
+    exit(false);
+  end;
+  CodeNode:=Tool.FindDeepestNodeAtPos(CleanPos,true);
+  DebugLn(['TDeclarationOverloadsGraph.Init Add start context']);
+  AddContext(Tool,CodeNode);
 
   Result:=true;
 end;

ide/findoverloadsdlg.pas

@@ -157,16 +157,18 @@ var
 begin
   Graph:=nil;
   FindOverloadsDialog:=nil;
+  CodeToolBoss.ActivateWriteLock;
   try
     if not CodeToolBoss.GatherOverloads(Code,X,Y,Graph) then begin
       LazarusIDE.DoJumpToCodeToolBossError;
       exit(mrCancel);
     end;
-    DebugLn(['ShowFindOverloadsDialog ',Graph.StartCode.Filename,' ',Graph.StartX,',',Graph.StartY]);
+    //DebugLn(['ShowFindOverloadsDialog ',Graph.StartCode.Filename,' ',Graph.StartX,',',Graph.StartY]);
     FindOverloadsDialog:=TFindOverloadsDialog.Create(nil);
     FindOverloadsDialog.Worker.Graph:=Graph;
     Result:=FindOverloadsDialog.ShowModal;
   finally
+    CodeToolBoss.DeactivateWriteLock;
     FindOverloadsDialog.Free;
     Graph.Free;
   end;