From 5364c52f9500d1c9ea6485b442f88d6887b4ae94 Mon Sep 17 00:00:00 2001 From: mattias Date: Sun, 8 Sep 2013 19:19:55 +0000 Subject: [PATCH] codetools: FindUsedUnitReferences git-svn-id: trunk@42681 - --- .gitattributes | 3 + components/codetools/codetoolmanager.pas | 33 ++- components/codetools/docs/codetoolmanager.xml | 4 +- .../examples/findusedunitreferences.lpi | 64 +++++ .../examples/findusedunitreferences.lpr | 91 +++++++ .../examples/scanexamples/usedunitrefs1.pas | 28 ++ components/codetools/finddeclarationtool.pas | 136 +++++++++- components/codetools/pascalreadertool.pas | 242 ++++++++++++++++++ 8 files changed, 597 insertions(+), 4 deletions(-) create mode 100644 components/codetools/examples/findusedunitreferences.lpi create mode 100644 components/codetools/examples/findusedunitreferences.lpr create mode 100644 components/codetools/examples/scanexamples/usedunitrefs1.pas 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 @@ + + + + + + + + + + + + </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> 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 <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. + 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(MinFloat<d); +end; + +end. + diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 4955639939..fa70e83b1b 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/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 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 (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