/components/codetools/pascalreadertool.pas

{
 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 *                                                                         *
 ***************************************************************************

  Author: Mattias Gaertner

  Abstract:
    TPascalReaderTool enhances TPascalParserTool.
    This tool provides a lot of useful functions to read the output of the
    TPascalParserTool.
}
unit PascalReaderTool;

{$ifdef FPC}{$mode objfpc}{$endif}{$H+}

interface

{$I codetools.inc}

uses
  {$IFDEF MEM_CHECK}
  MemCheck,
  {$ENDIF}
  Classes, SysUtils, FileProcs, CodeToolsStrConsts, CodeTree, CodeCache,
  CodeAtom, CustomCodeTool, PascalParserTool, KeywordFuncLists, BasicCodeTools,
  LinkScanner, AVL_Tree, LazFileUtils, LazDbgLog;

type
  TPascalHintModifier = (
    phmDeprecated,
    phmPlatform,
    phmLibrary,
    phmUnimplemented,
    phmExperimental
    );
  TPascalHintModifiers = set of TPascalHintModifier;

  TEPRIRange = (
    epriInCode,
    epriInComment,
    epriInDirective
    );

  //the scope groups of pascal methods.
  //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
  TPascalMethodGroup = (mgMethod, mgConstructor, mgClassConstructor, mgClassDestructor, mgClassOperator);

  TPascalMethodHeader = record
    Name, ResultType: string;
    Group: TPascalMethodGroup;
  end;

  TClassSectionVisibility = (
    csvEverything,//same class same unit
    csvPrivateAndHigher,//same unit different class
    csvProtectedAndHigher,//ancestor class different unit
    csvPublicAndHigher);//other class other unit

  TOnEachPRIdentifier = procedure(Sender: TPascalParserTool;
    IdentifierCleanPos: integer; Range: TEPRIRange;
    Node: TCodeTreeNode; Data: Pointer; var Abort: boolean) of object;

  { TPascalReaderTool }

  TPascalReaderTool = class(TPascalParserTool)
  protected
    CachedSourceName: string;
    procedure RaiseStrConstExpected;
  public
    // comments
    function CleanPosIsInComment(CleanPos, CleanCodePosInFront: integer;
        out CommentStart, CommentEnd: integer;
        OuterCommentBounds: boolean = true): boolean;

    // general extraction
    function ExtractNode(ANode: TCodeTreeNode;
        Attr: TProcHeadAttributes): string;
    function ExtractCode(StartPos, EndPos: integer;
        Attr: TProcHeadAttributes): string;
    function ExtractBrackets(BracketStartPos: integer;
        Attr: TProcHeadAttributes): string;
    function ExtractIdentifierWithPoints(StartPos: integer;
        ExceptionOnError: boolean): string;
    function ExtractIdentCharsFromStringConstant(
        StartPos, MinPos, MaxPos, MaxLen: integer): string;
    function ReadStringConstantValue(StartPos: integer): string;
    function GetNodeIdentifier(Node: TCodeTreeNode): PChar;
    function GetHintModifiers(Node: TCodeTreeNode): TPascalHintModifiers;
    procedure ForEachIdentifierInCleanSrc(StartPos, EndPos: integer;
        SkipComments: boolean; Node: TCodeTreeNode;
        const OnIdentifier: TOnEachPRIdentifier; Data: pointer;
        var Abort: boolean); // range in clean source
    procedure ForEachIdentifierInNode(Node: TCodeTreeNode; SkipComments: boolean;
        const OnIdentifier: TOnEachPRIdentifier; Data: Pointer; var Abort: boolean); // node and child nodes
    procedure ForEachIdentifier(SkipComments: boolean;
        const OnIdentifier: TOnEachPRIdentifier; Data: Pointer); // whole unit/program

    // properties
    function ExtractPropType(PropNode: TCodeTreeNode;
                             InUpperCase, EmptyIfIndexed: boolean): string;
    function MoveCursorToPropType(PropNode: TCodeTreeNode): boolean;
    function MoveCursorToPropName(PropNode: TCodeTreeNode): boolean;
    procedure MoveCursorBehindPropName(PropNode: TCodeTreeNode);
    function ExtractPropName(PropNode: TCodeTreeNode;
                             InUpperCase: boolean): string;
    function ExtractProperty(PropNode: TCodeTreeNode;
                             Attr: TProcHeadAttributes): string;
    function GetPropertyNameIdentifier(PropNode: TCodeTreeNode): PChar;
    function GetPropertyTypeIdentifier(PropNode: TCodeTreeNode): PChar;
    function PositionInPropertyName(PropNode: TCodeTreeNode;
                                    CleanPos: integer): boolean;
    function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
    function PropertyNodeHasParamList(PropNode: TCodeTreeNode): boolean;
    function PropNodeIsTypeLess(PropNode: TCodeTreeNode): boolean;
    function PropertyHasSpecifier(PropNode: TCodeTreeNode;
                 UpperKeyword: string; ExceptionOnNotFound: boolean = true): boolean;

    // procs
    function ExtractProcName(ProcNode: TCodeTreeNode;
        Attr: TProcHeadAttributes): string;
    function ExtractProcHead(ProcNode: TCodeTreeNode;
        Attr: TProcHeadAttributes): string;
    function ExtractProcHeadWithGroup(ProcNode: TCodeTreeNode;
        Attr: TProcHeadAttributes): TPascalMethodHeader;
    function ExtractProcedureHeader(CursorPos: TCodeXYPosition;
      Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
    function ExtractClassNameOfProcNode(ProcNode: TCodeTreeNode;
        AddParentClasses: boolean = true): string;
    function ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
        ProcSpec: TProcedureSpecifier): boolean;
    function GetProcNameIdentifier(ProcNode: TCodeTreeNode): PChar;
    function FindProcNode(StartNode: TCodeTreeNode; const AProcHead: string;
        AProcSpecType: TPascalMethodGroup;
        Attr: TProcHeadAttributes; Visibility: TClassSectionVisibility = csvEverything): TCodeTreeNode; overload;
    function FindProcNode(StartNode: TCodeTreeNode; const AProcHead: TPascalMethodHeader;
        Attr: TProcHeadAttributes; Visibility: TClassSectionVisibility = csvEverything): TCodeTreeNode; overload;
    function FindCorrespondingProcNode(ProcNode: TCodeTreeNode;
        Attr: TProcHeadAttributes = [phpWithoutClassKeyword,phpWithoutClassName]
        ): TCodeTreeNode;
    function FindCorrespondingProcParamNode(ProcParamNode: TCodeTreeNode;
        Attr: TProcHeadAttributes = [phpInUpperCase,phpWithoutClassName,phpWithVarModifiers]
        ): TCodeTreeNode;
    function FindProcBody(ProcNode: TCodeTreeNode): TCodeTreeNode;
    function ProcBodyIsEmpty(ProcNode: TCodeTreeNode): boolean;
    function ExtractProcedureGroup(ProcNode: TCodeTreeNode): TPascalMethodGroup;
    function ExtractFuncResultType(ProcNode: TCodeTreeNode;
        Attr: TProcHeadAttributes): string;
    procedure MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode);
    function MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
        ProcSpec: TProcedureSpecifier): boolean;
    procedure MoveCursorToProcName(ProcNode: TCodeTreeNode;
        SkipClassName: boolean);
    procedure MoveCursorBehindProcName(ProcNode: TCodeTreeNode);
    function PositionInProcName(ProcNode: TCodeTreeNode;
                                SkipClassName: boolean; CleanPos: integer): boolean;
    function PositionInFuncResultName(ProcNode: TCodeTreeNode;
                                      CleanPos: integer): boolean;
    function ProcNodeHasParamList(ProcNode: TCodeTreeNode): boolean;
    function ProcNodeHasOfObject(ProcNode: TCodeTreeNode): boolean;
    function GetProcParamList(ProcNode: TCodeTreeNode;
                              Parse: boolean = true): TCodeTreeNode;
    function NodeIsInAMethod(Node: TCodeTreeNode): boolean;
    function NodeIsMethodBody(ProcNode: TCodeTreeNode): boolean;
    function GetMethodOfBody(Node: TCodeTreeNode): TCodeTreeNode;
    function NodeIsFunction(ProcNode: TCodeTreeNode): boolean;
    function NodeIsClassConstructorOrDestructor(ProcNode: TCodeTreeNode): boolean;
    function NodeIsConstructor(ProcNode: TCodeTreeNode): boolean;
    function NodeIsDestructor(ProcNode: TCodeTreeNode): boolean;
    function NodeIsForwardProc(ProcNode: TCodeTreeNode): boolean;
    function NodeIsOperator(ProcNode: TCodeTreeNode): boolean;
    function NodeIsResultIdentifier(Node: TCodeTreeNode): boolean;
    function NodeIsResultType(Node: TCodeTreeNode): boolean;

    // classes
    function ExtractClassName(Node: TCodeTreeNode;
        InUpperCase: boolean; WithParents: boolean = true;
        WithGenericParams: boolean = false): string;
    function ExtractClassPath(Node: TCodeTreeNode): string;
    function ExtractClassInheritance(ClassNode: TCodeTreeNode;
        Attr: TProcHeadAttributes): string;
    function FindClassNode(StartNode: TCodeTreeNode;
        const AClassName: string; // nested: A.B
        IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
    function FindClassNodeBackwards(StartNode: TCodeTreeNode;
        const AClassName: string;
        IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
    function FindNestedClass(RootClassNode: TCodeTreeNode;
         AClassName: PChar; SkipFirst: boolean): TCodeTreeNode;
    function FindClassNode(CursorNode: TCodeTreeNode): TCodeTreeNode;
    function FindClassNodeForMethodBody(ProcNode: TCodeTreeNode;
        IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
    function FindClassOrInterfaceNode(CursorNode: TCodeTreeNode;
        FindClassOfMethod: boolean = false): TCodeTreeNode;
    function FindClassSection(ClassNode: TCodeTreeNode;
        NodeDesc: TCodeTreeNodeDesc): TCodeTreeNode;
    function FindLastClassSection(ClassNode: TCodeTreeNode;
        NodeDesc: TCodeTreeNodeDesc): TCodeTreeNode;
    function GetClassVisibility(Node: TCodeTreeNode): TCodeTreeNodeDesc;
    function FindClassNodeInInterface(const AClassName: string;
        IgnoreForwards, IgnoreNonForwards, ErrorOnNotFound: boolean): TCodeTreeNode;
    function FindClassNodeInUnit(const AClassName: string;
        IgnoreForwards, IgnoreNonForwards, IgnoreImplementation,
        ErrorOnNotFound: boolean): TCodeTreeNode;
    function FindFirstIdentNodeInClass(ClassNode: TCodeTreeNode): TCodeTreeNode;
    function FindLastIdentNodeInClass(ClassNode: TCodeTreeNode): TCodeTreeNode;
    function FindNextIdentNodeInClass(Node: TCodeTreeNode): TCodeTreeNode;
    function FindPriorIdentNodeInClass(Node: TCodeTreeNode): TCodeTreeNode;
    function ClassSectionNodeStartsWithWord(ANode: TCodeTreeNode): boolean;
    function IsClassNode(Node: TCodeTreeNode): boolean; // class, not object
    function FindInheritanceNode(ClassNode: TCodeTreeNode): TCodeTreeNode;
    function FindHelperForNode(HelperNode: TCodeTreeNode): TCodeTreeNode;
    function IdentNodeIsInVisibleClassSection(Node: TCodeTreeNode; Visibility: TClassSectionVisibility): Boolean;

    // records
    function ExtractRecordCaseType(RecordCaseNode: TCodeTreeNode): string;

    // variables, types
    function FindVarNode(StartNode: TCodeTreeNode;
        const UpperVarName: string;
        Visibility: TClassSectionVisibility = csvEverything): TCodeTreeNode;
    function FindTypeNodeOfDefinition(
        DefinitionNode: TCodeTreeNode): TCodeTreeNode;
    function NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode): boolean;
    function ExtractDefinitionNodeType(DefinitionNode: TCodeTreeNode): string;
    function ExtractDefinitionName(DefinitionNode: TCodeTreeNode): string;
    function FindDefinitionNameNode(DefinitionNode: TCodeTreeNode): TCodeTreeNode;
    function PositionInDefinitionName(DefinitionNode: TCodeTreeNode;
                                      CleanPos: integer): boolean;
    function MoveCursorToParameterSpecifier(DefinitionNode: TCodeTreeNode
                                            ): boolean;
    function GetFirstGroupVarNode(VarNode: TCodeTreeNode): TCodeTreeNode;
    function NodeIsIdentifierInInterface(Node: TCodeTreeNode): boolean;
    function NodeCanHaveForwardType(TypeNode: TCodeTreeNode): boolean;
    function NodeIsForwardType(TypeNode: TCodeTreeNode): boolean;
    function FindForwardTypeNode(TypeNode: TCodeTreeNode;
                                 SearchFirst: boolean): TCodeTreeNode;
    function FindTypeOfForwardNode(TypeNode: TCodeTreeNode): TCodeTreeNode;
    function FindEndOfWithExpr(WithVarNode: TCodeTreeNode): integer;
    function ExtractWithBlockExpression(WithVarNode: TCodeTreeNode; Attr: TProcHeadAttributes = []): string;
    function FindWithBlockStatement(WithVarNode: TCodeTreeNode): TCodeTreeNode;

    // arrays
    function ExtractArrayRange(ArrayNode: TCodeTreeNode;
        Attr: TProcHeadAttributes): string;

    // module sections
    function ExtractSourceName: string;
    function GetSourceNamePos(out NamePos: TAtomPosition): boolean;
    function GetSourceName(DoBuildTree: boolean = true): string;
    function GetSourceType: TCodeTreeNodeDesc;
    function PositionInSourceName(CleanPos: integer): boolean;

    // uses sections
    procedure MoveCursorToUsesStart(UsesNode: TCodeTreeNode);
    procedure MoveCursorToUsesEnd(UsesNode: TCodeTreeNode);
    function ReadNextUsedUnit(out UnitNameRange, InAtom: TAtomPosition;
          SyntaxExceptions: boolean = true): boolean;
    procedure ReadPriorUsedUnit(out UnitNameRange, InAtom: TAtomPosition);
    function ExtractUsedUnitNameAtCursor(InFilename: PAnsiString = nil): string;
    function ExtractUsedUnitName(UseUnitNode: TCodeTreeNode;
          InFilename: PAnsiString = nil): string;
    function ReadAndCompareUsedUnit(const AnUnitName: string): boolean;

    // comments
    function FindCommentInFront(const StartPos: TCodeXYPosition;
          const CommentText: string; InvokeBuildTree, SearchInParentNode,
          WithCommentBounds, CaseSensitive, IgnoreSpaces,
          CompareOnlyStart: boolean;
          out CommentStart, CommentEnd: TCodeXYPosition): boolean;
    function FindCommentInFront(StartPos: integer;
          const CommentText: string; SearchInParentNode,
          WithCommentBounds, CaseSensitive, IgnoreSpaces,
          CompareOnlyStart: boolean;
          out CommentStart, CommentEnd: integer): boolean;
    function GetPasDocComments(const StartPos: TCodeXYPosition;
                               InvokeBuildTree: boolean;
                               out ListOfPCodeXYPosition: TFPList): boolean;
    function GetPasDocComments(Node: TCodeTreeNode;
                               out ListOfPCodeXYPosition: TFPList): boolean;

    procedure CalcMemSize(Stats: TCTMemStats); override;
  end;

function CompareMethodHeaders(
  const Method1Name: string; Method1Group: TPascalMethodGroup; const Method1ResultType: string;
  const Method2Name: string; Method2Group: TPascalMethodGroup; const Method2ResultType: string): Integer; overload;
function CompareMethodHeaders(const Method1Head: TPascalMethodHeader; const Method2Head: TPascalMethodHeader): Integer; overload;
function SameMethodHeaders(
  const Method1Name: string; Method1Group: TPascalMethodGroup; const Method1ResultType: string;
  const Method2Name: string; Method2Group: TPascalMethodGroup; const Method2ResultType: string): Boolean; overload;
function SameMethodHeaders(const Method1Head: TPascalMethodHeader; const Method2Head: TPascalMethodHeader): Boolean; overload;
function CompareCodeTreeNodeExtMethodHeaders(NodeData1, NodeData2: pointer): integer;

implementation

function CompareMethodHeaders(const Method1Name: string;
  Method1Group: TPascalMethodGroup; const Method1ResultType: string;
  const Method2Name: string; Method2Group: TPascalMethodGroup;
  const Method2ResultType: string): Integer;
begin
  Result := (Ord(Method1Group) - Ord(Method2Group));
  if Result <> 0 then exit;
  Result := CompareTextIgnoringSpace(Method1Name,Method2Name,false);
  if Result <> 0 then exit;
  if Method1Group=mgClassOperator then
    Result := CompareTextIgnoringSpace(Method1ResultType,Method2ResultType,false);
end;

function CompareMethodHeaders(const Method1Head: TPascalMethodHeader;
  const Method2Head: TPascalMethodHeader): Integer;
begin
  Result := CompareMethodHeaders(
    Method1Head.Name, Method1Head.Group, Method1Head.ResultType,
    Method2Head.Name, Method2Head.Group, Method2Head.ResultType);
end;

function SameMethodHeaders(const Method1Name: string;
  Method1Group: TPascalMethodGroup; const Method1ResultType: string;
  const Method2Name: string; Method2Group: TPascalMethodGroup;
  const Method2ResultType: string): Boolean;
begin
  Result := CompareMethodHeaders(
    Method1Name, Method1Group, Method1ResultType,
    Method2Name, Method2Group, Method2ResultType) = 0;
end;

function SameMethodHeaders(const Method1Head: TPascalMethodHeader;
  const Method2Head: TPascalMethodHeader): Boolean;
begin
  Result := CompareMethodHeaders(Method1Head, Method2Head) = 0;
end;

function CompareCodeTreeNodeExtMethodHeaders(NodeData1, NodeData2: pointer): integer;
var
  NodeExt1: TCodeTreeNodeExtension absolute NodeData1;
  NodeExt2: TCodeTreeNodeExtension absolute NodeData2;
begin
  Result := CompareMethodHeaders(
    NodeExt1.Txt,TPascalMethodGroup(NodeExt1.Flags),NodeExt1.ExtTxt4,
    NodeExt2.Txt,TPascalMethodGroup(NodeExt2.Flags),NodeExt2.ExtTxt4);
end;


{ TPascalReaderTool }

procedure TPascalReaderTool.RaiseStrConstExpected;
begin
  RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsStringConstant,GetAtom]);
end;

function TPascalReaderTool.CleanPosIsInComment(CleanPos,
  CleanCodePosInFront: integer; out CommentStart, CommentEnd: integer;
  OuterCommentBounds: boolean): boolean;
var CommentLvl, CurCommentPos: integer;
  CurEnd: Integer;
  CurCommentInnerEnd: Integer;
begin
  Result:=false;
  CommentStart:=0;
  CommentEnd:=0;
  if CleanPos>SrcLen then exit;
  if CleanCodePosInFront>CleanPos then
    RaiseException(
      'TPascalReaderTool.CleanPosIsInComment CleanCodePosInFront>CleanPos');
  MoveCursorToCleanPos(CleanCodePosInFront);
  repeat
    ReadNextAtom;
    if CurPos.StartPos>CleanPos then begin
      //DebugLn(['TPascalReaderTool.CleanPosIsInComment ',GetATom,' StartPos=',CurPos.StartPos,' CleanPos=',CleanPos]);
      // CleanPos between two atoms -> parse space between for comments
      if LastAtoms.Count>0 then
        CommentStart:=LastAtoms.GetValueAt(0).EndPos
      else
        CommentStart:=CleanCodePosInFront;
      CurEnd:=CurPos.StartPos;
      if CurEnd>SrcLen then CurEnd:=SrcLen+1;
      while CommentStart<CurEnd do begin
        if IsCommentStartChar[Src[CommentStart]] then begin
          CurCommentPos:=CommentStart;
          CurCommentInnerEnd:=CurEnd;
          case Src[CommentStart] of
          '{':
            begin
              inc(CurCommentPos);
              if (CurCommentPos<=SrcLen) and (Src[CurCommentPos]=#3) then begin
                // codetools skip comment
                inc(CurCommentPos);
                if not OuterCommentBounds then CommentStart:=CurCommentPos;
                while (CurCommentPos<CurEnd) do begin
                  if (Src[CurCommentPos]=#3)
                  and (CurCommentPos+1<CurEnd) and (Src[CurCommentPos+1]='}')
                  then begin
                    CurCommentInnerEnd:=CurCommentPos;
                    inc(CurCommentPos,2);
                    break;
                  end;
                  inc(CurCommentPos);
                end;
              end else begin
                // pascal comment
                if not OuterCommentBounds then CommentStart:=CurCommentPos;
                CommentLvl:=1;
                while (CurCommentPos<CurEnd) do begin
                  case Src[CurCommentPos] of
                  '{': if Scanner.NestedComments then inc(CommentLvl);
                  '}':
                    begin
                      dec(CommentLvl);
                      if (CommentLvl=0) then begin
                        CurCommentInnerEnd:=CurCommentPos;
                        inc(CurCommentPos);
                        break;
                      end;
                    end;
                  end;
                  inc(CurCommentPos);
                end;
              end;
            end;
          '/':  // Delphi comment
            if (CurCommentPos<SrcLen) and (Src[CurCommentPos+1]='/') then
            begin
              inc(CurCommentPos,2);
              if not OuterCommentBounds then CommentStart:=CurCommentPos;
              while (CurCommentPos<CurEnd)
              and (not (Src[CurCommentPos] in [#10,#13])) do
                inc(CurCommentPos);
              CurCommentInnerEnd:=CurCommentPos;
              inc(CurCommentPos);
              if (CurCommentPos<CurEnd)
              and (Src[CurCommentPos] in [#10,#13])
              and (Src[CurCommentPos-1]<>Src[CurCommentPos]) then
                inc(CurCommentPos);
            end else
              break;
          '(': // Turbo pascal comment
            if (CurCommentPos<SrcLen) and (Src[CurCommentPos+1]='*') then
            begin
              inc(CurCommentPos,2);
              if not OuterCommentBounds then CommentStart:=CurCommentPos;
              while (CurCommentPos<CurEnd) do begin
                if (Src[CurCommentPos]='*') and (CurCommentPos+1<CurEnd)
                and (Src[CurCommentPos+1]=')') then
                begin
                  CurCommentInnerEnd:=CurCommentPos;
                  inc(CurCommentPos,2);
                  break;
                end;
                inc(CurCommentPos);
              end;
            end else
              break;
          end;
          if (CurCommentPos>CommentStart) and (CleanPos<CurCommentPos) then
          begin
            // CleanPos in comment
            if OuterCommentBounds then
              CommentEnd:=CurCommentPos
            else
              CommentEnd:=CurCommentInnerEnd;
            exit(true);
          end;
          CommentStart:=CurCommentPos;
        end else if IsSpaceChar[Src[CommentStart]] then begin
          repeat
            inc(CommentStart);
          until (CommentStart>=CommentEnd)
          or (not (IsSpaceChar[Src[CommentStart]]));
        end else begin
          break;
        end;
      end;
      // CleanPos not in a comment
      exit;
    end else if CurPos.EndPos>CleanPos then begin
      // CleanPos not in a comment
      exit;
    end;
    CleanCodePosInFront:=CurPos.EndPos;
  until CurPos.StartPos>=SrcLen;
end;

function TPascalReaderTool.ExtractPropType(PropNode: TCodeTreeNode;
  InUpperCase, EmptyIfIndexed: boolean): string;
begin
  Result:='';
  if (PropNode=nil)
  or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
    exit;
  MoveCursorToNodeStart(PropNode);
  ReadNextAtom;
  if (PropNode.Desc=ctnProperty) then begin
    if UpAtomIs('CLASS') then ReadNextAtom;
    if (not UpAtomIs('PROPERTY')) then exit;
    ReadNextAtom;
  end;
  AtomIsIdentifierE;
  ReadNextAtom;
  if CurPos.Flag=cafEdgedBracketOpen then begin
    if EmptyIfIndexed then exit;
    ReadTilBracketClose(true);
    ReadNextAtom;
  end;
  if CurPos.Flag in [cafSemicolon,cafEND] then exit;
  if not (CurPos.Flag=cafColon) then
    RaiseExceptionFmt(ctsStrExpectedButAtomFound,[':',GetAtom]);
  ReadNextAtom;
  AtomIsIdentifierE;
  if InUpperCase then
    Result:=GetUpAtom
  else
    Result:=GetAtom;
end;

function TPascalReaderTool.ExtractProcName(ProcNode: TCodeTreeNode;
  Attr: TProcHeadAttributes): string;
var
  ProcHeadNode: TCodeTreeNode;
  Part: String;
  HasClassName: Boolean;
begin
  Result:='';
  if [phpWithoutClassName,phpWithoutName]*Attr=
     [phpWithoutClassName,phpWithoutName]
  then
    exit;
  while (ProcNode<>nil) and (ProcNode.Desc<>ctnProcedure) do
    ProcNode:=ProcNode.Parent;
  if ProcNode=nil then exit;
  ProcHeadNode:=ProcNode.FirstChild;
  if (ProcHeadNode=nil) or (ProcHeadNode.StartPos<1) then exit;
  MoveCursorToNodeStart(ProcHeadNode);
  HasClassName:=false;
  repeat
    ReadNextAtom;
    if not AtomIsIdentifier then break;
    if phpInUpperCase in Attr then
      Part:=GetUpAtom
    else
      Part:=GetAtom;
    ReadNextAtom;
    if (CurPos.Flag<>cafPoint) then begin
      // end of method identifier is the proc name
      if phpWithoutName in Attr then break;
      if Result<>'' then Result:=Result+'.';
      Result:=Result+Part;
      break;
    end;
    if not (phpWithoutClassName in Attr) then begin
      // in front of . is class name
      if Result<>'' then Result:=Result+'.';
      Result:=Result+Part;
      HasClassName:=true;
    end;
  until false;
  if (not HasClassName)
  and ([phpWithoutClassName,phpAddClassName]*Attr=[phpAddClassName]) then begin
    Part:=ExtractClassName(ProcNode,false,true);
    if Part<>'' then
      Result:=Part+'.'+Result;
  end;
end;

function TPascalReaderTool.ExtractProcHead(ProcNode: TCodeTreeNode;
  Attr: TProcHeadAttributes): string;
var
  TheClassName, s: string;
  IsClassName, IsProcType: boolean;
  IsProcedure: Boolean;
  IsFunction: Boolean;
  IsOperator: Boolean;
  EndPos: Integer;
  ParentNode: TCodeTreeNode;
const
  SemiColon : char = ';';

  procedure PrependName(const Prepend: string; var aPath: string);
  begin
    if Prepend='' then exit;
    if aPath<>'' then
      aPath:=Prepend+'.'+aPath
    else
      aPath:=Prepend;
  end;

begin
  Result:='';
  ExtractProcHeadPos:=phepNone;
  if (ProcNode=nil) or (ProcNode.StartPos<1) then exit;
  if ProcNode.Desc=ctnProcedureHead then begin
    ProcNode:=ProcNode.Parent;
    if ProcNode=nil then exit;
  end;
  if ProcNode.Desc=ctnProcedure then
    IsProcType:=false
  else if ProcNode.Desc=ctnProcedureType then
    IsProcType:=true
  else
    exit;

  TheClassName:='';

  if (phpAddParentProcs in Attr) and (ProcNode.Parent.Desc=ctnProcedure) then begin
    // local proc
    ParentNode:=ProcNode.Parent;
    while ParentNode.Desc=ctnProcedure do begin
      PrependName(ExtractProcName(ParentNode,Attr*[phpInUpperCase]),TheClassName);
      ParentNode:=ParentNode.Parent;
    end;
  end;

  // build full class name
  if ([phpAddClassname,phpWithoutClassName]*Attr=[phpAddClassName]) then
    PrependName(ExtractClassName(ProcNode,phpInUpperCase in Attr,true),TheClassName);

  // reparse the clean source
  InitExtraction;
  MoveCursorToNodeStart(ProcNode);
  // parse procedure head = start + name + parameterlist + result type ;
  ExtractNextAtom(false,Attr);
  // read procedure start keyword
  if (UpAtomIs('CLASS') or UpAtomIs('STATIC')) then
    ExtractNextAtom((phpWithStart in Attr)
                    and not (phpWithoutClassKeyword in Attr),Attr);
  IsProcedure:=UpAtomIs('PROCEDURE');
  IsFunction:=(not IsProcedure) and UpAtomIs('FUNCTION');
  IsOperator:=(not IsProcedure) and (not IsFunction) and UpAtomIs('OPERATOR');
  if IsProcedure or IsFunction or IsOperator
  or (UpAtomIs('CONSTRUCTOR')) or (UpAtomIs('DESTRUCTOR'))
  then
    ExtractNextAtom(phpWithStart in Attr,Attr)
  else
    exit;
  ExtractProcHeadPos:=phepStart;
  if not IsProcType then begin
    // read name
    if ((not IsOperator)
    or (not WordIsCustomOperator.DoItCaseInsensitive(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)))
    and (not AtomIsIdentifier) then exit;

    if TheClassName<>'' then begin
      s:=TheClassName+'.';
      if phpInUpperCase in Attr then s:=UpperCaseStr(s);
      if ExtractStreamEndIsIdentChar then
        s:=' '+s;
      ExtractMemStream.Write(s[1],length(s));
    end;

    if [phpWithoutClassName,phpWithoutName]*Attr=[] then begin
      // read classname and name
      repeat
        ExtractNextAtom(true,Attr);
        if Scanner.CompilerMode = cmDELPHI then
        begin
          // delphi generics
          if AtomIsChar('<') then
          begin
            while not AtomIsChar('>') and (CurPos.EndPos < SrcLen) do
              ExtractNextAtom(not (phpWithoutGenericParams in Attr),Attr);
            ExtractNextAtom(not (phpWithoutGenericParams in Attr),Attr);
          end;
        end;
        if CurPos.Flag<>cafPoint then break;
        ExtractNextAtom(true,Attr);
        if ((not IsOperator)
        or (not WordIsCustomOperator.DoItCaseInsensitive(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)))
        and (not AtomIsIdentifier) then exit;
      until false;
    end else begin
      // read only part of name
      repeat
        ReadNextAtom;
        if (Scanner.CompilerMode = cmDELPHI) and AtomIsChar('<') then
        begin
          while not AtomIsChar('>') and (CurPos.EndPos < SrcLen) do
            ReadNextAtom;
          ReadNextAtom;
        end;
        IsClassName:=(CurPos.Flag=cafPoint);
        UndoReadNextAtom;
        if IsClassName then begin
          // read class name
          ExtractNextAtom(not (phpWithoutClassName in Attr),Attr);
          // read '.'
          ExtractNextAtom(not (phpWithoutClassName in Attr),Attr);
          if ((not IsOperator)
          or (not WordIsCustomOperator.DoItCaseInsensitive(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)))
          and (not AtomIsIdentifier) then exit;
        end else begin
          // read name
          ExtractNextAtom(not (phpWithoutName in Attr),Attr);
          break;
        end;
      until false;
    end;
    ExtractProcHeadPos:=phepName;
  end;
  // read parameter list
  if (CurPos.Flag=cafRoundBracketOpen) then
    ReadParamList(false,true,Attr);
  ExtractProcHeadPos:=phepParamList;
  if IsOperator and (CurPos.Flag=cafWord) then begin
    // read operator result name
    ExtractNextAtom([phpWithParameterNames,phpWithResultType]*Attr
                   =[phpWithParameterNames,phpWithResultType],Attr);
  end;
  // read result type
  if (CurPos.Flag=cafColon) then begin
    ExtractNextAtom(phpWithResultType in Attr,Attr);
    if not AtomIsIdentifier then exit;
    ExtractNextAtom(phpWithResultType in Attr,Attr);
    if CurPos.Flag=cafPoint then begin
      ExtractNextAtom(phpWithResultType in Attr,Attr);
      if not AtomIsIdentifier then exit;
      ExtractNextAtom(phpWithResultType in Attr,Attr);
    end;
    ExtractProcHeadPos:=phepResultType;
  end;
  // read 'of object'
  if UpAtomIs('OF') then begin
    if IsProcType then begin
      ExtractNextAtom(phpWithOfObject in Attr,Attr);
      if not UpAtomIs('OBJECT') then exit;
      ExtractNextAtom(phpWithOfObject in Attr,Attr);
    end;
  end;
  // read semicolon
  if CurPos.Flag=cafSemicolon then
    ExtractNextAtom(not (phpWithoutSemicolon in Attr),Attr);
  // read specifiers
  if [phpWithCallingSpecs,phpWithProcModifiers]*Attr<>[] then begin
    if ProcNode.FirstChild<>nil then
      EndPos:=ProcNode.FirstChild.EndPos
    else
      EndPos:=SrcLen+1;
    while (CurPos.StartPos<EndPos) do begin
      if CurPos.Flag=cafSemicolon then begin
        ExtractNextAtom(phpWithProcModifiers in Attr,Attr);
      end else begin
        if IsKeyWordCallingConvention.DoIdentifier(@Src[CurPos.StartPos])
        then begin
          ExtractNextAtom([phpWithCallingSpecs,phpWithProcModifiers]*Attr<>[],
                          Attr);
          if not (phpWithProcModifiers in Attr) then
            ExtractMemStream.Write(SemiColon,1);
        end
        else if (CurPos.Flag=cafEdgedBracketOpen) then begin
          ReadTilBracketClose(false);
          ExtractNextAtom(phpWithProcModifiers in Attr,Attr);
        end else begin
          ExtractNextAtom(phpWithProcModifiers in Attr,Attr);
        end;
      end;
    end;
  end;

  // copy memorystream to Result string
  Result:=GetExtraction(phpInUpperCase in Attr);
  
  // add semicolon
  if ([phpWithoutSemicolon,phpDoNotAddSemicolon]*Attr=[])
  and (Result<>'') and (Result[length(Result)]<>';') then
    Result:=Result+';';
end;

function TPascalReaderTool.ExtractProcHeadWithGroup(ProcNode: TCodeTreeNode;
  Attr: TProcHeadAttributes): TPascalMethodHeader;
begin
  Result.Name := ExtractProcHead(ProcNode, Attr);
  Result.Group := ExtractProcedureGroup(ProcNode);
  if Result.Group=mgClassOperator then
    Result.ResultType := ExtractFuncResultType(ProcNode, Attr);
end;

function TPascalReaderTool.ExtractProcedureHeader(CursorPos: TCodeXYPosition;
  Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
var
  CleanCursorPos: integer;
  ANode: TCodeTreeNode;
begin
  Result:=false;
  ProcHead:='';
  BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
    [btSetIgnoreErrorPos,btCursorPosOutAllowed]);
  ANode:=FindDeepestNodeAtPos(CleanCursorPos,True);
  while (ANode<>nil) and (ANode.Desc<>ctnProcedure) do
    ANode:=ANode.Parent;
  if ANode=nil then exit;
  ProcHead:=ExtractProcHead(ANode,Attributes);
  Result:=true;
end;

function TPascalReaderTool.ExtractClassName(Node: TCodeTreeNode;
  InUpperCase: boolean; WithParents: boolean; WithGenericParams: boolean
  ): string;
var
  ParamsNode: TCodeTreeNode;
  ParamNode: TCodeTreeNode;
  First: Boolean;
begin
  Result:='';
  while Node<>nil do begin
    case Node.Desc of
    ctnTypeDefinition:
      begin
        if Result<>'' then Result:='.'+Result;
        Result:=GetIdentifier(@Src[Node.StartPos])+Result;
        if not WithParents then break;
      end;
    ctnGenericType:
      begin
        if Result<>'' then Result:='.'+Result;
        if (Node.Desc = ctnGenericType) then begin
          // extract generic type param names
          if WithGenericParams then begin
            ParamsNode:=Node.FirstChild.NextBrother;
            First:=true;
            while ParamsNode<>nil do begin
              if ParamsNode.Desc=ctnGenericParams then begin
                Result:='>'+Result;
                ParamNode:=ParamsNode.FirstChild;
                while ParamNode<>nil do begin
                  if ParamNode.Desc=ctnGenericParameter then begin
                    if First then
                      First:=false
                    else
                      Result:=','+Result;
                    Result:=GetIdentifier(@Src[ParamNode.StartPos])+Result;
                  end;
                  ParamNode:=ParamNode.NextBrother;
                end;
                Result:='<'+Result;
              end;
              ParamsNode:=ParamsNode.NextBrother;
            end;
          end;
          Result:=GetIdentifier(@Src[Node.FirstChild.StartPos])+Result;
        end;
        if not WithParents then break;
      end;
    ctnParameterList:
      break;
    end;
    Node:=Node.Parent;
  end;

  if InUpperCase then
    Result:=UpperCaseStr(Result);
end;

function TPascalReaderTool.ExtractClassPath(Node: TCodeTreeNode): string;
var
  InArray: Boolean;
begin
  Result:='';
  InArray:=false;
  while Node<>nil do begin
    case Node.Desc of
    ctnTypeDefinition,ctnGenericType:
      begin
        if Result<>'' then Result:='.'+Result;
        if Node.Desc=ctnTypeDefinition then
          Result:=GetIdentifier(@Src[Node.StartPos])+Result
        else if Node.FirstChild<>nil then
        begin
          if (Scanner.CompilerMode = cmDELPHI) and (Node.Desc = ctnGenericType) then
            Result := Result + ExtractNode(Node.FirstChild.NextBrother, []);
          Result:=GetIdentifier(@Src[Node.FirstChild.StartPos])+Result;
        end;
      end;
    ctnParameterList:
      break;
    ctnRangedArrayType, ctnOpenArrayType:
       begin
         InArray := True;
         Result := '[]' + Result;
       end;
    ctnVarDefinition:
       if InArray then begin
         Result := GetIdentifier(@Src[Node.StartPos]) + Result;
         InArray := False;
       end;
    end;
    Node:=Node.Parent;
  end;
end;

function TPascalReaderTool.ExtractClassInheritance(
  ClassNode: TCodeTreeNode; Attr: TProcHeadAttributes): string;
begin
  Result:='';
  if (ClassNode=nil) or (not (ClassNode.Desc in AllClasses)) then exit;
  MoveCursorToNodeStart(ClassNode);
  ReadNextAtom; // class
  if UpAtomIs('PACKED') then ReadNextAtom;
  if not (UpAtomIs('CLASS') or UpAtomIs('OBJECT') or UpAtomIs('OBJCLASS')
       or (UpAtomIs('INTERFACE')))
  then
    exit;
  ReadNextAtom; // '('
  if CurPos.Flag<>cafRoundBracketOpen then exit;
  ReadNextAtom;
  if not AtomIsIdentifier then exit;
  MoveCursorToCleanPos(CurPos.StartPos);
  ExtractProcHeadPos:=phepNone;
  InitExtraction;
  while (CurPos.StartPos<=SrcLen) do begin
    ExtractNextAtom(true,Attr); // read ancestor/interface
    if not AtomIsIdentifier then break;
    ExtractNextAtom(true,Attr); // read ','
    if not AtomIsChar(',') then break;
  end;
  // copy memorystream to Result string
  Result:=GetExtraction(phpInUpperCase in Attr);
end;

function TPascalReaderTool.ExtractClassNameOfProcNode(ProcNode: TCodeTreeNode;
  AddParentClasses: boolean): string;
var
  Part: String;
begin
  Result:='';
  if (ProcNode<>nil) and (ProcNode.Desc=ctnProcedure) then
    ProcNode:=ProcNode.FirstChild;
  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedureHead) then exit;
  MoveCursorToNodeStart(ProcNode);
  repeat
    ReadNextAtom;
    if not AtomIsIdentifier then break;
    Part:=GetAtom;
    ReadNextAtom;
    if (Scanner.CompilerMode = cmDELPHI) and AtomIsChar('<') then
    begin { delphi generics }
      Part := Part + GetAtom;
      repeat
        ReadNextAtom;
        Part := Part + GetAtom;
      until (CurPos.StartPos > SrcLen) or AtomIsChar('>');
      ReadNextAtom;
    end;
    if (CurPos.Flag<>cafPoint) then break;
    if Result<>'' then Result:=Result+'.';
    Result:=Result+Part;
  until false;
  if not AddParentClasses then exit;
  Part:=ExtractClassName(ProcNode,false,true);
  if Part='' then exit;
  Result:=Part+'.'+Result;
end;

function TPascalReaderTool.FindProcNode(StartNode: TCodeTreeNode;
  const AProcHead: TPascalMethodHeader; Attr: TProcHeadAttributes;
  Visibility: TClassSectionVisibility): TCodeTreeNode;
// search in all next brothers for a Procedure Node with the Name ProcName
// if there are no further brothers and the parent is a section node
// ( e.g. 'interface', 'implementation', ...) or a class visibility node
// (e.g. 'public', 'private', ...) then the search will continue in the next
// section
var
  InClass: Boolean;
  CurProcHead: TPascalMethodHeader;
begin
  Result:=StartNode;
  InClass:=FindClassOrInterfaceNode(StartNode)<>nil;
  while (Result<>nil) do begin
    if Result.Desc=ctnProcedure then begin
      if (not ((phpIgnoreForwards in Attr)
               and ((Result.SubDesc and ctnsForwardDeclaration)>0)))
      and (not ((phpIgnoreProcsWithBody in Attr)
            and (FindProcBody(Result)<>nil)))
      and (not InClass or IdentNodeIsInVisibleClassSection(Result, Visibility))
      then
      begin
        CurProcHead:=ExtractProcHeadWithGroup(Result,Attr);
        //DebugLn(['TPascalReaderTool.FindProcNode B "',CurProcHead,'" =? "',AProcHead,'" Result=',CompareTextIgnoringSpace(CurProcHead,AProcHead,false)]);
        if (CurProcHead.Name<>'') and
            SameMethodHeaders(AProcHead, CurProcHead)
        then
          exit;
      end;
    end;
    // next node
    if InClass then
      Result:=FindNextIdentNodeInClass(Result)
    else
      Result:=FindNextNodeOnSameLvl(Result);
  end;
end;

function TPascalReaderTool.FindProcNode(StartNode: TCodeTreeNode;
  const AProcHead: string; AProcSpecType: TPascalMethodGroup;
  Attr: TProcHeadAttributes; Visibility: TClassSectionVisibility): TCodeTreeNode;
var
  ProcHead: TPascalMethodHeader;
begin
  ProcHead.Name := AProcHead;
  ProcHead.Group := AProcSpecType;
  Result := FindProcNode(StartNode, ProcHead, Attr, Visibility);
end;

function TPascalReaderTool.FindCorrespondingProcNode(ProcNode: TCodeTreeNode;
  Attr: TProcHeadAttributes): TCodeTreeNode;
var
  ClassNode: TCodeTreeNode;
  StartNode: TCodeTreeNode;
  ProcHead: TPascalMethodHeader;
begin
  Result:=nil;
  // get ctnProcedure
  //debugln('TPascalReaderTool.FindCorrespondingProcNode Start');
  if (ProcNode=nil) then exit;
  if ProcNode.Desc=ctnProcedureHead then begin
    ProcNode:=ProcNode.Parent;
    if (ProcNode=nil) then exit;
  end;
  if ProcNode.Desc<>ctnProcedure then exit;
  
  // check proc kind
  //debugln('TPascalReaderTool.FindCorrespondingProcNode Check kind');
  ClassNode:=FindClassOrInterfaceNode(ProcNode);
  if ClassNode<>nil then begin
    //debugln('TPascalReaderTool.FindCorrespondingProcNode Class');
    // in a class definition -> search method body
    StartNode:=ClassNode.GetTopMostNodeOfType(ctnTypeSection);
  end else if NodeIsMethodBody(ProcNode) then begin
    //debugln('TPascalReaderTool.FindCorrespondingProcNode Method ',ExtractClassNameOfProcNode(ProcNode));
    // in a method body -> search in class
    StartNode:=FindClassNodeInUnit(ExtractClassNameOfProcNode(ProcNode,true),
             true,false,false,true);
    if StartNode=nil then exit;
    if (StartNode<>nil) and (StartNode.Desc in AllClasses)
    then begin
      StartNode:=StartNode.FirstChild;
      while (StartNode<>nil) do begin
        if (StartNode.Desc in AllClassBaseSections)
        and (StartNode.FirstChild<>nil) then begin
          StartNode:=StartNode.FirstChild;
          break;
        end;
        StartNode:=StartNode.NextBrother;
      end;
    end;
  end else begin
    //DebugLn('TPascalReaderTool.FindCorrespondingProcNode Normal');
    // else: search on same lvl
    StartNode:=FindFirstNodeOnSameLvl(ProcNode);
  end;
  if StartNode=nil then exit;

  ProcHead:=ExtractProcHeadWithGroup(ProcNode,Attr);
  //debugln('TPascalReaderTool.FindCorrespondingProcNode StartNode=',StartNode.DescAsString,' ProcHead=',dbgstr(ProcHead),' ',dbgs(Attr),' ',StartNode.DescAsString);
  Result:=FindProcNode(StartNode,ProcHead,Attr);
  if Result=ProcNode then begin
    // found itself -> search further
    StartNode:=FindNextNodeOnSameLvl(Result);
    Result:=FindProcNode(StartNode,ProcHead,Attr);
  end;
  //if Result<>nil then debugln(['TPascalReaderTool.FindCorrespondingProcNode Result=',CleanPosToStr(Result.StartPos),' ',dbgstr(copy(Src,Result.StartPos,50))]);
end;

function TPascalReaderTool.FindCorrespondingProcParamNode(
  ProcParamNode: TCodeTreeNode; Attr: TProcHeadAttributes): TCodeTreeNode;
var
  ProcNode: TCodeTreeNode;
begin
  Result:=nil;
  if ProcParamNode=nil then exit;
  if (ProcParamNode.Desc=ctnVarDefinition)
  and (ProcParamNode.Parent.Desc=ctnParameterList)
  and (ProcParamNode.Parent.Parent.Desc=ctnProcedureHead) then begin
    // this is a parameter name
    ProcNode:=ProcParamNode.GetNodeOfType(ctnProcedure);
    if ProcNode=nil then exit;
    // search alias for parameter
    ProcNode:=FindCorrespondingProcNode(ProcNode,Attr);
    if ProcNode=nil then exit;
    BuildSubTreeForProcHead(ProcNode);
    Result:=ProcNode;
    while (Result<>nil) do begin
      //debugln(['TPascalReaderTool.FindCorrespondingProcParamNode ',dbgstr(copy(Src,Result.StartPos,20))]);
      if Result.Desc
        in [ctnProcedure,ctnProcedureHead,ctnParameterList]
      then
        Result:=Result.FirstChild
      else begin
        if Result.StartPos<1 then break;
        if CompareIdentifiers(@Src[ProcParamNode.StartPos],@Src[Result.StartPos])=0
        then exit;
        Result:=Result.NextBrother;
      end;
    end;
    Result:=nil;
  end;
end;

function TPascalReaderTool.FindDefinitionNameNode(DefinitionNode: TCodeTreeNode
  ): TCodeTreeNode;
begin
  if DefinitionNode.Desc=ctnGenericType then
  begin
    if DefinitionNode.FirstChild<>nil then
      Result:=DefinitionNode.FirstChild
    else
      Result:=nil;
  end else
    Result:=DefinitionNode;
end;

function TPascalReaderTool.FindProcBody(ProcNode: TCodeTreeNode): TCodeTreeNode;
begin
  Result:=ProcNode;
  if Result=nil then exit;
  if Result.Desc<>ctnProcedure then exit;
  Result:=Result.LastChild;
  while Result<>nil do begin
    if Result.Desc in [ctnBeginBlock,ctnAsmBlock] then
      exit;
    Result:=Result.PriorBrother;
  end;
end;

function TPascalReaderTool.ProcBodyIsEmpty(ProcNode: TCodeTreeNode): boolean;
var
  BodyNode: TCodeTreeNode;
  LastPos: LongInt;
begin
  Result:=false;
  BodyNode:=FindProcBody(ProcNode);
  if (BodyNode=nil) then exit;
  // check if there are nodes in front (e.g. local variables)
  if (BodyNode.PriorBrother<>nil)
  and (BodyNode.PriorBrother.Desc<>ctnProcedureHead) then
    exit;
  // check if there are child nodes
  if BodyNode.FirstChild<>nil then exit;
  // check if bodynode is only 'asm end' or 'begin end'
  // not even a comment should be there, only spaces are allowed
  if ProcNode.FirstChild.Desc<>ctnProcedureHead then exit;
  MoveCursorToCleanPos(ProcNode.FirstChild.EndPos);
  LastPos:=CurPos.EndPos;
  ReadNextAtom;
  if FindNextNonSpace(Src,LastPos)<>CurPos.StartPos then exit;
  if CurPos.Flag=cafSemicolon then begin
    // semicolon is allowed
    LastPos:=CurPos.EndPos;
    ReadNextAtom;
    if FindNextNonSpace(Src,LastPos)<>CurPos.StartPos then exit;
  end;
  if not (UpAtomIs('ASM') or UpAtomIs('BEGIN')) then exit;
  LastPos:=CurPos.EndPos;
  ReadNextAtom;
  if FindNextNonSpace(Src,LastPos)<>CurPos.StartPos then exit;
  // inherited is allowed
  if UpAtomIs('INHERITED') then begin
    ReadNextAtom;
    if CurPos.Flag=cafSemicolon then begin
      // semicolon is allowed
      LastPos:=CurPos.EndPos;
      ReadNextAtom;
      if FindNextNonSpace(Src,LastPos)<>CurPos.StartPos then exit;
    end;
  end;
  if not UpAtomIs('END') then exit;
  Result:=true;
end;

procedure TPascalReaderTool.MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode);
// After the call,
// CurPos will stand on the first proc specifier or on a semicolon
// this can be 'of object'
begin
  //DebugLn(['TPascalReaderTool.MoveCursorToFirstProcSpecifier ',ProcNode.DescAsString,' ',ProcNode.StartPos]);
  if (ProcNode<>nil) and (ProcNode.Desc in [ctnProcedureType,ctnProcedure]) then
    ProcNode:=ProcNode.FirstChild;
  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedureHead) then begin
    RaiseException('Internal Error in'
      +' TPascalParserTool.MoveCursorFirstProcSpecifier: '
      +' (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure)');
  end;
  if (ProcNode.LastChild<>nil) and (ProcNode.LastChild.Desc=ctnIdentifier) then
  begin
    // jump behind function result type
    MoveCursorToCleanPos(ProcNode.LastChild.EndPos);
    ReadNextAtom;
  end else if (ProcNode.FirstChild<>nil)
    and (ProcNode.FirstChild.Desc=ctnParameterList)
  then begin
    // jump behind parameter list
    MoveCursorToCleanPos(ProcNode.FirstChild.EndPos);
    ReadNextAtom;
  end else begin
    MoveCursorToNodeStart(ProcNode);
    ReadNextAtom;
    if AtomIsCustomOperator(true,false,false) then begin
      // read name
      ReadNextAtom;
      while (CurPos.Flag=cafPoint) do begin
        ReadNextAtom;
        if CurPos.Flag in [cafPoint,cafRoundBracketOpen,cafEdgedBracketOpen,cafColon,cafEnd,cafSemicolon]
        then break;
        ReadNextAtom;
      end;
    end;
    if (CurPos.Flag=cafRoundBracketOpen) then begin
      // read paramlist
      ReadTilBracketClose(false);
      ReadNextAtom;
    end;
  end;
  if (CurPos.Flag=cafColon) then begin
    // read function result type
    ReadNextAtom;
    if AtomIsIdentifier then begin
      ReadNextAtom;
      while CurPos.Flag=cafPoint do begin
        ReadNextAtom;
        if not AtomIsIdentifier then break;
        ReadNextAtom;
      end;
    end;
  end;
  // CurPos now stands on the first proc specifier or on a semicolon or on the syntax error
end;

function TPascalReaderTool.MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
  ProcSpec: TProcedureSpecifier): boolean;
begin
  if ProcNode.FirstChild=nil then begin
    exit(false);
  end;
  MoveCursorToFirstProcSpecifier(ProcNode);
  while (CurPos.StartPos<=ProcNode.FirstChild.EndPos) do begin
    if CurPos.Flag=cafSemicolon then begin
      ReadNextAtom;
    end else begin
      if UpAtomIs(ProcedureSpecifierNames[ProcSpec]) then begin
        Result:=true;
        exit;
      end;
      if (CurPos.Flag=cafEdgedBracketOpen) then begin
        ReadTilBracketClose(false);
        ReadNextAtom;
      end else if UpAtomIs('MESSAGE') then begin
        ReadNextAtom;
        ReadConstant(true,false,[]);
      end else if UpAtomIs('EXTERNAL') then begin
        ReadNextAtom;
        if CurPos.Flag<>cafSemicolon then begin
          if not UpAtomIs('NAME') then
            ReadConstant(true,false,[]);
          if UpAtomIs('NAME') or UpAtomIs('INDEX') then begin
            ReadNextAtom;
            ReadConstant(true,false,[]);
          end;
        end;
      end else begin
        ReadNextAtom;
      end;
    end;
  end;
  Result:=false;
end;

procedure TPascalReaderTool.MoveCursorToProcName(ProcNode: TCodeTreeNode;
  SkipClassName: boolean);
begin
  if (ProcNode.Desc=ctnProcedure) and (ProcNode.FirstChild<>nil)
  and (ProcNode.FirstChild.Desc=ctnProcedureHead) then
    ProcNode:=ProcNode.FirstChild;
  MoveCursorToNodeStart(ProcNode);
  ReadNextAtom;
  if (ProcNode.Desc=ctnProcedure) then begin
    if UpAtomIs('CLASS') then ReadNextAtom;
    ReadNextAtom; // skip proc keyword
  end;
  if not SkipClassName then exit;
  repeat
    ReadNextAtom;
    if CurPos.Flag<>cafPoint then begin
      UndoReadNextAtom;
      break;
    end;
    ReadNextAtom;
  until not AtomIsIdentifier;
end;

procedure TPascalReaderTool.MoveCursorBehindProcName(ProcNode: TCodeTreeNode);
begin
  if (ProcNode.FirstChild<>nil)
  and (ProcNode.FirstChild.Desc=ctnProcedureHead) then
    ProcNode:=ProcNode.FirstChild;
  MoveCursorToNodeStart(ProcNode);
  ReadNextAtom;
  if AtomIsIdentifier then begin
    ReadNextAtom;
    while CurPos.Flag=cafPoint do begin
      ReadNextAtom;
      if not AtomIsIdentifier then exit;
      ReadNextAtom;
    end;
  end else if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen,cafColon]
  then begin
  end else begin
    // operator
    ReadNextAtom;
  end;
end;

function TPascalReaderTool.PositionInProcName(ProcNode: TCodeTreeNode;
  SkipClassName: boolean; CleanPos: integer): boolean;
begin
  if (ProcNode.Desc=ctnProcedure) and (ProcNode.FirstChild<>nil)
  and (ProcNode.FirstChild.Desc=ctnProcedureHead) then
    ProcNode:=ProcNode.FirstChild;
  if (CleanPos<ProcNode.StartPos) or (CleanPos>ProcNode.EndPos) then exit(false);
  MoveCursorToNodeStart(ProcNode);
  ReadNextAtom;
  if (ProcNode.Desc=ctnProcedure) then begin
    if UpAtomIs('CLASS') then ReadNextAtom;
    ReadNextAtom; // skip proc keyword
  end;
  if CleanPos<CurPos.StartPos then exit(false);
  while CurPos.Flag=cafWord do begin
    ReadNextAtom;
    if CurPos.Flag<>cafPoint then begin
      UndoReadNextAtom;
      break;
    end;
    ReadNextAtom;
  end;
  // CurPos is now on the proc name
  if CleanPos>CurPos.EndPos then exit(false);
  if SkipClassName and (CleanPos<CurPos.StartPos) then exit(false);
  Result:=true;
end;

function TPascalReaderTool.PositionInFuncResultName(ProcNode: TCodeTreeNode;
  CleanPos: integer): boolean;
// true if position between ) and :
var
  Node: TCodeTreeNode;
begin
  Result:=false;
  if ProcNode=nil then exit;
  if ProcNode.Desc=ctnProcedure then begin
    ProcNode:=ProcNode.FirstChild;
    if ProcNode=nil then exit;
  end;
  if (ProcNode.Desc in [ctnIdentifier,ctnVarDefinition])
  and (ProcNode.Parent<>nil)
  and (ProcNode.Parent.Desc=ctnProcedureHead)
  and (CleanPos>=ProcNode.StartPos) and (CleanPos<=ProcNode.EndPos) then begin
    exit(true);
  end;
  if ProcNode.Desc=ctnProcedureHead then begin
    Node:=ProcNode.FirstChild;
    while (Node<>nil) and (Node.Desc<>ctnIdentifier) do begin
      if (Node.Desc=ctnIdentifier)
      and (CleanPos>=Node.StartPos) and (CleanPos<=Node.EndPos) then
        exit(true);
      Node:=Node.NextBrother;
    end;
  end;
  // read behind parameter list
  if ProcNode.Desc<>ctnProcedureHead then exit;
  if (ProcNode.FirstChild<>nil) and (ProcNode.FirstChild.Desc=ctnParameterList)
  then begin
    if (CleanPos<ProcNode.FirstChild.EndPos) then
      exit;
    MoveCursorToCleanPos(ProcNode.FirstChild.EndPos);
  end else begin
    MoveCursorToNodeStart(ProcNode);
    ReadNextAtom;
    while AtomIsIdentifier do begin
      ReadNextAtom;
      if (CurPos.Flag<>cafPoint) then break;
      ReadNextAtom;
    end;
    if CurPos.Flag=cafRoundBracketOpen then
      if not ReadTilBracketClose(false) then exit;
  end;
  if CurPos.StartPos>CleanPos then exit;
  // read optional result variable (e.g. operator can have them)
  ReadNextAtom;
  if AtomIsIdentifier then ReadNextAtom;
  if CurPos.Flag<>cafColon then exit;
  Result:=CleanPos<=CurPos.StartPos;
end;

function TPascalReaderTool.MoveCursorToPropType(PropNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  if (PropNode=nil)
  or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
    exit;
  MoveCursorToNodeStart(PropNode);
  ReadNextAtom;
  if (PropNode.Desc=ctnProperty) then begin
    if UpAtomIs('CLASS') then ReadNextAtom;
    if (not UpAtomIs('PROPERTY')) then exit;
    ReadNextAtom;
  end;
  if not AtomIsIdentifier then exit;
  ReadNextAtom;
  if CurPos.Flag=cafEdgedBracketOpen then begin
    ReadTilBracketClose(true);
    ReadNextAtom;
  end;
  if CurPos.Flag in [cafSemicolon,cafEND] then exit;
  if CurPos.Flag<>cafColon then exit;
  ReadNextAtom;
  Result:=CurPos.Flag=cafWord;
end;

function TPascalReaderTool.MoveCursorToPropName(PropNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  if (PropNode=nil)
  or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
    exit;
  MoveCursorToNodeStart(PropNode);
  ReadNextAtom;
  if (PropNode.Desc=ctnProperty) then begin
    if UpAtomIs('CLASS') then ReadNextAtom;
    if (not UpAtomIs('PROPERTY')) then exit;
    ReadNextAtom;
  end;
  Result:=CurPos.Flag=cafWord;
end;

procedure TPascalReaderTool.MoveCursorBehindPropName(PropNode: TCodeTreeNode);
begin
  if (PropNode=nil)
  or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
    exit;
  MoveCursorToNodeStart(PropNode);
  ReadNextAtom;
  if (PropNode.Desc=ctnProperty) then begin
    if UpAtomIs('CLASS') then ReadNextAtom;
    if (not UpAtomIs('PROPERTY')) then exit;
    ReadNextAtom;
  end;
  if not AtomIsIdentifier then exit;
  ReadNextAtom;
end;

function TPascalReaderTool.ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
  ProcSpec: TProcedureSpecifier): boolean;
begin
  Result:=false;
  if ProcNode=nil then exit;
  if ProcNode.Desc=ctnProcedureHead then
    ProcNode:=ProcNode.Parent;
  {$IFDEF CheckNodeTool}
  if ProcNode.Desc<>ctnProcedure then begin
    DebugLn(['TPascalReaderTool.ProcNodeHasSpecifier Desc=',ProcNode.DescAsString]);
    CTDumpStack;
    RaiseException('[TPascalReaderTool.ProcNodeHasSpecifier] '
      +'internal error: invalid ProcNode');
  end;
  {$ENDIF}
  if (ProcNode.FirstChild=nil)
  or ((ProcNode.SubDesc and ctnsNeedJITParsing)>0) then
    BuildSubTreeForProcHead(ProcNode);

  // ToDo: ppu, dcu

  Result:=MoveCursorToProcSpecifier(ProcNode,ProcSpec);
end;

function TPascalReaderTool.GetProcNameIdentifier(ProcNode: TCodeTreeNode): PChar;
begin

  // ToDo: ppu, dcu

  Result:=nil;
  if ProcNode=nil then exit;
  if ProcNode.Desc=ctnProcedure then begin
    ProcNode:=ProcNode.FirstChild;
    if ProcNode=nil then exit;
  end;
  MoveCursorToNodeStart(ProcNode);
  repeat
    ReadNextAtom;
    if not AtomIsIdentifier then exit(nil);
    Result:=@Src[CurPos.StartPos];
    ReadNextAtom;
  until CurPos.Flag<>cafPoint;
end;

function TPascalReaderTool.ExtractNode(ANode: TCodeTreeNode;
  Attr: TProcHeadAttributes): string;
begin
  Result:='';
  ExtractProcHeadPos:=phepNone;
  if (ANode=nil) or (ANode.StartPos<1) then exit;
  InitExtraction;
  // reparse the clean source
  MoveCursorToNodeStart(ANode);
  while (ANode.EndPos>CurPos.StartPos)
  and (CurPos.StartPos<=SrcLen) do
    ExtractNextAtom(true,Attr);
  // copy memorystream to Result string
  Result:=GetExtraction(phpInUpperCase in Attr);
end;

function TPascalReaderTool.ExtractCode(StartPos, EndPos: integer;
  Attr: TProcHeadAttributes): string;
begin
  Result:='';
  ExtractProcHeadPos:=phepNone;
  if (StartPos<1) or (StartPos>=EndPos) or (StartPos>SrcLen) then exit;
  InitExtraction;
  // reparse the clean source
  MoveCursorToCleanPos(StartPos);
  while (EndPos>CurPos.StartPos)
  and (CurPos.StartPos<=SrcLen) do
    ExtractNextAtom(true,Attr);
  // copy memorystream to Result string
  Result:=GetExtraction(phpInUpperCase in Attr);
end;

function TPascalReaderTool.ExtractBrackets(BracketStartPos: integer;
  Attr: TProcHeadAttributes): string;

  function ExtractTilBracketClose(ExtractBrackets: boolean): boolean;
  var
    CloseBracket: TCommonAtomFlag;
    First: Boolean;
  begin
    Result:=true;
    case CurPos.Flag of
    cafRoundBracketOpen: CloseBracket:=cafRoundBracketClose;
    cafEdgedBracketOpen: CloseBracket:=cafEdgedBracketClose;
    else exit;
    end;
    First:=true;
    repeat
      if First then
        ExtractNextAtom(ExtractBrackets,Attr)
      else
        ExtractNextAtom(true,Attr);
      if CurPos.StartPos>SrcLen then exit;
      if CurPos.Flag=CloseBracket then exit(true);
      if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
        if not ExtractTilBracketClose(true) then exit;
      end;
    until false;
  end;

begin
  Result:='';
  ExtractProcHeadPos:=phepNone;
  if (BracketStartPos<1) or (BracketStartPos>SrcLen) then exit;
  InitExtraction;
  // reparse the clean source
  MoveCursorToCleanPos(BracketStartPos);
  ReadNextAtom;
  if not ExtractTilBracketClose(not (phpWithoutBrackets in Attr)) then exit;
  if not (phpWithoutBrackets in Attr) then
    ExtractNextAtom(true,Attr);
  // copy memorystream to Result string
  Result:=GetExtraction(phpInUpperCase in Attr);
end;

function TPascalReaderTool.ExtractIdentifierWithPoints(StartPos: integer;
  ExceptionOnError: boolean): string;
begin
  Result:='';
  MoveCursorToCleanPos(StartPos);
  ReadNextAtom;
  if not AtomIsIdentifierE(ExceptionOnError) then exit;
  Result:=GetAtom;
  repeat
    ReadNextAtom;
    if CurPos.Flag<>cafPoint then
      exit;
    ReadNextAtom;
    if not AtomIsIdentifierE(ExceptionOnError) then exit;
    Result+='.'+GetAtom;
  until false;
end;

function TPascalReaderTool.ExtractPropName(PropNode: TCodeTreeNode;
  InUpperCase: boolean): string;
begin
  Result:='';
  if not MoveCursorToPropName(PropNode) then exit;
  if InUpperCase then
    Result:=GetUpAtom
  else
    Result:=GetAtom;
end;

function TPascalReaderTool.ExtractProperty(PropNode: TCodeTreeNode;
  Attr: TProcHeadAttributes): string;
begin
  Result:='';
  ExtractProcHeadPos:=phepNone;
  if (PropNode=nil) or (PropNode.StartPos<1)
  or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
    exit;
  // start extraction
  InitExtraction;
  MoveCursorToNodeStart(PropNode);
  ExtractNextAtom(false,Attr);
  if (PropNode.Desc=ctnProperty) then begin
    if UpAtomIs('CLASS') then
      ExtractNextAtom(phpWithStart in Attr,Attr);
    // parse 'property'
    ExtractNextAtom(phpWithStart in Attr,Attr);
  end;
  ExtractProcHeadPos:=phepStart;
  // parse name
  ExtractNextAtom(not (phpWithoutName in Attr),Attr);
  ExtractProcHeadPos:=phepName;
  // read parameter list
  if (CurPos.Flag=cafEdgedBracketOpen) then
    ReadParamList(false,true,Attr);
  ExtractProcHeadPos:=phepParamList;
  // read result type
  if (CurPos.Flag=cafColon) then begin
    ExtractNextAtom(phpWithResultType in Attr,Attr);
    if not AtomIsIdentifier then exit;
    ExtractNextAtom(phpWithResultType in Attr,Attr);
    if CurPos.Flag=cafPoint then begin
      // unit.type
      ExtractNextAtom(phpWithResultType in Attr,Attr);
      if not AtomIsIdentifier then exit;
      ExtractNextAtom(phpWithResultType in Attr,Attr);
    end;
    ExtractProcHeadPos:=phepResultType;
  end;

  // copy memorystream to Result string
  Result:=GetExtraction(phpInUpperCase in Attr);
end;

function TPascalReaderTool.GetPropertyNameIdentifier(PropNode: TCodeTreeNode): PChar;
begin
  // ToDo: ppu, dcu

  Result:=nil;
  if PropNode=nil then exit;
  if not MoveCursorToPropName(PropNode) then exit;
  Result:=@Src[CurPos.StartPos];
end;

function TPascalReaderTool.GetPropertyTypeIdentifier(PropNode: TCodeTreeNode): PChar;
begin

  // ToDo: ppu, dcu

  Result:=nil;
  if PropNode=nil then exit;
  if not MoveCursorToPropType(PropNode) then exit;
  Result:=@Src[CurPos.StartPos];
end;

function TPascalReaderTool.PositionInPropertyName(PropNode: TCodeTreeNode;
  CleanPos: integer): boolean;
begin
  if PropNode=nil then exit(false);
  MoveCursorToNodeStart(PropNode);
  if (PropNode.Desc=ctnProperty) then begin
    ReadNextAtom; // read 'property'
    if UpAtomIs('CLASS') then ReadNextAtom;
  end;
  ReadNextAtom; // read name
  Result:=(CurPos.Flag=cafWord)
          and (CleanPos>=CurPos.StartPos) and (CleanPos<=CurPos.EndPos);
end;

function TPascalReaderTool.ExtractIdentCharsFromStringConstant(StartPos,
  MinPos, MaxPos, MaxLen: integer): string;
var
  APos: Integer;
  IdentStartPos: Integer;
  IdentStr: String;
  IdentEndPos: LongInt;
begin
  Result:='';
  APos:=StartPos;
  while APos<SrcLen do begin
    if (Src[APos]='#') then begin
      // skip char constant
      inc(APos);
      if IsNumberChar[Src[APos]] then begin
        while (APos<CurPos.EndPos) and IsNumberChar[Src[APos]] do
          inc(APos)
      end else if Src[APos]='$' then begin
        while (APos<CurPos.EndPos) and IsHexNumberChar[Src[APos]] do
          inc(APos);
      end;
    end else if (Src[APos]='''') then begin
      inc(APos);
      repeat
        // read identifier chars
        IdentStartPos:=APos;
        while (APos<SrcLen) and (IsIdentChar[Src[APos]]) do
          inc(APos);
        IdentEndPos:=APos;
        if IdentStartPos<MinPos then IdentStartPos:=MinPos;
        if IdentEndPos>MaxPos then IdentEndPos:=MaxPos;
        if (IdentEndPos>IdentStartPos) then begin
          if IdentEndPos-IdentStartPos+length(Result)>MaxLen then
            IdentEndPos:=IdentStartPos+MaxLen-length(Result);
          IdentStr:=copy(Src,IdentStartPos,IdentEndPos-IdentStartPos);
          if (IdentStr<>'') then begin
            IdentStr[1]:=UpChars[IdentStr[1]];
            Result:=Result+IdentStr;
          end;
        end;
        // skip non identifier chars
        while (APos<SrcLen) and (Src[APos]<>'''')
        and (not IsIdentChar[Src[APos]])
        do
          inc(APos);
      until (APos>=SrcLen) or (Src[APos]='''') or (length(Result)>=MaxLen);
      inc(APos);
    end else
      break;
  end;
end;

function TPascalReaderTool.ReadStringConstantValue(StartPos: integer): string;
// reads a string constant and returns the resulting string
var
  Run: Integer;
  NumberStart: PChar;
  ResultLen: Integer;
  Number: Integer;
  p: PChar;
begin
  Result:='';
  if StartPos>SrcLen then exit;
  // first read and calculate the resulting length, then copy the chars
  for Run:=1 to 2 do begin
    ResultLen:=0;
    p:=@Src[StartPos];
    while true do begin
      case p^ of
      '''':
        begin
          // read string
          inc(p);
          while true do begin
            if p^='''' then begin
              if p[1]='''' then begin
                // a double ' means a single '
                inc(ResultLen);
                if Run=2 then Result[ResultLen]:='''';
                inc(p,2);
              end else begin
                // a single ' means end of string constant
                inc(p);
                break;
              end;
            end else begin
              // normal char
              inc(ResultLen);
              if Run=2 then Result[ResultLen]:=p^;
              inc(p);
            end;
          end;
        end;
      '#':
        begin
          // read char constant
          inc(p);
          NumberStart:=p;
          if IsNumberChar[p^] then begin
            // read decimal number
            while IsNumberChar[p^] do
              inc(p);
            Number:=StrToIntDef(copy(Src,NumberStart-PChar(Src)+1,p-NumberStart),-1);
          end else if p^='$' then begin
            // read hexnumber
            inc(p);
            while IsHexNumberChar[p^] do
              inc(p);
            Number:=HexStrToIntDef(NumberStart,-1);
          end else
            Number:=-1;
          // add special character
          if (Number<0) or (Number>255) then break;
          inc(ResultLen);
          if Run=2 then Result[ResultLen]:=chr(Number);
        end;
      '^':
        begin
          inc(p);
          if p^ in ['A'..'Z'] then begin
            inc(ResultLen);
            if Run=2 then Result[ResultLen]:=chr(ord(p^)-ord('A'));
          end else begin
            break;
          end;
        end;
      else
        break;
      end;
    end;
    if Run=1 then SetLength(Result,ResultLen);
  end;
end;

function TPascalReaderTool.GetNodeIdentifier(Node: TCodeTreeNode): PChar;
begin
  Result:=nil;
  if (Node=nil) or (Node.StartPos>SrcLen) then exit;
  case Node.Desc of
  ctnProcedure,ctnProcedureHead:
    Result:=GetProcNameIdentifier(Node);
  ctnProperty:
     Result:=GetPropertyNameIdentifier(Node);
  ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition,
  ctnEnumIdentifier,ctnIdentifier:
    Result:=@Src[Node.StartPos];
  end;
end;

function TPascalReaderTool.GetHintModifiers(Node: TCodeTreeNode): TPascalHintModifiers;

  function IsHintModifier: boolean;
  begin
    if CurPos.Flag<>cafWord then exit(false);
    Result:=true;
    if UpAtomIs('PLATFORM') then
      Include(GetHintModifiers,phmPlatform)
    else if UpAtomIs('UNIMPLEMENTED') then
      Include(GetHintModifiers,phmUnimplemented)
    else if UpAtomIs('LIBRARY') then
      Include(GetHintModifiers,phmLibrary)
    else if UpAtomIs('EXPERIMENTAL') then
      Include(GetHintModifiers,phmExperimental)
    else if UpAtomIs('DEPRECATED') then
      Include(GetHintModifiers,phmDeprecated)
    else
      Result:=false;
  end;

begin
  Result:=[];
  if Node=nil then exit;
  case Node.Desc of

  ctnProgram,ctnPackage,ctnLibrary,ctnUnit:
    begin
      MoveCursorToNodeStart(Node);
      ReadNextAtom;
      if not (UpAtomIs('PROGRAM') or UpAtomIs('PACKAGE') or UpAtomIs('LIBRARY')
        or UpAtomIs('UNIT')) then exit;
      ReadNextAtom;// name
      while IsHintModifier do ReadNextAtom;
    end;

  ctnProcedure,ctnProcedureType,ctnProcedureHead:
    begin
      if Node.Desc<>ctnProcedureHead then begin
        Node:=Node.FirstChild;
        if Node=nil then exit;
      end;
      MoveCursorToFirstProcSpecifier(Node);
      // ToDo:
    end;

  ctnProperty:
    begin
      Node:=Node.LastChild;
      while Node<>nil do begin
        if Node.Desc=ctnHintModifier then begin
          MoveCursorToNodeStart(Node);
          ReadNextAtom;
          IsHintModifier;
        end;
        Node:=Node.PriorBrother;
      end;
    end;

  ctnVarDefinition,ctnConstant,ctnConstDefinition,
  ctnTypeDefinition,ctnGenericType:
    begin
      Node:=FindTypeNodeOfDefinition(Node);
      if Node=nil then exit;
      while (Node<>nil) do begin
        if Node.Desc=ctnHintModifier then begin
          MoveCursorToNodeStart(Node);
          ReadNextAtom;
          IsHintModifier;
        end;
        Node:=Node.NextBrother;
      end;
    end;

  end;
end;

procedure TPascalReaderTool.ForEachIdentifierInCleanSrc(StartPos,
  EndPos: integer; SkipComments: boolean; Node: TCodeTreeNode;
  const OnIdentifier: TOnEachPRIdentifier; Data: pointer; var Abort: boolean);
var
  CommentLvl: Integer;
  InStrConst: Boolean;
  p: PChar;
  EndP: Pointer;
  Range: TEPRIRange;

  procedure SkipIdentifier; inline;
  begin
    while (p<EndP) and IsIdentChar[p^] do inc(p);
  end;

begin
  //debugln(['TPascalReaderTool.ForEachIdentifierInCleanSrc Node=',Node.DescAsString,' "',dbgstr(Src,StartPos,EndPos-StartPos),'"']);
  if (StartPos<1) then
    StartPos:=1;
  if StartPos>SrcLen then exit;
  if EndPos>SrcLen then EndPos:=SrcLen+1;
  if StartPos>=EndPos then exit;
  Range:=epriInCode;
  p:=@Src[StartPos];
  EndP:=p+EndPos-StartPos;
  while p<EndP do begin
    case p^ of

    '{':
      begin
        inc(p);
        if p^=#3 then begin
          // codetools skip comment {#3 #3}
          inc(p);
          repeat
            if p>=EndP then exit;
            if (p^=#3) and (p[1]='}')
            then begin
              inc(p,2);
              break;
            end;
            inc(p);
          until false;
        end else begin
          // pascal comment {}
          CommentLvl:=1;
          InStrConst:=false;
          if p^='$' then
            Range:=epriInDirective
          else
            Range:=epriInComment;
          repeat
            if p>=EndP then exit;
            case p^ of
            '{': if Scanner.NestedComments then inc(CommentLvl);
            '}':
              begin
                dec(CommentLvl);
                if CommentLvl=0 then break;
              end;
            'a'..'z','A'..'Z','_':
              if not InStrConst then begin
                if not SkipComments then begin
                  OnIdentifier(Self,p-PChar(Src)+1,Range,Node,Data,Abort);
                  SkipIdentifier;
                  if Abort then exit;
                end;
                while (p<EndP) and IsIdentChar[p^] do inc(p);
              end;
            '''':
              InStrConst:=not InStrConst;
            #10,#13:
              InStrConst:=false;
            end;
            inc(p);
          until false;
          inc(p);
          //debugln(StartPos,' ',copy(Src,CommentStart,StartPos-CommentStart));
        end;
      end;

    '/':  // Delphi comment
      if p[1]<>'/' then begin
        inc(p);
      end else begin
        inc(p,2);
        InStrConst:=false;
        repeat
          if p>=EndP then exit;
          case p^ of
          #10,#13:
            break;
          'a'..'z','A'..'Z','_':
            if not InStrConst then begin
              if not SkipComments then begin
                OnIdentifier(Self,p-PChar(Src)+1,Range,Node,Data,Abort);
                SkipIdentifier;
                if Abort then exit;
              end;
              while (p<EndP) and IsIdentChar[p^] do inc(p);
            end;
          '''':
            InStrConst:=not InStrConst;
          end;
          inc(p);
        until false;
        inc(p);
        if (p<EndP) and (p^ in [#10,#13])
        and (p[-1]<>p^) then
          inc(p);
      end;

    '(': // turbo pascal comment
      if (p[1]<>'*') then begin
        inc(p);
      end else begin
        inc(p,3);
        InStrConst:=false;
        repeat
          if p>=EndP then exit;
          case p^ of
          ')':
            if p[-1]='*' then break;
          'a'..'z','A'..'Z','_':
            if not InStrConst then begin
              if not SkipComments then begin
                OnIdentifier(Self,p-PChar(Src)+1,Range,Node,Data,Abort);
                SkipIdentifier;
                if Abort then exit;
              end;
              SkipIdentifier;
            end;
          '''':
            InStrConst:=not InStrConst;
          #10,#13:
            InStrConst:=false;
          end;
          inc(p);
        until false;
        inc(p);
      end;

    'a'..'z','A'..'Z','_':
      begin
        OnIdentifier(Self,p-PChar(Src)+1,epriInCode,Node,Data,Abort);
        SkipIdentifier;
        if Abort then exit;
      end;

    '''':
      begin
        // skip string constant
        inc(p);
        while p<EndP do begin
          if (not (p^ in ['''',#10,#13])) then
            inc(p)
          else begin
            inc(p);
            break;
          end;
        end;
      end;

    else
      inc(p);
    end;
  end;
end;

procedure TPascalReaderTool.ForEachIdentifierInNode(Node: TCodeTreeNode;
  SkipComments: boolean; const OnIdentifier: TOnEachPRIdentifier;
  Data: Pointer; var Abort: boolean);
var
  StartPos: Integer;
  EndPos: Integer;
  Child: TCodeTreeNode;
begin
  //debugln(['TPascalReaderTool.ForEachIdentifierInNode START ',Node.DescAsString]);
  if NodeNeedsBuildSubTree(Node) then
    BuildSubTree(Node);
  if Node.FirstChild<>nil then begin
    EndPos:=Node.StartPos;
    Child:=Node.FirstChild;
    while Child<>nil do begin
      // scan in front of child
      ForEachIdentifierInCleanSrc(EndPos,Child.StartPos,SkipComments,
        Node,OnIdentifier,Data,Abort);
      if Abort then exit;
      // scan child
      ForEachIdentifierInNode(Child,SkipComments,OnIdentifier,Data,Abort);
      if Abort then exit;
      EndPos:=Child.EndPos;
      Child:=Child.NextBrother;
    end;
    // scan behind children
    ForEachIdentifierInCleanSrc(EndPos,Node.EndPos,SkipComments,
      Node,OnIdentifier,Data,Abort);
  end else begin
    // leaf node
    StartPos:=Node.StartPos;
    EndPos:=Node.EndPos;
    // nodes without children can overlap with their NextBrother
    if (Node.NextBrother<>nil)
    and (Node.NextBrother.StartPos<EndPos) then
      EndPos:=Node.NextBrother.StartPos;
    // scan node range
    ForEachIdentifierInCleanSrc(StartPos,EndPos,SkipComments,
      Node,OnIdentifier,Data,Abort);
  end;
end;

procedure TPascalReaderTool.ForEachIdentifier(SkipComments: boolean;
  const OnIdentifier: TOnEachPRIdentifier; Data: Pointer);
var
  Node: TCodeTreeNode;
  Abort: boolean;
begin
  //debugln(['TPascalReaderTool.ForEachIdentifier START']);
  Node:=Tree.Root;
  Abort:=false;
  while Node<>nil do begin
    ForEachIdentifierInNode(Node,SkipComments,OnIdentifier,Data,Abort);
    if Abort then exit;
    Node:=Node.NextBrother;
  end;
end;

function TPascalReaderTool.FindVarNode(StartNode: TCodeTreeNode;
  const UpperVarName: string; Visibility: TClassSectionVisibility
  ): TCodeTreeNode;
var
  InClass: Boolean;
begin
  Result:=StartNode;
  InClass:=FindClassOrInterfaceNode(StartNode)<>nil;
  while Result<>nil do begin
    if (Result.Desc=ctnVarDefinition)
    and (not InClass or IdentNodeIsInVisibleClassSection(Result, Visibility))
    and (CompareNodeIdentChars(Result,UpperVarName)=0) then
      exit;
    if InClass then
      Result:=FindNextIdentNodeInClass(Result)
    else
      Result:=FindNextNodeOnSameLvl(Result);
  end;
end;

function TPascalReaderTool.FindTypeNodeOfDefinition(
  DefinitionNode: TCodeTreeNode): TCodeTreeNode;
// for example: 'var a,b,c: integer;'  only c has a type child
begin
  Result:=DefinitionNode;
  while (Result<>nil)
  and (Result.Desc in AllIdentifierDefinitions) do begin
    if (Result.FirstChild<>nil) then begin
      Result:=Result.FirstChild;
      if Result.Desc=ctnGenericName then begin
        // skip generic name and params
        Result:=Result.NextBrother;
        if Result=nil then exit;
        Result:=Result.NextBrother;
        if Result=nil then exit;
      end;
      if (not (Result.Desc in AllPascalTypes)) then
        Result:=nil;
      exit;
    end;
    if Result.Desc<>ctnVarDefinition then exit(nil);
    Result:=Result.NextBrother;
  end;
end;

function TPascalReaderTool.FindClassNode(StartNode: TCodeTreeNode;
  const AClassName: string; IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
// search for class like types on same level
var
  ANode, CurClassNode: TCodeTreeNode;
  NameNode: TCodeTreeNode;
  p: PChar;
begin
  ANode:=StartNode;
  Result:=nil;
  if AClassName='' then exit;
  p:=PChar(AClassName);
  while (ANode<>nil) do begin
    if ANode.Desc in [ctnTypeDefinition,ctnGenericType] then begin
      //debugln(['TPascalReaderTool.FindClassNode ',GetIdentifier(@Src[ANode.StartPos])]);
      CurClassNode:=FindTypeNodeOfDefinition(ANode);
      if (CurClassNode<>nil)
      and (CurClassNode.Desc in AllClassObjects) then begin
        if (not (IgnoreForwards
                 and ((CurClassNode.SubDesc and ctnsForwardDeclaration)>0)))
        and (not (IgnoreNonForwards
                 and ((CurClassNode.SubDesc and ctnsForwardDeclaration)=0)))
        then begin
          NameNode:=ANode;
          if (ANode.Desc=ctnGenericType) and (ANode.FirstChild<>nil) then
            NameNode:=ANode.FirstChild;
          //debugln(['TPascalReaderTool.FindClassNode class name = "',GetIdentifier(@Src[NameNode.StartPos]),'"']);
          if NameNode.StartPos>SrcLen then exit;
          if CompareIdentifiers(p,@Src[NameNode.StartPos])=0 then begin
            Result:=FindNestedClass(CurClassNode,p,true);
            exit;
          end;
        end;
      end;
    end;
    // next node
    if (ANode.Desc in [ctnTypeSection]+AllCodeSections)
    and (ANode.FirstChild<>nil) then
      ANode:=ANode.FirstChild
    else if ANode.NextBrother<>nil then
      ANode:=ANode.NextBrother
    else begin
      // skip procs, const and var sections
      repeat
        ANode:=ANode.Parent;
        if (ANode=nil) then exit;
        if (not (ANode.Desc in [ctnTypeSection]+AllCodeSections)) then exit;
        if ANode.NextBrother<>nil then begin
          ANode:=ANode.NextBrother;
          break;
        end;
      until false;
    end;
  end;
end;

function TPascalReaderTool.FindClassNodeBackwards(StartNode: TCodeTreeNode;
  const AClassName: string; IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
var
  ANode: TCodeTreeNode;
  CurClassNode: TCodeTreeNode;
  p: PChar;
begin
  ANode:=StartNode;
  p:=PChar(AClassName);
  while ANode<>nil do begin
    if ANode.Desc=ctnTypeDefinition then begin
      CurClassNode:=ANode.FirstChild;
      if (CurClassNode<>nil)
      and (CurClassNode.Desc in AllClassObjects) then begin
        if (not (IgnoreForwards
                 and ((CurClassNode.SubDesc and ctnsForwardDeclaration)>0)))
        and (not (IgnoreNonForwards
                 and ((CurClassNode.SubDesc and ctnsForwardDeclaration)=0)))
        then begin
          if CompareIdentifiers(p,@Src[ANode.StartPos])=0 then begin
            Result:=FindNestedClass(CurClassNode,p,true);
            exit;
          end;
        end;
      end;
    end;
    if ANode.PriorBrother<>nil then begin
      ANode:=ANode.PriorBrother;
      if (ANode.FirstChild<>nil) and (ANode.Desc in AllCodeSections) then
        ANode:=ANode.LastChild;
      if (ANode.FirstChild<>nil) and (ANode.Desc in AllDefinitionSections) then
        ANode:=ANode.LastChild;
    end else begin
      ANode:=ANode.Parent;
    end;
  end;
  Result:=nil;
end;

function TPascalReaderTool.FindNestedClass(RootClassNode: TCodeTreeNode;
  AClassName: PChar; SkipFirst: boolean): TCodeTreeNode;
var
  p: PChar;
  Node: TCodeTreeNode;
  EndNode: TCodeTreeNode;
begin
  Result:=nil;
  if RootClassNode=nil then exit;
  if AClassName=nil then exit;
  p:=AClassName;
  if SkipFirst then begin
    while IsIdentChar[p^] do inc(p);
    if p^='<' then
    begin
      while not (p^ in [#0,'>']) do Inc(p);
      if p^ = '>' then Inc(p);
    end;
    if p^=#0 then exit(RootClassNode);
    if p^<>'.' then exit;
    inc(p);
  end;
  //debugln(['TPascalReaderTool.FindNestedClass p="',p,'"']);
  if not IsIdentStartChar[p^] then exit;
  EndNode:=RootClassNode.NextSkipChilds;
  Node:=RootClassNode.Next;
  while Node<>EndNode do begin
    // debugln(['TPascalReaderTool.FindNestedClass Node=',node.DescAsString]);
    if Node.Desc in [ctnTypeDefinition,ctnGenericType] then begin
      if (Node.LastChild<>nil) and (Node.LastChild.Desc in AllClasses) then begin
        if ((Node.Desc=ctnTypeDefinition)
          and (CompareIdentifierPtrs(p,@Src[Node.StartPos])=0))
        or ((Node.FirstChild.Desc=ctnGenericName)
          and (CompareIdentifierPtrs(p,@Src[Node.FirstChild.StartPos])=0))
        then begin
          // class found
          Node:=Node.LastChild;
          while IsIdentChar[p^] do inc(p);
          if p^=#0 then exit(Node);
          if p^<>'.' then exit;
          Result:=FindNestedClass(Node,p+1,false);
          exit;
        end;
      end;
    end;
    if Node.Desc in AllClassSections then
      Node:=Node.Next
    else
      Node:=Node.NextSkipChilds;
  end;
end;

function TPascalReaderTool.FindClassNode(CursorNode: TCodeTreeNode): TCodeTreeNode;
// find class node of a node in a procedure (declaration or body)
begin
  while CursorNode<>nil do begin
    if CursorNode.Desc in AllClassObjects then begin
      Result:=CursorNode;
      exit;
    end else if NodeIsMethodBody(CursorNode) then begin
      Result:=FindClassNodeForMethodBody(CursorNode,true,false);
      exit;
    end;
    CursorNode:=CursorNode.Parent;
  end;
  Result:=nil;
end;

function TPascalReaderTool.FindClassNodeForMethodBody(ProcNode: TCodeTreeNode;
  IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
var
  ProcClassName: String;
begin
  Result:=nil;
  ProcClassName:=ExtractClassNameOfProcNode(ProcNode,true);
  if ProcClassName='' then exit;
  Result:=FindClassNodeBackwards(ProcNode,ProcClassName,IgnoreForwards,
                                 IgnoreNonForwards);
end;

function TPascalReaderTool.FindClassOrInterfaceNode(CursorNode: TCodeTreeNode;
  FindClassOfMethod: boolean): TCodeTreeNode;
begin
  while CursorNode<>nil do begin
    if CursorNode.Desc in AllClasses then begin
      Result:=CursorNode;
      exit;
    end else if FindClassOfMethod and NodeIsMethodBody(CursorNode) then begin
      Result:=FindClassNodeForMethodBody(CursorNode,true,false);
      exit;
    end;
    CursorNode:=CursorNode.Parent;
  end;
  Result:=nil;
end;

function TPascalReaderTool.FindClassSection(ClassNode: TCodeTreeNode;
  NodeDesc: TCodeTreeNodeDesc): TCodeTreeNode;
begin
  Result:=ClassNode.FirstChild;
  while (Result<>nil) and (Result.Desc<>NodeDesc) do
    Result:=Result.NextBrother;
end;

function TPascalReaderTool.FindLastClassSection(ClassNode: TCodeTreeNode;
  NodeDesc: TCodeTreeNodeDesc): TCodeTreeNode;
begin
  Result:=ClassNode.LastChild;
  while (Result<>nil) and (Result.Desc<>NodeDesc) do
    Result:=Result.PriorBrother;
end;

function TPascalReaderTool.GetClassVisibility(Node: TCodeTreeNode
  ): TCodeTreeNodeDesc;
begin
  Result:=ctnNone;
  if Node=nil then exit;
  if Node.Desc=ctnProcedureHead then
    Node:=Node.Parent;
  if not (Node.Desc in AllClassSections) then begin
    Node:=Node.Parent;
    if Node=nil then exit;
  end;
  if Node.Desc in AllClassSubSections then
    Node:=Node.Parent;
  if Node.Desc in AllClassBaseSections then
    Result:=Node.Desc;
end;

function TPascalReaderTool.FindClassNodeInInterface(
  const AClassName: string; IgnoreForwards, IgnoreNonForwards,
  ErrorOnNotFound: boolean): TCodeTreeNode;
  
  procedure RaiseClassNotFound;
  begin
    RaiseExceptionFmt(ctsClassSNotFound, [AClassName]);
  end;
  
begin
  Result:=Tree.Root;
  if Result<>nil then begin
    if Result.Desc=ctnUnit then
      Result:=Result.NextBrother;
    if Result<>nil then begin
      Result:=FindClassNode(Result.FirstChild,AClassName,
                            IgnoreForwards, IgnoreNonForwards);
      if (Result<>nil) and Result.HasParentOfType(ctnImplementation) then
        Result:=nil;
    end;
  end;
  if (Result=nil) and ErrorOnNotFound then
    RaiseClassNotFound;
end;

function TPascalReaderTool.FindClassNodeInUnit(const AClassName: string;
  IgnoreForwards, IgnoreNonForwards, IgnoreImplementation,
  ErrorOnNotFound: boolean): TCodeTreeNode;

  procedure RaiseClassNotFound;
  begin
    RaiseExceptionFmt(ctsClassSNotFound, [AClassName]);
  end;

begin
  Result:=Tree.Root;
  if Result<>nil then begin
    if Result.Desc in [ctnUnit,ctnLibrary,ctnPackage] then begin
      Result:=Result.NextBrother;
    end;
    if Result<>nil then begin
      Result:=FindClassNode(Result.FirstChild,AClassName,
                            IgnoreForwards, IgnoreNonForwards);
      if (Result<>nil) and IgnoreImplementation
      and Result.HasParentOfType(ctnImplementation) then
        Result:=nil;
    end;
  end;
  if (Result=nil) and ErrorOnNotFound then
    RaiseClassNotFound;
end;

function TPascalReaderTool.FindFirstIdentNodeInClass(ClassNode: TCodeTreeNode
  ): TCodeTreeNode;
begin
  if (ClassNode=nil) then exit(nil);
  Result:=FindNextIdentNodeInClass(ClassNode.FirstChild);
end;

function TPascalReaderTool.FindLastIdentNodeInClass(ClassNode: TCodeTreeNode
  ): TCodeTreeNode;
begin
  if (ClassNode=nil) then exit(nil);
  Result:=ClassNode.LastChild;
  if Result=nil then exit;
  while (Result.FirstChild<>nil) and (Result.Desc in AllClassSections) do
    Result:=Result.LastChild;
  if not (Result.Desc in AllClassSections) then
    Result:=FindPriorIdentNodeInClass(Result);
end;

function TPascalReaderTool.FindNextIdentNodeInClass(Node: TCodeTreeNode
  ): TCodeTreeNode;
// Node must be nil or a class section or an identifier node in a class
begin
  Result:=Node;
  if Result=nil then exit;
  repeat
    // descend into class sections, skip empty class sections
    if (Result.FirstChild<>nil) and (Result.Desc in AllClassSections) then
      Result:=Result.FirstChild
    else begin
      while Result.NextBrother=nil do begin
        Result:=Result.Parent;
        if (Result=nil) or (not (Result.Desc in AllClassSections)) then
          exit(nil);
      end;
      Result:=Result.NextBrother
    end;
  until not (Result.Desc in AllClassSections);
end;

function TPascalReaderTool.FindPriorIdentNodeInClass(Node: TCodeTreeNode
  ): TCodeTreeNode;
begin
  Result:=Node;
  if Result=nil then exit;
  repeat
    if Result.PriorBrother<>nil then begin
      Result:=Result.PriorBrother;
      while (Result.LastChild<>nil) and (Result.Desc in AllClassSections) do
        Result:=Result.LastChild;
    end else if Result.Parent.Desc in AllClassSections then
      Result:=Result.Parent
    else
      exit(nil);
  until not (Result.Desc in AllClassSections);
end;

function TPascalReaderTool.ClassSectionNodeStartsWithWord(ANode: TCodeTreeNode
  ): boolean;
begin
  Result:=(ANode<>nil) and (ANode.StartPos<ANode.EndPos)
    and (IsIdentStartChar[Src[ANode.StartPos]]);
end;

function TPascalReaderTool.IsClassNode(Node: TCodeTreeNode): boolean;
begin
  Result:=(Node<>nil) and (Node.Desc=ctnClass);
end;

function TPascalReaderTool.FindInheritanceNode(ClassNode: TCodeTreeNode): TCodeTreeNode;
begin
  Result:=ClassNode.FirstChild;
  while (Result<>nil) and (Result.Desc in [ctnClassSealed,ctnClassAbstract,ctnClassExternal]) do
    Result:=Result.NextBrother;
  if (Result<>nil) and (Result.Desc<>ctnClassInheritance) then
    Result:=nil;
end;

function TPascalReaderTool.ExtractRecordCaseType(RecordCaseNode: TCodeTreeNode): string;
//  case a:b.c of
//  case a:(b,c) of
var
  VarNode: TCodeTreeNode;
begin
  Result:='';
  VarNode:=RecordCaseNode.FirstChild;
  if VarNode=nil then exit;
  if VarNode.FirstChild<>nil then
    Result:=ExtractNode(RecordCaseNode.FirstChild,[]);
end;

function TPascalReaderTool.GetSourceType: TCodeTreeNodeDesc;
begin
  if Tree.Root<>nil then
    Result:=Tree.Root.Desc
  else
    Result:=ctnNone;
end;

function TPascalReaderTool.IdentNodeIsInVisibleClassSection(
  Node: TCodeTreeNode; Visibility: TClassSectionVisibility): Boolean;
begin
  if Visibility = csvEverything then
    Result := True
  else
  if (Node.Parent<>nil) then
    case Visibility of
      //csvAbovePrivate: todo: add strict private and strict protected (should be registered as new sections)
      csvProtectedAndHigher:
        Result := not(Node.Parent.Desc = ctnClassPrivate);//todo: add strict private
      csvPublicAndHigher:
        Result := not(Node.Parent.Desc in [ctnClassPrivate, ctnClassProtected]);//todo: strict private and strict protected
    else
      Result := True
    end
  else
    Result := False;
end;

function TPascalReaderTool.ExtractProcedureGroup(ProcNode: TCodeTreeNode
  ): TPascalMethodGroup;
begin
  Result:=mgMethod;
  if (ProcNode=nil) then exit;
  if ProcNode.Desc=ctnProcedureHead then
    ProcNode:=ProcNode.Parent;
  if ProcNode.Desc<>ctnProcedure then exit;
  MoveCursorToNodeStart(ProcNode);
  ReadNextAtom;
  if UpAtomIs('CLASS') then
  begin
    ReadNextAtom;
    if UpAtomIs('CONSTRUCTOR') then
      Result := mgClassConstructor
    else if UpAtomIs('DESTRUCTOR') then
      Result := mgClassDestructor
    else if UpAtomIs('OPERATOR') then
      Result := mgClassOperator;
  end else
  if UpAtomIs('CONSTRUCTOR') then
    Result := mgConstructor
end;

function TPascalReaderTool.PositionInSourceName(CleanPos: integer): boolean;
var
  NamePos: TAtomPosition;
begin
  Result:=false;
  if not GetSourceNamePos(NamePos) then exit;
  Result:=(CleanPos>=NamePos.StartPos) and (CleanPos<NamePos.EndPos);
end;

function TPascalReaderTool.ExtractSourceName: string;
begin
  Result:='';
  if Tree.Root<>nil then begin
    MoveCursorToNodeStart(Tree.Root);
    ReadNextAtom; // read source type 'program', 'unit' ...
    if (Tree.Root.Desc<>ctnProgram) or UpAtomIs('PROGRAM') then begin
      ReadNextAtom; // read name
      if AtomIsIdentifier then begin
        Result:=copy(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
        ReadNextAtom;
        while CurPos.Flag=cafPoint do begin
          ReadNextAtom;
          if not AtomIsIdentifier then exit;
          Result:=Result+'.'+copy(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
          ReadNextAtom;
        end;
        exit;
      end;
    end;
  end;
  if (Tree.Root<>nil) and (Tree.Root.Desc=ctnProgram) then
    // a program without the 'program' header uses the file name as name
    Result:=ExtractFileNameOnly(MainFilename)
  else
    Result:='';
end;

function TPascalReaderTool.GetSourceNamePos(out NamePos: TAtomPosition
  ): boolean;
begin
  Result:=false;
  NamePos.StartPos:=-1;
  if Tree.Root=nil then exit;
  MoveCursorToNodeStart(Tree.Root);
  ReadNextAtom; // read source type 'program', 'unit' ...
  if (Tree.Root.Desc=ctnProgram) and (not UpAtomIs('PROGRAM')) then exit;
  ReadNextAtom; // read name
  if not AtomIsIdentifier then exit;
  NamePos:=CurPos;
  Result:=true;
  ReadNextAtom;
  while CurPos.Flag=cafPoint do begin
    ReadNextAtom;
    if not AtomIsIdentifier then exit;
    NamePos.EndPos:=CurPos.EndPos;
    ReadNextAtom;
  end;
end;

function TPascalReaderTool.GetSourceName(DoBuildTree: boolean): string;
begin
  Result:='';
  if DoBuildTree then
    BuildTree(lsrSourceName);
  CachedSourceName:=ExtractSourceName;
  Result:=CachedSourceName;
end;

function TPascalReaderTool.NodeIsInAMethod(Node: TCodeTreeNode): boolean;
begin
  Result:=false;
  while (Node<>nil) do begin
    if (Node.Desc=ctnProcedure) then begin
      if NodeIsMethodBody(Node) then begin
        Result:=true;
        exit;
      end;
    end;
    Node:=Node.Parent;
  end;
end;

function TPascalReaderTool.NodeIsMethodBody(ProcNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  if (ProcNode<>nil) and (ProcNode.Desc=ctnProcedure)
  and (ProcNode.FirstChild<>nil) then begin

    // ToDo: ppu, dcu

    MoveCursorToNodeStart(ProcNode.FirstChild); // ctnProcedureHead
    ReadNextAtom;
    if not AtomIsIdentifier then exit;
    ReadNextAtom;
    if (CurPos.Flag<>cafPoint) then exit;
    Result:=true;
    exit;
  end;
end;

function TPascalReaderTool.GetMethodOfBody(Node: TCodeTreeNode): TCodeTreeNode;
begin
  Result:=Node;
  while (Result<>nil) and not NodeIsMethodBody(Result) do
    Result:=Result.Parent;
end;

function TPascalReaderTool.NodeIsFunction(ProcNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then exit;
  MoveCursorToNodeStart(ProcNode);
  ReadNextAtom;
  if UpAtomIs('CLASS') then ReadNextAtom;
  Result:=UpAtomIs('FUNCTION');
end;

function TPascalReaderTool.NodeIsConstructor(ProcNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  if (ProcNode=nil) then exit;
  if ProcNode.Desc=ctnProcedureHead then
    ProcNode:=ProcNode.Parent;
  if ProcNode.Desc<>ctnProcedure then exit;
  MoveCursorToNodeStart(ProcNode);
  ReadNextAtom;
  if UpAtomIs('CLASS') then ReadNextAtom;
  Result:=UpAtomIs('CONSTRUCTOR');
  if not Result and UpAtomIs('FUNCTION')
  and ([cmsObjectiveC1,cmsObjectiveC2]*Scanner.CompilerModeSwitches<>[]) then
  begin
    ProcNode:=ProcNode.FirstChild;
    if ProcNode=nil then exit;
    if (ProcNode.SubDesc and ctnsNeedJITParsing)>0 then
      BuildSubTreeForProcHead(ProcNode);
    ProcNode:=ProcNode.FirstChild;
    if (ProcNode=nil) then exit;
    if ProcNode.Desc=ctnParameterList then
      ProcNode:=ProcNode.NextBrother;
    if (ProcNode=nil) then exit;
    MoveCursorToNodeStart(ProcNode);
    ReadNextAtom;
    Result:=UpAtomIs('ID');
  end;
end;

function TPascalReaderTool.NodeIsDestructor(ProcNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  if (ProcNode=nil) then exit;
  if ProcNode.Desc=ctnProcedureHead then
    ProcNode:=ProcNode.Parent;
  if ProcNode.Desc<>ctnProcedure then exit;
  MoveCursorToNodeStart(ProcNode);
  ReadNextAtom;
  Result:=UpAtomIs('DESTRUCTOR');
end;

function TPascalReaderTool.NodeIsForwardProc(ProcNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  // check if procedure
  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then exit;
  // check if in interface
  if (ProcNode.Parent<>nil) and (ProcNode.Parent.Desc=ctnInterface) then
    exit(true);
  // check if has forward
  if (ctnsForwardDeclaration and ProcNode.SubDesc)>0 then exit(true);
end;

function TPascalReaderTool.NodeIsOperator(ProcNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  if (ProcNode=nil) then exit;
  if ProcNode.Desc=ctnProcedureHead then
    ProcNode:=ProcNode.Parent;
  if ProcNode.Desc<>ctnProcedure then exit;
  MoveCursorToNodeStart(ProcNode);
  ReadNextAtom;
  if UpAtomIs('CLASS') then ReadNextAtom;
  Result:=UpAtomIs('OPERATOR');
end;

function TPascalReaderTool.NodeIsResultIdentifier(Node: TCodeTreeNode): boolean;
begin
  Result:=(Node<>nil)
    and (Node.Desc=ctnVarDefinition)
    and (Node.Parent<>nil)
    and (Node.Parent.Desc=ctnProcedureHead);
end;

function TPascalReaderTool.NodeIsResultType(Node: TCodeTreeNode): boolean;
begin
  Result:=(Node<>nil)
    and (Node.Desc=ctnIdentifier)
    and (Node.Parent<>nil)
    and (Node.Parent.Desc=ctnProcedureHead);
end;

function TPascalReaderTool.NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode
  ): boolean;
begin
  ANode:=ANode.Parent;
  while ANode<>nil do begin
    if ANode.Desc in (AllIdentifierDefinitions+AllPascalTypes) then begin
      Result:=true;
      exit;
    end;
    ANode:=ANode.Parent;
  end;
  Result:=false;
end;

function TPascalReaderTool.ExtractDefinitionNodeType(
  DefinitionNode: TCodeTreeNode): string;
var
  TypeNode: TCodeTreeNode;
begin
  Result:='';
  TypeNode:=FindTypeNodeOfDefinition(DefinitionNode);
  if TypeNode=nil then exit;
  if TypeNode.Desc=ctnIdentifier then
    Result:=GetIdentifier(@Src[TypeNode.StartPos]);
end;

function TPascalReaderTool.ExtractFuncResultType(ProcNode: TCodeTreeNode;
  Attr: TProcHeadAttributes): string;
begin
  Result := '';
  if (ProcNode=nil) then exit;
  if ProcNode.Desc=ctnProcedure then
    ProcNode:=ProcNode.FirstChild;
  if (ProcNode=nil) or(ProcNode.Desc<>ctnProcedureHead) then
    Exit;
  MoveCursorToCleanPos(ProcNode.EndPos);
  CurNode:=ProcNode;
  ReadPriorAtom;
  if CurPos.Flag<>cafSemicolon then
    Exit;
  ReadPriorAtom;
  if CurPos.Flag<>cafWord then
    Exit;
  if phpInUpperCase in Attr then
    Result := GetUpAtom
  else
    Result := GetAtom;
end;

function TPascalReaderTool.ExtractDefinitionName(DefinitionNode: TCodeTreeNode
  ): string;
begin
  DefinitionNode:=FindDefinitionNameNode(DefinitionNode);
  if DefinitionNode<>nil then
    Result:=GetIdentifier(@Src[DefinitionNode.StartPos])
  else
    Result:='';
end;

function TPascalReaderTool.PositionInDefinitionName(
  DefinitionNode: TCodeTreeNode; CleanPos: integer): boolean;
var
  StartPos: LongInt;
begin
  if DefinitionNode.Desc=ctnGenericType then begin
    if DefinitionNode.FirstChild<>nil then
      StartPos:=DefinitionNode.FirstChild.StartPos
    else
      StartPos:=0;
  end else begin
    StartPos:=DefinitionNode.StartPos;
  end;
  Result:=(CleanPos>=StartPos) and (CleanPos<StartPos+GetIdentLen(@Src[StartPos]));
end;

function TPascalReaderTool.MoveCursorToParameterSpecifier(
  DefinitionNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  if (DefinitionNode=nil) or (DefinitionNode.Desc<>ctnVarDefinition)
  or (DefinitionNode.Parent=nil)
  or (DefinitionNode.Parent.Desc<>ctnParameterList) then exit;
  // find first variable node of this type (e.g. var a,b,c,d: integer)
  DefinitionNode:=GetFirstGroupVarNode(DefinitionNode);
  if DefinitionNode.PriorBrother<>nil then
    MoveCursorToCleanPos(DefinitionNode.PriorBrother.EndPos)
  else
    MoveCursorToCleanPos(DefinitionNode.Parent.StartPos);
  ReadNextAtom;
  while (CurPos.StartPos<DefinitionNode.StartPos) do ReadNextAtom;
  UndoReadNextAtom;
  Result:=CurPos.Flag=cafWord;
end;

function TPascalReaderTool.GetFirstGroupVarNode(VarNode: TCodeTreeNode): TCodeTreeNode;
begin
  Result:=VarNode;
  if (VarNode=nil) or (VarNode.Desc<>ctnVarDefinition) then exit;
  while VarNode<>nil do begin
    VarNode:=VarNode.PriorBrother;
    if (VarNode=nil) or (VarNode.Desc<>ctnVarDefinition)
    or (VarNode.FirstChild<>nil) then exit;
    Result:=VarNode;
  end;
end;

function TPascalReaderTool.FindEndOfWithExpr(WithVarNode: TCodeTreeNode): integer;
begin
  if WithVarNode.Desc<>ctnWithVariable then exit(-1);
  MoveCursorToCleanPos(WithVarNode.StartPos);
  ReadNextAtom;
  if not ReadTilVariableEnd(true,true) then exit(-1);
  UndoReadNextAtom;
  Result:=CurPos.EndPos;
end;

function TPascalReaderTool.ExtractWithBlockExpression(
  WithVarNode: TCodeTreeNode; Attr: TProcHeadAttributes): string;
var
  EndPos: Integer;
begin
  EndPos:=FindEndOfWithExpr(WithVarNode);
  if EndPos<1 then exit('');
  Result:=ExtractCode(WithVarNode.StartPos,EndPos,Attr);
end;

function TPascalReaderTool.FindWithBlockStatement(WithVarNode: TCodeTreeNode
  ): TCodeTreeNode;
begin
  Result:=WithVarNode;
  repeat
    if Result=nil then exit;
    if Result.Desc<>ctnWithVariable then exit(nil);
    if Result.FirstChild<>nil then begin
      Result:=Result.FirstChild;
      if Result.Desc=ctnWithStatement then exit;
      exit(nil);
    end;
  until false;
end;

function TPascalReaderTool.NodeIsIdentifierInInterface(Node: TCodeTreeNode): boolean;
// true if identifier is visible from other units (without prefixing)
begin
  case Node.Desc of
  ctnEnumIdentifier:
    Result:=true;
  ctnVarDefinition:
    Result:=(Node.Parent.Desc=ctnVarSection)
            and (Node.Parent.Parent.Desc=ctnInterface);
  ctnConstDefinition:
    Result:=(Node.Parent.Desc=ctnConstSection)
            and (Node.Parent.Parent.Desc=ctnInterface);
  ctnTypeDefinition,ctnGenericType:
    Result:=(Node.Parent.Desc=ctnTypeSection)
            and (Node.Parent.Parent.Desc=ctnInterface);
  ctnProcedure,ctnProperty:
    Result:=Node.Parent.Desc=ctnInterface;
  ctnProcedureHead:
    Result:=(Node.Parent.Desc=ctnProcedure)
        and (Node.Parent.Parent.Desc=ctnInterface);
  end;
  Result:=false;
end;

function TPascalReaderTool.NodeCanHaveForwardType(TypeNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  if (TypeNode=nil) or (TypeNode.Desc<>ctnTypeDefinition)
  or (TypeNode.FirstChild=nil) then
    exit;
  if (TypeNode.FirstChild.Desc in AllClasses)
  and (TypeNode.FirstChild.SubDesc and ctnsForwardDeclaration=0) then
    Result:=true;
end;

function TPascalReaderTool.NodeIsClassConstructorOrDestructor(
  ProcNode: TCodeTreeNode): boolean;
begin
  Result := ExtractProcedureGroup(ProcNode) in [mgClassConstructor, mgClassDestructor];
end;

function TPascalReaderTool.NodeIsForwardType(TypeNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  if (TypeNode=nil) or (TypeNode.Desc<>ctnTypeDefinition)
  or (TypeNode.FirstChild=nil) then
    exit;
  if (TypeNode.FirstChild.Desc in AllClasses)
  and (TypeNode.FirstChild.SubDesc and ctnsForwardDeclaration>0) then
    Result:=true;
end;

function TPascalReaderTool.FindForwardTypeNode(TypeNode: TCodeTreeNode;
  SearchFirst: boolean): TCodeTreeNode;
{ Find the first forward type of TypeNode
}

  function Next: TCodeTreeNode;
  begin
    Result:=FindForwardTypeNode;
    if Result.PriorBrother<>nil then
      // search upwards
      Result:=Result.PriorBrother
    else if Result.Parent.Desc in AllDefinitionSections then begin
      // type section was searched
      // check for other type sections in front
      Result:=Result.Parent;
      repeat
        while (Result.PriorBrother<>nil) do begin
          Result:=Result.PriorBrother;
          if (Result.Desc in AllDefinitionSections)
          and (Result.LastChild<>nil) then begin
            Result:=Result.LastChild;
            exit;
          end;
        end;
        // check if in implementation section
        if (Result.Parent=nil) or (Result.Parent.Desc<>ctnImplementation) then
          exit(nil);
        Result:=Result.Parent;
        // check if there is an interface section
        if (Result.PriorBrother=nil) or (Result.PriorBrother.Desc<>ctnInterface)
        then
          exit(nil);
        // search in interface section
        Result:=Result.PriorBrother;
        Result:=Result.LastChild;
      until Result=nil;
    end else
      exit;
  end;

var
  Node: TCodeTreeNode;
begin
  Result:=nil;
  if not NodeCanHaveForwardType(TypeNode) then exit;
  Node:=TypeNode;
  while Node<>nil do begin
    if Node.Desc in AllIdentifierDefinitions then begin
      if CompareIdentifiers(@Src[TypeNode.StartPos],@Src[Node.StartPos])=0
      then begin
        if (Node.Desc=ctnTypeDefinition) and NodeIsForwardType(Node) then begin
          // a forward
          Result:=Node;
          if not SearchFirst then exit;
        end else begin
          // a redefinition
          exit;
        end;
      end;
    end;
    Node:=Next;
  end;
end;

function TPascalReaderTool.FindHelperForNode(HelperNode: TCodeTreeNode
  ): TCodeTreeNode;
begin
  Result:=HelperNode.FirstChild;
  while (Result<>nil) and (Result.Desc = ctnClassInheritance) do
    Result:=Result.NextBrother;
  if (Result<>nil) and (Result.Desc<>ctnHelperFor) then
    Result:=nil;
end;

function TPascalReaderTool.FindTypeOfForwardNode(TypeNode: TCodeTreeNode
  ): TCodeTreeNode;

  function Next: TCodeTreeNode;
  begin
    Result:=FindTypeOfForwardNode;
    if Result.NextBrother<>nil then
      // search forwards
      Result:=Result.NextBrother
    else if Result.Parent.Desc in AllDefinitionSections then begin
      // type section was searched
      // check for other type sections in front
      Result:=Result.Parent;
      repeat
        while (Result.NextBrother<>nil) do begin
          Result:=Result.NextBrother;
          if (Result.Desc in AllDefinitionSections)
          and (Result.FirstChild<>nil) then begin
            Result:=Result.FirstChild;
            exit;
          end;
        end;
        // check if in interface section
        if (Result.Parent=nil) or (Result.Parent.Desc<>ctnInterface) then
          exit(nil);
        Result:=Result.Parent;
        // check if there is an implementation section
        if (Result.NextBrother=nil) or (Result.NextBrother.Desc<>ctnImplementation)
        then
          exit(nil);
        // search in implementation section
        Result:=Result.NextBrother;
        Result:=Result.FirstChild;
      until Result=nil;
    end else
      exit;
  end;

var
  Node: TCodeTreeNode;
begin
  Result:=nil;
  if not NodeIsForwardType(TypeNode) then exit;
  Node:=TypeNode;
  while Node<>nil do begin
    if Node.Desc in AllIdentifierDefinitions then begin
      if CompareIdentifiers(@Src[TypeNode.StartPos],@Src[Node.StartPos])=0
      then begin
        if (Node.Desc=ctnTypeDefinition) and (not NodeIsForwardType(Node)) then
        begin
          // a type
          Result:=Node;
          exit;
        end else begin
          // a redefinition
          exit;
        end;
      end;
    end;
    Node:=Next;
  end;
end;

function TPascalReaderTool.ExtractArrayRange(ArrayNode: TCodeTreeNode;
  Attr: TProcHeadAttributes): string;
begin
  Result:='';
  if (ArrayNode=nil) or (ArrayNode.Desc<>ctnRangedArrayType) then exit;
  MoveCursorToNodeStart(ArrayNode);
  if not ReadNextUpAtomIs('ARRAY') then exit;
  if not ReadNextAtomIsChar('[') then exit;
  Result:=ExtractBrackets(CurPos.StartPos,Attr);
end;

function TPascalReaderTool.PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
begin
  Result:=false;
  if (PropertyNode=nil) or (PropertyNode.Desc<>ctnProperty) then exit;
  MoveCursorToCleanPos(PropertyNode.EndPos);
  ReadPriorAtom;
  if (CurPos.Flag<>cafSemicolon) then exit;
  ReadPriorAtom;
  Result:=UpAtomIs('DEFAULT');
end;

function TPascalReaderTool.PropertyNodeHasParamList(PropNode: TCodeTreeNode
  ): boolean;
begin

  // ToDo: ppu, dcu

  Result:=false;
  if not MoveCursorToPropName(PropNode) then exit;
  ReadNextAtom;
  Result:=(CurPos.Flag=cafEdgedBracketOpen);
end;

function TPascalReaderTool.PropNodeIsTypeLess(PropNode: TCodeTreeNode): boolean;
begin

  // ToDo: ppu, dcu

  Result:=false;
  if PropNode.Desc<>ctnProperty then exit;
  if not MoveCursorToPropName(PropNode) then exit;
  ReadNextAtom; // read colon, skip parameters
  if CurPos.Flag=cafEdgedBracketOpen then begin
    ReadTilBracketClose(true);
    ReadNextAtom;
  end;
  Result:=(CurPos.Flag<>cafColon);
end;

function TPascalReaderTool.PropertyHasSpecifier(PropNode: TCodeTreeNode;
  UpperKeyword: string; ExceptionOnNotFound: boolean): boolean;
// true if cursor is on keyword
begin

  // ToDo: ppu, dcu

  Result:=false;
  if not MoveCursorToPropName(PropNode) then exit;
  if not AtomIsIdentifierE(ExceptionOnNotFound) then exit;
  ReadNextAtom;
  if CurPos.Flag=cafEdgedBracketOpen then begin
    if not ReadTilBracketClose(ExceptionOnNotFound) then exit;
    ReadNextAtom;
  end;
  if CurPos.Flag=cafColon then begin
    // read type
    ReadNextAtom;
    if not AtomIsIdentifierE(ExceptionOnNotFound) then exit;
    ReadNextAtom;
    if CurPos.Flag=cafPoint then begin
      ReadNextAtom;
      if not AtomIsIdentifierE(ExceptionOnNotFound) then exit;
      ReadNextAtom;
    end;
  end;

  UpperKeyword:=UpperCaseStr(UpperKeyword);
  // read specifiers
  while not (CurPos.Flag in [cafSemicolon,cafNone]) do begin
    if WordIsPropertySpecifier.DoIdentifier(@Src[CurPos.StartPos])
    then begin
      if UpAtomIs(UpperKeyword) then exit(true);
    end else if CurPos.Flag=cafEdgedBracketOpen then begin
      if not ReadTilBracketClose(ExceptionOnNotFound) then exit;
      ReadNextAtom;
    end;
    ReadNextAtom;
  end;
  // read modifiers
  while CurPos.Flag=cafSemicolon do begin
    ReadNextAtom;
    if UpAtomIs('DEFAULT') or UpAtomIs('NODEFAULT') or UpAtomIs('DEPRECATED')
    then begin
      if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(UpperKeyword))=0 then exit(true);
    end else if UpAtomIs('ENUMERATOR') then begin
      if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(UpperKeyword))=0 then exit(true);
      ReadNextAtom;
      if not AtomIsIdentifier then exit;
    end else
      exit;
    ReadNextAtom;
  end;
end;

function TPascalReaderTool.ProcNodeHasParamList(ProcNode: TCodeTreeNode): boolean;
begin

  // ToDo: ppu, dcu

  Result:=false;
  if ProcNode=nil then exit;
  if ProcNode.Desc=ctnProcedure then begin
    ProcNode:=ProcNode.FirstChild;
    if ProcNode=nil then exit;
  end;
  if ProcNode.Desc<>ctnProcedureHead then exit;
  if ProcNode.FirstChild<>nil then begin
    Result:=ProcNode.FirstChild.Desc=ctnParameterList;
    exit;
  end;
  MoveCursorBehindProcName(ProcNode);
  Result:=CurPos.Flag=cafRoundBracketOpen;
end;

function TPascalReaderTool.ProcNodeHasOfObject(ProcNode: TCodeTreeNode
  ): boolean;
begin

  // ToDo: ppu, dcu

  Result:=false;
  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedureType) then exit;
  MoveCursorToFirstProcSpecifier(ProcNode);
  Result:=UpAtomIs('OF') and ReadNextUpAtomIs('OBJECT');
end;

function TPascalReaderTool.GetProcParamList(ProcNode: TCodeTreeNode;
  Parse: boolean): TCodeTreeNode;
begin
  Result:=ProcNode;
  if Result=nil then exit;
  if Result.Desc=ctnProcedure then begin
    Result:=Result.FirstChild;
    if Result=nil then exit;
  end;
  if Result.Desc<>ctnProcedureHead then exit(nil);
  if Parse then
    BuildSubTreeForProcHead(Result);
  Result:=Result.FirstChild;
  if Result=nil then exit;
  if Result.Desc<>ctnParameterList then exit(nil);
end;

procedure TPascalReaderTool.MoveCursorToUsesStart(UsesNode: TCodeTreeNode);
begin
  if (UsesNode=nil)
  or ((UsesNode.Desc<>ctnUsesSection) and (UsesNode.Desc<>ctnContainsSection))
  then
    RaiseException('[TPascalParserTool.MoveCursorToUsesStart] '
      +'internal error: invalid UsesNode');
  // search through the uses section
  MoveCursorToCleanPos(UsesNode.StartPos);
  ReadNextAtom;
  if (not UpAtomIs('USES')) and (not UpAtomIs('CONTAINS')) then
    RaiseExceptionFmt(ctsStrExpectedButAtomFound,['uses',GetAtom]);
  ReadNextAtom;
end;

procedure TPascalReaderTool.MoveCursorToUsesEnd(UsesNode: TCodeTreeNode);
begin
  if (UsesNode=nil)
  or ((UsesNode.Desc<>ctnUsesSection) and (UsesNode.Desc<>ctnContainsSection))
  then
    RaiseException('[TPascalParserTool.MoveCursorToUsesEnd] '
      +'internal error: invalid UsesNode');
  // search backwards through the uses section
  MoveCursorToCleanPos(UsesNode.EndPos);
  ReadPriorAtom; // read ';'
  if not AtomIsChar(';') then
    RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]);
end;

function TPascalReaderTool.ReadNextUsedUnit(out UnitNameRange,
  InAtom: TAtomPosition; SyntaxExceptions: boolean): boolean;
// after reading CurPos is on atom behind, i.e. comma or semicolon
begin
  Result:=false;
  if not AtomIsIdentifierE(SyntaxExceptions) then exit;
  UnitNameRange:=CurPos;
  repeat
    ReadNextAtom;
    if CurPos.Flag<>cafPoint then break;
    ReadNextAtom;
    if not AtomIsIdentifierE(SyntaxExceptions) then exit;
    UnitNameRange.EndPos:=CurPos.EndPos;
  until false;
  if UpAtomIs('IN') then begin
    ReadNextAtom; // read filename
    if not AtomIsStringConstant then begin
      if not SyntaxExceptions then exit;
      RaiseStrConstExpected;
    end;
    InAtom:=CurPos;
    ReadNextAtom; // read comma or semicolon
  end else begin
    InAtom:=CleanAtomPosition;
  end;
  Result:=true;
end;

procedure TPascalReaderTool.ReadPriorUsedUnit(out UnitNameRange,InAtom: TAtomPosition);
begin
  ReadPriorAtom; // read unitname
  if AtomIsStringConstant then begin
    InAtom:=CurPos;
    ReadPriorAtom; // read 'in'
    if not UpAtomIs('IN') then
      RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsKeywordIn,GetAtom]);
    ReadPriorAtom; // read unitname
  end else begin
    InAtom:=CleanAtomPosition;
  end;
  AtomIsIdentifierE;
  UnitNameRange:=CurPos;
  repeat
    ReadPriorAtom;
    if CurPos.Flag<>cafPoint then break;
    ReadPriorAtom;
    AtomIsIdentifierE;
    UnitNameRange.StartPos:=CurPos.StartPos;
  until false;
end;

function TPascalReaderTool.ExtractUsedUnitNameAtCursor(InFilename: PAnsiString): string;
begin
  Result:='';
  if InFilename<>nil then
    InFilename^:='';
  while CurPos.Flag=cafWord do begin
    if Result<>'' then
      Result:=Result+'.';
    Result:=Result+GetAtom;
    ReadNextAtom;
    if CurPos.Flag<>cafPoint then break;
    ReadNextAtom;
  end;
  if UpAtomIs('IN') then begin
    ReadNextAtom;
    if not AtomIsStringConstant then exit;
    if InFilename<>nil then
      InFilename^:=copy(Src,CurPos.StartPos+1,CurPos.EndPos-CurPos.StartPos-2);
    ReadNextAtom;
  end;
end;

function TPascalReaderTool.ExtractUsedUnitName(UseUnitNode: TCodeTreeNode;
  InFilename: PAnsiString): string;
// after reading CurPos is on atom behind, i.e. comma or semicolon
begin
  Result:='';
  if InFilename<>nil then InFilename^:='';
  if (UseUnitNode=nil) or (UseUnitNode.Desc<>ctnUseUnit) then exit;
  MoveCursorToCleanPos(UseUnitNode.StartPos);
  ReadNextAtom;
  Result:=ExtractUsedUnitNameAtCursor(InFilename);
end;

function TPascalReaderTool.ReadAndCompareUsedUnit(const AnUnitName: string): boolean;
// after reading cursor is on atom behind unit name
var
  p: PChar;
begin
  Result:=false;
  if IsDottedIdentifier(AnUnitName) then
    p:=PChar(AnUnitName)
  else
    p:=nil;
  repeat
    if not AtomIsIdentifier then exit;
    if (p<>nil) then begin
      if CompareIdentifiers(p,@Src[CurPos.StartPos])=0 then
        inc(p,CurPos.EndPos-CurPos.StartPos)
      else
        p:=nil;
    end;
    ReadNextAtom;
    if CurPos.Flag<>cafPoint then begin
      // end of unit name
      Result:=(p<>nil) and (p^=#0);
      exit;
    end;
    // dot
    if (p<>nil) then begin
      if p='.' then
        inc(p)
      else
        p:=nil;
    end;
    ReadNextAtom;
  until false;
end;

function TPascalReaderTool.FindCommentInFront(const StartPos: TCodeXYPosition;
  const CommentText: string; InvokeBuildTree, SearchInParentNode,
  WithCommentBounds, CaseSensitive, IgnoreSpaces, CompareOnlyStart: boolean;
  out CommentStart, CommentEnd: TCodeXYPosition): boolean;
var
  CleanCursorPos: integer;
  CommentCleanStart: integer;
  CommentCleanEnd: integer;
begin
  Result:=false;
  if CommentText='' then exit;

  {debugln('TPascalReaderTool.FindCommentInFront A CommentText="',CommentText,'" ',
    ' StartPos=Y='+dbgs(StartPos.Y)+',X='+dbgs(StartPos.X),
    ' InvokeBuildTree='+dbgs(InvokeBuildTree),
    ' SearchInParentNode='+dbgs(SearchInParentNode),
    ' WithCommentBounds='+dbgs(WithCommentBounds),
    ' CaseSensitive='+dbgs(CaseSensitive),
    ' IgnoreSpaces='+dbgs(IgnoreSpaces),
    ' CompareOnlyStart='+dbgs(CompareOnlyStart)); }

  // parse source and find clean positions
  if InvokeBuildTree then
    BuildTreeAndGetCleanPos(StartPos,CleanCursorPos,[])
  else
    if CaretToCleanPos(StartPos,CleanCursorPos)<>0 then
      exit;
  Result:=FindCommentInFront(CleanCursorPos,CommentText,SearchInParentNode,
                  WithCommentBounds,CaseSensitive,IgnoreSpaces,CompareOnlyStart,
                  CommentCleanStart,CommentCleanEnd);
  if not Result then exit;
  Result:=(CommentCleanStart>=1)
          and CleanPosToCaret(CommentCleanStart,CommentStart)
          and CleanPosToCaret(CommentCleanEnd,CommentEnd);
end;

function TPascalReaderTool.FindCommentInFront(StartPos: integer;
  const CommentText: string;
  SearchInParentNode, WithCommentBounds, CaseSensitive,
  IgnoreSpaces, CompareOnlyStart: boolean;
  out CommentStart, CommentEnd: integer): boolean;
// searches a comment in front of StartPos starting with CommentText.
var
  FoundStartPos: integer;
  FoundEndPos: integer;

  procedure CompareComment(CStartPos, CEndPos: integer);
  var
    Found: LongInt;
    CompareStartPos: LongInt;
    CompareEndPos: LongInt;
    CompareLen: Integer;
    CompareCommentLength: Integer;
  begin
    //debugln('CompareComment "',copy(Src,CStartPos,CEndPos-CStartPos),'"');

    CompareStartPos:=CStartPos;
    CompareEndPos:=CEndPos;
    if not WithCommentBounds then begin
      // chomp comment boundaries
      case Src[CompareStartPos] of
      '/','(': inc(CompareStartPos,2);
      '{':
        if (CompareStartPos<SrcLen) and (Src[CompareStartPos+1]=#3) then
          // the codetools skip comment is no real comment
          exit
        else
          inc(CompareStartPos,1);
      end;
      case Src[CompareEndPos-1] of
      '}': dec(CompareEndPos);
      ')': dec(CompareEndPos,2);
      #10,#13:
        begin
          dec(CompareEndPos);
          if (Src[CompareEndPos-1] in [#10,#13])
          and (Src[CompareEndPos-1]<>Src[CompareEndPos]) then
            dec(CompareEndPos);
        end;
      end;
    end;
    if CompareStartPos>CompareEndPos then exit;

    if IgnoreSpaces then begin
      while (CompareStartPos<=CompareEndPos)
      and IsSpaceChar[Src[CompareStartPos]]
      do
        inc(CompareStartPos);
    end;

    CompareCommentLength:=length(CommentText);
    CompareLen:=CompareEndPos-CompareStartPos;
    if CompareOnlyStart and (CompareLen>CompareCommentLength) then
      CompareLen:=CompareCommentLength;

    //debugln('Compare: "',copy(Src,CompareStartPos,CompareEndPos-CompareStartPos),'"',
    //  ' "',CommentText,'"');
    if IgnoreSpaces then begin
      Found:=CompareTextIgnoringSpace(
                          @Src[CompareStartPos],CompareLen,
                          @CommentText[1],length(CommentText),
                          CaseSensitive);
    end else begin
      Found:=CompareText(@Src[CompareStartPos],CompareLen,
                         @CommentText[1],length(CommentText),
                         CaseSensitive);
    end;
    if Found=0 then begin
      FoundStartPos:=CStartPos;
      FoundEndPos:=CEndPos;
    end;
  end;

var
  ANode: TCodeTreeNode;
  p: LongInt;
  CommentStartPos: LongInt;
begin
  Result:=false;
  if StartPos>SrcLen then
    StartPos:=SrcLen+1;
  if CommentText='' then exit;

  {debugln('TPascalReaderTool.FindCommentInFront A CommentText="',CommentText,'" ',
    ' StartPos=Y='+dbgs(StartPos.Y)+',X='+dbgs(StartPos.X),
    ' InvokeBuildTree='+dbgs(InvokeBuildTree),
    ' SearchInParentNode='+dbgs(SearchInParentNode),
    ' WithCommentBounds='+dbgs(WithCommentBounds),
    ' CaseSensitive='+dbgs(CaseSensitive),
    ' IgnoreSpaces='+dbgs(IgnoreSpaces),
    ' CompareOnlyStart='+dbgs(CompareOnlyStart)); }

  // find node
  ANode:=FindDeepestNodeAtPos(StartPos,true);
  if (ANode=nil) then exit;

  { find end of last atom in front of node
    for example:
      uses classes;

      // Comment
      type

    If ANode is the 'type' block, the position after the semicolon is searched
  }

  if SearchInParentNode and (ANode.Parent<>nil) then begin
    // search all siblings in front
    ANode:=ANode.Parent;
    MoveCursorToCleanPos(ANode.Parent.StartPos);
  end else if ANode.PriorBrother<>nil then begin
    // search between prior sibling and this node
    //DebugLn('TPascalReaderTool.FindCommentInFront ANode.Prior=',ANode.Prior.DescAsString);
    MoveCursorToLastNodeAtom(ANode.PriorBrother);
  end else if ANode.Parent<>nil then begin
    // search from start of parent node to this node
    //DebugLn('TPascalReaderTool.FindCommentInFront ANode.Parent=',ANode.Parent.DescAsString);
    MoveCursorToCleanPos(ANode.Parent.StartPos);
  end else begin
    // search in this node
    //DebugLn('TPascalReaderTool.FindCommentInFront Aode=',ANode.DescAsString);
    MoveCursorToCleanPos(ANode.StartPos);
  end;
  p:=CurPos.EndPos;

  //debugln('TPascalReaderTool.FindCommentInFront B Area="',copy(Src,CurPos.StartPos,StartPos-CurPos.StartPos),'"');

  FoundStartPos:=-1;
  repeat
    //debugln('TPascalReaderTool.FindCommentInFront Atom=',GetAtom);
    CommentStartPos:=FindNextComment(Src,p,StartPos);
    if CommentStartPos>=StartPos then break;
    p:=FindCommentEnd(Src,CommentStartPos,Scanner.NestedComments);
    if p>StartPos then break;
    CompareComment(CommentStartPos,p);
  until false;

  Result:=(FoundStartPos>=1);
  CommentStart:=FoundStartPos;
  CommentEnd:=FoundEndPos;
end;

function TPascalReaderTool.GetPasDocComments(const StartPos: TCodeXYPosition;
  InvokeBuildTree: boolean; out ListOfPCodeXYPosition: TFPList): boolean;
var
  CleanCursorPos: integer;
  ANode: TCodeTreeNode;
begin
  ListOfPCodeXYPosition:=nil;
  Result:=false;

  // parse source and find clean positions
  if InvokeBuildTree then
    BuildTreeAndGetCleanPos(StartPos,CleanCursorPos)
  else
    if CaretToCleanPos(StartPos,CleanCursorPos)<>0 then
      exit;

  ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
  Result:=GetPasDocComments(ANode,ListOfPCodeXYPosition);
end;

function TPascalReaderTool.GetPasDocComments(Node: TCodeTreeNode;
  out ListOfPCodeXYPosition: TFPList): boolean;
// Comments are normally in front.
// { Description of TMyClass. }
//  TMyClass = class
//
// Comments can be behind in the same line
// property Color; // description of Color
//
// Comments can be in the following line if started with <
//
// comment starting with $ or % are ignored

  function CommentBelongsToPrior(CommentStart: integer): boolean;
  var
    p: Integer;
  begin
    //DebugLn(['CommentBelongsToPrior Comment=',dbgstr(copy(Src,CommentStart,20))]);
    if (CommentStart<SrcLen) and (Src[CommentStart]='{')
    and (Src[CommentStart+1]='<') then
      Result:=true
    else if (CommentStart+2<=SrcLen) and (Src[CommentStart]='(')
    and (Src[CommentStart+1]='*') and (Src[CommentStart+2]='<') then
      Result:=true
    else if (CommentStart+2<=SrcLen) and (Src[CommentStart]='/')
    and (Src[CommentStart+1]='/') and (Src[CommentStart+2]='<') then
      Result:=true
    else begin
      p:=CommentStart-1;
      while (p>=1) and (Src[p] in [' ',#9]) do dec(p);
      //DebugLn(['CommentBelongsToPrior Code in front: ',dbgstr(copy(Src,p,20))]);
      if (p<1) or (Src[p] in [#10,#13]) then
        Result:=false
      else
        Result:=true; // there is code in the same line in front of the comment
    end;
  end;

  procedure Add(CleanPos: integer);
  var
    CodePos: TCodeXYPosition;
  begin
    if not CleanPosToCaret(CleanPos,CodePos) then exit;
    AddCodePosition(ListOfPCodeXYPosition,CodePos);
  end;

  function Scan(StartPos, EndPos: integer): boolean;
  var
    p: LongInt;
    pp: PChar;
  begin
    // read comments (start in front of node)
    //DebugLn(['TPascalReaderTool.GetPasDocComments Scan Src=',copy(Src,StartPos,EndPos-StartPos)]);
    if EndPos>SrcLen then EndPos:=SrcLen+1;
    p:=FindLineEndOrCodeInFrontOfPosition(StartPos,true);
    while p<EndPos do begin
      p:=FindNextComment(Src,p,EndPos);
      if (p>=EndPos) then break;
      pp:=@Src[p];
      if ((pp^='/') and (pp[1]='/') and (pp[2] in ['$','%']))
      or ((pp^='{') and (pp[1] in ['$','%']))
      or ((pp^='(') and (pp[1]='*') and (pp[2] in ['$','%']))
      then
        break;
      //debugln(['TStandardCodeTool.GetPasDocComments Comment="',copy(Src,p,FindCommentEnd(Src,p,Scanner.NestedComments)-p),'"']);
      if (p<StartPos) then begin
        // comment in front of node
        if not CommentBelongsToPrior(p) then
          Add(p);
      end else if (p<EndPos) then begin
        // comment in the middle or behind
        if CommentBelongsToPrior(p) then
          Add(p);
      end;
      p:=FindCommentEnd(Src,p,Scanner.NestedComments);
    end;
    Result:=true;
  end;

var
  NextNode: TCodeTreeNode;
  EndPos: LongInt;
  TypeNode: TCodeTreeNode;
begin
  ListOfPCodeXYPosition:=nil;
  Result:=false;
  if (Node=nil) then exit;
  if (Node.Desc=ctnProcedureHead)
  and (Node.Parent<>nil) and (Node.Parent.Desc=ctnProcedure) then
    Node:=Node.Parent;

  // add space behind node to scan range
  NextNode:=Node.Next;
  if NextNode<>nil then
    EndPos:=NextNode.StartPos
  else
    EndPos:=Node.EndPos;

  // scan range for comments
  if not Scan(Node.StartPos,EndPos) then exit;

  if Node.Desc in AllIdentifierDefinitions then begin
    // scan behind type
    // for example:   i: integer; // comment
    TypeNode:=FindTypeNodeOfDefinition(Node);
    if TypeNode<>nil then begin
      NextNode:=TypeNode.Next;
      if NextNode<>nil then
        EndPos:=NextNode.StartPos
      else
        EndPos:=Node.EndPos;
      if not Scan(TypeNode.EndPos,EndPos) then exit;
    end;
  end;
  Result:=true;
end;

procedure TPascalReaderTool.CalcMemSize(Stats: TCTMemStats);
begin
  inherited CalcMemSize(Stats);
  Stats.Add('TPascalReaderTool',MemSizeString(CachedSourceName));
end;

end.