{
 ***************************************************************************
 *                                                                         *
 *   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:=ProcNo…