codetools: FindUsedUnitReferences

git-svn-id: trunk@42681 -

.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

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;

components/codetools/docs/codetoolmanager.xml

@@ -1,4 +1,4 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <fpdoc-descriptions>
   <package name="CodeTools">
     <module name="CodeToolManager">
@@ -6,6 +6,8 @@
         <short>Returns the unit search path of the given directory separated by semicolon</short>
         <descr>The unit path is created from the define templates variable #UnitPath.</descr>
       </element>
+    <element name="TCodeToolManager.FindUnitReferences"><short>Searches unitname of UnitCode in unit of TargetCode</short>
+      </element>
     </module>
   </package>
 </fpdoc-descriptions>

components/codetools/examples/findusedunitreferences.lpi

@@ -0,0 +1,64 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="findusedunitreferences"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <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>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="CodeTools"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="4">
+      <Unit0>
+        <Filename Value="findusedunitreferences.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="findusedunitreferences"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="scanexamples/simpleunit1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="SimpleUnit1"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="scanexamples/unusedunits1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="UnusedUnits1"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="scanexamples/usedunitrefs1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="UsedUnitRefs1"/>
+      </Unit3>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="scanexamples"/>
+    </SearchPaths>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

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 <http://www.gnu.org/copyleft/gpl.html>. 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),' <filename> <X> <Y>');
+    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.
+

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(MinFloat<d);
+end;
+
+end.
+

components/codetools/finddeclarationtool.pas

@@ -727,6 +727,9 @@ type
     function CheckParameterSyntax(StartPos, CleanCursorPos: integer;
       out ParameterAtom, ProcNameAtom: TAtomPosition;
       out ParameterIndex: integer): boolean;
+    procedure OnFindUsedUnitIdentifier(Sender: TPascalParserTool;
+      IdentifierCleanPos: integer; Range: TEPRIRange;
+      Node: TCodeTreeNode; Data: Pointer; var Abort: boolean);
   protected
   public
     constructor Create;
@@ -823,7 +826,11 @@ type
     function FindReferences(const CursorPos: TCodeXYPosition;
       SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean;
     function FindUnitReferences(UnitCode: TCodeBuffer;
-      SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean;
+      SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean; // searches unitname of UnitCode
+    procedure FindUsedUnitReferences(const CursorPos: TCodeXYPosition;
+      SkipComments: boolean; out ListOfPCodeXYPosition: TFPList); // searches all references of unit in uses clause
+    procedure FindUsedUnitReferences(TargetTool: TFindDeclarationTool;
+      SkipComments: boolean; out ListOfPCodeXYPosition: TFPList); // searches all references of TargetTool
 
     function CleanPosIsDeclarationIdentifier(CleanPos: integer;
                                              Node: TCodeTreeNode): boolean;
@@ -899,6 +906,18 @@ function dbgs(const vat: TVariableAtomType): string; overload;
 
 implementation
 
+type
+
+  { TFindUsedUnitReferences }
+
+  TFindUsedUnitReferences = class
+  public
+    TargetTool: TFindDeclarationTool;
+    TargetUnitName: string;
+    ListOfPCodeXYPosition: TFPList;
+    Params: TFindDeclarationParams;
+    destructor Destroy; override;
+  end;
 
 function dbgs(const Flags: TFindDeclarationFlags): string;
 var
@@ -1203,6 +1222,12 @@ begin
   ListOfPFindContext:=nil;
 end;
 
+destructor TFindUsedUnitReferences.Destroy;
+begin
+  FreeAndNil(Params);
+  inherited Destroy;
+end;
+
 { TFindDeclarationTool }
 
 function TFindDeclarationTool.FindDeclaration(const CursorPos: TCodeXYPosition;
@@ -4613,7 +4638,7 @@ var
       except
         on E: ECodeToolError do begin
           if E.Sender<>Self 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

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 (p<EndP) and IsIdentChar[p^] do inc(p);
+  end;
+
+begin
+  //debugln(['TPascalReaderTool.ForEachIdentifierInCleanSrc Node=',Node.DescAsString,' "',dbgstr(Src,StartPos,EndPos-StartPos),'"']);
+  if StartPos>SrcLen then exit;
+  if EndPos>SrcLen then EndPos:=SrcLen+1;
+  if StartPos>=EndPos then exit;
+  p:=@Src[StartPos];
+  EndP:=p+EndPos-StartPos;
+  while p<EndP do begin
+    case p^ of
+
+    '{':
+      begin
+        inc(p);
+        if p^=#3 then begin
+          // codetools skip comment {#3 #3}
+          inc(p);
+          repeat
+            if 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<EndP) and IsIdentChar[p^] do inc(p);
+              end;
+            '''':
+              InStrConst:=not InStrConst;
+            #10,#13:
+              InStrConst:=false;
+            end;
+            inc(p);
+          until false;
+          inc(p);
+          //debugln(StartPos,' ',copy(Src,CommentStart,StartPos-CommentStart));
+        end;
+      end;
+
+    '/':  // Delphi comment
+      if p[1]<>'/' 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 (p<EndP) and IsIdentChar[p^] do inc(p);
+            end;
+          '''':
+            InStrConst:=not InStrConst;
+          end;
+          inc(p);
+        until false;
+        inc(p);
+        if (p<EndP) and (p^ in [#10,#13])
+        and (p[-1]<>p^) 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 p<EndP do begin
+          if (not (p^ in ['''',#10,#13])) then
+            inc(p)
+          else begin
+            inc(p);
+            break;
+          end;
+        end;
+      end;
+
+    else
+      inc(p);
+    end;
+  end;
+end;
+
+procedure TPascalReaderTool.ForEachIdentifierInNode(Node: TCodeTreeNode;
+  SkipComments: boolean; const OnIdentifier: TOnEachPRIdentifier;
+  Data: Pointer; var Abort: boolean);
+var
+  StartPos: Integer;
+  EndPos: Integer;
+  Child: TCodeTreeNode;
+begin
+  //debugln(['TPascalReaderTool.ForEachIdentifierInNode START ',Node.DescAsString]);
+  if NodeNeedsBuildSubTree(Node) then
+    BuildSubTree(Node);
+  if Node.FirstChild<>nil 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.StartPos<EndPos) then
+      EndPos:=Node.NextBrother.StartPos;
+    // scan node range
+    ForEachIdentifierInCleanSrc(StartPos,EndPos,SkipComments,
+      Node,OnIdentifier,Data,Abort);
+  end;
+end;
+
+procedure TPascalReaderTool.ForEachIdentifier(SkipComments: boolean;
+  const OnIdentifier: TOnEachPRIdentifier; Data: Pointer);
+var
+  Node: TCodeTreeNode;
+  Abort: boolean;
+begin
+  //debugln(['TPascalReaderTool.ForEachIdentifier START']);
+  Node:=Tree.Root;
+  Abort:=false;
+  while Node<>nil 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