diff --git a/.gitattributes b/.gitattributes
index a1435ced3e..00dc57e2d2 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -740,6 +740,8 @@ components/codetools/examples/finddeclaration.lpi svneol=native#text/plain
components/codetools/examples/finddeclaration.lpr svneol=native#text/plain
components/codetools/examples/findunusedunits.lpi svneol=native#text/plain
components/codetools/examples/findunusedunits.lpr svneol=native#text/pascal
+components/codetools/examples/findusedunitreferences.lpi svneol=native#text/plain
+components/codetools/examples/findusedunitreferences.lpr svneol=native#text/plain
components/codetools/examples/fixdefinitionorder.lpi svneol=native#text/plain
components/codetools/examples/fixdefinitionorder.lpr svneol=native#text/plain
components/codetools/examples/fixfilenames.lpi svneol=native#text/plain
@@ -812,6 +814,7 @@ components/codetools/examples/scanexamples/test.h svneol=native#text/plain
components/codetools/examples/scanexamples/tgeneric2.pas svneol=native#text/plain
components/codetools/examples/scanexamples/uglyifdefs.pas svneol=native#text/plain
components/codetools/examples/scanexamples/unusedunits1.pas svneol=native#text/pascal
+components/codetools/examples/scanexamples/usedunitrefs1.pas svneol=native#text/plain
components/codetools/examples/scanexamples/wrongforwarddefinitions.pas svneol=native#text/plain
components/codetools/examples/setincludepath.lpi svneol=native#text/plain
components/codetools/examples/setincludepath.pas svneol=native#text/plain
diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas
index b589dc78a0..f8b82108d7 100644
--- a/components/codetools/codetoolmanager.pas
+++ b/components/codetools/codetoolmanager.pas
@@ -474,7 +474,7 @@ type
function GatherOverloads(Code: TCodeBuffer; X,Y: integer;
out Graph: TDeclarationOverloadsGraph): boolean;
- // rename, remove identifier
+ // find references, rename identifier, remove identifier
function FindReferences(IdentifierCode: TCodeBuffer;
X, Y: integer; SearchInCode: TCodeBuffer; SkipComments: boolean;
var ListOfPCodeXYPosition: TFPList;
@@ -482,6 +482,8 @@ type
): boolean;
function FindUnitReferences(UnitCode, TargetCode: TCodeBuffer;
SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
+ function FindUsedUnitReferences(Code: TCodeBuffer; X, Y: integer;
+ SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
function RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
const OldIdentifier, NewIdentifier: string;
DeclarationCode: TCodeBuffer = nil; DeclarationCaretXY: PPoint = nil): boolean;
@@ -2530,6 +2532,7 @@ end;
function TCodeToolManager.FindUnitReferences(UnitCode, TargetCode: TCodeBuffer;
SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
+// finds unit name of UnitCode in unit of TargetCode
begin
Result:=false;
{$IFDEF CTDEBUG}
@@ -2548,6 +2551,34 @@ begin
{$ENDIF}
end;
+function TCodeToolManager.FindUsedUnitReferences(Code: TCodeBuffer; X,
+ Y: integer; SkipComments: boolean; var ListOfPCodeXYPosition: TFPList
+ ): boolean;
+// finds in unit of Code all references of the unit at the uses clause at X,Y
+var
+ CursorPos: TCodeXYPosition;
+begin
+ Result:=false;
+ {$IFDEF CTDEBUG}
+ DebugLn('TCodeToolManager.FindUsedUnitReferences A ',Code.Filename,' X=',X,' Y=',Y,' SkipComments=',SkipComments);
+ {$ENDIF}
+ ListOfPCodeXYPosition:=nil;
+ if not InitCurCodeTool(Code) then exit;
+ CursorPos.X:=X;
+ CursorPos.Y:=Y;
+ CursorPos.Code:=Code;
+ try
+ FCurCodeTool.FindUsedUnitReferences(CursorPos,SkipComments,
+ ListOfPCodeXYPosition);
+ Result:=true;
+ except
+ on e: Exception do HandleException(e);
+ end;
+ {$IFDEF CTDEBUG}
+ DebugLn('TCodeToolManager.FindUnitReferences END ');
+ {$ENDIF}
+end;
+
function TCodeToolManager.RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
const OldIdentifier, NewIdentifier: string; DeclarationCode: TCodeBuffer;
DeclarationCaretXY: PPoint): boolean;
diff --git a/components/codetools/docs/codetoolmanager.xml b/components/codetools/docs/codetoolmanager.xml
index bed8fbdf72..1b4585c74b 100644
--- a/components/codetools/docs/codetoolmanager.xml
+++ b/components/codetools/docs/codetoolmanager.xml
@@ -1,4 +1,4 @@
-
+
@@ -6,6 +6,8 @@
Returns the unit search path of the given directory separated by semicolon
The unit path is created from the define templates variable #UnitPath.
+ Searches unitname of UnitCode in unit of TargetCode
+
diff --git a/components/codetools/examples/findusedunitreferences.lpi b/components/codetools/examples/findusedunitreferences.lpi
new file mode 100644
index 0000000000..7492f10824
--- /dev/null
+++ b/components/codetools/examples/findusedunitreferences.lpi
@@ -0,0 +1,64 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/codetools/examples/findusedunitreferences.lpr b/components/codetools/examples/findusedunitreferences.lpr
new file mode 100644
index 0000000000..2bdff8ea6c
--- /dev/null
+++ b/components/codetools/examples/findusedunitreferences.lpr
@@ -0,0 +1,91 @@
+{
+ ***************************************************************************
+ * *
+ * 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 . 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:
+ Simple demonstrating, how to setup the codetools, FPC and Lazarus Source
+ directory to find what unit A uses of unit B.
+
+ Usage:
+ findusedunitreferences filename line column
+
+ Filename is a unit.
+ Line, column is a unit within a uses section.
+}
+program FindUsedUnitReferences;
+
+{$mode objfpc}{$H+}
+
+uses
+ Classes, SysUtils, CodeCache, CodeToolManager, DefineTemplates,
+ CodeToolsConfig, FileProcs, usedunitrefs1;
+
+const
+ ConfigFilename = 'codetools.config';
+var
+ Code: TCodeBuffer;
+ Filename: String;
+ ListOfPCodeXYPosition: TFPList;
+ X: Integer;
+ Y: Integer;
+begin
+ if (ParamCount>=1) and (Paramcount<3) then begin
+ writeln('Usage:');
+ writeln(' ',ParamStr(0));
+ writeln(' ',ParamStr(0),' ');
+ Halt(1);
+ end;
+
+ CodeToolBoss.SimpleInit(ConfigFilename);
+
+ // Example: find all references to unit Math
+ Filename:=ExpandFileName('scanexamples/usedunitrefs1.pas');
+ X:=23;
+ Y:=8;
+
+ if (ParamCount>=3) then begin
+ Filename:=CleanAndExpandFilename(ParamStr(1));
+ X:=StrToInt(ParamStr(2));
+ Y:=StrToInt(ParamStr(3));
+ writeln('File: ',Filename,' Line=',Y,' Column=',X);
+ end;
+
+ // Step 1: load the file
+ Code:=CodeToolBoss.LoadFile(Filename,false,false);
+ if Code=nil then
+ raise Exception.Create('loading failed '+Filename);
+
+ // Step 2: find references
+ writeln('Filename: ',Code.Filename);
+ ListOfPCodeXYPosition:=nil;
+ try
+ if CodeToolBoss.FindUsedUnitReferences(Code,X,Y,false,ListOfPCodeXYPosition) then
+ begin
+ writeln('List:');
+ writeln(ListOfPCodeXYPositionToStr(ListOfPCodeXYPosition));
+ end else begin
+ writeln('CodeToolBoss.FindUsedUnitReferences failed: ',CodeToolBoss.ErrorMessage);
+ end;
+ finally
+ FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
+ end;
+end.
+
diff --git a/components/codetools/examples/scanexamples/usedunitrefs1.pas b/components/codetools/examples/scanexamples/usedunitrefs1.pas
new file mode 100644
index 0000000000..1f6b55f85a
--- /dev/null
+++ b/components/codetools/examples/scanexamples/usedunitrefs1.pas
@@ -0,0 +1,28 @@
+unit UsedUnitRefs1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, math, process;
+
+implementation
+
+procedure DoSome;
+var
+ c: TComponent;
+ d: float;
+ i: Int64;
+begin
+ c:=TComponent.Create(nil);
+ c.Free;
+ d:=1.3;
+ i:=round(d);
+ writeln(i+abs(d));
+ writeln(sin(d));
+ writeln(MinFloatSelf then begin
- // there is an error in another unit, which prevetns searching
+ // there is an error in another unit, which prevents searching
// stop further searching in this unit
raise;
end;
@@ -5097,6 +5122,55 @@ begin
Result:=true;
end;
+procedure TFindDeclarationTool.FindUsedUnitReferences(
+ const CursorPos: TCodeXYPosition; SkipComments: boolean; out
+ ListOfPCodeXYPosition: TFPList);
+var
+ CleanPos: integer;
+ Node: TCodeTreeNode;
+ UnitInFilename: string;
+ AnUnitName: String;
+ TargetCode: TCodeBuffer;
+ TargetTool: TFindDeclarationTool;
+begin
+ //debugln(['TFindDeclarationTool.FindUsedUnitReferences ',dbgs(CursorPos)]);
+ ListOfPCodeXYPosition:=nil;
+ BuildTreeAndGetCleanPos(CursorPos,CleanPos);
+ Node:=FindDeepestNodeAtPos(CleanPos,true);
+ if Node.Desc<>ctnUseUnit then
+ RaiseException('This function needs the cursor at a unit in a uses clause');
+ // cursor is on an used unit -> try to locate it
+ MoveCursorToCleanPos(Node.StartPos);
+ ReadNextAtom;
+ AnUnitName:=ExtractUsedUnitNameAtCursor(@UnitInFilename);
+ //debugln(['TFindDeclarationTool.FindUsedUnitReferences Used Unit=',AnUnitName,' in "',UnitInFilename,'"']);
+ TargetCode:=FindUnitSource(AnUnitName,UnitInFilename,true,Node.StartPos);
+ //debugln(['TFindDeclarationTool.FindUsedUnitReferences TargetCode=',TargetCode.Filename]);
+ TargetTool:=FOnGetCodeToolForBuffer(Self,TargetCode,false);
+ FindUsedUnitReferences(TargetTool,SkipComments,ListOfPCodeXYPosition);
+end;
+
+procedure TFindDeclarationTool.FindUsedUnitReferences(
+ TargetTool: TFindDeclarationTool; SkipComments: boolean; out
+ ListOfPCodeXYPosition: TFPList);
+var
+ refs: TFindUsedUnitReferences;
+begin
+ ListOfPCodeXYPosition:=TFPList.Create;
+ if TargetTool=nil then
+ RaiseException('TargetTool=nil');
+ TargetTool.BuildInterfaceIdentifierCache(true);
+ refs:=TFindUsedUnitReferences.Create;
+ try
+ refs.TargetTool:=TargetTool;
+ refs.TargetUnitName:=TargetTool.GetSourceName(false);
+ refs.ListOfPCodeXYPosition:=ListOfPCodeXYPosition;
+ ForEachIdentifier(SkipComments,@OnFindUsedUnitIdentifier,refs);
+ finally
+ refs.Free;
+ end;
+end;
+
{-------------------------------------------------------------------------------
function TFindDeclarationTool.CleanPosIsDeclarationIdentifier(CleanPos: integer;
Node: TCodeTreeNode): boolean;
@@ -9444,6 +9518,64 @@ begin
until false;
end;
+procedure TFindDeclarationTool.OnFindUsedUnitIdentifier(
+ Sender: TPascalParserTool; IdentifierCleanPos: integer; Range: TEPRIRange;
+ Node: TCodeTreeNode; Data: Pointer; var Abort: boolean);
+var
+ Identifier: PChar;
+ CacheEntry: PInterfaceIdentCacheEntry;
+ refs: TFindUsedUnitReferences;
+ Found: Boolean;
+ ReferencePos: TCodeXYPosition;
+begin
+ if Range=epriInDirective then exit;
+ if not (Node.Desc in (AllPascalTypes+AllPascalStatements)) then exit;
+ Identifier:=@Src[IdentifierCleanPos];
+ refs:=TFindUsedUnitReferences(Data);
+ CacheEntry:=refs.TargetTool.FInterfaceIdentifierCache.FindIdentifier(Identifier);
+ //debugln(['TFindUsedUnitReferences.OnIdentifier Identifier=',GetIdentifier(Identifier),' Found=',CacheEntry<>nil]);
+ if (CacheEntry=nil)
+ and (CompareIdentifiers(Identifier,PChar(refs.TargetUnitName))<>0) then
+ exit;
+ Sender.MoveCursorToCleanPos(IdentifierCleanPos);
+ Sender.ReadPriorAtom;
+ if (Sender.CurPos.Flag=cafPoint) or (Sender.UpAtomIs('inherited')) then exit;
+ //debugln(['TFindUsedUnitReferences.OnIdentifier Identifier=',GetIdentifier(Identifier),' at begin of term']);
+ // find declaration
+ if refs.Params=nil then
+ refs.Params:=TFindDeclarationParams.Create
+ else
+ refs.Params.Clear;
+ refs.Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,
+ fdfIgnoreCurContextNode];
+ refs.Params.ContextNode:=Node;
+ //debugln(copy(Src,Params.ContextNode.StartPos,200));
+ refs.Params.SetIdentifier(Self,Identifier,@CheckSrcIdentifier);
+
+ if Range=epriInCode then begin
+ // search identifier in code
+ Found:=FindDeclarationOfIdentAtParam(refs.Params);
+ end else begin
+ // search identifier in comment -> if not found, this is no problem
+ // => silently ignore
+ try
+ Found:=FindDeclarationOfIdentAtParam(refs.Params);
+ except
+ on E: ECodeToolError do begin
+ // continue
+ end;
+ on E: Exception do
+ raise;
+ end;
+ end;
+ //debugln(['TFindUsedUnitReferences.OnIdentifier Identifier=',GetIdentifier(Identifier),' found=',Found]);
+
+ if not Found then exit;
+
+ if CleanPosToCaret(IdentifierCleanPos,ReferencePos) then
+ AddCodePosition(refs.ListOfPCodeXYPosition,ReferencePos);
+end;
+
function TFindDeclarationTool.FindNthParameterNode(Node: TCodeTreeNode;
ParameterIndex: integer): TCodeTreeNode;
var
diff --git a/components/codetools/pascalreadertool.pas b/components/codetools/pascalreadertool.pas
index f5893a08ed..18f71f0765 100644
--- a/components/codetools/pascalreadertool.pas
+++ b/components/codetools/pascalreadertool.pas
@@ -51,6 +51,16 @@ type
);
TPascalHintModifiers = set of TPascalHintModifier;
+ TEPRIRange = (
+ epriInCode,
+ epriInComment,
+ epriInDirective
+ );
+
+ TOnEachPRIdentifier = procedure(Sender: TPascalParserTool;
+ IdentifierCleanPos: integer; Range: TEPRIRange;
+ Node: TCodeTreeNode; Data: Pointer; var Abort: boolean) of object;
+
{ TPascalReaderTool }
TPascalReaderTool = class(TPascalParserTool)
@@ -75,6 +85,14 @@ type
function ReadStringConstantValue(StartPos: integer): string;
function GetNodeIdentifier(Node: TCodeTreeNode): PChar;
function GetHintModifiers(Node: TCodeTreeNode): TPascalHintModifiers;
+ procedure ForEachIdentifierInCleanSrc(StartPos, EndPos: integer;
+ SkipComments: boolean; Node: TCodeTreeNode;
+ const OnIdentifier: TOnEachPRIdentifier; Data: pointer;
+ var Abort: boolean); // range in clean source
+ procedure ForEachIdentifierInNode(Node: TCodeTreeNode; SkipComments: boolean;
+ const OnIdentifier: TOnEachPRIdentifier; Data: Pointer; var Abort: boolean); // node and child nodes
+ procedure ForEachIdentifier(SkipComments: boolean;
+ const OnIdentifier: TOnEachPRIdentifier; Data: Pointer); // whole unit/program
// properties
function ExtractPropType(PropNode: TCodeTreeNode;
@@ -1689,6 +1707,230 @@ begin
end;
end;
+procedure TPascalReaderTool.ForEachIdentifierInCleanSrc(StartPos,
+ EndPos: integer; SkipComments: boolean; Node: TCodeTreeNode;
+ const OnIdentifier: TOnEachPRIdentifier; Data: pointer; var Abort: boolean);
+var
+ CommentLvl: Integer;
+ InStrConst: Boolean;
+ p: PChar;
+ EndP: Pointer;
+ Range: TEPRIRange;
+
+ procedure SkipIdentifier; inline;
+ begin
+ while (pSrcLen then exit;
+ if EndPos>SrcLen then EndPos:=SrcLen+1;
+ if StartPos>=EndPos then exit;
+ p:=@Src[StartPos];
+ EndP:=p+EndPos-StartPos;
+ while p=EndP then exit;
+ if (p^=#3) and (p[1]='}')
+ then begin
+ inc(p,2);
+ break;
+ end;
+ inc(p);
+ until false;
+ end else begin
+ // pascal comment {}
+ CommentLvl:=1;
+ InStrConst:=false;
+ if p^='$' then
+ Range:=epriInDirective
+ else
+ Range:=epriInComment;
+ repeat
+ if p>=EndP then exit;
+ case p^ of
+ '{': if Scanner.NestedComments then inc(CommentLvl);
+ '}':
+ begin
+ dec(CommentLvl);
+ if CommentLvl=0 then break;
+ end;
+ 'a'..'z','A'..'Z','_':
+ if not InStrConst then begin
+ if not SkipComments then begin
+ OnIdentifier(Self,p-PChar(Src)+1,Range,Node,Data,Abort);
+ SkipIdentifier;
+ if Abort then exit;
+ end;
+ while (p'/' then begin
+ inc(p);
+ end else begin
+ inc(p,2);
+ InStrConst:=false;
+ repeat
+ if p>=EndP then exit;
+ case p^ of
+ #10,#13:
+ break;
+ 'a'..'z','A'..'Z','_':
+ if not InStrConst then begin
+ if not SkipComments then begin
+ OnIdentifier(Self,p-PChar(Src)+1,Range,Node,Data,Abort);
+ SkipIdentifier;
+ if Abort then exit;
+ end;
+ while (pp^) then
+ inc(p);
+ end;
+
+ '(': // turbo pascal comment
+ if (p[1]<>'*') then begin
+ inc(p);
+ end else begin
+ inc(p,3);
+ InStrConst:=false;
+ repeat
+ if p>=EndP then exit;
+ case p^ of
+ ')':
+ if p[-1]='*' then break;
+ 'a'..'z','A'..'Z','_':
+ if not InStrConst then begin
+ if not SkipComments then begin
+ OnIdentifier(Self,p-PChar(Src)+1,Range,Node,Data,Abort);
+ SkipIdentifier;
+ if Abort then exit;
+ end;
+ SkipIdentifier;
+ end;
+ '''':
+ InStrConst:=not InStrConst;
+ #10,#13:
+ InStrConst:=false;
+ end;
+ inc(p);
+ until false;
+ inc(p);
+ end;
+
+ 'a'..'z','A'..'Z','_':
+ begin
+ OnIdentifier(Self,p-PChar(Src)+1,epriInCode,Node,Data,Abort);
+ SkipIdentifier;
+ if Abort then exit;
+ end;
+
+ '''':
+ begin
+ // skip string constant
+ inc(p);
+ while pnil then begin
+ EndPos:=Node.StartPos;
+ Child:=Node.FirstChild;
+ while Child<>nil do begin
+ // scan in front of child
+ ForEachIdentifierInCleanSrc(EndPos,Child.StartPos,SkipComments,
+ Node,OnIdentifier,Data,Abort);
+ if Abort then exit;
+ // scan child
+ ForEachIdentifierInNode(Child,SkipComments,OnIdentifier,Data,Abort);
+ if Abort then exit;
+ EndPos:=Child.EndPos;
+ Child:=Child.NextBrother;
+ end;
+ // scan behind children
+ ForEachIdentifierInCleanSrc(EndPos,Node.EndPos,SkipComments,
+ Node,OnIdentifier,Data,Abort);
+ end else begin
+ // leaf node
+ StartPos:=Node.StartPos;
+ EndPos:=Node.EndPos;
+ // nodes without children can overlap with their NextBrother
+ if (Node.NextBrother<>nil)
+ and (Node.NextBrother.StartPosnil do begin
+ ForEachIdentifierInNode(Node,SkipComments,OnIdentifier,Data,Abort);
+ if Abort then exit;
+ Node:=Node.NextBrother;
+ end;
+end;
+
function TPascalReaderTool.FindVarNode(StartNode: TCodeTreeNode;
const UpperVarName: string): TCodeTreeNode;
var