PageRenderTime 58ms CodeModel.GetById 24ms app.highlight 16ms RepoModel.GetById 1ms app.codeStats 1ms

/components/codetools/pascalreadertool.pas

http://github.com/graemeg/lazarus
Pascal | 3764 lines | 3238 code | 237 blank | 289 comment | 762 complexity | 9588f51c2b0af8cf12bed6b33ebc8a5b MD5 | raw file
   1{
   2 ***************************************************************************
   3 *                                                                         *
   4 *   This source is free software; you can redistribute it and/or modify   *
   5 *   it under the terms of the GNU General Public License as published by  *
   6 *   the Free Software Foundation; either version 2 of the License, or     *
   7 *   (at your option) any later version.                                   *
   8 *                                                                         *
   9 *   This code is distributed in the hope that it will be useful, but      *
  10 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
  11 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
  12 *   General Public License for more details.                              *
  13 *                                                                         *
  14 *   A copy of the GNU General Public License is available on the World    *
  15 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
  16 *   obtain it by writing to the Free Software Foundation,                 *
  17 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
  18 *                                                                         *
  19 ***************************************************************************
  20
  21  Author: Mattias Gaertner
  22
  23  Abstract:
  24    TPascalReaderTool enhances TPascalParserTool.
  25    This tool provides a lot of useful functions to read the output of the
  26    TPascalParserTool.
  27}
  28unit PascalReaderTool;
  29
  30{$ifdef FPC}{$mode objfpc}{$endif}{$H+}
  31
  32interface
  33
  34{$I codetools.inc}
  35
  36uses
  37  {$IFDEF MEM_CHECK}
  38  MemCheck,
  39  {$ENDIF}
  40  Classes, SysUtils, FileProcs, CodeToolsStrConsts, CodeTree, CodeCache,
  41  CodeAtom, CustomCodeTool, PascalParserTool, KeywordFuncLists, BasicCodeTools,
  42  LinkScanner, AVL_Tree, LazFileUtils, LazDbgLog;
  43
  44type
  45  TPascalHintModifier = (
  46    phmDeprecated,
  47    phmPlatform,
  48    phmLibrary,
  49    phmUnimplemented,
  50    phmExperimental
  51    );
  52  TPascalHintModifiers = set of TPascalHintModifier;
  53
  54  TEPRIRange = (
  55    epriInCode,
  56    epriInComment,
  57    epriInDirective
  58    );
  59
  60  //the scope groups of pascal methods.
  61  //please note that Destructor is principally a method and thus is not listed here -> you cannot define "procedure Destroy;" and "destructor Destroy" in one class
  62  TPascalMethodGroup = (mgMethod, mgConstructor, mgClassConstructor, mgClassDestructor, mgClassOperator);
  63
  64  TPascalMethodHeader = record
  65    Name, ResultType: string;
  66    Group: TPascalMethodGroup;
  67  end;
  68
  69  TClassSectionVisibility = (
  70    csvEverything,//same class same unit
  71    csvPrivateAndHigher,//same unit different class
  72    csvProtectedAndHigher,//ancestor class different unit
  73    csvPublicAndHigher);//other class other unit
  74
  75  TOnEachPRIdentifier = procedure(Sender: TPascalParserTool;
  76    IdentifierCleanPos: integer; Range: TEPRIRange;
  77    Node: TCodeTreeNode; Data: Pointer; var Abort: boolean) of object;
  78
  79  { TPascalReaderTool }
  80
  81  TPascalReaderTool = class(TPascalParserTool)
  82  protected
  83    CachedSourceName: string;
  84    procedure RaiseStrConstExpected;
  85  public
  86    // comments
  87    function CleanPosIsInComment(CleanPos, CleanCodePosInFront: integer;
  88        out CommentStart, CommentEnd: integer;
  89        OuterCommentBounds: boolean = true): boolean;
  90
  91    // general extraction
  92    function ExtractNode(ANode: TCodeTreeNode;
  93        Attr: TProcHeadAttributes): string;
  94    function ExtractCode(StartPos, EndPos: integer;
  95        Attr: TProcHeadAttributes): string;
  96    function ExtractBrackets(BracketStartPos: integer;
  97        Attr: TProcHeadAttributes): string;
  98    function ExtractIdentifierWithPoints(StartPos: integer;
  99        ExceptionOnError: boolean): string;
 100    function ExtractIdentCharsFromStringConstant(
 101        StartPos, MinPos, MaxPos, MaxLen: integer): string;
 102    function ReadStringConstantValue(StartPos: integer): string;
 103    function GetNodeIdentifier(Node: TCodeTreeNode): PChar;
 104    function GetHintModifiers(Node: TCodeTreeNode): TPascalHintModifiers;
 105    procedure ForEachIdentifierInCleanSrc(StartPos, EndPos: integer;
 106        SkipComments: boolean; Node: TCodeTreeNode;
 107        const OnIdentifier: TOnEachPRIdentifier; Data: pointer;
 108        var Abort: boolean); // range in clean source
 109    procedure ForEachIdentifierInNode(Node: TCodeTreeNode; SkipComments: boolean;
 110        const OnIdentifier: TOnEachPRIdentifier; Data: Pointer; var Abort: boolean); // node and child nodes
 111    procedure ForEachIdentifier(SkipComments: boolean;
 112        const OnIdentifier: TOnEachPRIdentifier; Data: Pointer); // whole unit/program
 113
 114    // properties
 115    function ExtractPropType(PropNode: TCodeTreeNode;
 116                             InUpperCase, EmptyIfIndexed: boolean): string;
 117    function MoveCursorToPropType(PropNode: TCodeTreeNode): boolean;
 118    function MoveCursorToPropName(PropNode: TCodeTreeNode): boolean;
 119    procedure MoveCursorBehindPropName(PropNode: TCodeTreeNode);
 120    function ExtractPropName(PropNode: TCodeTreeNode;
 121                             InUpperCase: boolean): string;
 122    function ExtractProperty(PropNode: TCodeTreeNode;
 123                             Attr: TProcHeadAttributes): string;
 124    function GetPropertyNameIdentifier(PropNode: TCodeTreeNode): PChar;
 125    function GetPropertyTypeIdentifier(PropNode: TCodeTreeNode): PChar;
 126    function PositionInPropertyName(PropNode: TCodeTreeNode;
 127                                    CleanPos: integer): boolean;
 128    function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
 129    function PropertyNodeHasParamList(PropNode: TCodeTreeNode): boolean;
 130    function PropNodeIsTypeLess(PropNode: TCodeTreeNode): boolean;
 131    function PropertyHasSpecifier(PropNode: TCodeTreeNode;
 132                 UpperKeyword: string; ExceptionOnNotFound: boolean = true): boolean;
 133
 134    // procs
 135    function ExtractProcName(ProcNode: TCodeTreeNode;
 136        Attr: TProcHeadAttributes): string;
 137    function ExtractProcHead(ProcNode: TCodeTreeNode;
 138        Attr: TProcHeadAttributes): string;
 139    function ExtractProcHeadWithGroup(ProcNode: TCodeTreeNode;
 140        Attr: TProcHeadAttributes): TPascalMethodHeader;
 141    function ExtractProcedureHeader(CursorPos: TCodeXYPosition;
 142      Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
 143    function ExtractClassNameOfProcNode(ProcNode: TCodeTreeNode;
 144        AddParentClasses: boolean = true): string;
 145    function ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
 146        ProcSpec: TProcedureSpecifier): boolean;
 147    function GetProcNameIdentifier(ProcNode: TCodeTreeNode): PChar;
 148    function FindProcNode(StartNode: TCodeTreeNode; const AProcHead: string;
 149        AProcSpecType: TPascalMethodGroup;
 150        Attr: TProcHeadAttributes; Visibility: TClassSectionVisibility = csvEverything): TCodeTreeNode; overload;
 151    function FindProcNode(StartNode: TCodeTreeNode; const AProcHead: TPascalMethodHeader;
 152        Attr: TProcHeadAttributes; Visibility: TClassSectionVisibility = csvEverything): TCodeTreeNode; overload;
 153    function FindCorrespondingProcNode(ProcNode: TCodeTreeNode;
 154        Attr: TProcHeadAttributes = [phpWithoutClassKeyword,phpWithoutClassName]
 155        ): TCodeTreeNode;
 156    function FindCorrespondingProcParamNode(ProcParamNode: TCodeTreeNode;
 157        Attr: TProcHeadAttributes = [phpInUpperCase,phpWithoutClassName,phpWithVarModifiers]
 158        ): TCodeTreeNode;
 159    function FindProcBody(ProcNode: TCodeTreeNode): TCodeTreeNode;
 160    function ProcBodyIsEmpty(ProcNode: TCodeTreeNode): boolean;
 161    function ExtractProcedureGroup(ProcNode: TCodeTreeNode): TPascalMethodGroup;
 162    function ExtractFuncResultType(ProcNode: TCodeTreeNode;
 163        Attr: TProcHeadAttributes): string;
 164    procedure MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode);
 165    function MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
 166        ProcSpec: TProcedureSpecifier): boolean;
 167    procedure MoveCursorToProcName(ProcNode: TCodeTreeNode;
 168        SkipClassName: boolean);
 169    procedure MoveCursorBehindProcName(ProcNode: TCodeTreeNode);
 170    function PositionInProcName(ProcNode: TCodeTreeNode;
 171                                SkipClassName: boolean; CleanPos: integer): boolean;
 172    function PositionInFuncResultName(ProcNode: TCodeTreeNode;
 173                                      CleanPos: integer): boolean;
 174    function ProcNodeHasParamList(ProcNode: TCodeTreeNode): boolean;
 175    function ProcNodeHasOfObject(ProcNode: TCodeTreeNode): boolean;
 176    function GetProcParamList(ProcNode: TCodeTreeNode;
 177                              Parse: boolean = true): TCodeTreeNode;
 178    function NodeIsInAMethod(Node: TCodeTreeNode): boolean;
 179    function NodeIsMethodBody(ProcNode: TCodeTreeNode): boolean;
 180    function GetMethodOfBody(Node: TCodeTreeNode): TCodeTreeNode;
 181    function NodeIsFunction(ProcNode: TCodeTreeNode): boolean;
 182    function NodeIsClassConstructorOrDestructor(ProcNode: TCodeTreeNode): boolean;
 183    function NodeIsConstructor(ProcNode: TCodeTreeNode): boolean;
 184    function NodeIsDestructor(ProcNode: TCodeTreeNode): boolean;
 185    function NodeIsForwardProc(ProcNode: TCodeTreeNode): boolean;
 186    function NodeIsOperator(ProcNode: TCodeTreeNode): boolean;
 187    function NodeIsResultIdentifier(Node: TCodeTreeNode): boolean;
 188    function NodeIsResultType(Node: TCodeTreeNode): boolean;
 189
 190    // classes
 191    function ExtractClassName(Node: TCodeTreeNode;
 192        InUpperCase: boolean; WithParents: boolean = true;
 193        WithGenericParams: boolean = false): string;
 194    function ExtractClassPath(Node: TCodeTreeNode): string;
 195    function ExtractClassInheritance(ClassNode: TCodeTreeNode;
 196        Attr: TProcHeadAttributes): string;
 197    function FindClassNode(StartNode: TCodeTreeNode;
 198        const AClassName: string; // nested: A.B
 199        IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
 200    function FindClassNodeBackwards(StartNode: TCodeTreeNode;
 201        const AClassName: string;
 202        IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
 203    function FindNestedClass(RootClassNode: TCodeTreeNode;
 204         AClassName: PChar; SkipFirst: boolean): TCodeTreeNode;
 205    function FindClassNode(CursorNode: TCodeTreeNode): TCodeTreeNode;
 206    function FindClassNodeForMethodBody(ProcNode: TCodeTreeNode;
 207        IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
 208    function FindClassOrInterfaceNode(CursorNode: TCodeTreeNode;
 209        FindClassOfMethod: boolean = false): TCodeTreeNode;
 210    function FindClassSection(ClassNode: TCodeTreeNode;
 211        NodeDesc: TCodeTreeNodeDesc): TCodeTreeNode;
 212    function FindLastClassSection(ClassNode: TCodeTreeNode;
 213        NodeDesc: TCodeTreeNodeDesc): TCodeTreeNode;
 214    function GetClassVisibility(Node: TCodeTreeNode): TCodeTreeNodeDesc;
 215    function FindClassNodeInInterface(const AClassName: string;
 216        IgnoreForwards, IgnoreNonForwards, ErrorOnNotFound: boolean): TCodeTreeNode;
 217    function FindClassNodeInUnit(const AClassName: string;
 218        IgnoreForwards, IgnoreNonForwards, IgnoreImplementation,
 219        ErrorOnNotFound: boolean): TCodeTreeNode;
 220    function FindFirstIdentNodeInClass(ClassNode: TCodeTreeNode): TCodeTreeNode;
 221    function FindLastIdentNodeInClass(ClassNode: TCodeTreeNode): TCodeTreeNode;
 222    function FindNextIdentNodeInClass(Node: TCodeTreeNode): TCodeTreeNode;
 223    function FindPriorIdentNodeInClass(Node: TCodeTreeNode): TCodeTreeNode;
 224    function ClassSectionNodeStartsWithWord(ANode: TCodeTreeNode): boolean;
 225    function IsClassNode(Node: TCodeTreeNode): boolean; // class, not object
 226    function FindInheritanceNode(ClassNode: TCodeTreeNode): TCodeTreeNode;
 227    function FindHelperForNode(HelperNode: TCodeTreeNode): TCodeTreeNode;
 228    function IdentNodeIsInVisibleClassSection(Node: TCodeTreeNode; Visibility: TClassSectionVisibility): Boolean;
 229
 230    // records
 231    function ExtractRecordCaseType(RecordCaseNode: TCodeTreeNode): string;
 232
 233    // variables, types
 234    function FindVarNode(StartNode: TCodeTreeNode;
 235        const UpperVarName: string;
 236        Visibility: TClassSectionVisibility = csvEverything): TCodeTreeNode;
 237    function FindTypeNodeOfDefinition(
 238        DefinitionNode: TCodeTreeNode): TCodeTreeNode;
 239    function NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode): boolean;
 240    function ExtractDefinitionNodeType(DefinitionNode: TCodeTreeNode): string;
 241    function ExtractDefinitionName(DefinitionNode: TCodeTreeNode): string;
 242    function FindDefinitionNameNode(DefinitionNode: TCodeTreeNode): TCodeTreeNode;
 243    function PositionInDefinitionName(DefinitionNode: TCodeTreeNode;
 244                                      CleanPos: integer): boolean;
 245    function MoveCursorToParameterSpecifier(DefinitionNode: TCodeTreeNode
 246                                            ): boolean;
 247    function GetFirstGroupVarNode(VarNode: TCodeTreeNode): TCodeTreeNode;
 248    function NodeIsIdentifierInInterface(Node: TCodeTreeNode): boolean;
 249    function NodeCanHaveForwardType(TypeNode: TCodeTreeNode): boolean;
 250    function NodeIsForwardType(TypeNode: TCodeTreeNode): boolean;
 251    function FindForwardTypeNode(TypeNode: TCodeTreeNode;
 252                                 SearchFirst: boolean): TCodeTreeNode;
 253    function FindTypeOfForwardNode(TypeNode: TCodeTreeNode): TCodeTreeNode;
 254    function FindEndOfWithExpr(WithVarNode: TCodeTreeNode): integer;
 255    function ExtractWithBlockExpression(WithVarNode: TCodeTreeNode; Attr: TProcHeadAttributes = []): string;
 256    function FindWithBlockStatement(WithVarNode: TCodeTreeNode): TCodeTreeNode;
 257
 258    // arrays
 259    function ExtractArrayRange(ArrayNode: TCodeTreeNode;
 260        Attr: TProcHeadAttributes): string;
 261
 262    // module sections
 263    function ExtractSourceName: string;
 264    function GetSourceNamePos(out NamePos: TAtomPosition): boolean;
 265    function GetSourceName(DoBuildTree: boolean = true): string;
 266    function GetSourceType: TCodeTreeNodeDesc;
 267    function PositionInSourceName(CleanPos: integer): boolean;
 268
 269    // uses sections
 270    procedure MoveCursorToUsesStart(UsesNode: TCodeTreeNode);
 271    procedure MoveCursorToUsesEnd(UsesNode: TCodeTreeNode);
 272    function ReadNextUsedUnit(out UnitNameRange, InAtom: TAtomPosition;
 273          SyntaxExceptions: boolean = true): boolean;
 274    procedure ReadPriorUsedUnit(out UnitNameRange, InAtom: TAtomPosition);
 275    function ExtractUsedUnitNameAtCursor(InFilename: PAnsiString = nil): string;
 276    function ExtractUsedUnitName(UseUnitNode: TCodeTreeNode;
 277          InFilename: PAnsiString = nil): string;
 278    function ReadAndCompareUsedUnit(const AnUnitName: string): boolean;
 279
 280    // comments
 281    function FindCommentInFront(const StartPos: TCodeXYPosition;
 282          const CommentText: string; InvokeBuildTree, SearchInParentNode,
 283          WithCommentBounds, CaseSensitive, IgnoreSpaces,
 284          CompareOnlyStart: boolean;
 285          out CommentStart, CommentEnd: TCodeXYPosition): boolean;
 286    function FindCommentInFront(StartPos: integer;
 287          const CommentText: string; SearchInParentNode,
 288          WithCommentBounds, CaseSensitive, IgnoreSpaces,
 289          CompareOnlyStart: boolean;
 290          out CommentStart, CommentEnd: integer): boolean;
 291    function GetPasDocComments(const StartPos: TCodeXYPosition;
 292                               InvokeBuildTree: boolean;
 293                               out ListOfPCodeXYPosition: TFPList): boolean;
 294    function GetPasDocComments(Node: TCodeTreeNode;
 295                               out ListOfPCodeXYPosition: TFPList): boolean;
 296
 297    procedure CalcMemSize(Stats: TCTMemStats); override;
 298  end;
 299
 300function CompareMethodHeaders(
 301  const Method1Name: string; Method1Group: TPascalMethodGroup; const Method1ResultType: string;
 302  const Method2Name: string; Method2Group: TPascalMethodGroup; const Method2ResultType: string): Integer; overload;
 303function CompareMethodHeaders(const Method1Head: TPascalMethodHeader; const Method2Head: TPascalMethodHeader): Integer; overload;
 304function SameMethodHeaders(
 305  const Method1Name: string; Method1Group: TPascalMethodGroup; const Method1ResultType: string;
 306  const Method2Name: string; Method2Group: TPascalMethodGroup; const Method2ResultType: string): Boolean; overload;
 307function SameMethodHeaders(const Method1Head: TPascalMethodHeader; const Method2Head: TPascalMethodHeader): Boolean; overload;
 308function CompareCodeTreeNodeExtMethodHeaders(NodeData1, NodeData2: pointer): integer;
 309
 310implementation
 311
 312function CompareMethodHeaders(const Method1Name: string;
 313  Method1Group: TPascalMethodGroup; const Method1ResultType: string;
 314  const Method2Name: string; Method2Group: TPascalMethodGroup;
 315  const Method2ResultType: string): Integer;
 316begin
 317  Result := (Ord(Method1Group) - Ord(Method2Group));
 318  if Result <> 0 then exit;
 319  Result := CompareTextIgnoringSpace(Method1Name,Method2Name,false);
 320  if Result <> 0 then exit;
 321  if Method1Group=mgClassOperator then
 322    Result := CompareTextIgnoringSpace(Method1ResultType,Method2ResultType,false);
 323end;
 324
 325function CompareMethodHeaders(const Method1Head: TPascalMethodHeader;
 326  const Method2Head: TPascalMethodHeader): Integer;
 327begin
 328  Result := CompareMethodHeaders(
 329    Method1Head.Name, Method1Head.Group, Method1Head.ResultType,
 330    Method2Head.Name, Method2Head.Group, Method2Head.ResultType);
 331end;
 332
 333function SameMethodHeaders(const Method1Name: string;
 334  Method1Group: TPascalMethodGroup; const Method1ResultType: string;
 335  const Method2Name: string; Method2Group: TPascalMethodGroup;
 336  const Method2ResultType: string): Boolean;
 337begin
 338  Result := CompareMethodHeaders(
 339    Method1Name, Method1Group, Method1ResultType,
 340    Method2Name, Method2Group, Method2ResultType) = 0;
 341end;
 342
 343function SameMethodHeaders(const Method1Head: TPascalMethodHeader;
 344  const Method2Head: TPascalMethodHeader): Boolean;
 345begin
 346  Result := CompareMethodHeaders(Method1Head, Method2Head) = 0;
 347end;
 348
 349function CompareCodeTreeNodeExtMethodHeaders(NodeData1, NodeData2: pointer): integer;
 350var
 351  NodeExt1: TCodeTreeNodeExtension absolute NodeData1;
 352  NodeExt2: TCodeTreeNodeExtension absolute NodeData2;
 353begin
 354  Result := CompareMethodHeaders(
 355    NodeExt1.Txt,TPascalMethodGroup(NodeExt1.Flags),NodeExt1.ExtTxt4,
 356    NodeExt2.Txt,TPascalMethodGroup(NodeExt2.Flags),NodeExt2.ExtTxt4);
 357end;
 358
 359
 360{ TPascalReaderTool }
 361
 362procedure TPascalReaderTool.RaiseStrConstExpected;
 363begin
 364  RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsStringConstant,GetAtom]);
 365end;
 366
 367function TPascalReaderTool.CleanPosIsInComment(CleanPos,
 368  CleanCodePosInFront: integer; out CommentStart, CommentEnd: integer;
 369  OuterCommentBounds: boolean): boolean;
 370var CommentLvl, CurCommentPos: integer;
 371  CurEnd: Integer;
 372  CurCommentInnerEnd: Integer;
 373begin
 374  Result:=false;
 375  CommentStart:=0;
 376  CommentEnd:=0;
 377  if CleanPos>SrcLen then exit;
 378  if CleanCodePosInFront>CleanPos then
 379    RaiseException(
 380      'TPascalReaderTool.CleanPosIsInComment CleanCodePosInFront>CleanPos');
 381  MoveCursorToCleanPos(CleanCodePosInFront);
 382  repeat
 383    ReadNextAtom;
 384    if CurPos.StartPos>CleanPos then begin
 385      //DebugLn(['TPascalReaderTool.CleanPosIsInComment ',GetATom,' StartPos=',CurPos.StartPos,' CleanPos=',CleanPos]);
 386      // CleanPos between two atoms -> parse space between for comments
 387      if LastAtoms.Count>0 then
 388        CommentStart:=LastAtoms.GetValueAt(0).EndPos
 389      else
 390        CommentStart:=CleanCodePosInFront;
 391      CurEnd:=CurPos.StartPos;
 392      if CurEnd>SrcLen then CurEnd:=SrcLen+1;
 393      while CommentStart<CurEnd do begin
 394        if IsCommentStartChar[Src[CommentStart]] then begin
 395          CurCommentPos:=CommentStart;
 396          CurCommentInnerEnd:=CurEnd;
 397          case Src[CommentStart] of
 398          '{':
 399            begin
 400              inc(CurCommentPos);
 401              if (CurCommentPos<=SrcLen) and (Src[CurCommentPos]=#3) then begin
 402                // codetools skip comment
 403                inc(CurCommentPos);
 404                if not OuterCommentBounds then CommentStart:=CurCommentPos;
 405                while (CurCommentPos<CurEnd) do begin
 406                  if (Src[CurCommentPos]=#3)
 407                  and (CurCommentPos+1<CurEnd) and (Src[CurCommentPos+1]='}')
 408                  then begin
 409                    CurCommentInnerEnd:=CurCommentPos;
 410                    inc(CurCommentPos,2);
 411                    break;
 412                  end;
 413                  inc(CurCommentPos);
 414                end;
 415              end else begin
 416                // pascal comment
 417                if not OuterCommentBounds then CommentStart:=CurCommentPos;
 418                CommentLvl:=1;
 419                while (CurCommentPos<CurEnd) do begin
 420                  case Src[CurCommentPos] of
 421                  '{': if Scanner.NestedComments then inc(CommentLvl);
 422                  '}':
 423                    begin
 424                      dec(CommentLvl);
 425                      if (CommentLvl=0) then begin
 426                        CurCommentInnerEnd:=CurCommentPos;
 427                        inc(CurCommentPos);
 428                        break;
 429                      end;
 430                    end;
 431                  end;
 432                  inc(CurCommentPos);
 433                end;
 434              end;
 435            end;
 436          '/':  // Delphi comment
 437            if (CurCommentPos<SrcLen) and (Src[CurCommentPos+1]='/') then
 438            begin
 439              inc(CurCommentPos,2);
 440              if not OuterCommentBounds then CommentStart:=CurCommentPos;
 441              while (CurCommentPos<CurEnd)
 442              and (not (Src[CurCommentPos] in [#10,#13])) do
 443                inc(CurCommentPos);
 444              CurCommentInnerEnd:=CurCommentPos;
 445              inc(CurCommentPos);
 446              if (CurCommentPos<CurEnd)
 447              and (Src[CurCommentPos] in [#10,#13])
 448              and (Src[CurCommentPos-1]<>Src[CurCommentPos]) then
 449                inc(CurCommentPos);
 450            end else
 451              break;
 452          '(': // Turbo pascal comment
 453            if (CurCommentPos<SrcLen) and (Src[CurCommentPos+1]='*') then
 454            begin
 455              inc(CurCommentPos,2);
 456              if not OuterCommentBounds then CommentStart:=CurCommentPos;
 457              while (CurCommentPos<CurEnd) do begin
 458                if (Src[CurCommentPos]='*') and (CurCommentPos+1<CurEnd)
 459                and (Src[CurCommentPos+1]=')') then
 460                begin
 461                  CurCommentInnerEnd:=CurCommentPos;
 462                  inc(CurCommentPos,2);
 463                  break;
 464                end;
 465                inc(CurCommentPos);
 466              end;
 467            end else
 468              break;
 469          end;
 470          if (CurCommentPos>CommentStart) and (CleanPos<CurCommentPos) then
 471          begin
 472            // CleanPos in comment
 473            if OuterCommentBounds then
 474              CommentEnd:=CurCommentPos
 475            else
 476              CommentEnd:=CurCommentInnerEnd;
 477            exit(true);
 478          end;
 479          CommentStart:=CurCommentPos;
 480        end else if IsSpaceChar[Src[CommentStart]] then begin
 481          repeat
 482            inc(CommentStart);
 483          until (CommentStart>=CommentEnd)
 484          or (not (IsSpaceChar[Src[CommentStart]]));
 485        end else begin
 486          break;
 487        end;
 488      end;
 489      // CleanPos not in a comment
 490      exit;
 491    end else if CurPos.EndPos>CleanPos then begin
 492      // CleanPos not in a comment
 493      exit;
 494    end;
 495    CleanCodePosInFront:=CurPos.EndPos;
 496  until CurPos.StartPos>=SrcLen;
 497end;
 498
 499function TPascalReaderTool.ExtractPropType(PropNode: TCodeTreeNode;
 500  InUpperCase, EmptyIfIndexed: boolean): string;
 501begin
 502  Result:='';
 503  if (PropNode=nil)
 504  or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
 505    exit;
 506  MoveCursorToNodeStart(PropNode);
 507  ReadNextAtom;
 508  if (PropNode.Desc=ctnProperty) then begin
 509    if UpAtomIs('CLASS') then ReadNextAtom;
 510    if (not UpAtomIs('PROPERTY')) then exit;
 511    ReadNextAtom;
 512  end;
 513  AtomIsIdentifierE;
 514  ReadNextAtom;
 515  if CurPos.Flag=cafEdgedBracketOpen then begin
 516    if EmptyIfIndexed then exit;
 517    ReadTilBracketClose(true);
 518    ReadNextAtom;
 519  end;
 520  if CurPos.Flag in [cafSemicolon,cafEND] then exit;
 521  if not (CurPos.Flag=cafColon) then
 522    RaiseExceptionFmt(ctsStrExpectedButAtomFound,[':',GetAtom]);
 523  ReadNextAtom;
 524  AtomIsIdentifierE;
 525  if InUpperCase then
 526    Result:=GetUpAtom
 527  else
 528    Result:=GetAtom;
 529end;
 530
 531function TPascalReaderTool.ExtractProcName(ProcNode: TCodeTreeNode;
 532  Attr: TProcHeadAttributes): string;
 533var
 534  ProcHeadNode: TCodeTreeNode;
 535  Part: String;
 536  HasClassName: Boolean;
 537begin
 538  Result:='';
 539  if [phpWithoutClassName,phpWithoutName]*Attr=
 540     [phpWithoutClassName,phpWithoutName]
 541  then
 542    exit;
 543  while (ProcNode<>nil) and (ProcNode.Desc<>ctnProcedure) do
 544    ProcNode:=ProcNode.Parent;
 545  if ProcNode=nil then exit;
 546  ProcHeadNode:=ProcNode.FirstChild;
 547  if (ProcHeadNode=nil) or (ProcHeadNode.StartPos<1) then exit;
 548  MoveCursorToNodeStart(ProcHeadNode);
 549  HasClassName:=false;
 550  repeat
 551    ReadNextAtom;
 552    if not AtomIsIdentifier then break;
 553    if phpInUpperCase in Attr then
 554      Part:=GetUpAtom
 555    else
 556      Part:=GetAtom;
 557    ReadNextAtom;
 558    if (CurPos.Flag<>cafPoint) then begin
 559      // end of method identifier is the proc name
 560      if phpWithoutName in Attr then break;
 561      if Result<>'' then Result:=Result+'.';
 562      Result:=Result+Part;
 563      break;
 564    end;
 565    if not (phpWithoutClassName in Attr) then begin
 566      // in front of . is class name
 567      if Result<>'' then Result:=Result+'.';
 568      Result:=Result+Part;
 569      HasClassName:=true;
 570    end;
 571  until false;
 572  if (not HasClassName)
 573  and ([phpWithoutClassName,phpAddClassName]*Attr=[phpAddClassName]) then begin
 574    Part:=ExtractClassName(ProcNode,false,true);
 575    if Part<>'' then
 576      Result:=Part+'.'+Result;
 577  end;
 578end;
 579
 580function TPascalReaderTool.ExtractProcHead(ProcNode: TCodeTreeNode;
 581  Attr: TProcHeadAttributes): string;
 582var
 583  TheClassName, s: string;
 584  IsClassName, IsProcType: boolean;
 585  IsProcedure: Boolean;
 586  IsFunction: Boolean;
 587  IsOperator: Boolean;
 588  EndPos: Integer;
 589  ParentNode: TCodeTreeNode;
 590const
 591  SemiColon : char = ';';
 592
 593  procedure PrependName(const Prepend: string; var aPath: string);
 594  begin
 595    if Prepend='' then exit;
 596    if aPath<>'' then
 597      aPath:=Prepend+'.'+aPath
 598    else
 599      aPath:=Prepend;
 600  end;
 601
 602begin
 603  Result:='';
 604  ExtractProcHeadPos:=phepNone;
 605  if (ProcNode=nil) or (ProcNode.StartPos<1) then exit;
 606  if ProcNode.Desc=ctnProcedureHead then begin
 607    ProcNode:=ProcNode.Parent;
 608    if ProcNode=nil then exit;
 609  end;
 610  if ProcNode.Desc=ctnProcedure then
 611    IsProcType:=false
 612  else if ProcNode.Desc=ctnProcedureType then
 613    IsProcType:=true
 614  else
 615    exit;
 616
 617  TheClassName:='';
 618
 619  if (phpAddParentProcs in Attr) and (ProcNode.Parent.Desc=ctnProcedure) then begin
 620    // local proc
 621    ParentNode:=ProcNode.Parent;
 622    while ParentNode.Desc=ctnProcedure do begin
 623      PrependName(ExtractProcName(ParentNode,Attr*[phpInUpperCase]),TheClassName);
 624      ParentNode:=ParentNode.Parent;
 625    end;
 626  end;
 627
 628  // build full class name
 629  if ([phpAddClassname,phpWithoutClassName]*Attr=[phpAddClassName]) then
 630    PrependName(ExtractClassName(ProcNode,phpInUpperCase in Attr,true),TheClassName);
 631
 632  // reparse the clean source
 633  InitExtraction;
 634  MoveCursorToNodeStart(ProcNode);
 635  // parse procedure head = start + name + parameterlist + result type ;
 636  ExtractNextAtom(false,Attr);
 637  // read procedure start keyword
 638  if (UpAtomIs('CLASS') or UpAtomIs('STATIC')) then
 639    ExtractNextAtom((phpWithStart in Attr)
 640                    and not (phpWithoutClassKeyword in Attr),Attr);
 641  IsProcedure:=UpAtomIs('PROCEDURE');
 642  IsFunction:=(not IsProcedure) and UpAtomIs('FUNCTION');
 643  IsOperator:=(not IsProcedure) and (not IsFunction) and UpAtomIs('OPERATOR');
 644  if IsProcedure or IsFunction or IsOperator
 645  or (UpAtomIs('CONSTRUCTOR')) or (UpAtomIs('DESTRUCTOR'))
 646  then
 647    ExtractNextAtom(phpWithStart in Attr,Attr)
 648  else
 649    exit;
 650  ExtractProcHeadPos:=phepStart;
 651  if not IsProcType then begin
 652    // read name
 653    if ((not IsOperator)
 654    or (not WordIsCustomOperator.DoItCaseInsensitive(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)))
 655    and (not AtomIsIdentifier) then exit;
 656
 657    if TheClassName<>'' then begin
 658      s:=TheClassName+'.';
 659      if phpInUpperCase in Attr then s:=UpperCaseStr(s);
 660      if ExtractStreamEndIsIdentChar then
 661        s:=' '+s;
 662      ExtractMemStream.Write(s[1],length(s));
 663    end;
 664
 665    if [phpWithoutClassName,phpWithoutName]*Attr=[] then begin
 666      // read classname and name
 667      repeat
 668        ExtractNextAtom(true,Attr);
 669        if Scanner.CompilerMode = cmDELPHI then
 670        begin
 671          // delphi generics
 672          if AtomIsChar('<') then
 673          begin
 674            while not AtomIsChar('>') and (CurPos.EndPos < SrcLen) do
 675              ExtractNextAtom(not (phpWithoutGenericParams in Attr),Attr);
 676            ExtractNextAtom(not (phpWithoutGenericParams in Attr),Attr);
 677          end;
 678        end;
 679        if CurPos.Flag<>cafPoint then break;
 680        ExtractNextAtom(true,Attr);
 681        if ((not IsOperator)
 682        or (not WordIsCustomOperator.DoItCaseInsensitive(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)))
 683        and (not AtomIsIdentifier) then exit;
 684      until false;
 685    end else begin
 686      // read only part of name
 687      repeat
 688        ReadNextAtom;
 689        if (Scanner.CompilerMode = cmDELPHI) and AtomIsChar('<') then
 690        begin
 691          while not AtomIsChar('>') and (CurPos.EndPos < SrcLen) do
 692            ReadNextAtom;
 693          ReadNextAtom;
 694        end;
 695        IsClassName:=(CurPos.Flag=cafPoint);
 696        UndoReadNextAtom;
 697        if IsClassName then begin
 698          // read class name
 699          ExtractNextAtom(not (phpWithoutClassName in Attr),Attr);
 700          // read '.'
 701          ExtractNextAtom(not (phpWithoutClassName in Attr),Attr);
 702          if ((not IsOperator)
 703          or (not WordIsCustomOperator.DoItCaseInsensitive(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)))
 704          and (not AtomIsIdentifier) then exit;
 705        end else begin
 706          // read name
 707          ExtractNextAtom(not (phpWithoutName in Attr),Attr);
 708          break;
 709        end;
 710      until false;
 711    end;
 712    ExtractProcHeadPos:=phepName;
 713  end;
 714  // read parameter list
 715  if (CurPos.Flag=cafRoundBracketOpen) then
 716    ReadParamList(false,true,Attr);
 717  ExtractProcHeadPos:=phepParamList;
 718  if IsOperator and (CurPos.Flag=cafWord) then begin
 719    // read operator result name
 720    ExtractNextAtom([phpWithParameterNames,phpWithResultType]*Attr
 721                   =[phpWithParameterNames,phpWithResultType],Attr);
 722  end;
 723  // read result type
 724  if (CurPos.Flag=cafColon) then begin
 725    ExtractNextAtom(phpWithResultType in Attr,Attr);
 726    if not AtomIsIdentifier then exit;
 727    ExtractNextAtom(phpWithResultType in Attr,Attr);
 728    if CurPos.Flag=cafPoint then begin
 729      ExtractNextAtom(phpWithResultType in Attr,Attr);
 730      if not AtomIsIdentifier then exit;
 731      ExtractNextAtom(phpWithResultType in Attr,Attr);
 732    end;
 733    ExtractProcHeadPos:=phepResultType;
 734  end;
 735  // read 'of object'
 736  if UpAtomIs('OF') then begin
 737    if IsProcType then begin
 738      ExtractNextAtom(phpWithOfObject in Attr,Attr);
 739      if not UpAtomIs('OBJECT') then exit;
 740      ExtractNextAtom(phpWithOfObject in Attr,Attr);
 741    end;
 742  end;
 743  // read semicolon
 744  if CurPos.Flag=cafSemicolon then
 745    ExtractNextAtom(not (phpWithoutSemicolon in Attr),Attr);
 746  // read specifiers
 747  if [phpWithCallingSpecs,phpWithProcModifiers]*Attr<>[] then begin
 748    if ProcNode.FirstChild<>nil then
 749      EndPos:=ProcNode.FirstChild.EndPos
 750    else
 751      EndPos:=SrcLen+1;
 752    while (CurPos.StartPos<EndPos) do begin
 753      if CurPos.Flag=cafSemicolon then begin
 754        ExtractNextAtom(phpWithProcModifiers in Attr,Attr);
 755      end else begin
 756        if IsKeyWordCallingConvention.DoIdentifier(@Src[CurPos.StartPos])
 757        then begin
 758          ExtractNextAtom([phpWithCallingSpecs,phpWithProcModifiers]*Attr<>[],
 759                          Attr);
 760          if not (phpWithProcModifiers in Attr) then
 761            ExtractMemStream.Write(SemiColon,1);
 762        end
 763        else if (CurPos.Flag=cafEdgedBracketOpen) then begin
 764          ReadTilBracketClose(false);
 765          ExtractNextAtom(phpWithProcModifiers in Attr,Attr);
 766        end else begin
 767          ExtractNextAtom(phpWithProcModifiers in Attr,Attr);
 768        end;
 769      end;
 770    end;
 771  end;
 772
 773  // copy memorystream to Result string
 774  Result:=GetExtraction(phpInUpperCase in Attr);
 775  
 776  // add semicolon
 777  if ([phpWithoutSemicolon,phpDoNotAddSemicolon]*Attr=[])
 778  and (Result<>'') and (Result[length(Result)]<>';') then
 779    Result:=Result+';';
 780end;
 781
 782function TPascalReaderTool.ExtractProcHeadWithGroup(ProcNode: TCodeTreeNode;
 783  Attr: TProcHeadAttributes): TPascalMethodHeader;
 784begin
 785  Result.Name := ExtractProcHead(ProcNode, Attr);
 786  Result.Group := ExtractProcedureGroup(ProcNode);
 787  if Result.Group=mgClassOperator then
 788    Result.ResultType := ExtractFuncResultType(ProcNode, Attr);
 789end;
 790
 791function TPascalReaderTool.ExtractProcedureHeader(CursorPos: TCodeXYPosition;
 792  Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
 793var
 794  CleanCursorPos: integer;
 795  ANode: TCodeTreeNode;
 796begin
 797  Result:=false;
 798  ProcHead:='';
 799  BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
 800    [btSetIgnoreErrorPos,btCursorPosOutAllowed]);
 801  ANode:=FindDeepestNodeAtPos(CleanCursorPos,True);
 802  while (ANode<>nil) and (ANode.Desc<>ctnProcedure) do
 803    ANode:=ANode.Parent;
 804  if ANode=nil then exit;
 805  ProcHead:=ExtractProcHead(ANode,Attributes);
 806  Result:=true;
 807end;
 808
 809function TPascalReaderTool.ExtractClassName(Node: TCodeTreeNode;
 810  InUpperCase: boolean; WithParents: boolean; WithGenericParams: boolean
 811  ): string;
 812var
 813  ParamsNode: TCodeTreeNode;
 814  ParamNode: TCodeTreeNode;
 815  First: Boolean;
 816begin
 817  Result:='';
 818  while Node<>nil do begin
 819    case Node.Desc of
 820    ctnTypeDefinition:
 821      begin
 822        if Result<>'' then Result:='.'+Result;
 823        Result:=GetIdentifier(@Src[Node.StartPos])+Result;
 824        if not WithParents then break;
 825      end;
 826    ctnGenericType:
 827      begin
 828        if Result<>'' then Result:='.'+Result;
 829        if (Node.Desc = ctnGenericType) then begin
 830          // extract generic type param names
 831          if WithGenericParams then begin
 832            ParamsNode:=Node.FirstChild.NextBrother;
 833            First:=true;
 834            while ParamsNode<>nil do begin
 835              if ParamsNode.Desc=ctnGenericParams then begin
 836                Result:='>'+Result;
 837                ParamNode:=ParamsNode.FirstChild;
 838                while ParamNode<>nil do begin
 839                  if ParamNode.Desc=ctnGenericParameter then begin
 840                    if First then
 841                      First:=false
 842                    else
 843                      Result:=','+Result;
 844                    Result:=GetIdentifier(@Src[ParamNode.StartPos])+Result;
 845                  end;
 846                  ParamNode:=ParamNode.NextBrother;
 847                end;
 848                Result:='<'+Result;
 849              end;
 850              ParamsNode:=ParamsNode.NextBrother;
 851            end;
 852          end;
 853          Result:=GetIdentifier(@Src[Node.FirstChild.StartPos])+Result;
 854        end;
 855        if not WithParents then break;
 856      end;
 857    ctnParameterList:
 858      break;
 859    end;
 860    Node:=Node.Parent;
 861  end;
 862
 863  if InUpperCase then
 864    Result:=UpperCaseStr(Result);
 865end;
 866
 867function TPascalReaderTool.ExtractClassPath(Node: TCodeTreeNode): string;
 868var
 869  InArray: Boolean;
 870begin
 871  Result:='';
 872  InArray:=false;
 873  while Node<>nil do begin
 874    case Node.Desc of
 875    ctnTypeDefinition,ctnGenericType:
 876      begin
 877        if Result<>'' then Result:='.'+Result;
 878        if Node.Desc=ctnTypeDefinition then
 879          Result:=GetIdentifier(@Src[Node.StartPos])+Result
 880        else if Node.FirstChild<>nil then
 881        begin
 882          if (Scanner.CompilerMode = cmDELPHI) and (Node.Desc = ctnGenericType) then
 883            Result := Result + ExtractNode(Node.FirstChild.NextBrother, []);
 884          Result:=GetIdentifier(@Src[Node.FirstChild.StartPos])+Result;
 885        end;
 886      end;
 887    ctnParameterList:
 888      break;
 889    ctnRangedArrayType, ctnOpenArrayType:
 890       begin
 891         InArray := True;
 892         Result := '[]' + Result;
 893       end;
 894    ctnVarDefinition:
 895       if InArray then begin
 896         Result := GetIdentifier(@Src[Node.StartPos]) + Result;
 897         InArray := False;
 898       end;
 899    end;
 900    Node:=Node.Parent;
 901  end;
 902end;
 903
 904function TPascalReaderTool.ExtractClassInheritance(
 905  ClassNode: TCodeTreeNode; Attr: TProcHeadAttributes): string;
 906begin
 907  Result:='';
 908  if (ClassNode=nil) or (not (ClassNode.Desc in AllClasses)) then exit;
 909  MoveCursorToNodeStart(ClassNode);
 910  ReadNextAtom; // class
 911  if UpAtomIs('PACKED') then ReadNextAtom;
 912  if not (UpAtomIs('CLASS') or UpAtomIs('OBJECT') or UpAtomIs('OBJCLASS')
 913       or (UpAtomIs('INTERFACE')))
 914  then
 915    exit;
 916  ReadNextAtom; // '('
 917  if CurPos.Flag<>cafRoundBracketOpen then exit;
 918  ReadNextAtom;
 919  if not AtomIsIdentifier then exit;
 920  MoveCursorToCleanPos(CurPos.StartPos);
 921  ExtractProcHeadPos:=phepNone;
 922  InitExtraction;
 923  while (CurPos.StartPos<=SrcLen) do begin
 924    ExtractNextAtom(true,Attr); // read ancestor/interface
 925    if not AtomIsIdentifier then break;
 926    ExtractNextAtom(true,Attr); // read ','
 927    if not AtomIsChar(',') then break;
 928  end;
 929  // copy memorystream to Result string
 930  Result:=GetExtraction(phpInUpperCase in Attr);
 931end;
 932
 933function TPascalReaderTool.ExtractClassNameOfProcNode(ProcNode: TCodeTreeNode;
 934  AddParentClasses: boolean): string;
 935var
 936  Part: String;
 937begin
 938  Result:='';
 939  if (ProcNode<>nil) and (ProcNode.Desc=ctnProcedure) then
 940    ProcNode:=ProcNode.FirstChild;
 941  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedureHead) then exit;
 942  MoveCursorToNodeStart(ProcNode);
 943  repeat
 944    ReadNextAtom;
 945    if not AtomIsIdentifier then break;
 946    Part:=GetAtom;
 947    ReadNextAtom;
 948    if (Scanner.CompilerMode = cmDELPHI) and AtomIsChar('<') then
 949    begin { delphi generics }
 950      Part := Part + GetAtom;
 951      repeat
 952        ReadNextAtom;
 953        Part := Part + GetAtom;
 954      until (CurPos.StartPos > SrcLen) or AtomIsChar('>');
 955      ReadNextAtom;
 956    end;
 957    if (CurPos.Flag<>cafPoint) then break;
 958    if Result<>'' then Result:=Result+'.';
 959    Result:=Result+Part;
 960  until false;
 961  if not AddParentClasses then exit;
 962  Part:=ExtractClassName(ProcNode,false,true);
 963  if Part='' then exit;
 964  Result:=Part+'.'+Result;
 965end;
 966
 967function TPascalReaderTool.FindProcNode(StartNode: TCodeTreeNode;
 968  const AProcHead: TPascalMethodHeader; Attr: TProcHeadAttributes;
 969  Visibility: TClassSectionVisibility): TCodeTreeNode;
 970// search in all next brothers for a Procedure Node with the Name ProcName
 971// if there are no further brothers and the parent is a section node
 972// ( e.g. 'interface', 'implementation', ...) or a class visibility node
 973// (e.g. 'public', 'private', ...) then the search will continue in the next
 974// section
 975var
 976  InClass: Boolean;
 977  CurProcHead: TPascalMethodHeader;
 978begin
 979  Result:=StartNode;
 980  InClass:=FindClassOrInterfaceNode(StartNode)<>nil;
 981  while (Result<>nil) do begin
 982    if Result.Desc=ctnProcedure then begin
 983      if (not ((phpIgnoreForwards in Attr)
 984               and ((Result.SubDesc and ctnsForwardDeclaration)>0)))
 985      and (not ((phpIgnoreProcsWithBody in Attr)
 986            and (FindProcBody(Result)<>nil)))
 987      and (not InClass or IdentNodeIsInVisibleClassSection(Result, Visibility))
 988      then
 989      begin
 990        CurProcHead:=ExtractProcHeadWithGroup(Result,Attr);
 991        //DebugLn(['TPascalReaderTool.FindProcNode B "',CurProcHead,'" =? "',AProcHead,'" Result=',CompareTextIgnoringSpace(CurProcHead,AProcHead,false)]);
 992        if (CurProcHead.Name<>'') and
 993            SameMethodHeaders(AProcHead, CurProcHead)
 994        then
 995          exit;
 996      end;
 997    end;
 998    // next node
 999    if InClass then
1000      Result:=FindNextIdentNodeInClass(Result)
1001    else
1002      Result:=FindNextNodeOnSameLvl(Result);
1003  end;
1004end;
1005
1006function TPascalReaderTool.FindProcNode(StartNode: TCodeTreeNode;
1007  const AProcHead: string; AProcSpecType: TPascalMethodGroup;
1008  Attr: TProcHeadAttributes; Visibility: TClassSectionVisibility): TCodeTreeNode;
1009var
1010  ProcHead: TPascalMethodHeader;
1011begin
1012  ProcHead.Name := AProcHead;
1013  ProcHead.Group := AProcSpecType;
1014  Result := FindProcNode(StartNode, ProcHead, Attr, Visibility);
1015end;
1016
1017function TPascalReaderTool.FindCorrespondingProcNode(ProcNode: TCodeTreeNode;
1018  Attr: TProcHeadAttributes): TCodeTreeNode;
1019var
1020  ClassNode: TCodeTreeNode;
1021  StartNode: TCodeTreeNode;
1022  ProcHead: TPascalMethodHeader;
1023begin
1024  Result:=nil;
1025  // get ctnProcedure
1026  //debugln('TPascalReaderTool.FindCorrespondingProcNode Start');
1027  if (ProcNode=nil) then exit;
1028  if ProcNode.Desc=ctnProcedureHead then begin
1029    ProcNode:=ProcNode.Parent;
1030    if (ProcNode=nil) then exit;
1031  end;
1032  if ProcNode.Desc<>ctnProcedure then exit;
1033  
1034  // check proc kind
1035  //debugln('TPascalReaderTool.FindCorrespondingProcNode Check kind');
1036  ClassNode:=FindClassOrInterfaceNode(ProcNode);
1037  if ClassNode<>nil then begin
1038    //debugln('TPascalReaderTool.FindCorrespondingProcNode Class');
1039    // in a class definition -> search method body
1040    StartNode:=ClassNode.GetTopMostNodeOfType(ctnTypeSection);
1041  end else if NodeIsMethodBody(ProcNode) then begin
1042    //debugln('TPascalReaderTool.FindCorrespondingProcNode Method ',ExtractClassNameOfProcNode(ProcNode));
1043    // in a method body -> search in class
1044    StartNode:=FindClassNodeInUnit(ExtractClassNameOfProcNode(ProcNode,true),
1045             true,false,false,true);
1046    if StartNode=nil then exit;
1047    if (StartNode<>nil) and (StartNode.Desc in AllClasses)
1048    then begin
1049      StartNode:=StartNode.FirstChild;
1050      while (StartNode<>nil) do begin
1051        if (StartNode.Desc in AllClassBaseSections)
1052        and (StartNode.FirstChild<>nil) then begin
1053          StartNode:=StartNode.FirstChild;
1054          break;
1055        end;
1056        StartNode:=StartNode.NextBrother;
1057      end;
1058    end;
1059  end else begin
1060    //DebugLn('TPascalReaderTool.FindCorrespondingProcNode Normal');
1061    // else: search on same lvl
1062    StartNode:=FindFirstNodeOnSameLvl(ProcNode);
1063  end;
1064  if StartNode=nil then exit;
1065
1066  ProcHead:=ExtractProcHeadWithGroup(ProcNode,Attr);
1067  //debugln('TPascalReaderTool.FindCorrespondingProcNode StartNode=',StartNode.DescAsString,' ProcHead=',dbgstr(ProcHead),' ',dbgs(Attr),' ',StartNode.DescAsString);
1068  Result:=FindProcNode(StartNode,ProcHead,Attr);
1069  if Result=ProcNode then begin
1070    // found itself -> search further
1071    StartNode:=FindNextNodeOnSameLvl(Result);
1072    Result:=FindProcNode(StartNode,ProcHead,Attr);
1073  end;
1074  //if Result<>nil then debugln(['TPascalReaderTool.FindCorrespondingProcNode Result=',CleanPosToStr(Result.StartPos),' ',dbgstr(copy(Src,Result.StartPos,50))]);
1075end;
1076
1077function TPascalReaderTool.FindCorrespondingProcParamNode(
1078  ProcParamNode: TCodeTreeNode; Attr: TProcHeadAttributes): TCodeTreeNode;
1079var
1080  ProcNode: TCodeTreeNode;
1081begin
1082  Result:=nil;
1083  if ProcParamNode=nil then exit;
1084  if (ProcParamNode.Desc=ctnVarDefinition)
1085  and (ProcParamNode.Parent.Desc=ctnParameterList)
1086  and (ProcParamNode.Parent.Parent.Desc=ctnProcedureHead) then begin
1087    // this is a parameter name
1088    ProcNode:=ProcParamNode.GetNodeOfType(ctnProcedure);
1089    if ProcNode=nil then exit;
1090    // search alias for parameter
1091    ProcNode:=FindCorrespondingProcNode(ProcNode,Attr);
1092    if ProcNode=nil then exit;
1093    BuildSubTreeForProcHead(ProcNode);
1094    Result:=ProcNode;
1095    while (Result<>nil) do begin
1096      //debugln(['TPascalReaderTool.FindCorrespondingProcParamNode ',dbgstr(copy(Src,Result.StartPos,20))]);
1097      if Result.Desc
1098        in [ctnProcedure,ctnProcedureHead,ctnParameterList]
1099      then
1100        Result:=Result.FirstChild
1101      else begin
1102        if Result.StartPos<1 then break;
1103        if CompareIdentifiers(@Src[ProcParamNode.StartPos],@Src[Result.StartPos])=0
1104        then exit;
1105        Result:=Result.NextBrother;
1106      end;
1107    end;
1108    Result:=nil;
1109  end;
1110end;
1111
1112function TPascalReaderTool.FindDefinitionNameNode(DefinitionNode: TCodeTreeNode
1113  ): TCodeTreeNode;
1114begin
1115  if DefinitionNode.Desc=ctnGenericType then
1116  begin
1117    if DefinitionNode.FirstChild<>nil then
1118      Result:=DefinitionNode.FirstChild
1119    else
1120      Result:=nil;
1121  end else
1122    Result:=DefinitionNode;
1123end;
1124
1125function TPascalReaderTool.FindProcBody(ProcNode: TCodeTreeNode): TCodeTreeNode;
1126begin
1127  Result:=ProcNode;
1128  if Result=nil then exit;
1129  if Result.Desc<>ctnProcedure then exit;
1130  Result:=Result.LastChild;
1131  while Result<>nil do begin
1132    if Result.Desc in [ctnBeginBlock,ctnAsmBlock] then
1133      exit;
1134    Result:=Result.PriorBrother;
1135  end;
1136end;
1137
1138function TPascalReaderTool.ProcBodyIsEmpty(ProcNode: TCodeTreeNode): boolean;
1139var
1140  BodyNode: TCodeTreeNode;
1141  LastPos: LongInt;
1142begin
1143  Result:=false;
1144  BodyNode:=FindProcBody(ProcNode);
1145  if (BodyNode=nil) then exit;
1146  // check if there are nodes in front (e.g. local variables)
1147  if (BodyNode.PriorBrother<>nil)
1148  and (BodyNode.PriorBrother.Desc<>ctnProcedureHead) then
1149    exit;
1150  // check if there are child nodes
1151  if BodyNode.FirstChild<>nil then exit;
1152  // check if bodynode is only 'asm end' or 'begin end'
1153  // not even a comment should be there, only spaces are allowed
1154  if ProcNode.FirstChild.Desc<>ctnProcedureHead then exit;
1155  MoveCursorToCleanPos(ProcNode.FirstChild.EndPos);
1156  LastPos:=CurPos.EndPos;
1157  ReadNextAtom;
1158  if FindNextNonSpace(Src,LastPos)<>CurPos.StartPos then exit;
1159  if CurPos.Flag=cafSemicolon then begin
1160    // semicolon is allowed
1161    LastPos:=CurPos.EndPos;
1162    ReadNextAtom;
1163    if FindNextNonSpace(Src,LastPos)<>CurPos.StartPos then exit;
1164  end;
1165  if not (UpAtomIs('ASM') or UpAtomIs('BEGIN')) then exit;
1166  LastPos:=CurPos.EndPos;
1167  ReadNextAtom;
1168  if FindNextNonSpace(Src,LastPos)<>CurPos.StartPos then exit;
1169  // inherited is allowed
1170  if UpAtomIs('INHERITED') then begin
1171    ReadNextAtom;
1172    if CurPos.Flag=cafSemicolon then begin
1173      // semicolon is allowed
1174      LastPos:=CurPos.EndPos;
1175      ReadNextAtom;
1176      if FindNextNonSpace(Src,LastPos)<>CurPos.StartPos then exit;
1177    end;
1178  end;
1179  if not UpAtomIs('END') then exit;
1180  Result:=true;
1181end;
1182
1183procedure TPascalReaderTool.MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode);
1184// After the call,
1185// CurPos will stand on the first proc specifier or on a semicolon
1186// this can be 'of object'
1187begin
1188  //DebugLn(['TPascalReaderTool.MoveCursorToFirstProcSpecifier ',ProcNode.DescAsString,' ',ProcNode.StartPos]);
1189  if (ProcNode<>nil) and (ProcNode.Desc in [ctnProcedureType,ctnProcedure]) then
1190    ProcNode:=ProcNode.FirstChild;
1191  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedureHead) then begin
1192    RaiseException('Internal Error in'
1193      +' TPascalParserTool.MoveCursorFirstProcSpecifier: '
1194      +' (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure)');
1195  end;
1196  if (ProcNode.LastChild<>nil) and (ProcNode.LastChild.Desc=ctnIdentifier) then
1197  begin
1198    // jump behind function result type
1199    MoveCursorToCleanPos(ProcNode.LastChild.EndPos);
1200    ReadNextAtom;
1201  end else if (ProcNode.FirstChild<>nil)
1202    and (ProcNode.FirstChild.Desc=ctnParameterList)
1203  then begin
1204    // jump behind parameter list
1205    MoveCursorToCleanPos(ProcNode.FirstChild.EndPos);
1206    ReadNextAtom;
1207  end else begin
1208    MoveCursorToNodeStart(ProcNode);
1209    ReadNextAtom;
1210    if AtomIsCustomOperator(true,false,false) then begin
1211      // read name
1212      ReadNextAtom;
1213      while (CurPos.Flag=cafPoint) do begin
1214        ReadNextAtom;
1215        if CurPos.Flag in [cafPoint,cafRoundBracketOpen,cafEdgedBracketOpen,cafColon,cafEnd,cafSemicolon]
1216        then break;
1217        ReadNextAtom;
1218      end;
1219    end;
1220    if (CurPos.Flag=cafRoundBracketOpen) then begin
1221      // read paramlist
1222      ReadTilBracketClose(false);
1223      ReadNextAtom;
1224    end;
1225  end;
1226  if (CurPos.Flag=cafColon) then begin
1227    // read function result type
1228    ReadNextAtom;
1229    if AtomIsIdentifier then begin
1230      ReadNextAtom;
1231      while CurPos.Flag=cafPoint do begin
1232        ReadNextAtom;
1233        if not AtomIsIdentifier then break;
1234        ReadNextAtom;
1235      end;
1236    end;
1237  end;
1238  // CurPos now stands on the first proc specifier or on a semicolon or on the syntax error
1239end;
1240
1241function TPascalReaderTool.MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
1242  ProcSpec: TProcedureSpecifier): boolean;
1243begin
1244  if ProcNode.FirstChild=nil then begin
1245    exit(false);
1246  end;
1247  MoveCursorToFirstProcSpecifier(ProcNode);
1248  while (CurPos.StartPos<=ProcNode.FirstChild.EndPos) do begin
1249    if CurPos.Flag=cafSemicolon then begin
1250      ReadNextAtom;
1251    end else begin
1252      if UpAtomIs(ProcedureSpecifierNames[ProcSpec]) then begin
1253        Result:=true;
1254        exit;
1255      end;
1256      if (CurPos.Flag=cafEdgedBracketOpen) then begin
1257        ReadTilBracketClose(false);
1258        ReadNextAtom;
1259      end else if UpAtomIs('MESSAGE') then begin
1260        ReadNextAtom;
1261        ReadConstant(true,false,[]);
1262      end else if UpAtomIs('EXTERNAL') then begin
1263        ReadNextAtom;
1264        if CurPos.Flag<>cafSemicolon then begin
1265          if not UpAtomIs('NAME') then
1266            ReadConstant(true,false,[]);
1267          if UpAtomIs('NAME') or UpAtomIs('INDEX') then begin
1268            ReadNextAtom;
1269            ReadConstant(true,false,[]);
1270          end;
1271        end;
1272      end else begin
1273        ReadNextAtom;
1274      end;
1275    end;
1276  end;
1277  Result:=false;
1278end;
1279
1280procedure TPascalReaderTool.MoveCursorToProcName(ProcNode: TCodeTreeNode;
1281  SkipClassName: boolean);
1282begin
1283  if (ProcNode.Desc=ctnProcedure) and (ProcNode.FirstChild<>nil)
1284  and (ProcNode.FirstChild.Desc=ctnProcedureHead) then
1285    ProcNode:=ProcNode.FirstChild;
1286  MoveCursorToNodeStart(ProcNode);
1287  ReadNextAtom;
1288  if (ProcNode.Desc=ctnProcedure) then begin
1289    if UpAtomIs('CLASS') then ReadNextAtom;
1290    ReadNextAtom; // skip proc keyword
1291  end;
1292  if not SkipClassName then exit;
1293  repeat
1294    ReadNextAtom;
1295    if CurPos.Flag<>cafPoint then begin
1296      UndoReadNextAtom;
1297      break;
1298    end;
1299    ReadNextAtom;
1300  until not AtomIsIdentifier;
1301end;
1302
1303procedure TPascalReaderTool.MoveCursorBehindProcName(ProcNode: TCodeTreeNode);
1304begin
1305  if (ProcNode.FirstChild<>nil)
1306  and (ProcNode.FirstChild.Desc=ctnProcedureHead) then
1307    ProcNode:=ProcNode.FirstChild;
1308  MoveCursorToNodeStart(ProcNode);
1309  ReadNextAtom;
1310  if AtomIsIdentifier then begin
1311    ReadNextAtom;
1312    while CurPos.Flag=cafPoint do begin
1313      ReadNextAtom;
1314      if not AtomIsIdentifier then exit;
1315      ReadNextAtom;
1316    end;
1317  end else if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen,cafColon]
1318  then begin
1319  end else begin
1320    // operator
1321    ReadNextAtom;
1322  end;
1323end;
1324
1325function TPascalReaderTool.PositionInProcName(ProcNode: TCodeTreeNode;
1326  SkipClassName: boolean; CleanPos: integer): boolean;
1327begin
1328  if (ProcNode.Desc=ctnProcedure) and (ProcNode.FirstChild<>nil)
1329  and (ProcNode.FirstChild.Desc=ctnProcedureHead) then
1330    ProcNode:=ProcNode.FirstChild;
1331  if (CleanPos<ProcNode.StartPos) or (CleanPos>ProcNode.EndPos) then exit(false);
1332  MoveCursorToNodeStart(ProcNode);
1333  ReadNextAtom;
1334  if (ProcNode.Desc=ctnProcedure) then begin
1335    if UpAtomIs('CLASS') then ReadNextAtom;
1336    ReadNextAtom; // skip proc keyword
1337  end;
1338  if CleanPos<CurPos.StartPos then exit(false);
1339  while CurPos.Flag=cafWord do begin
1340    ReadNextAtom;
1341    if CurPos.Flag<>cafPoint then begin
1342      UndoReadNextAtom;
1343      break;
1344    end;
1345    ReadNextAtom;
1346  end;
1347  // CurPos is now on the proc name
1348  if CleanPos>CurPos.EndPos then exit(false);
1349  if SkipClassName and (CleanPos<CurPos.StartPos) then exit(false);
1350  Result:=true;
1351end;
1352
1353function TPascalReaderTool.PositionInFuncResultName(ProcNode: TCodeTreeNode;
1354  CleanPos: integer): boolean;
1355// true if position between ) and :
1356var
1357  Node: TCodeTreeNode;
1358begin
1359  Result:=false;
1360  if ProcNode=nil then exit;
1361  if ProcNode.Desc=ctnProcedure then begin
1362    ProcNode:=ProcNode.FirstChild;
1363    if ProcNode=nil then exit;
1364  end;
1365  if (ProcNode.Desc in [ctnIdentifier,ctnVarDefinition])
1366  and (ProcNode.Parent<>nil)
1367  and (ProcNode.Parent.Desc=ctnProcedureHead)
1368  and (CleanPos>=ProcNode.StartPos) and (CleanPos<=ProcNode.EndPos) then begin
1369    exit(true);
1370  end;
1371  if ProcNode.Desc=ctnProcedureHead then begin
1372    Node:=ProcNode.FirstChild;
1373    while (Node<>nil) and (Node.Desc<>ctnIdentifier) do begin
1374      if (Node.Desc=ctnIdentifier)
1375      and (CleanPos>=Node.StartPos) and (CleanPos<=Node.EndPos) then
1376        exit(true);
1377      Node:=Node.NextBrother;
1378    end;
1379  end;
1380  // read behind parameter list
1381  if ProcNode.Desc<>ctnProcedureHead then exit;
1382  if (ProcNode.FirstChild<>nil) and (ProcNode.FirstChild.Desc=ctnParameterList)
1383  then begin
1384    if (CleanPos<ProcNode.FirstChild.EndPos) then
1385      exit;
1386    MoveCursorToCleanPos(ProcNode.FirstChild.EndPos);
1387  end else begin
1388    MoveCursorToNodeStart(ProcNode);
1389    ReadNextAtom;
1390    while AtomIsIdentifier do begin
1391      ReadNextAtom;
1392      if (CurPos.Flag<>cafPoint) then break;
1393      ReadNextAtom;
1394    end;
1395    if CurPos.Flag=cafRoundBracketOpen then
1396      if not ReadTilBracketClose(false) then exit;
1397  end;
1398  if CurPos.StartPos>CleanPos then exit;
1399  // read optional result variable (e.g. operator can have them)
1400  ReadNextAtom;
1401  if AtomIsIdentifier then ReadNextAtom;
1402  if CurPos.Flag<>cafColon then exit;
1403  Result:=CleanPos<=CurPos.StartPos;
1404end;
1405
1406function TPascalReaderTool.MoveCursorToPropType(PropNode: TCodeTreeNode): boolean;
1407begin
1408  Result:=false;
1409  if (PropNode=nil)
1410  or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
1411    exit;
1412  MoveCursorToNodeStart(PropNode);
1413  ReadNextAtom;
1414  if (PropNode.Desc=ctnProperty) then begin
1415    if UpAtomIs('CLASS') then ReadNextAtom;
1416    if (not UpAtomIs('PROPERTY')) then exit;
1417    ReadNextAtom;
1418  end;
1419  if not AtomIsIdentifier then exit;
1420  ReadNextAtom;
1421  if CurPos.Flag=cafEdgedBracketOpen then begin
1422    ReadTilBracketClose(true);
1423    ReadNextAtom;
1424  end;
1425  if CurPos.Flag in [cafSemicolon,cafEND] then exit;
1426  if CurPos.Flag<>cafColon then exit;
1427  ReadNextAtom;
1428  Result:=CurPos.Flag=cafWord;
1429end;
1430
1431function TPascalReaderTool.MoveCursorToPropName(PropNode: TCodeTreeNode): boolean;
1432begin
1433  Result:=false;
1434  if (PropNode=nil)
1435  or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
1436    exit;
1437  MoveCursorToNodeStart(PropNode);
1438  ReadNextAtom;
1439  if (PropNode.Desc=ctnProperty) then begin
1440    if UpAtomIs('CLASS') then ReadNextAtom;
1441    if (not UpAtomIs('PROPERTY')) then exit;
1442    ReadNextAtom;
1443  end;
1444  Result:=CurPos.Flag=cafWord;
1445end;
1446
1447procedure TPascalReaderTool.MoveCursorBehindPropName(PropNode: TCodeTreeNode);
1448begin
1449  if (PropNode=nil)
1450  or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
1451    exit;
1452  MoveCursorToNodeStart(PropNode);
1453  ReadNextAtom;
1454  if (PropNode.Desc=ctnProperty) then begin
1455    if UpAtomIs('CLASS') then ReadNextAtom;
1456    if (not UpAtomIs('PROPERTY')) then exit;
1457    ReadNextAtom;
1458  end;
1459  if not AtomIsIdentifier then exit;
1460  ReadNextAtom;
1461end;
1462
1463function TPascalReaderTool.ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
1464  ProcSpec: TProcedureSpecifier): boolean;
1465begin
1466  Result:=false;
1467  if ProcNode=nil then exit;
1468  if ProcNode.Desc=ctnProcedureHead then
1469    ProcNode:=ProcNode.Parent;
1470  {$IFDEF CheckNodeTool}
1471  if ProcNode.Desc<>ctnProcedure then begin
1472    DebugLn(['TPascalReaderTool.ProcNodeHasSpecifier Desc=',ProcNode.DescAsString]);
1473    CTDumpStack;
1474    RaiseException('[TPascalReaderTool.ProcNodeHasSpecifier] '
1475      +'internal error: invalid ProcNode');
1476  end;
1477  {$ENDIF}
1478  if (ProcNode.FirstChild=nil)
1479  or ((ProcNode.SubDesc and ctnsNeedJITParsing)>0) then
1480    BuildSubTreeForProcHead(ProcNode);
1481
1482  // ToDo: ppu, dcu
1483
1484  Result:=MoveCursorToProcSpecifier(ProcNode,ProcSpec);
1485end;
1486
1487function TPascalReaderTool.GetProcNameIdentifier(ProcNode: TCodeTreeNode): PChar;
1488begin
1489
1490  // ToDo: ppu, dcu
1491
1492  Result:=nil;
1493  if ProcNode=nil then exit;
1494  if ProcNode.Desc=ctnProcedure then begin
1495    ProcNode:=ProcNode.FirstChild;
1496    if ProcNode=nil then exit;
1497  end;
1498  MoveCursorToNodeStart(ProcNode);
1499  repeat
1500    ReadNextAtom;
1501    if not AtomIsIdentifier then exit(nil);
1502    Result:=@Src[CurPos.StartPos];
1503    ReadNextAtom;
1504  until CurPos.Flag<>cafPoint;
1505end;
1506
1507function TPascalReaderTool.ExtractNode(ANode: TCodeTreeNode;
1508  Attr: TProcHeadAttributes): string;
1509begin
1510  Result:='';
1511  ExtractProcHeadPos:=phepNone;
1512  if (ANode=nil) or (ANode.StartPos<1) then exit;
1513  InitExtraction;
1514  // reparse the clean source
1515  MoveCursorToNodeStart(ANode);
1516  while (ANode.EndPos>CurPos.StartPos)
1517  and (CurPos.StartPos<=SrcLen) do
1518    ExtractNextAtom(true,Attr);
1519  // copy memorystream to Result string
1520  Result:=GetExtraction(phpInUpperCase in Attr);
1521end;
1522
1523function TPascalReaderTool.ExtractCode(StartPos, EndPos: integer;
1524  Attr: TProcHeadAttributes): string;
1525begin
1526  Result:='';
1527  ExtractProcHeadPos:=phepNone;
1528  if (StartPos<1) or (StartPos>=EndPos) or (StartPos>SrcLen) then exit;
1529  InitExtraction;
1530  // reparse the clean source
1531  MoveCursorToCleanPos(StartPos);
1532  while (EndPos>CurPos.StartPos)
1533  and (CurPos.StartPos<=SrcLen) do
1534    ExtractNextAtom(true,Attr);
1535  // copy memorystream to Result string
1536  Result:=GetExtraction(phpInUpperCase in Attr);
1537end;
1538
1539function TPascalReaderTool.ExtractBrackets(BracketStartPos: integer;
1540  Attr: TProcHeadAttributes): string;
1541
1542  function ExtractTilBracketClose(ExtractBrackets: boolean): boolean;
1543  var
1544    CloseBracket: TCommonAtomFlag;
1545    First: Boolean;
1546  begin
1547    Result:=true;
1548    case CurPos.Flag of
1549    cafRoundBracketOpen: CloseBracket:=cafRoundBracketClose;
1550    cafEdgedBracketOpen: CloseBracket:=cafEdgedBracketClose;
1551    else exit;
1552    end;
1553    First:=true;
1554    repeat
1555      if First then
1556        ExtractNextAtom(ExtractBrackets,Attr)
1557      else
1558        ExtractNextAtom(true,Attr);
1559      if CurPos.StartPos>SrcLen then exit;
1560      if CurPos.Flag=CloseBracket then exit(true);
1561      if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
1562        if not ExtractTilBracketClose(true) then exit;
1563      end;
1564    until false;
1565  end;
1566
1567begin
1568  Result:='';
1569  ExtractProcHeadPos:=phepNone;
1570  if (BracketStartPos<1) or (BracketStartPos>SrcLen) then exit;
1571  InitExtraction;
1572  // reparse the clean source
1573  MoveCursorToCleanPos(BracketStartPos);
1574  ReadNextAtom;
1575  if not ExtractTilBracketClose(not (phpWithoutBrackets in Attr)) then exit;
1576  if not (phpWithoutBrackets in Attr) then
1577    ExtractNextAtom(true,Attr);
1578  // copy memorystream to Result string
1579  Result:=GetExtraction(phpInUpperCase in Attr);
1580end;
1581
1582function TPascalReaderTool.ExtractIdentifierWithPoints(StartPos: integer;
1583  ExceptionOnError: boolean): string;
1584begin
1585  Result:='';
1586  MoveCursorToCleanPos(StartPos);
1587  ReadNextAtom;
1588  if not AtomIsIdentifierE(ExceptionOnError) then exit;
1589  Result:=GetAtom;
1590  repeat
1591    ReadNextAtom;
1592    if CurPos.Flag<>cafPoint then
1593      exit;
1594    ReadNextAtom;
1595    if not AtomIsIdentifierE(ExceptionOnError) then exit;
1596    Result+='.'+GetAtom;
1597  until false;
1598end;
1599
1600function TPascalReaderTool.ExtractPropName(PropNode: TCodeTreeNode;
1601  InUpperCase: boolean): string;
1602begin
1603  Result:='';
1604  if not MoveCursorToPropName(PropNode) then exit;
1605  if InUpperCase then
1606    Result:=GetUpAtom
1607  else
1608    Result:=GetAtom;
1609end;
1610
1611function TPascalReaderTool.ExtractProperty(PropNode: TCodeTreeNode;
1612  Attr: TProcHeadAttributes): string;
1613begin
1614  Result:='';
1615  ExtractProcHeadPos:=phepNone;
1616  if (PropNode=nil) or (PropNode.StartPos<1)
1617  or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
1618    exit;
1619  // start extraction
1620  InitExtraction;
1621  MoveCursorToNodeStart(PropNode);
1622  ExtractNextAtom(false,Attr);
1623  if (PropNode.Desc=ctnProperty) then begin
1624    if UpAtomIs('CLASS') then
1625      ExtractNextAtom(phpWithStart in Attr,Attr);
1626    // parse 'property'
1627    ExtractNextAtom(phpWithStart in Attr,Attr);
1628  end;
1629  ExtractProcHeadPos:=phepStart;
1630  // parse name
1631  ExtractNextAtom(not (phpWithoutName in Attr),Attr);
1632  ExtractProcHeadPos:=phepName;
1633  // read parameter list
1634  if (CurPos.Flag=cafEdgedBracketOpen) then
1635    ReadParamList(false,true,Attr);
1636  ExtractProcHeadPos:=phepParamList;
1637  // read result type
1638  if (CurPos.Flag=cafColon) then begin
1639    ExtractNextAtom(phpWithResultType in Attr,Attr);
1640    if not AtomIsIdentifier then exit;
1641    ExtractNextAtom(phpWithResultType in Attr,Attr);
1642    if CurPos.Flag=cafPoint then begin
1643      // unit.type
1644      ExtractNextAtom(phpWithResultType in Attr,Attr);
1645      if not AtomIsIdentifier then exit;
1646      ExtractNextAtom(phpWithResultType in Attr,Attr);
1647    end;
1648    ExtractProcHeadPos:=phepResultType;
1649  end;
1650
1651  // copy memorystream to Result string
1652  Result:=GetExtraction(phpInUpperCase in Attr);
1653end;
1654
1655function TPascalReaderTool.GetPropertyNameIdentifier(PropNode: TCodeTreeNode): PChar;
1656begin
1657  // ToDo: ppu, dcu
1658
1659  Result:=nil;
1660  if PropNode=nil then exit;
1661  if not MoveCursorToPropName(PropNode) then exit;
1662  Result:=@Src[CurPos.StartPos];
1663end;
1664
1665function TPascalReaderTool.GetPropertyTypeIdentifier(PropNode: TCodeTreeNode): PChar;
1666begin
1667
1668  // ToDo: ppu, dcu
1669
1670  Result:=nil;
1671  if PropNode=nil then exit;
1672  if not MoveCursorToPropType(PropNode) then exit;
1673  Result:=@Src[CurPos.StartPos];
1674end;
1675
1676function TPascalReaderTool.PositionInPropertyName(PropNode: TCodeTreeNode;
1677  CleanPos: integer): boolean;
1678begin
1679  if PropNode=nil then exit(false);
1680  MoveCursorToNodeStart(PropNode);
1681  if (PropNode.Desc=ctnProperty) then begin
1682    ReadNextAtom; // read 'property'
1683    if UpAtomIs('CLASS') then ReadNextAtom;
1684  end;
1685  ReadNextAtom; // read name
1686  Result:=(CurPos.Flag=cafWord)
1687          and (CleanPos>=CurPos.StartPos) and (CleanPos<=CurPos.EndPos);
1688end;
1689
1690function TPascalReaderTool.ExtractIdentCharsFromStringConstant(StartPos,
1691  MinPos, MaxPos, MaxLen: integer): string;
1692var
1693  APos: Integer;
1694  IdentStartPos: Integer;
1695  IdentStr: String;
1696  IdentEndPos: LongInt;
1697begin
1698  Result:='';
1699  APos:=StartPos;
1700  while APos<SrcLen do begin
1701    if (Src[APos]='#') then begin
1702      // skip char constant
1703      inc(APos);
1704      if IsNumberChar[Src[APos]] then begin
1705        while (APos<CurPos.EndPos) and IsNumberChar[Src[APos]] do
1706          inc(APos)
1707      end else if Src[APos]='$' then begin
1708        while (APos<CurPos.EndPos) and IsHexNumberChar[Src[APos]] do
1709          inc(APos);
1710      end;
1711    end else if (Src[APos]='''') then begin
1712      inc(APos);
1713      repeat
1714        // read identifier chars
1715        IdentStartPos:=APos;
1716        while (APos<SrcLen) and (IsIdentChar[Src[APos]]) do
1717          inc(APos);
1718        IdentEndPos:=APos;
1719        if IdentStartPos<MinPos then IdentStartPos:=MinPos;
1720        if IdentEndPos>MaxPos then IdentEndPos:=MaxPos;
1721        if (IdentEndPos>IdentStartPos) then begin
1722          if IdentEndPos-IdentStartPos+length(Result)>MaxLen then
1723            IdentEndPos:=IdentStartPos+MaxLen-length(Result);
1724          IdentStr:=copy(Src,IdentStartPos,IdentEndPos-IdentStartPos);
1725          if (IdentStr<>'') then begin
1726            IdentStr[1]:=UpChars[IdentStr[1]];
1727            Result:=Result+IdentStr;
1728          end;
1729        end;
1730        // skip non identifier chars
1731        while (APos<SrcLen) and (Src[APos]<>'''')
1732        and (not IsIdentChar[Src[APos]])
1733        do
1734          inc(APos);
1735      until (APos>=SrcLen) or (Src[APos]='''') or (length(Result)>=MaxLen);
1736      inc(APos);
1737    end else
1738      break;
1739  end;
1740end;
1741
1742function TPascalReaderTool.ReadStringConstantValue(StartPos: integer): string;
1743// reads a string constant and returns the resulting string
1744var
1745  Run: Integer;
1746  NumberStart: PChar;
1747  ResultLen: Integer;
1748  Number: Integer;
1749  p: PChar;
1750begin
1751  Result:='';
1752  if StartPos>SrcLen then exit;
1753  // first read and calculate the resulting length, then copy the chars
1754  for Run:=1 to 2 do begin
1755    ResultLen:=0;
1756    p:=@Src[StartPos];
1757    while true do begin
1758      case p^ of
1759      '''':
1760        begin
1761          // read string
1762          inc(p);
1763          while true do begin
1764            if p^='''' then begin
1765              if p[1]='''' then begin
1766                // a double ' means a single '
1767                inc(ResultLen);
1768                if Run=2 then Result[ResultLen]:='''';
1769                inc(p,2);
1770              end else begin
1771                // a single ' means end of string constant
1772                inc(p);
1773                break;
1774              end;
1775            end else begin
1776              // normal char
1777              inc(ResultLen);
1778              if Run=2 then Result[ResultLen]:=p^;
1779              inc(p);
1780            end;
1781          end;
1782        end;
1783      '#':
1784        begin
1785          // read char constant
1786          inc(p);
1787          NumberStart:=p;
1788          if IsNumberChar[p^] then begin
1789            // read decimal number
1790            while IsNumberChar[p^] do
1791              inc(p);
1792            Number:=StrToIntDef(copy(Src,NumberStart-PChar(Src)+1,p-NumberStart),-1);
1793          end else if p^='$' then begin
1794            // read hexnumber
1795            inc(p);
1796            while IsHexNumberChar[p^] do
1797              inc(p);
1798            Number:=HexStrToIntDef(NumberStart,-1);
1799          end else
1800            Number:=-1;
1801          // add special character
1802          if (Number<0) or (Number>255) then break;
1803          inc(ResultLen);
1804          if Run=2 then Result[ResultLen]:=chr(Number);
1805        end;
1806      '^':
1807        begin
1808          inc(p);
1809          if p^ in ['A'..'Z'] then begin
1810            inc(ResultLen);
1811            if Run=2 then Result[ResultLen]:=chr(ord(p^)-ord('A'));
1812          end else begin
1813            break;
1814          end;
1815        end;
1816      else
1817        break;
1818      end;
1819    end;
1820    if Run=1 then SetLength(Result,ResultLen);
1821  end;
1822end;
1823
1824function TPascalReaderTool.GetNodeIdentifier(Node: TCodeTreeNode): PChar;
1825begin
1826  Result:=nil;
1827  if (Node=nil) or (Node.StartPos>SrcLen) then exit;
1828  case Node.Desc of
1829  ctnProcedure,ctnProcedureHead:
1830    Result:=GetProcNameIdentifier(Node);
1831  ctnProperty:
1832     Result:=GetPropertyNameIdentifier(Node);
1833  ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition,
1834  ctnEnumIdentifier,ctnIdentifier:
1835    Result:=@Src[Node.StartPos];
1836  end;
1837end;
1838
1839function TPascalReaderTool.GetHintModifiers(Node: TCodeTreeNode): TPascalHintModifiers;
1840
1841  function IsHintModifier: boolean;
1842  begin
1843    if CurPos.Flag<>cafWord then exit(false);
1844    Result:=true;
1845    if UpAtomIs('PLATFORM') then
1846      Include(GetHintModifiers,phmPlatform)
1847    else if UpAtomIs('UNIMPLEMENTED') then
1848      Include(GetHintModifiers,phmUnimplemented)
1849    else if UpAtomIs('LIBRARY') then
1850      Include(GetHintModifiers,phmLibrary)
1851    else if UpAtomIs('EXPERIMENTAL') then
1852      Include(GetHintModifiers,phmExperimental)
1853    else if UpAtomIs('DEPRECATED') then
1854      Include(GetHintModifiers,phmDeprecated)
1855    else
1856      Result:=false;
1857  end;
1858
1859begin
1860  Result:=[];
1861  if Node=nil then exit;
1862  case Node.Desc of
1863
1864  ctnProgram,ctnPackage,ctnLibrary,ctnUnit:
1865    begin
1866      MoveCursorToNodeStart(Node);
1867      ReadNextAtom;
1868      if not (UpAtomIs('PROGRAM') or UpAtomIs('PACKAGE') or UpAtomIs('LIBRARY')
1869        or UpAtomIs('UNIT')) then exit;
1870      ReadNextAtom;// name
1871      while IsHintModifier do ReadNextAtom;
1872    end;
1873
1874  ctnProcedure,ctnProcedureType,ctnProcedureHead:
1875    begin
1876      if Node.Desc<>ctnProcedureHead then begin
1877        Node:=Node.FirstChild;
1878        if Node=nil then exit;
1879      end;
1880      MoveCursorToFirstProcSpecifier(Node);
1881      // ToDo:
1882    end;
1883
1884  ctnProperty:
1885    begin
1886      Node:=Node.LastChild;
1887      while Node<>nil do begin
1888        if Node.Desc=ctnHintModifier then begin
1889          MoveCursorToNodeStart(Node);
1890          ReadNextAtom;
1891          IsHintModifier;
1892        end;
1893        Node:=Node.PriorBrother;
1894      end;
1895    end;
1896
1897  ctnVarDefinition,ctnConstant,ctnConstDefinition,
1898  ctnTypeDefinition,ctnGenericType:
1899    begin
1900      Node:=FindTypeNodeOfDefinition(Node);
1901      if Node=nil then exit;
1902      while (Node<>nil) do begin
1903        if Node.Desc=ctnHintModifier then begin
1904          MoveCursorToNodeStart(Node);
1905          ReadNextAtom;
1906          IsHintModifier;
1907        end;
1908        Node:=Node.NextBrother;
1909      end;
1910    end;
1911
1912  end;
1913end;
1914
1915procedure TPascalReaderTool.ForEachIdentifierInCleanSrc(StartPos,
1916  EndPos: integer; SkipComments: boolean; Node: TCodeTreeNode;
1917  const OnIdentifier: TOnEachPRIdentifier; Data: pointer; var Abort: boolean);
1918var
1919  CommentLvl: Integer;
1920  InStrConst: Boolean;
1921  p: PChar;
1922  EndP: Pointer;
1923  Range: TEPRIRange;
1924
1925  procedure SkipIdentifier; inline;
1926  begin
1927    while (p<EndP) and IsIdentChar[p^] do inc(p);
1928  end;
1929
1930begin
1931  //debugln(['TPascalReaderTool.ForEachIdentifierInCleanSrc Node=',Node.DescAsString,' "',dbgstr(Src,StartPos,EndPos-StartPos),'"']);
1932  if (StartPos<1) then
1933    StartPos:=1;
1934  if StartPos>SrcLen then exit;
1935  if EndPos>SrcLen then EndPos:=SrcLen+1;
1936  if StartPos>=EndPos then exit;
1937  Range:=epriInCode;
1938  p:=@Src[StartPos];
1939  EndP:=p+EndPos-StartPos;
1940  while p<EndP do begin
1941    case p^ of
1942
1943    '{':
1944      begin
1945        inc(p);
1946        if p^=#3 then begin
1947          // codetools skip comment {#3 #3}
1948          inc(p);
1949          repeat
1950            if p>=EndP then exit;
1951            if (p^=#3) and (p[1]='}')
1952            then begin
1953              inc(p,2);
1954              break;
1955            end;
1956            inc(p);
1957          until false;
1958        end else begin
1959          // pascal comment {}
1960          CommentLvl:=1;
1961          InStrConst:=false;
1962          if p^='$' then
1963            Range:=epriInDirective
1964          else
1965            Range:=epriInComment;
1966          repeat
1967            if p>=EndP then exit;
1968            case p^ of
1969            '{': if Scanner.NestedComments then inc(CommentLvl);
1970            '}':
1971              begin
1972                dec(CommentLvl);
1973                if CommentLvl=0 then break;
1974              end;
1975            'a'..'z','A'..'Z','_':
1976              if not InStrConst then begin
1977                if not SkipComments then begin
1978                  OnIdentifier(Self,p-PChar(Src)+1,Range,Node,Data,Abort);
1979                  SkipIdentifier;
1980                  if Abort then exit;
1981                end;
1982                while (p<EndP) and IsIdentChar[p^] do inc(p);
1983              end;
1984            '''':
1985              InStrConst:=not InStrConst;
1986            #10,#13:
1987              InStrConst:=false;
1988            end;
1989            inc(p);
1990          until false;
1991          inc(p);
1992          //debugln(StartPos,' ',copy(Src,CommentStart,StartPos-CommentStart));
1993        end;
1994      end;
1995
1996    '/':  // Delphi comment
1997      if p[1]<>'/' then begin
1998        inc(p);
1999      end else begin
2000        inc(p,2);
2001        InStrConst:=false;
2002        repeat
2003          if p>=EndP then exit;
2004          case p^ of
2005          #10,#13:
2006            break;
2007          'a'..'z','A'..'Z','_':
2008            if not InStrConst then begin
2009              if not SkipComments then begin
2010                OnIdentifier(Self,p-PChar(Src)+1,Range,Node,Data,Abort);
2011                SkipIdentifier;
2012                if Abort then exit;
2013              end;
2014              while (p<EndP) and IsIdentChar[p^] do inc(p);
2015            end;
2016          '''':
2017            InStrConst:=not InStrConst;
2018          end;
2019          inc(p);
2020        until false;
2021        inc(p);
2022        if (p<EndP) and (p^ in [#10,#13])
2023        and (p[-1]<>p^) then
2024          inc(p);
2025      end;
2026
2027    '(': // turbo pascal comment
2028      if (p[1]<>'*') then begin
2029        inc(p);
2030      end else begin
2031        inc(p,3);
2032        InStrConst:=false;
2033        repeat
2034          if p>=EndP then exit;
2035          case p^ of
2036          ')':
2037            if p[-1]='*' then break;
2038          'a'..'z','A'..'Z','_':
2039            if not InStrConst then begin
2040              if not SkipComments then begin
2041                OnIdentifier(Self,p-PChar(Src)+1,Range,Node,Data,Abort);
2042                SkipIdentifier;
2043                if Abort then exit;
2044              end;
2045              SkipIdentifier;
2046            end;
2047          '''':
2048            InStrConst:=not InStrConst;
2049          #10,#13:
2050            InStrConst:=false;
2051          end;
2052          inc(p);
2053        until false;
2054        inc(p);
2055      end;
2056
2057    'a'..'z','A'..'Z','_':
2058      begin
2059        OnIdentifier(Self,p-PChar(Src)+1,epriInCode,Node,Data,Abort);
2060        SkipIdentifier;
2061        if Abort then exit;
2062      end;
2063
2064    '''':
2065      begin
2066        // skip string constant
2067        inc(p);
2068        while p<EndP do begin
2069          if (not (p^ in ['''',#10,#13])) then
2070            inc(p)
2071          else begin
2072            inc(p);
2073            break;
2074          end;
2075        end;
2076      end;
2077
2078    else
2079      inc(p);
2080    end;
2081  end;
2082end;
2083
2084procedure TPascalReaderTool.ForEachIdentifierInNode(Node: TCodeTreeNode;
2085  SkipComments: boolean; const OnIdentifier: TOnEachPRIdentifier;
2086  Data: Pointer; var Abort: boolean);
2087var
2088  StartPos: Integer;
2089  EndPos: Integer;
2090  Child: TCodeTreeNode;
2091begin
2092  //debugln(['TPascalReaderTool.ForEachIdentifierInNode START ',Node.DescAsString]);
2093  if NodeNeedsBuildSubTree(Node) then
2094    BuildSubTree(Node);
2095  if Node.FirstChild<>nil then begin
2096    EndPos:=Node.StartPos;
2097    Child:=Node.FirstChild;
2098    while Child<>nil do begin
2099      // scan in front of child
2100      ForEachIdentifierInCleanSrc(EndPos,Child.StartPos,SkipComments,
2101        Node,OnIdentifier,Data,Abort);
2102      if Abort then exit;
2103      // scan child
2104      ForEachIdentifierInNode(Child,SkipComments,OnIdentifier,Data,Abort);
2105      if Abort then exit;
2106      EndPos:=Child.EndPos;
2107      Child:=Child.NextBrother;
2108    end;
2109    // scan behind children
2110    ForEachIdentifierInCleanSrc(EndPos,Node.EndPos,SkipComments,
2111      Node,OnIdentifier,Data,Abort);
2112  end else begin
2113    // leaf node
2114    StartPos:=Node.StartPos;
2115    EndPos:=Node.EndPos;
2116    // nodes without children can overlap with their NextBrother
2117    if (Node.NextBrother<>nil)
2118    and (Node.NextBrother.StartPos<EndPos) then
2119      EndPos:=Node.NextBrother.StartPos;
2120    // scan node range
2121    ForEachIdentifierInCleanSrc(StartPos,EndPos,SkipComments,
2122      Node,OnIdentifier,Data,Abort);
2123  end;
2124end;
2125
2126procedure TPascalReaderTool.ForEachIdentifier(SkipComments: boolean;
2127  const OnIdentifier: TOnEachPRIdentifier; Data: Pointer);
2128var
2129  Node: TCodeTreeNode;
2130  Abort: boolean;
2131begin
2132  //debugln(['TPascalReaderTool.ForEachIdentifier START']);
2133  Node:=Tree.Root;
2134  Abort:=false;
2135  while Node<>nil do begin
2136    ForEachIdentifierInNode(Node,SkipComments,OnIdentifier,Data,Abort);
2137    if Abort then exit;
2138    Node:=Node.NextBrother;
2139  end;
2140end;
2141
2142function TPascalReaderTool.FindVarNode(StartNode: TCodeTreeNode;
2143  const UpperVarName: string; Visibility: TClassSectionVisibility
2144  ): TCodeTreeNode;
2145var
2146  InClass: Boolean;
2147begin
2148  Result:=StartNode;
2149  InClass:=FindClassOrInterfaceNode(StartNode)<>nil;
2150  while Result<>nil do begin
2151    if (Result.Desc=ctnVarDefinition)
2152    and (not InClass or IdentNodeIsInVisibleClassSection(Result, Visibility))
2153    and (CompareNodeIdentChars(Result,UpperVarName)=0) then
2154      exit;
2155    if InClass then
2156      Result:=FindNextIdentNodeInClass(Result)
2157    else
2158      Result:=FindNextNodeOnSameLvl(Result);
2159  end;
2160end;
2161
2162function TPascalReaderTool.FindTypeNodeOfDefinition(
2163  DefinitionNode: TCodeTreeNode): TCodeTreeNode;
2164// for example: 'var a,b,c: integer;'  only c has a type child
2165begin
2166  Result:=DefinitionNode;
2167  while (Result<>nil)
2168  and (Result.Desc in AllIdentifierDefinitions) do begin
2169    if (Result.FirstChild<>nil) then begin
2170      Result:=Result.FirstChild;
2171      if Result.Desc=ctnGenericName then begin
2172        // skip generic name and params
2173        Result:=Result.NextBrother;
2174        if Result=nil then exit;
2175        Result:=Result.NextBrother;
2176        if Result=nil then exit;
2177      end;
2178      if (not (Result.Desc in AllPascalTypes)) then
2179        Result:=nil;
2180      exit;
2181    end;
2182    if Result.Desc<>ctnVarDefinition then exit(nil);
2183    Result:=Result.NextBrother;
2184  end;
2185end;
2186
2187function TPascalReaderTool.FindClassNode(StartNode: TCodeTreeNode;
2188  const AClassName: string; IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
2189// search for class like types on same level
2190var
2191  ANode, CurClassNode: TCodeTreeNode;
2192  NameNode: TCodeTreeNode;
2193  p: PChar;
2194begin
2195  ANode:=StartNode;
2196  Result:=nil;
2197  if AClassName='' then exit;
2198  p:=PChar(AClassName);
2199  while (ANode<>nil) do begin
2200    if ANode.Desc in [ctnTypeDefinition,ctnGenericType] then begin
2201      //debugln(['TPascalReaderTool.FindClassNode ',GetIdentifier(@Src[ANode.StartPos])]);
2202      CurClassNode:=FindTypeNodeOfDefinition(ANode);
2203      if (CurClassNode<>nil)
2204      and (CurClassNode.Desc in AllClassObjects) then begin
2205        if (not (IgnoreForwards
2206                 and ((CurClassNode.SubDesc and ctnsForwardDeclaration)>0)))
2207        and (not (IgnoreNonForwards
2208                 and ((CurClassNode.SubDesc and ctnsForwardDeclaration)=0)))
2209        then begin
2210          NameNode:=ANode;
2211          if (ANode.Desc=ctnGenericType) and (ANode.FirstChild<>nil) then
2212            NameNode:=ANode.FirstChild;
2213          //debugln(['TPascalReaderTool.FindClassNode class name = "',GetIdentifier(@Src[NameNode.StartPos]),'"']);
2214          if NameNode.StartPos>SrcLen then exit;
2215          if CompareIdentifiers(p,@Src[NameNode.StartPos])=0 then begin
2216            Result:=FindNestedClass(CurClassNode,p,true);
2217            exit;
2218          end;
2219        end;
2220      end;
2221    end;
2222    // next node
2223    if (ANode.Desc in [ctnTypeSection]+AllCodeSections)
2224    and (ANode.FirstChild<>nil) then
2225      ANode:=ANode.FirstChild
2226    else if ANode.NextBrother<>nil then
2227      ANode:=ANode.NextBrother
2228    else begin
2229      // skip procs, const and var sections
2230      repeat
2231        ANode:=ANode.Parent;
2232        if (ANode=nil) then exit;
2233        if (not (ANode.Desc in [ctnTypeSection]+AllCodeSections)) then exit;
2234        if ANode.NextBrother<>nil then begin
2235          ANode:=ANode.NextBrother;
2236          break;
2237        end;
2238      until false;
2239    end;
2240  end;
2241end;
2242
2243function TPascalReaderTool.FindClassNodeBackwards(StartNode: TCodeTreeNode;
2244  const AClassName: string; IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
2245var
2246  ANode: TCodeTreeNode;
2247  CurClassNode: TCodeTreeNode;
2248  p: PChar;
2249begin
2250  ANode:=StartNode;
2251  p:=PChar(AClassName);
2252  while ANode<>nil do begin
2253    if ANode.Desc=ctnTypeDefinition then begin
2254      CurClassNode:=ANode.FirstChild;
2255      if (CurClassNode<>nil)
2256      and (CurClassNode.Desc in AllClassObjects) then begin
2257        if (not (IgnoreForwards
2258                 and ((CurClassNode.SubDesc and ctnsForwardDeclaration)>0)))
2259        and (not (IgnoreNonForwards
2260                 and ((CurClassNode.SubDesc and ctnsForwardDeclaration)=0)))
2261        then begin
2262          if CompareIdentifiers(p,@Src[ANode.StartPos])=0 then begin
2263            Result:=FindNestedClass(CurClassNode,p,true);
2264            exit;
2265          end;
2266        end;
2267      end;
2268    end;
2269    if ANode.PriorBrother<>nil then begin
2270      ANode:=ANode.PriorBrother;
2271      if (ANode.FirstChild<>nil) and (ANode.Desc in AllCodeSections) then
2272        ANode:=ANode.LastChild;
2273      if (ANode.FirstChild<>nil) and (ANode.Desc in AllDefinitionSections) then
2274        ANode:=ANode.LastChild;
2275    end else begin
2276      ANode:=ANode.Parent;
2277    end;
2278  end;
2279  Result:=nil;
2280end;
2281
2282function TPascalReaderTool.FindNestedClass(RootClassNode: TCodeTreeNode;
2283  AClassName: PChar; SkipFirst: boolean): TCodeTreeNode;
2284var
2285  p: PChar;
2286  Node: TCodeTreeNode;
2287  EndNode: TCodeTreeNode;
2288begin
2289  Result:=nil;
2290  if RootClassNode=nil then exit;
2291  if AClassName=nil then exit;
2292  p:=AClassName;
2293  if SkipFirst then begin
2294    while IsIdentChar[p^] do inc(p);
2295    if p^='<' then
2296    begin
2297      while not (p^ in [#0,'>']) do Inc(p);
2298      if p^ = '>' then Inc(p);
2299    end;
2300    if p^=#0 then exit(RootClassNode);
2301    if p^<>'.' then exit;
2302    inc(p);
2303  end;
2304  //debugln(['TPascalReaderTool.FindNestedClass p="',p,'"']);
2305  if not IsIdentStartChar[p^] then exit;
2306  EndNode:=RootClassNode.NextSkipChilds;
2307  Node:=RootClassNode.Next;
2308  while Node<>EndNode do begin
2309    // debugln(['TPascalReaderTool.FindNestedClass Node=',node.DescAsString]);
2310    if Node.Desc in [ctnTypeDefinition,ctnGenericType] then begin
2311      if (Node.LastChild<>nil) and (Node.LastChild.Desc in AllClasses) then begin
2312        if ((Node.Desc=ctnTypeDefinition)
2313          and (CompareIdentifierPtrs(p,@Src[Node.StartPos])=0))
2314        or ((Node.FirstChild.Desc=ctnGenericName)
2315          and (CompareIdentifierPtrs(p,@Src[Node.FirstChild.StartPos])=0))
2316        then begin
2317          // class found
2318          Node:=Node.LastChild;
2319          while IsIdentChar[p^] do inc(p);
2320          if p^=#0 then exit(Node);
2321          if p^<>'.' then exit;
2322          Result:=FindNestedClass(Node,p+1,false);
2323          exit;
2324        end;
2325      end;
2326    end;
2327    if Node.Desc in AllClassSections then
2328      Node:=Node.Next
2329    else
2330      Node:=Node.NextSkipChilds;
2331  end;
2332end;
2333
2334function TPascalReaderTool.FindClassNode(CursorNode: TCodeTreeNode): TCodeTreeNode;
2335// find class node of a node in a procedure (declaration or body)
2336begin
2337  while CursorNode<>nil do begin
2338    if CursorNode.Desc in AllClassObjects then begin
2339      Result:=CursorNode;
2340      exit;
2341    end else if NodeIsMethodBody(CursorNode) then begin
2342      Result:=FindClassNodeForMethodBody(CursorNode,true,false);
2343      exit;
2344    end;
2345    CursorNode:=CursorNode.Parent;
2346  end;
2347  Result:=nil;
2348end;
2349
2350function TPascalReaderTool.FindClassNodeForMethodBody(ProcNode: TCodeTreeNode;
2351  IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
2352var
2353  ProcClassName: String;
2354begin
2355  Result:=nil;
2356  ProcClassName:=ExtractClassNameOfProcNode(ProcNode,true);
2357  if ProcClassName='' then exit;
2358  Result:=FindClassNodeBackwards(ProcNode,ProcClassName,IgnoreForwards,
2359                                 IgnoreNonForwards);
2360end;
2361
2362function TPascalReaderTool.FindClassOrInterfaceNode(CursorNode: TCodeTreeNode;
2363  FindClassOfMethod: boolean): TCodeTreeNode;
2364begin
2365  while CursorNode<>nil do begin
2366    if CursorNode.Desc in AllClasses then begin
2367      Result:=CursorNode;
2368      exit;
2369    end else if FindClassOfMethod and NodeIsMethodBody(CursorNode) then begin
2370      Result:=FindClassNodeForMethodBody(CursorNode,true,false);
2371      exit;
2372    end;
2373    CursorNode:=CursorNode.Parent;
2374  end;
2375  Result:=nil;
2376end;
2377
2378function TPascalReaderTool.FindClassSection(ClassNode: TCodeTreeNode;
2379  NodeDesc: TCodeTreeNodeDesc): TCodeTreeNode;
2380begin
2381  Result:=ClassNode.FirstChild;
2382  while (Result<>nil) and (Result.Desc<>NodeDesc) do
2383    Result:=Result.NextBrother;
2384end;
2385
2386function TPascalReaderTool.FindLastClassSection(ClassNode: TCodeTreeNode;
2387  NodeDesc: TCodeTreeNodeDesc): TCodeTreeNode;
2388begin
2389  Result:=ClassNode.LastChild;
2390  while (Result<>nil) and (Result.Desc<>NodeDesc) do
2391    Result:=Result.PriorBrother;
2392end;
2393
2394function TPascalReaderTool.GetClassVisibility(Node: TCodeTreeNode
2395  ): TCodeTreeNodeDesc;
2396begin
2397  Result:=ctnNone;
2398  if Node=nil then exit;
2399  if Node.Desc=ctnProcedureHead then
2400    Node:=Node.Parent;
2401  if not (Node.Desc in AllClassSections) then begin
2402    Node:=Node.Parent;
2403    if Node=nil then exit;
2404  end;
2405  if Node.Desc in AllClassSubSections then
2406    Node:=Node.Parent;
2407  if Node.Desc in AllClassBaseSections then
2408    Result:=Node.Desc;
2409end;
2410
2411function TPascalReaderTool.FindClassNodeInInterface(
2412  const AClassName: string; IgnoreForwards, IgnoreNonForwards,
2413  ErrorOnNotFound: boolean): TCodeTreeNode;
2414  
2415  procedure RaiseClassNotFound;
2416  begin
2417    RaiseExceptionFmt(ctsClassSNotFound, [AClassName]);
2418  end;
2419  
2420begin
2421  Result:=Tree.Root;
2422  if Result<>nil then begin
2423    if Result.Desc=ctnUnit then
2424      Result:=Result.NextBrother;
2425    if Result<>nil then begin
2426      Result:=FindClassNode(Result.FirstChild,AClassName,
2427                            IgnoreForwards, IgnoreNonForwards);
2428      if (Result<>nil) and Result.HasParentOfType(ctnImplementation) then
2429        Result:=nil;
2430    end;
2431  end;
2432  if (Result=nil) and ErrorOnNotFound then
2433    RaiseClassNotFound;
2434end;
2435
2436function TPascalReaderTool.FindClassNodeInUnit(const AClassName: string;
2437  IgnoreForwards, IgnoreNonForwards, IgnoreImplementation,
2438  ErrorOnNotFound: boolean): TCodeTreeNode;
2439
2440  procedure RaiseClassNotFound;
2441  begin
2442    RaiseExceptionFmt(ctsClassSNotFound, [AClassName]);
2443  end;
2444
2445begin
2446  Result:=Tree.Root;
2447  if Result<>nil then begin
2448    if Result.Desc in [ctnUnit,ctnLibrary,ctnPackage] then begin
2449      Result:=Result.NextBrother;
2450    end;
2451    if Result<>nil then begin
2452      Result:=FindClassNode(Result.FirstChild,AClassName,
2453                            IgnoreForwards, IgnoreNonForwards);
2454      if (Result<>nil) and IgnoreImplementation
2455      and Result.HasParentOfType(ctnImplementation) then
2456        Result:=nil;
2457    end;
2458  end;
2459  if (Result=nil) and ErrorOnNotFound then
2460    RaiseClassNotFound;
2461end;
2462
2463function TPascalReaderTool.FindFirstIdentNodeInClass(ClassNode: TCodeTreeNode
2464  ): TCodeTreeNode;
2465begin
2466  if (ClassNode=nil) then exit(nil);
2467  Result:=FindNextIdentNodeInClass(ClassNode.FirstChild);
2468end;
2469
2470function TPascalReaderTool.FindLastIdentNodeInClass(ClassNode: TCodeTreeNode
2471  ): TCodeTreeNode;
2472begin
2473  if (ClassNode=nil) then exit(nil);
2474  Result:=ClassNode.LastChild;
2475  if Result=nil then exit;
2476  while (Result.FirstChild<>nil) and (Result.Desc in AllClassSections) do
2477    Result:=Result.LastChild;
2478  if not (Result.Desc in AllClassSections) then
2479    Result:=FindPriorIdentNodeInClass(Result);
2480end;
2481
2482function TPascalReaderTool.FindNextIdentNodeInClass(Node: TCodeTreeNode
2483  ): TCodeTreeNode;
2484// Node must be nil or a class section or an identifier node in a class
2485begin
2486  Result:=Node;
2487  if Result=nil then exit;
2488  repeat
2489    // descend into class sections, skip empty class sections
2490    if (Result.FirstChild<>nil) and (Result.Desc in AllClassSections) then
2491      Result:=Result.FirstChild
2492    else begin
2493      while Result.NextBrother=nil do begin
2494        Result:=Result.Parent;
2495        if (Result=nil) or (not (Result.Desc in AllClassSections)) then
2496          exit(nil);
2497      end;
2498      Result:=Result.NextBrother
2499    end;
2500  until not (Result.Desc in AllClassSections);
2501end;
2502
2503function TPascalReaderTool.FindPriorIdentNodeInClass(Node: TCodeTreeNode
2504  ): TCodeTreeNode;
2505begin
2506  Result:=Node;
2507  if Result=nil then exit;
2508  repeat
2509    if Result.PriorBrother<>nil then begin
2510      Result:=Result.PriorBrother;
2511      while (Result.LastChild<>nil) and (Result.Desc in AllClassSections) do
2512        Result:=Result.LastChild;
2513    end else if Result.Parent.Desc in AllClassSections then
2514      Result:=Result.Parent
2515    else
2516      exit(nil);
2517  until not (Result.Desc in AllClassSections);
2518end;
2519
2520function TPascalReaderTool.ClassSectionNodeStartsWithWord(ANode: TCodeTreeNode
2521  ): boolean;
2522begin
2523  Result:=(ANode<>nil) and (ANode.StartPos<ANode.EndPos)
2524    and (IsIdentStartChar[Src[ANode.StartPos]]);
2525end;
2526
2527function TPascalReaderTool.IsClassNode(Node: TCodeTreeNode): boolean;
2528begin
2529  Result:=(Node<>nil) and (Node.Desc=ctnClass);
2530end;
2531
2532function TPascalReaderTool.FindInheritanceNode(ClassNode: TCodeTreeNode): TCodeTreeNode;
2533begin
2534  Result:=ClassNode.FirstChild;
2535  while (Result<>nil) and (Result.Desc in [ctnClassSealed,ctnClassAbstract,ctnClassExternal]) do
2536    Result:=Result.NextBrother;
2537  if (Result<>nil) and (Result.Desc<>ctnClassInheritance) then
2538    Result:=nil;
2539end;
2540
2541function TPascalReaderTool.ExtractRecordCaseType(RecordCaseNode: TCodeTreeNode): string;
2542//  case a:b.c of
2543//  case a:(b,c) of
2544var
2545  VarNode: TCodeTreeNode;
2546begin
2547  Result:='';
2548  VarNode:=RecordCaseNode.FirstChild;
2549  if VarNode=nil then exit;
2550  if VarNode.FirstChild<>nil then
2551    Result:=ExtractNode(RecordCaseNode.FirstChild,[]);
2552end;
2553
2554function TPascalReaderTool.GetSourceType: TCodeTreeNodeDesc;
2555begin
2556  if Tree.Root<>nil then
2557    Result:=Tree.Root.Desc
2558  else
2559    Result:=ctnNone;
2560end;
2561
2562function TPascalReaderTool.IdentNodeIsInVisibleClassSection(
2563  Node: TCodeTreeNode; Visibility: TClassSectionVisibility): Boolean;
2564begin
2565  if Visibility = csvEverything then
2566    Result := True
2567  else
2568  if (Node.Parent<>nil) then
2569    case Visibility of
2570      //csvAbovePrivate: todo: add strict private and strict protected (should be registered as new sections)
2571      csvProtectedAndHigher:
2572        Result := not(Node.Parent.Desc = ctnClassPrivate);//todo: add strict private
2573      csvPublicAndHigher:
2574        Result := not(Node.Parent.Desc in [ctnClassPrivate, ctnClassProtected]);//todo: strict private and strict protected
2575    else
2576      Result := True
2577    end
2578  else
2579    Result := False;
2580end;
2581
2582function TPascalReaderTool.ExtractProcedureGroup(ProcNode: TCodeTreeNode
2583  ): TPascalMethodGroup;
2584begin
2585  Result:=mgMethod;
2586  if (ProcNode=nil) then exit;
2587  if ProcNode.Desc=ctnProcedureHead then
2588    ProcNode:=ProcNode.Parent;
2589  if ProcNode.Desc<>ctnProcedure then exit;
2590  MoveCursorToNodeStart(ProcNode);
2591  ReadNextAtom;
2592  if UpAtomIs('CLASS') then
2593  begin
2594    ReadNextAtom;
2595    if UpAtomIs('CONSTRUCTOR') then
2596      Result := mgClassConstructor
2597    else if UpAtomIs('DESTRUCTOR') then
2598      Result := mgClassDestructor
2599    else if UpAtomIs('OPERATOR') then
2600      Result := mgClassOperator;
2601  end else
2602  if UpAtomIs('CONSTRUCTOR') then
2603    Result := mgConstructor
2604end;
2605
2606function TPascalReaderTool.PositionInSourceName(CleanPos: integer): boolean;
2607var
2608  NamePos: TAtomPosition;
2609begin
2610  Result:=false;
2611  if not GetSourceNamePos(NamePos) then exit;
2612  Result:=(CleanPos>=NamePos.StartPos) and (CleanPos<NamePos.EndPos);
2613end;
2614
2615function TPascalReaderTool.ExtractSourceName: string;
2616begin
2617  Result:='';
2618  if Tree.Root<>nil then begin
2619    MoveCursorToNodeStart(Tree.Root);
2620    ReadNextAtom; // read source type 'program', 'unit' ...
2621    if (Tree.Root.Desc<>ctnProgram) or UpAtomIs('PROGRAM') then begin
2622      ReadNextAtom; // read name
2623      if AtomIsIdentifier then begin
2624        Result:=copy(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
2625        ReadNextAtom;
2626        while CurPos.Flag=cafPoint do begin
2627          ReadNextAtom;
2628          if not AtomIsIdentifier then exit;
2629          Result:=Result+'.'+copy(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
2630          ReadNextAtom;
2631        end;
2632        exit;
2633      end;
2634    end;
2635  end;
2636  if (Tree.Root<>nil) and (Tree.Root.Desc=ctnProgram) then
2637    // a program without the 'program' header uses the file name as name
2638    Result:=ExtractFileNameOnly(MainFilename)
2639  else
2640    Result:='';
2641end;
2642
2643function TPascalReaderTool.GetSourceNamePos(out NamePos: TAtomPosition
2644  ): boolean;
2645begin
2646  Result:=false;
2647  NamePos.StartPos:=-1;
2648  if Tree.Root=nil then exit;
2649  MoveCursorToNodeStart(Tree.Root);
2650  ReadNextAtom; // read source type 'program', 'unit' ...
2651  if (Tree.Root.Desc=ctnProgram) and (not UpAtomIs('PROGRAM')) then exit;
2652  ReadNextAtom; // read name
2653  if not AtomIsIdentifier then exit;
2654  NamePos:=CurPos;
2655  Result:=true;
2656  ReadNextAtom;
2657  while CurPos.Flag=cafPoint do begin
2658    ReadNextAtom;
2659    if not AtomIsIdentifier then exit;
2660    NamePos.EndPos:=CurPos.EndPos;
2661    ReadNextAtom;
2662  end;
2663end;
2664
2665function TPascalReaderTool.GetSourceName(DoBuildTree: boolean): string;
2666begin
2667  Result:='';
2668  if DoBuildTree then
2669    BuildTree(lsrSourceName);
2670  CachedSourceName:=ExtractSourceName;
2671  Result:=CachedSourceName;
2672end;
2673
2674function TPascalReaderTool.NodeIsInAMethod(Node: TCodeTreeNode): boolean;
2675begin
2676  Result:=false;
2677  while (Node<>nil) do begin
2678    if (Node.Desc=ctnProcedure) then begin
2679      if NodeIsMethodBody(Node) then begin
2680        Result:=true;
2681        exit;
2682      end;
2683    end;
2684    Node:=Node.Parent;
2685  end;
2686end;
2687
2688function TPascalReaderTool.NodeIsMethodBody(ProcNode: TCodeTreeNode): boolean;
2689begin
2690  Result:=false;
2691  if (ProcNode<>nil) and (ProcNode.Desc=ctnProcedure)
2692  and (ProcNode.FirstChild<>nil) then begin
2693
2694    // ToDo: ppu, dcu
2695
2696    MoveCursorToNodeStart(ProcNode.FirstChild); // ctnProcedureHead
2697    ReadNextAtom;
2698    if not AtomIsIdentifier then exit;
2699    ReadNextAtom;
2700    if (CurPos.Flag<>cafPoint) then exit;
2701    Result:=true;
2702    exit;
2703  end;
2704end;
2705
2706function TPascalReaderTool.GetMethodOfBody(Node: TCodeTreeNode): TCodeTreeNode;
2707begin
2708  Result:=Node;
2709  while (Result<>nil) and not NodeIsMethodBody(Result) do
2710    Result:=Result.Parent;
2711end;
2712
2713function TPascalReaderTool.NodeIsFunction(ProcNode: TCodeTreeNode): boolean;
2714begin
2715  Result:=false;
2716  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then exit;
2717  MoveCursorToNodeStart(ProcNode);
2718  ReadNextAtom;
2719  if UpAtomIs('CLASS') then ReadNextAtom;
2720  Result:=UpAtomIs('FUNCTION');
2721end;
2722
2723function TPascalReaderTool.NodeIsConstructor(ProcNode: TCodeTreeNode): boolean;
2724begin
2725  Result:=false;
2726  if (ProcNode=nil) then exit;
2727  if ProcNode.Desc=ctnProcedureHead then
2728    ProcNode:=ProcNode.Parent;
2729  if ProcNode.Desc<>ctnProcedure then exit;
2730  MoveCursorToNodeStart(ProcNode);
2731  ReadNextAtom;
2732  if UpAtomIs('CLASS') then ReadNextAtom;
2733  Result:=UpAtomIs('CONSTRUCTOR');
2734  if not Result and UpAtomIs('FUNCTION')
2735  and ([cmsObjectiveC1,cmsObjectiveC2]*Scanner.CompilerModeSwitches<>[]) then
2736  begin
2737    ProcNode:=ProcNode.FirstChild;
2738    if ProcNode=nil then exit;
2739    if (ProcNode.SubDesc and ctnsNeedJITParsing)>0 then
2740      BuildSubTreeForProcHead(ProcNode);
2741    ProcNode:=ProcNode.FirstChild;
2742    if (ProcNode=nil) then exit;
2743    if ProcNode.Desc=ctnParameterList then
2744      ProcNode:=ProcNode.NextBrother;
2745    if (ProcNode=nil) then exit;
2746    MoveCursorToNodeStart(ProcNode);
2747    ReadNextAtom;
2748    Result:=UpAtomIs('ID');
2749  end;
2750end;
2751
2752function TPascalReaderTool.NodeIsDestructor(ProcNode: TCodeTreeNode): boolean;
2753begin
2754  Result:=false;
2755  if (ProcNode=nil) then exit;
2756  if ProcNode.Desc=ctnProcedureHead then
2757    ProcNode:=ProcNode.Parent;
2758  if ProcNode.Desc<>ctnProcedure then exit;
2759  MoveCursorToNodeStart(ProcNode);
2760  ReadNextAtom;
2761  Result:=UpAtomIs('DESTRUCTOR');
2762end;
2763
2764function TPascalReaderTool.NodeIsForwardProc(ProcNode: TCodeTreeNode): boolean;
2765begin
2766  Result:=false;
2767  // check if procedure
2768  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then exit;
2769  // check if in interface
2770  if (ProcNode.Parent<>nil) and (ProcNode.Parent.Desc=ctnInterface) then
2771    exit(true);
2772  // check if has forward
2773  if (ctnsForwardDeclaration and ProcNode.SubDesc)>0 then exit(true);
2774end;
2775
2776function TPascalReaderTool.NodeIsOperator(ProcNode: TCodeTreeNode): boolean;
2777begin
2778  Result:=false;
2779  if (ProcNode=nil) then exit;
2780  if ProcNode.Desc=ctnProcedureHead then
2781    ProcNode:=ProcNode.Parent;
2782  if ProcNode.Desc<>ctnProcedure then exit;
2783  MoveCursorToNodeStart(ProcNode);
2784  ReadNextAtom;
2785  if UpAtomIs('CLASS') then ReadNextAtom;
2786  Result:=UpAtomIs('OPERATOR');
2787end;
2788
2789function TPascalReaderTool.NodeIsResultIdentifier(Node: TCodeTreeNode): boolean;
2790begin
2791  Result:=(Node<>nil)
2792    and (Node.Desc=ctnVarDefinition)
2793    and (Node.Parent<>nil)
2794    and (Node.Parent.Desc=ctnProcedureHead);
2795end;
2796
2797function TPascalReaderTool.NodeIsResultType(Node: TCodeTreeNode): boolean;
2798begin
2799  Result:=(Node<>nil)
2800    and (Node.Desc=ctnIdentifier)
2801    and (Node.Parent<>nil)
2802    and (Node.Parent.Desc=ctnProcedureHead);
2803end;
2804
2805function TPascalReaderTool.NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode
2806  ): boolean;
2807begin
2808  ANode:=ANode.Parent;
2809  while ANode<>nil do begin
2810    if ANode.Desc in (AllIdentifierDefinitions+AllPascalTypes) then begin
2811      Result:=true;
2812      exit;
2813    end;
2814    ANode:=ANode.Parent;
2815  end;
2816  Result:=false;
2817end;
2818
2819function TPascalReaderTool.ExtractDefinitionNodeType(
2820  DefinitionNode: TCodeTreeNode): string;
2821var
2822  TypeNode: TCodeTreeNode;
2823begin
2824  Result:='';
2825  TypeNode:=FindTypeNodeOfDefinition(DefinitionNode);
2826  if TypeNode=nil then exit;
2827  if TypeNode.Desc=ctnIdentifier then
2828    Result:=GetIdentifier(@Src[TypeNode.StartPos]);
2829end;
2830
2831function TPascalReaderTool.ExtractFuncResultType(ProcNode: TCodeTreeNode;
2832  Attr: TProcHeadAttributes): string;
2833begin
2834  Result := '';
2835  if (ProcNode=nil) then exit;
2836  if ProcNode.Desc=ctnProcedure then
2837    ProcNode:=ProcNode.FirstChild;
2838  if (ProcNode=nil) or(ProcNode.Desc<>ctnProcedureHead) then
2839    Exit;
2840  MoveCursorToCleanPos(ProcNode.EndPos);
2841  CurNode:=ProcNode;
2842  ReadPriorAtom;
2843  if CurPos.Flag<>cafSemicolon then
2844    Exit;
2845  ReadPriorAtom;
2846  if CurPos.Flag<>cafWord then
2847    Exit;
2848  if phpInUpperCase in Attr then
2849    Result := GetUpAtom
2850  else
2851    Result := GetAtom;
2852end;
2853
2854function TPascalReaderTool.ExtractDefinitionName(DefinitionNode: TCodeTreeNode
2855  ): string;
2856begin
2857  DefinitionNode:=FindDefinitionNameNode(DefinitionNode);
2858  if DefinitionNode<>nil then
2859    Result:=GetIdentifier(@Src[DefinitionNode.StartPos])
2860  else
2861    Result:='';
2862end;
2863
2864function TPascalReaderTool.PositionInDefinitionName(
2865  DefinitionNode: TCodeTreeNode; CleanPos: integer): boolean;
2866var
2867  StartPos: LongInt;
2868begin
2869  if DefinitionNode.Desc=ctnGenericType then begin
2870    if DefinitionNode.FirstChild<>nil then
2871      StartPos:=DefinitionNode.FirstChild.StartPos
2872    else
2873      StartPos:=0;
2874  end else begin
2875    StartPos:=DefinitionNode.StartPos;
2876  end;
2877  Result:=(CleanPos>=StartPos) and (CleanPos<StartPos+GetIdentLen(@Src[StartPos]));
2878end;
2879
2880function TPascalReaderTool.MoveCursorToParameterSpecifier(
2881  DefinitionNode: TCodeTreeNode): boolean;
2882begin
2883  Result:=false;
2884  if (DefinitionNode=nil) or (DefinitionNode.Desc<>ctnVarDefinition)
2885  or (DefinitionNode.Parent=nil)
2886  or (DefinitionNode.Parent.Desc<>ctnParameterList) then exit;
2887  // find first variable node of this type (e.g. var a,b,c,d: integer)
2888  DefinitionNode:=GetFirstGroupVarNode(DefinitionNode);
2889  if DefinitionNode.PriorBrother<>nil then
2890    MoveCursorToCleanPos(DefinitionNode.PriorBrother.EndPos)
2891  else
2892    MoveCursorToCleanPos(DefinitionNode.Parent.StartPos);
2893  ReadNextAtom;
2894  while (CurPos.StartPos<DefinitionNode.StartPos) do ReadNextAtom;
2895  UndoReadNextAtom;
2896  Result:=CurPos.Flag=cafWord;
2897end;
2898
2899function TPascalReaderTool.GetFirstGroupVarNode(VarNode: TCodeTreeNode): TCodeTreeNode;
2900begin
2901  Result:=VarNode;
2902  if (VarNode=nil) or (VarNode.Desc<>ctnVarDefinition) then exit;
2903  while VarNode<>nil do begin
2904    VarNode:=VarNode.PriorBrother;
2905    if (VarNode=nil) or (VarNode.Desc<>ctnVarDefinition)
2906    or (VarNode.FirstChild<>nil) then exit;
2907    Result:=VarNode;
2908  end;
2909end;
2910
2911function TPascalReaderTool.FindEndOfWithExpr(WithVarNode: TCodeTreeNode): integer;
2912begin
2913  if WithVarNode.Desc<>ctnWithVariable then exit(-1);
2914  MoveCursorToCleanPos(WithVarNode.StartPos);
2915  ReadNextAtom;
2916  if not ReadTilVariableEnd(true,true) then exit(-1);
2917  UndoReadNextAtom;
2918  Result:=CurPos.EndPos;
2919end;
2920
2921function TPascalReaderTool.ExtractWithBlockExpression(
2922  WithVarNode: TCodeTreeNode; Attr: TProcHeadAttributes): string;
2923var
2924  EndPos: Integer;
2925begin
2926  EndPos:=FindEndOfWithExpr(WithVarNode);
2927  if EndPos<1 then exit('');
2928  Result:=ExtractCode(WithVarNode.StartPos,EndPos,Attr);
2929end;
2930
2931function TPascalReaderTool.FindWithBlockStatement(WithVarNode: TCodeTreeNode
2932  ): TCodeTreeNode;
2933begin
2934  Result:=WithVarNode;
2935  repeat
2936    if Result=nil then exit;
2937    if Result.Desc<>ctnWithVariable then exit(nil);
2938    if Result.FirstChild<>nil then begin
2939      Result:=Result.FirstChild;
2940      if Result.Desc=ctnWithStatement then exit;
2941      exit(nil);
2942    end;
2943  until false;
2944end;
2945
2946function TPascalReaderTool.NodeIsIdentifierInInterface(Node: TCodeTreeNode): boolean;
2947// true if identifier is visible from other units (without prefixing)
2948begin
2949  case Node.Desc of
2950  ctnEnumIdentifier:
2951    Result:=true;
2952  ctnVarDefinition:
2953    Result:=(Node.Parent.Desc=ctnVarSection)
2954            and (Node.Parent.Parent.Desc=ctnInterface);
2955  ctnConstDefinition:
2956    Result:=(Node.Parent.Desc=ctnConstSection)
2957            and (Node.Parent.Parent.Desc=ctnInterface);
2958  ctnTypeDefinition,ctnGenericType:
2959    Result:=(Node.Parent.Desc=ctnTypeSection)
2960            and (Node.Parent.Parent.Desc=ctnInterface);
2961  ctnProcedure,ctnProperty:
2962    Result:=Node.Parent.Desc=ctnInterface;
2963  ctnProcedureHead:
2964    Result:=(Node.Parent.Desc=ctnProcedure)
2965        and (Node.Parent.Parent.Desc=ctnInterface);
2966  end;
2967  Result:=false;
2968end;
2969
2970function TPascalReaderTool.NodeCanHaveForwardType(TypeNode: TCodeTreeNode): boolean;
2971begin
2972  Result:=false;
2973  if (TypeNode=nil) or (TypeNode.Desc<>ctnTypeDefinition)
2974  or (TypeNode.FirstChild=nil) then
2975    exit;
2976  if (TypeNode.FirstChild.Desc in AllClasses)
2977  and (TypeNode.FirstChild.SubDesc and ctnsForwardDeclaration=0) then
2978    Result:=true;
2979end;
2980
2981function TPascalReaderTool.NodeIsClassConstructorOrDestructor(
2982  ProcNode: TCodeTreeNode): boolean;
2983begin
2984  Result := ExtractProcedureGroup(ProcNode) in [mgClassConstructor, mgClassDestructor];
2985end;
2986
2987function TPascalReaderTool.NodeIsForwardType(TypeNode: TCodeTreeNode): boolean;
2988begin
2989  Result:=false;
2990  if (TypeNode=nil) or (TypeNode.Desc<>ctnTypeDefinition)
2991  or (TypeNode.FirstChild=nil) then
2992    exit;
2993  if (TypeNode.FirstChild.Desc in AllClasses)
2994  and (TypeNode.FirstChild.SubDesc and ctnsForwardDeclaration>0) then
2995    Result:=true;
2996end;
2997
2998function TPascalReaderTool.FindForwardTypeNode(TypeNode: TCodeTreeNode;
2999  SearchFirst: boolean): TCodeTreeNode;
3000{ Find the first forward type of TypeNode
3001}
3002
3003  function Next: TCodeTreeNode;
3004  begin
3005    Result:=FindForwardTypeNode;
3006    if Result.PriorBrother<>nil then
3007      // search upwards
3008      Result:=Result.PriorBrother
3009    else if Result.Parent.Desc in AllDefinitionSections then begin
3010      // type section was searched
3011      // check for other type sections in front
3012      Result:=Result.Parent;
3013      repeat
3014        while (Result.PriorBrother<>nil) do begin
3015          Result:=Result.PriorBrother;
3016          if (Result.Desc in AllDefinitionSections)
3017          and (Result.LastChild<>nil) then begin
3018            Result:=Result.LastChild;
3019            exit;
3020          end;
3021        end;
3022        // check if in implementation section
3023        if (Result.Parent=nil) or (Result.Parent.Desc<>ctnImplementation) then
3024          exit(nil);
3025        Result:=Result.Parent;
3026        // check if there is an interface section
3027        if (Result.PriorBrother=nil) or (Result.PriorBrother.Desc<>ctnInterface)
3028        then
3029          exit(nil);
3030        // search in interface section
3031        Result:=Result.PriorBrother;
3032        Result:=Result.LastChild;
3033      until Result=nil;
3034    end else
3035      exit;
3036  end;
3037
3038var
3039  Node: TCodeTreeNode;
3040begin
3041  Result:=nil;
3042  if not NodeCanHaveForwardType(TypeNode) then exit;
3043  Node:=TypeNode;
3044  while Node<>nil do begin
3045    if Node.Desc in AllIdentifierDefinitions then begin
3046      if CompareIdentifiers(@Src[TypeNode.StartPos],@Src[Node.StartPos])=0
3047      then begin
3048        if (Node.Desc=ctnTypeDefinition) and NodeIsForwardType(Node) then begin
3049          // a forward
3050          Result:=Node;
3051          if not SearchFirst then exit;
3052        end else begin
3053          // a redefinition
3054          exit;
3055        end;
3056      end;
3057    end;
3058    Node:=Next;
3059  end;
3060end;
3061
3062function TPascalReaderTool.FindHelperForNode(HelperNode: TCodeTreeNode
3063  ): TCodeTreeNode;
3064begin
3065  Result:=HelperNode.FirstChild;
3066  while (Result<>nil) and (Result.Desc = ctnClassInheritance) do
3067    Result:=Result.NextBrother;
3068  if (Result<>nil) and (Result.Desc<>ctnHelperFor) then
3069    Result:=nil;
3070end;
3071
3072function TPascalReaderTool.FindTypeOfForwardNode(TypeNode: TCodeTreeNode
3073  ): TCodeTreeNode;
3074
3075  function Next: TCodeTreeNode;
3076  begin
3077    Result:=FindTypeOfForwardNode;
3078    if Result.NextBrother<>nil then
3079      // search forwards
3080      Result:=Result.NextBrother
3081    else if Result.Parent.Desc in AllDefinitionSections then begin
3082      // type section was searched
3083      // check for other type sections in front
3084      Result:=Result.Parent;
3085      repeat
3086        while (Result.NextBrother<>nil) do begin
3087          Result:=Result.NextBrother;
3088          if (Result.Desc in AllDefinitionSections)
3089          and (Result.FirstChild<>nil) then begin
3090            Result:=Result.FirstChild;
3091            exit;
3092          end;
3093        end;
3094        // check if in interface section
3095        if (Result.Parent=nil) or (Result.Parent.Desc<>ctnInterface) then
3096          exit(nil);
3097        Result:=Result.Parent;
3098        // check if there is an implementation section
3099        if (Result.NextBrother=nil) or (Result.NextBrother.Desc<>ctnImplementation)
3100        then
3101          exit(nil);
3102        // search in implementation section
3103        Result:=Result.NextBrother;
3104        Result:=Result.FirstChild;
3105      until Result=nil;
3106    end else
3107      exit;
3108  end;
3109
3110var
3111  Node: TCodeTreeNode;
3112begin
3113  Result:=nil;
3114  if not NodeIsForwardType(TypeNode) then exit;
3115  Node:=TypeNode;
3116  while Node<>nil do begin
3117    if Node.Desc in AllIdentifierDefinitions then begin
3118      if CompareIdentifiers(@Src[TypeNode.StartPos],@Src[Node.StartPos])=0
3119      then begin
3120        if (Node.Desc=ctnTypeDefinition) and (not NodeIsForwardType(Node)) then
3121        begin
3122          // a type
3123          Result:=Node;
3124          exit;
3125        end else begin
3126          // a redefinition
3127          exit;
3128        end;
3129      end;
3130    end;
3131    Node:=Next;
3132  end;
3133end;
3134
3135function TPascalReaderTool.ExtractArrayRange(ArrayNode: TCodeTreeNode;
3136  Attr: TProcHeadAttributes): string;
3137begin
3138  Result:='';
3139  if (ArrayNode=nil) or (ArrayNode.Desc<>ctnRangedArrayType) then exit;
3140  MoveCursorToNodeStart(ArrayNode);
3141  if not ReadNextUpAtomIs('ARRAY') then exit;
3142  if not ReadNextAtomIsChar('[') then exit;
3143  Result:=ExtractBrackets(CurPos.StartPos,Attr);
3144end;
3145
3146function TPascalReaderTool.PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
3147begin
3148  Result:=false;
3149  if (PropertyNode=nil) or (PropertyNode.Desc<>ctnProperty) then exit;
3150  MoveCursorToCleanPos(PropertyNode.EndPos);
3151  ReadPriorAtom;
3152  if (CurPos.Flag<>cafSemicolon) then exit;
3153  ReadPriorAtom;
3154  Result:=UpAtomIs('DEFAULT');
3155end;
3156
3157function TPascalReaderTool.PropertyNodeHasParamList(PropNode: TCodeTreeNode
3158  ): boolean;
3159begin
3160
3161  // ToDo: ppu, dcu
3162
3163  Result:=false;
3164  if not MoveCursorToPropName(PropNode) then exit;
3165  ReadNextAtom;
3166  Result:=(CurPos.Flag=cafEdgedBracketOpen);
3167end;
3168
3169function TPascalReaderTool.PropNodeIsTypeLess(PropNode: TCodeTreeNode): boolean;
3170begin
3171
3172  // ToDo: ppu, dcu
3173
3174  Result:=false;
3175  if PropNode.Desc<>ctnProperty then exit;
3176  if not MoveCursorToPropName(PropNode) then exit;
3177  ReadNextAtom; // read colon, skip parameters
3178  if CurPos.Flag=cafEdgedBracketOpen then begin
3179    ReadTilBracketClose(true);
3180    ReadNextAtom;
3181  end;
3182  Result:=(CurPos.Flag<>cafColon);
3183end;
3184
3185function TPascalReaderTool.PropertyHasSpecifier(PropNode: TCodeTreeNode;
3186  UpperKeyword: string; ExceptionOnNotFound: boolean): boolean;
3187// true if cursor is on keyword
3188begin
3189
3190  // ToDo: ppu, dcu
3191
3192  Result:=false;
3193  if not MoveCursorToPropName(PropNode) then exit;
3194  if not AtomIsIdentifierE(ExceptionOnNotFound) then exit;
3195  ReadNextAtom;
3196  if CurPos.Flag=cafEdgedBracketOpen then begin
3197    if not ReadTilBracketClose(ExceptionOnNotFound) then exit;
3198    ReadNextAtom;
3199  end;
3200  if CurPos.Flag=cafColon then begin
3201    // read type
3202    ReadNextAtom;
3203    if not AtomIsIdentifierE(ExceptionOnNotFound) then exit;
3204    ReadNextAtom;
3205    if CurPos.Flag=cafPoint then begin
3206      ReadNextAtom;
3207      if not AtomIsIdentifierE(ExceptionOnNotFound) then exit;
3208      ReadNextAtom;
3209    end;
3210  end;
3211
3212  UpperKeyword:=UpperCaseStr(UpperKeyword);
3213  // read specifiers
3214  while not (CurPos.Flag in [cafSemicolon,cafNone]) do begin
3215    if WordIsPropertySpecifier.DoIdentifier(@Src[CurPos.StartPos])
3216    then begin
3217      if UpAtomIs(UpperKeyword) then exit(true);
3218    end else if CurPos.Flag=cafEdgedBracketOpen then begin
3219      if not ReadTilBracketClose(ExceptionOnNotFound) then exit;
3220      ReadNextAtom;
3221    end;
3222    ReadNextAtom;
3223  end;
3224  // read modifiers
3225  while CurPos.Flag=cafSemicolon do begin
3226    ReadNextAtom;
3227    if UpAtomIs('DEFAULT') or UpAtomIs('NODEFAULT') or UpAtomIs('DEPRECATED')
3228    then begin
3229      if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(UpperKeyword))=0 then exit(true);
3230    end else if UpAtomIs('ENUMERATOR') then begin
3231      if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(UpperKeyword))=0 then exit(true);
3232      ReadNextAtom;
3233      if not AtomIsIdentifier then exit;
3234    end else
3235      exit;
3236    ReadNextAtom;
3237  end;
3238end;
3239
3240function TPascalReaderTool.ProcNodeHasParamList(ProcNode: TCodeTreeNode): boolean;
3241begin
3242
3243  // ToDo: ppu, dcu
3244
3245  Result:=false;
3246  if ProcNode=nil then exit;
3247  if ProcNode.Desc=ctnProcedure then begin
3248    ProcNode:=ProcNode.FirstChild;
3249    if ProcNode=nil then exit;
3250  end;
3251  if ProcNode.Desc<>ctnProcedureHead then exit;
3252  if ProcNode.FirstChild<>nil then begin
3253    Result:=ProcNode.FirstChild.Desc=ctnParameterList;
3254    exit;
3255  end;
3256  MoveCursorBehindProcName(ProcNode);
3257  Result:=CurPos.Flag=cafRoundBracketOpen;
3258end;
3259
3260function TPascalReaderTool.ProcNodeHasOfObject(ProcNode: TCodeTreeNode
3261  ): boolean;
3262begin
3263
3264  // ToDo: ppu, dcu
3265
3266  Result:=false;
3267  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedureType) then exit;
3268  MoveCursorToFirstProcSpecifier(ProcNode);
3269  Result:=UpAtomIs('OF') and ReadNextUpAtomIs('OBJECT');
3270end;
3271
3272function TPascalReaderTool.GetProcParamList(ProcNode: TCodeTreeNode;
3273  Parse: boolean): TCodeTreeNode;
3274begin
3275  Result:=ProcNode;
3276  if Result=nil then exit;
3277  if Result.Desc=ctnProcedure then begin
3278    Result:=Result.FirstChild;
3279    if Result=nil then exit;
3280  end;
3281  if Result.Desc<>ctnProcedureHead then exit(nil);
3282  if Parse then
3283    BuildSubTreeForProcHead(Result);
3284  Result:=Result.FirstChild;
3285  if Result=nil then exit;
3286  if Result.Desc<>ctnParameterList then exit(nil);
3287end;
3288
3289procedure TPascalReaderTool.MoveCursorToUsesStart(UsesNode: TCodeTreeNode);
3290begin
3291  if (UsesNode=nil)
3292  or ((UsesNode.Desc<>ctnUsesSection) and (UsesNode.Desc<>ctnContainsSection))
3293  then
3294    RaiseException('[TPascalParserTool.MoveCursorToUsesStart] '
3295      +'internal error: invalid UsesNode');
3296  // search through the uses section
3297  MoveCursorToCleanPos(UsesNode.StartPos);
3298  ReadNextAtom;
3299  if (not UpAtomIs('USES')) and (not UpAtomIs('CONTAINS')) then
3300    RaiseExceptionFmt(ctsStrExpectedButAtomFound,['uses',GetAtom]);
3301  ReadNextAtom;
3302end;
3303
3304procedure TPascalReaderTool.MoveCursorToUsesEnd(UsesNode: TCodeTreeNode);
3305begin
3306  if (UsesNode=nil)
3307  or ((UsesNode.Desc<>ctnUsesSection) and (UsesNode.Desc<>ctnContainsSection))
3308  then
3309    RaiseException('[TPascalParserTool.MoveCursorToUsesEnd] '
3310      +'internal error: invalid UsesNode');
3311  // search backwards through the uses section
3312  MoveCursorToCleanPos(UsesNode.EndPos);
3313  ReadPriorAtom; // read ';'
3314  if not AtomIsChar(';') then
3315    RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]);
3316end;
3317
3318function TPascalReaderTool.ReadNextUsedUnit(out UnitNameRange,
3319  InAtom: TAtomPosition; SyntaxExceptions: boolean): boolean;
3320// after reading CurPos is on atom behind, i.e. comma or semicolon
3321begin
3322  Result:=false;
3323  if not AtomIsIdentifierE(SyntaxExceptions) then exit;
3324  UnitNameRange:=CurPos;
3325  repeat
3326    ReadNextAtom;
3327    if CurPos.Flag<>cafPoint then break;
3328    ReadNextAtom;
3329    if not AtomIsIdentifierE(SyntaxExceptions) then exit;
3330    UnitNameRange.EndPos:=CurPos.EndPos;
3331  until false;
3332  if UpAtomIs('IN') then begin
3333    ReadNextAtom; // read filename
3334    if not AtomIsStringConstant then begin
3335      if not SyntaxExceptions then exit;
3336      RaiseStrConstExpected;
3337    end;
3338    InAtom:=CurPos;
3339    ReadNextAtom; // read comma or semicolon
3340  end else begin
3341    InAtom:=CleanAtomPosition;
3342  end;
3343  Result:=true;
3344end;
3345
3346procedure TPascalReaderTool.ReadPriorUsedUnit(out UnitNameRange,InAtom: TAtomPosition);
3347begin
3348  ReadPriorAtom; // read unitname
3349  if AtomIsStringConstant then begin
3350    InAtom:=CurPos;
3351    ReadPriorAtom; // read 'in'
3352    if not UpAtomIs('IN') then
3353      RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsKeywordIn,GetAtom]);
3354    ReadPriorAtom; // read unitname
3355  end else begin
3356    InAtom:=CleanAtomPosition;
3357  end;
3358  AtomIsIdentifierE;
3359  UnitNameRange:=CurPos;
3360  repeat
3361    ReadPriorAtom;
3362    if CurPos.Flag<>cafPoint then break;
3363    ReadPriorAtom;
3364    AtomIsIdentifierE;
3365    UnitNameRange.StartPos:=CurPos.StartPos;
3366  until false;
3367end;
3368
3369function TPascalReaderTool.ExtractUsedUnitNameAtCursor(InFilename: PAnsiString): string;
3370begin
3371  Result:='';
3372  if InFilename<>nil then
3373    InFilename^:='';
3374  while CurPos.Flag=cafWord do begin
3375    if Result<>'' then
3376      Result:=Result+'.';
3377    Result:=Result+GetAtom;
3378    ReadNextAtom;
3379    if CurPos.Flag<>cafPoint then break;
3380    ReadNextAtom;
3381  end;
3382  if UpAtomIs('IN') then begin
3383    ReadNextAtom;
3384    if not AtomIsStringConstant then exit;
3385    if InFilename<>nil then
3386      InFilename^:=copy(Src,CurPos.StartPos+1,CurPos.EndPos-CurPos.StartPos-2);
3387    ReadNextAtom;
3388  end;
3389end;
3390
3391function TPascalReaderTool.ExtractUsedUnitName(UseUnitNode: TCodeTreeNode;
3392  InFilename: PAnsiString): string;
3393// after reading CurPos is on atom behind, i.e. comma or semicolon
3394begin
3395  Result:='';
3396  if InFilename<>nil then InFilename^:='';
3397  if (UseUnitNode=nil) or (UseUnitNode.Desc<>ctnUseUnit) then exit;
3398  MoveCursorToCleanPos(UseUnitNode.StartPos);
3399  ReadNextAtom;
3400  Result:=ExtractUsedUnitNameAtCursor(InFilename);
3401end;
3402
3403function TPascalReaderTool.ReadAndCompareUsedUnit(const AnUnitName: string): boolean;
3404// after reading cursor is on atom behind unit name
3405var
3406  p: PChar;
3407begin
3408  Result:=false;
3409  if IsDottedIdentifier(AnUnitName) then
3410    p:=PChar(AnUnitName)
3411  else
3412    p:=nil;
3413  repeat
3414    if not AtomIsIdentifier then exit;
3415    if (p<>nil) then begin
3416      if CompareIdentifiers(p,@Src[CurPos.StartPos])=0 then
3417        inc(p,CurPos.EndPos-CurPos.StartPos)
3418      else
3419        p:=nil;
3420    end;
3421    ReadNextAtom;
3422    if CurPos.Flag<>cafPoint then begin
3423      // end of unit name
3424      Result:=(p<>nil) and (p^=#0);
3425      exit;
3426    end;
3427    // dot
3428    if (p<>nil) then begin
3429      if p='.' then
3430        inc(p)
3431      else
3432        p:=nil;
3433    end;
3434    ReadNextAtom;
3435  until false;
3436end;
3437
3438function TPascalReaderTool.FindCommentInFront(const StartPos: TCodeXYPosition;
3439  const CommentText: string; InvokeBuildTree, SearchInParentNode,
3440  WithCommentBounds, CaseSensitive, IgnoreSpaces, CompareOnlyStart: boolean;
3441  out CommentStart, CommentEnd: TCodeXYPosition): boolean;
3442var
3443  CleanCursorPos: integer;
3444  CommentCleanStart: integer;
3445  CommentCleanEnd: integer;
3446begin
3447  Result:=false;
3448  if CommentText='' then exit;
3449
3450  {debugln('TPascalReaderTool.FindCommentInFront A CommentText="',CommentText,'" ',
3451    ' StartPos=Y='+dbgs(StartPos.Y)+',X='+dbgs(StartPos.X),
3452    ' InvokeBuildTree='+dbgs(InvokeBuildTree),
3453    ' SearchInParentNode='+dbgs(SearchInParentNode),
3454    ' WithCommentBounds='+dbgs(WithCommentBounds),
3455    ' CaseSensitive='+dbgs(CaseSensitive),
3456    ' IgnoreSpaces='+dbgs(IgnoreSpaces),
3457    ' CompareOnlyStart='+dbgs(CompareOnlyStart)); }
3458
3459  // parse source and find clean positions
3460  if InvokeBuildTree then
3461    BuildTreeAndGetCleanPos(StartPos,CleanCursorPos,[])
3462  else
3463    if CaretToCleanPos(StartPos,CleanCursorPos)<>0 then
3464      exit;
3465  Result:=FindCommentInFront(CleanCursorPos,CommentText,SearchInParentNode,
3466                  WithCommentBounds,CaseSensitive,IgnoreSpaces,CompareOnlyStart,
3467                  CommentCleanStart,CommentCleanEnd);
3468  if not Result then exit;
3469  Result:=(CommentCleanStart>=1)
3470          and CleanPosToCaret(CommentCleanStart,CommentStart)
3471          and CleanPosToCaret(CommentCleanEnd,CommentEnd);
3472end;
3473
3474function TPascalReaderTool.FindCommentInFront(StartPos: integer;
3475  const CommentText: string;
3476  SearchInParentNode, WithCommentBounds, CaseSensitive,
3477  IgnoreSpaces, CompareOnlyStart: boolean;
3478  out CommentStart, CommentEnd: integer): boolean;
3479// searches a comment in front of StartPos starting with CommentText.
3480var
3481  FoundStartPos: integer;
3482  FoundEndPos: integer;
3483
3484  procedure CompareComment(CStartPos, CEndPos: integer);
3485  var
3486    Found: LongInt;
3487    CompareStartPos: LongInt;
3488    CompareEndPos: LongInt;
3489    CompareLen: Integer;
3490    CompareCommentLength: Integer;
3491  begin
3492    //debugln('CompareComment "',copy(Src,CStartPos,CEndPos-CStartPos),'"');
3493
3494    CompareStartPos:=CStartPos;
3495    CompareEndPos:=CEndPos;
3496    if not WithCommentBounds then begin
3497      // chomp comment boundaries
3498      case Src[CompareStartPos] of
3499      '/','(': inc(CompareStartPos,2);
3500      '{':
3501        if (CompareStartPos<SrcLen) and (Src[CompareStartPos+1]=#3) then
3502          // the codetools skip comment is no real comment
3503          exit
3504        else
3505          inc(CompareStartPos,1);
3506      end;
3507      case Src[CompareEndPos-1] of
3508      '}': dec(CompareEndPos);
3509      ')': dec(CompareEndPos,2);
3510      #10,#13:
3511        begin
3512          dec(CompareEndPos);
3513          if (Src[CompareEndPos-1] in [#10,#13])
3514          and (Src[CompareEndPos-1]<>Src[CompareEndPos]) then
3515            dec(CompareEndPos);
3516        end;
3517      end;
3518    end;
3519    if CompareStartPos>CompareEndPos then exit;
3520
3521    if IgnoreSpaces then begin
3522      while (CompareStartPos<=CompareEndPos)
3523      and IsSpaceChar[Src[CompareStartPos]]
3524      do
3525        inc(CompareStartPos);
3526    end;
3527
3528    CompareCommentLength:=length(CommentText);
3529    CompareLen:=CompareEndPos-CompareStartPos;
3530    if CompareOnlyStart and (CompareLen>CompareCommentLength) then
3531      CompareLen:=CompareCommentLength;
3532
3533    //debugln('Compare: "',copy(Src,CompareStartPos,CompareEndPos-CompareStartPos),'"',
3534    //  ' "',CommentText,'"');
3535    if IgnoreSpaces then begin
3536      Found:=CompareTextIgnoringSpace(
3537                          @Src[CompareStartPos],CompareLen,
3538                          @CommentText[1],length(CommentText),
3539                          CaseSensitive);
3540    end else begin
3541      Found:=CompareText(@Src[CompareStartPos],CompareLen,
3542                         @CommentText[1],length(CommentText),
3543                         CaseSensitive);
3544    end;
3545    if Found=0 then begin
3546      FoundStartPos:=CStartPos;
3547      FoundEndPos:=CEndPos;
3548    end;
3549  end;
3550
3551var
3552  ANode: TCodeTreeNode;
3553  p: LongInt;
3554  CommentStartPos: LongInt;
3555begin
3556  Result:=false;
3557  if StartPos>SrcLen then
3558    StartPos:=SrcLen+1;
3559  if CommentText='' then exit;
3560
3561  {debugln('TPascalReaderTool.FindCommentInFront A CommentText="',CommentText,'" ',
3562    ' StartPos=Y='+dbgs(StartPos.Y)+',X='+dbgs(StartPos.X),
3563    ' InvokeBuildTree='+dbgs(InvokeBuildTree),
3564    ' SearchInParentNode='+dbgs(SearchInParentNode),
3565    ' WithCommentBounds='+dbgs(WithCommentBounds),
3566    ' CaseSensitive='+dbgs(CaseSensitive),
3567    ' IgnoreSpaces='+dbgs(IgnoreSpaces),
3568    ' CompareOnlyStart='+dbgs(CompareOnlyStart)); }
3569
3570  // find node
3571  ANode:=FindDeepestNodeAtPos(StartPos,true);
3572  if (ANode=nil) then exit;
3573
3574  { find end of last atom in front of node
3575    for example:
3576      uses classes;
3577
3578      // Comment
3579      type
3580
3581    If ANode is the 'type' block, the position after the semicolon is searched
3582  }
3583
3584  if SearchInParentNode and (ANode.Parent<>nil) then begin
3585    // search all siblings in front
3586    ANode:=ANode.Parent;
3587    MoveCursorToCleanPos(ANode.Parent.StartPos);
3588  end else if ANode.PriorBrother<>nil then begin
3589    // search between prior sibling and this node
3590    //DebugLn('TPascalReaderTool.FindCommentInFront ANode.Prior=',ANode.Prior.DescAsString);
3591    MoveCursorToLastNodeAtom(ANode.PriorBrother);
3592  end else if ANode.Parent<>nil then begin
3593    // search from start of parent node to this node
3594    //DebugLn('TPascalReaderTool.FindCommentInFront ANode.Parent=',ANode.Parent.DescAsString);
3595    MoveCursorToCleanPos(ANode.Parent.StartPos);
3596  end else begin
3597    // search in this node
3598    //DebugLn('TPascalReaderTool.FindCommentInFront Aode=',ANode.DescAsString);
3599    MoveCursorToCleanPos(ANode.StartPos);
3600  end;
3601  p:=CurPos.EndPos;
3602
3603  //debugln('TPascalReaderTool.FindCommentInFront B Area="',copy(Src,CurPos.StartPos,StartPos-CurPos.StartPos),'"');
3604
3605  FoundStartPos:=-1;
3606  repeat
3607    //debugln('TPascalReaderTool.FindCommentInFront Atom=',GetAtom);
3608    CommentStartPos:=FindNextComment(Src,p,StartPos);
3609    if CommentStartPos>=StartPos then break;
3610    p:=FindCommentEnd(Src,CommentStartPos,Scanner.NestedComments);
3611    if p>StartPos then break;
3612    CompareComment(CommentStartPos,p);
3613  until false;
3614
3615  Result:=(FoundStartPos>=1);
3616  CommentStart:=FoundStartPos;
3617  CommentEnd:=FoundEndPos;
3618end;
3619
3620function TPascalReaderTool.GetPasDocComments(const StartPos: TCodeXYPosition;
3621  InvokeBuildTree: boolean; out ListOfPCodeXYPosition: TFPList): boolean;
3622var
3623  CleanCursorPos: integer;
3624  ANode: TCodeTreeNode;
3625begin
3626  ListOfPCodeXYPosition:=nil;
3627  Result:=false;
3628
3629  // parse source and find clean positions
3630  if InvokeBuildTree then
3631    BuildTreeAndGetCleanPos(StartPos,CleanCursorPos)
3632  else
3633    if CaretToCleanPos(StartPos,CleanCursorPos)<>0 then
3634      exit;
3635
3636  ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
3637  Result:=GetPasDocComments(ANode,ListOfPCodeXYPosition);
3638end;
3639
3640function TPascalReaderTool.GetPasDocComments(Node: TCodeTreeNode;
3641  out ListOfPCodeXYPosition: TFPList): boolean;
3642// Comments are normally in front.
3643// { Description of TMyClass. }
3644//  TMyClass = class
3645//
3646// Comments can be behind in the same line
3647// property Color; // description of Color
3648//
3649// Comments can be in the following line if started with <
3650//
3651// comment starting with $ or % are ignored
3652
3653  function CommentBelongsToPrior(CommentStart: integer): boolean;
3654  var
3655    p: Integer;
3656  begin
3657    //DebugLn(['CommentBelongsToPrior Comment=',dbgstr(copy(Src,CommentStart,20))]);
3658    if (CommentStart<SrcLen) and (Src[CommentStart]='{')
3659    and (Src[CommentStart+1]='<') then
3660      Result:=true
3661    else if (CommentStart+2<=SrcLen) and (Src[CommentStart]='(')
3662    and (Src[CommentStart+1]='*') and (Src[CommentStart+2]='<') then
3663      Result:=true
3664    else if (CommentStart+2<=SrcLen) and (Src[CommentStart]='/')
3665    and (Src[CommentStart+1]='/') and (Src[CommentStart+2]='<') then
3666      Result:=true
3667    else begin
3668      p:=CommentStart-1;
3669      while (p>=1) and (Src[p] in [' ',#9]) do dec(p);
3670      //DebugLn(['CommentBelongsToPrior Code in front: ',dbgstr(copy(Src,p,20))]);
3671      if (p<1) or (Src[p] in [#10,#13]) then
3672        Result:=false
3673      else
3674        Result:=true; // there is code in the same line in front of the comment
3675    end;
3676  end;
3677
3678  procedure Add(CleanPos: integer);
3679  var
3680    CodePos: TCodeXYPosition;
3681  begin
3682    if not CleanPosToCaret(CleanPos,CodePos) then exit;
3683    AddCodePosition(ListOfPCodeXYPosition,CodePos);
3684  end;
3685
3686  function Scan(StartPos, EndPos: integer): boolean;
3687  var
3688    p: LongInt;
3689    pp: PChar;
3690  begin
3691    // read comments (start in front of node)
3692    //DebugLn(['TPascalReaderTool.GetPasDocComments Scan Src=',copy(Src,StartPos,EndPos-StartPos)]);
3693    if EndPos>SrcLen then EndPos:=SrcLen+1;
3694    p:=FindLineEndOrCodeInFrontOfPosition(StartPos,true);
3695    while p<EndPos do begin
3696      p:=FindNextComment(Src,p,EndPos);
3697      if (p>=EndPos) then break;
3698      pp:=@Src[p];
3699      if ((pp^='/') and (pp[1]='/') and (pp[2] in ['$','%']))
3700      or ((pp^='{') and (pp[1] in ['$','%']))
3701      or ((pp^='(') and (pp[1]='*') and (pp[2] in ['$','%']))
3702      then
3703        break;
3704      //debugln(['TStandardCodeTool.GetPasDocComments Comment="',copy(Src,p,FindCommentEnd(Src,p,Scanner.NestedComments)-p),'"']);
3705      if (p<StartPos) then begin
3706        // comment in front of node
3707        if not CommentBelongsToPrior(p) then
3708          Add(p);
3709      end else if (p<EndPos) then begin
3710        // comment in the middle or behind
3711        if CommentBelongsToPrior(p) then
3712          Add(p);
3713      end;
3714      p:=FindCommentEnd(Src,p,Scanner.NestedComments);
3715    end;
3716    Result:=true;
3717  end;
3718
3719var
3720  NextNode: TCodeTreeNode;
3721  EndPos: LongInt;
3722  TypeNode: TCodeTreeNode;
3723begin
3724  ListOfPCodeXYPosition:=nil;
3725  Result:=false;
3726  if (Node=nil) then exit;
3727  if (Node.Desc=ctnProcedureHead)
3728  and (Node.Parent<>nil) and (Node.Parent.Desc=ctnProcedure) then
3729    Node:=Node.Parent;
3730
3731  // add space behind node to scan range
3732  NextNode:=Node.Next;
3733  if NextNode<>nil then
3734    EndPos:=NextNode.StartPos
3735  else
3736    EndPos:=Node.EndPos;
3737
3738  // scan range for comments
3739  if not Scan(Node.StartPos,EndPos) then exit;
3740
3741  if Node.Desc in AllIdentifierDefinitions then begin
3742    // scan behind type
3743    // for example:   i: integer; // comment
3744    TypeNode:=FindTypeNodeOfDefinition(Node);
3745    if TypeNode<>nil then begin
3746      NextNode:=TypeNode.Next;
3747      if NextNode<>nil then
3748        EndPos:=NextNode.StartPos
3749      else
3750        EndPos:=Node.EndPos;
3751      if not Scan(TypeNode.EndPos,EndPos) then exit;
3752    end;
3753  end;
3754  Result:=true;
3755end;
3756
3757procedure TPascalReaderTool.CalcMemSize(Stats: TCTMemStats);
3758begin
3759  inherited CalcMemSize(Stats);
3760  Stats.Add('TPascalReaderTool',MemSizeString(CachedSourceName));
3761end;
3762
3763end.
3764