{
 ***************************************************************************
 *                                                                         *
 *   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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 *                                                                         *
 ***************************************************************************

  Author: Mattias Gaertner

  Abstract:
    TCustomCodeTool is the ancestor class for code tools which parses code
    beginning with the Main Source code. It can parse atoms, the smallest code
    elements in source code, create new code tree nodes and provides several
    useful functions for parsing and changing code.

}
unit CustomCodeTool;

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

interface

{$I codetools.inc}

{ $DEFINE ShowIgnoreError}
{ $DEFINE VerboseUpdateNeeded}

uses
  {$IFDEF MEM_CHECK}
  MemCheck,
  {$ENDIF}
  Classes, SysUtils, Laz_AVL_Tree,
  // Codetools
  FileProcs, CodeToolsStrConsts, CodeTree, CodeAtom,
  KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache,
  // LazUtils
  LazFileUtils, LazUtilities, LazDbgLog;

type
  TCodeToolPhase = (
    ctpNone,
    ctpScan,
    ctpParse,
    ctpTool
    );

  TCustomCodeTool = class;


  // types for errors

  { ECodeToolError }

  ECodeToolError = class(Exception)
    Sender: TCustomCodeTool;
    Id: int64;
    constructor Create(ASender: TCustomCodeTool; TheId: int64; const AMessage: string);
  end;
  
  ECodeToolErrors = class of ECodeToolError;
  
  { ECodeToolFileNotFound }

  ECodeToolFileNotFound = class(ECodeToolError)
    Filename: string;
    constructor Create(ASender: TCustomCodeTool; TheId: int64;
      const AMessage, AFilename: string);
  end;
  
  
  // types for user aborts
  TOnParserProgress = function(Tool: TCustomCodeTool): boolean of object;
  TCodeTreeChangeEvent = procedure(Tool: TCustomCodeTool;
                                   NodesDeleting: boolean) of object;
  TGetChangeStepEvent = procedure(out ChangeStep: integer) of object;

  EParserAbort = class(ECodeToolError)
  end;

  { TCodeTreeNodeParseError }

  TCodeTreeNodeParseError = class
  public
    Node: TCodeTreeNode;
    CleanPos: integer;
    NicePos: TCodeXYPosition;
    Msg: string;
    constructor Create(ANode: TCodeTreeNode);
  end;
  
  { TCustomCodeTool }

  TCustomCodeTool = class(TObject)
  private
    FLastProgressPos: integer;
    FNodesDeletedChangeStep: integer;
    FOnParserProgress: TOnParserProgress;
    FOnSetGlobalWriteLock: TOnSetWriteLock;
    FScanner: TLinkScanner;
    FOnTreeChange: TCodeTreeChangeEvent;
    FTreeChangeStep: integer;
    FNodeParseErrors: TAVLTree; // tree of TCodeTreeNodeParseError
  protected
    FLastScannerChangeStep: integer;
    FIgnoreErrorAfter: TCodePosition;
    KeyWordFuncList: TKeyWordFunctionList;
    WordIsKeyWordFuncList: TKeyWordFunctionList;
    FRangeValidTill: TLinkScannerRange; // if there was an error, it excludes the last section
    function DefaultKeyWordFunc: boolean;
    procedure BuildDefaultKeyWordFunctions; virtual;
    procedure SetScanner(NewScanner: TLinkScanner); virtual;
    procedure DoDeleteNodes(StartNode: TCodeTreeNode); virtual;
    procedure CloseUnfinishedNodes;
    procedure SaveRaiseIdentExpectedButAtomFound(id: int64);
    procedure SaveRaiseBracketOpenExpectedButAtomFound(id: int64);
    procedure SaveRaiseBracketCloseExpectedButAtomFound(id: int64);
    procedure RaiseUndoImpossible(id: int64);
    procedure SetIgnoreErrorAfter(const AValue: TCodePosition); virtual;
    procedure IncreaseTreeChangeStep(NodesDeleting: boolean);
  protected
    LastErrorMessage: string;
    LastErrorCurPos: TAtomPosition;
    LastErrorValid: boolean;
    LastErrorBehindIgnorePosition: boolean;
    LastErrorCheckedForIgnored: boolean;
    LastErrorNicePosition: TCodeXYPosition;
    LastErrorId: int64;
    procedure ClearLastError;
    procedure RaiseLastError;
    procedure DoProgress; inline;
    procedure NotifyAboutProgress;
    procedure FetchScannerSource; virtual;
    function InternalAtomIsIdentifier: boolean; inline;
  public
    Tree: TCodeTree;

    // current Values, Position, Node ...
    CurPos: TAtomPosition;
    Src: string;
    SrcLen: integer;
    CurNode: TCodeTreeNode;
    LastAtoms: TAtomRing;

    CheckFilesOnDisk: boolean;
    IndentSize: integer;
    VisibleEditorLines: integer;
    JumpSingleLinePos: integer; // in percent 0..100
    JumpCodeBlockPos: integer; // in percent 0..100
    CursorBeyondEOL: boolean;
    
    ErrorPosition: TCodeXYPosition;
    ErrorNicePosition: TCodeXYPosition;// if NiceErrorPosition is set, then it is in front of ErrorPosition

    property Scanner: TLinkScanner read FScanner write SetScanner;
    function MainFilename: string;
    property TreeChangeStep: integer read FTreeChangeStep;
    property NodesDeletedChangeStep: integer read FNodesDeletedChangeStep;
    property OnTreeChange: TCodeTreeChangeEvent read FOnTreeChange
                                                write FOnTreeChange;
    
    function FindDeepestNodeAtPos(P: integer;
      ExceptionOnNotFound: boolean): TCodeTreeNode; {$IFDEF UseInline}inline;{$ENDIF}
    function FindDeepestNodeAtPos(StartNode: TCodeTreeNode; P: integer;
      ExceptionOnNotFound: boolean): TCodeTreeNode;
    function CaretToCleanPos(const Caret: TCodeXYPosition;
        out CleanPos: integer): integer;  // 0=valid CleanPos
                          //-1=CursorPos was skipped, CleanPos between two links
                          // 1=CursorPos beyond scanned code
                          //-2=X,Y beyond source
    function CodePosToCleanPos(const CodePos: TCodePosition;
        out CleanPos: integer): integer;  // 0=valid CleanPos
                          //-1=CursorPos was skipped, CleanPos between two links
                          // 1=CursorPos beyond scanned code
    function CleanPosToCodePos(CleanPos: integer;
        out CodePos:TCodePosition): boolean; // true=ok, false=invalid CleanPos
    function CleanPosToCaret(CleanPos: integer;
        out Caret:TCodeXYPosition): boolean; // true=ok, false=invalid CleanPos
    function CleanPosToCaretAndTopLine(CleanPos: integer;
        out Caret:TCodeXYPosition; out NewTopLine: integer): boolean; // true=ok, false=invalid CleanPos
    function CleanPosToStr(CleanPos: integer; WithFilename: boolean = false): string;
    function CodeXYToStr(const CodePos: TCodeXYPosition; WithFilename: boolean = false): string;
    function CleanPosToRelativeStr(CleanPos: integer;
        const BaseFilename: string): string;
    procedure GetCleanPosInfo(CodePosInFront, CleanPos: integer;
        ResolveComments: boolean; out SameArea: TAtomPosition);
    procedure GetLineInfo(ACleanPos: integer;
        out ALineStart, ALineEnd, AFirstAtomStart, ALastAtomEnd: integer);
    function FindLineEndOrCodeAfterPosition(StartPos: integer;
        SkipEmptyLines: boolean = false; IncludeLineEnd: boolean = false): integer;
    function FindLineEndOrCodeInFrontOfPosition(StartPos: integer;
        StopAtDirectives: boolean = true; SkipEmptyLines: boolean = false): integer;
    function SkipResourceDirective(StartPos: integer): integer;

    function UpdateNeeded(Range: TLinkScannerRange): boolean;
    procedure BeginParsing(Range: TLinkScannerRange); virtual;
    procedure BeginParsingAndGetCleanPos(
        Range: TLinkScannerRange; CursorPos: TCodeXYPosition;
        out CleanCursorPos: integer);

    function StringIsKeyWord(const Word: string): boolean;
    
    // cursor moving
    procedure MoveCursorToNodeStart(ANode: TCodeTreeNode); {$IFDEF UseInline}inline;{$ENDIF}
    procedure MoveCursorToCleanPos(ACleanPos: integer);
    procedure MoveCursorToCleanPos(ACleanPos: PChar);
    procedure MoveCursorToAtomPos(const AnAtomPos: TAtomPosition);
    procedure MoveCursorToNearestAtom(ACleanPos: integer);
    procedure MoveCursorToLastNodeAtom(ANode: TCodeTreeNode);
    function IsPCharInSrc(ACleanPos: PChar): boolean;

    // read atoms
    procedure ReadNextAtom;
    procedure UndoReadNextAtom;
    procedure ReadPriorAtom;
    procedure ReadPriorAtomSafe(CleanPos: integer);
    procedure ReadAsStringConstant; // start at CurPos.StartPos

    // read blocks
    function ReadTilBracketClose(ExceptionOnNotFound: boolean): boolean;
    function ReadBackTilBracketOpen(ExceptionOnNotFound: boolean): boolean;
    procedure ReadTillCommentEnd;
    
    // read atoms
    function AtomIs(const AnAtom: shortstring): boolean; // case sensitive
    function UpAtomIs(const AnAtom: shortstring): boolean; // compare to uppercase
    function UpAtomIs(const AtomPos: TAtomPosition; const AnAtom: shortstring): boolean; overload;
    function ReadNextAtomIs(const AnAtom: shortstring): boolean; {$IFDEF UseInline}inline;{$ENDIF}
    function ReadNextAtomIsIdentifier(Identifier: PChar): boolean; {$IFDEF UseInline}inline;{$ENDIF}
    function ReadNextUpAtomIs(const AnAtom: shortstring): boolean; {$IFDEF UseInline}inline;{$ENDIF}
    function ReadNextAtomIsChar(const c: char): boolean; {$IFDEF UseInline}inline;{$ENDIF}
    function AtomIsChar(const c: char): boolean; {$IFDEF UseInline}inline;{$ENDIF}
    function AtomIsKeyWord: boolean;
    function AtomIsNumber: boolean; {$IFDEF UseInline}inline;{$ENDIF}
    function AtomIsRealNumber: boolean;
    function AtomIsStringConstant: boolean; {$IFDEF UseInline}inline;{$ENDIF}
    function AtomIsCharConstant: boolean;
    function AtomIsEmptyStringConstant: boolean;
    function AtomIsIdentifier(Identifier: PChar): boolean;
    function AtomIsIdentifier: boolean;
    procedure AtomIsIdentifierE; overload;
    function AtomIsIdentifierE(ExceptionOnNotFound: boolean): boolean; overload;
    procedure AtomIsIdentifierSaveE(id: int64);
    function AtomIsCustomOperator(AllowIdentifier, ExceptionOnNotFound, SaveE: boolean): boolean;
    function LastAtomIs(BackIndex: integer;
        const AnAtom: shortstring): boolean; // 0=current, 1=prior current, ...
    function LastUpAtomIs(BackIndex: integer;
        const AnAtom: shortstring): boolean; // 0=current, 1=prior current, ...
    function GetAtom: string;
    function GetUpAtom: string;
    function GetAtom(const Atom: TAtomPosition): string;
    function GetUpAtom(const Atom: TAtomPosition): string;
    function FreeUpAtomIs(const FreeAtomPos: TAtomPosition;
        const AnAtom: shortstring): boolean;
    
    // identifiers
    function CompareNodeIdentChars(ANode: TCodeTreeNode;
        const AnUpperIdent: string): integer;
    function CompareSrcIdentifiers(
      CleanStartPos1, CleanStartPos2: integer): boolean;
    function CompareSrcIdentifiers(Identifier1, Identifier2: PChar): boolean;
    function CompareSrcIdentifiers(CleanStartPos: integer;
      AnIdentifier: PChar): boolean;
    function CompareSrcIdentifiersMethod(Identifier1, Identifier2: Pointer): integer;
    function ExtractIdentifier(CleanStartPos: integer): string;
    function ExtractDottedIdentifier(CleanStartPos: integer): string;

    procedure CreateChildNode;
    procedure EndChildNode; {$IFDEF UseInline}inline;{$ENDIF}
    function DoAtom: boolean; virtual;

    // write lock
    procedure ActivateGlobalWriteLock; virtual;
    procedure DeactivateGlobalWriteLock; virtual;
    property OnSetGlobalWriteLock: TOnSetWriteLock
      read FOnSetGlobalWriteLock write FOnSetGlobalWriteLock;
      
    // error handling
    procedure RaiseExceptionInstance(TheException: ECodeToolError;
      ClearNicePos: boolean = true); virtual;
    procedure RaiseExceptionClass(id: int64; const AMessage: string;
      ExceptionClass: ECodeToolErrors; ClearNicePos: boolean); virtual;
    procedure RaiseException(id: int64; const AMessage: string;
      ClearNicePos: boolean = true); virtual;
    procedure RaiseExceptionFmt(id: int64; const AMessage: string;
      const args: array of const; ClearNicePos: boolean = true);
    procedure RaiseExceptionAtCleanPos(id: int64; const AMessage: string;
      CleanPos: integer); virtual;
    procedure RaiseExceptionAtErrorPos(id: int64; const AMessage: string;
      ClearNicePos: boolean = true); virtual; // set ErrorPosition before calling this
    // permanent errors, that the parser will raise again
    procedure SaveRaiseException(id: int64; const AMessage: string;
      ClearNicePos: boolean = true); virtual;
    procedure SaveRaiseExceptionFmt(id: int64; const AMessage: string;
      const args: array of const; ClearNicePos: boolean = true);
    procedure SetNiceErrorPos(CleanPos: integer);
    property IgnoreErrorAfter: TCodePosition
      read FIgnoreErrorAfter write SetIgnoreErrorAfter;
    procedure ClearIgnoreErrorAfter;
    function IgnoreErrorAfterPositionIsInFrontOfLastErrMessage: boolean;
    function IgnoreErrorAfterValid: boolean;
    function IgnoreErrorAfterCleanedPos: integer;
    function CleanPosIsAfterIgnorePos(CleanPos: integer): boolean;
    function LastErrorIsInFrontOfCleanedPos(ACleanedPos: integer): boolean;
    procedure RaiseLastErrorIfInFrontOfCleanedPos(ACleanedPos: integer);
    function GetNodeParserError(Node: TCodeTreeNode): TCodeTreeNodeParseError;
    function SetNodeParserError(Node: TCodeTreeNode; const ErrorMsg: string;
      const ErrorCleanPos: integer;
      const ErrorNiceCleanPos: TCodeXYPosition
      ): TCodeTreeNodeParseError;
    procedure RaiseNodeParserError(Node: TCodeTreeNode);
    procedure RaiseCursorOutsideCode(CursorPos: TCodeXYPosition);
    property OnParserProgress: TOnParserProgress
      read FOnParserProgress write FOnParserProgress;

    // debugging
    procedure Clear; virtual;
    function NodeDescToStr(Desc: integer): string;
    function NodeSubDescToStr(Desc, SubDesc: integer): string;
    procedure ConsistencyCheck; virtual;
    procedure WriteDebugTreeReport;
    procedure CalcMemSize(Stats: TCTMemStats); virtual;
    procedure CheckNodeTool(Node: TCodeTreeNode);
    constructor Create;
    destructor Destroy; override;
  end;
  
var
  RaiseUnhandableExceptions: boolean;

function CompareCodeTreeNodeParserError(Error1, Error2: Pointer): integer;
function CompareNodeWithCodeTreeNodeParserError(Node, Error: Pointer): integer;

implementation

function CompareCodeTreeNodeParserError(Error1, Error2: Pointer): integer;
var
  AnError1: TCodeTreeNodeParseError absolute Error1;
  AnError2: TCodeTreeNodeParseError absolute Error2;
begin
  Result:=ComparePointers(AnError1.Node,AnError2.Node);
end;

function CompareNodeWithCodeTreeNodeParserError(Node, Error: Pointer): integer;
var
  AnError: TCodeTreeNodeParseError absolute Error;
begin
  Result:=ComparePointers(Node,AnError.Node);
end;

{ TCustomCodeTool }

constructor TCustomCodeTool.Create;
begin
  inherited Create;
  Tree:=TCodeTree.Create;
  KeyWordFuncList:=TKeyWordFunctionList.Create('TCustomCodeTool.KeyWordFuncList');
  BuildDefaultKeyWordFunctions;
  WordIsKeyWordFuncList:=WordIsKeyWord;
  LastAtoms:=TAtomRing.Create;
  IndentSize:=2;
  VisibleEditorLines:=20;
  CursorBeyondEOL:=true;
  Clear;
end;

destructor TCustomCodeTool.Destroy;
begin
  Clear;
  FreeAndNil(LastAtoms);
  FreeAndNil(Tree);
  FreeAndNil(KeyWordFuncList);
  inherited Destroy;
end;

procedure TCustomCodeTool.Clear;
begin
  if Tree<>nil then DoDeleteNodes(Tree.Root);
  CurPos:=StartAtomPosition;
  LastAtoms.Clear;
  ClearLastError;
end;

procedure TCustomCodeTool.RaiseException(id: int64; const AMessage: string;
  ClearNicePos: boolean);
begin
  RaiseExceptionClass(id,AMessage,ECodeToolError,ClearNicePos);
end;

procedure TCustomCodeTool.RaiseExceptionFmt(id: int64; const AMessage: string;
  const args: array of const; ClearNicePos: boolean);
begin
  RaiseException(id,Format(AMessage,args),ClearNicePos);
end;

procedure TCustomCodeTool.RaiseExceptionAtCleanPos(id: int64;
  const AMessage: string; CleanPos: integer);
begin
  MoveCursorToCleanPos(CleanPos);
  RaiseException(id,AMessage);
end;

procedure TCustomCodeTool.RaiseExceptionAtErrorPos(id: int64;
  const AMessage: string; ClearNicePos: boolean);
begin
  if ClearNicePos then
    ErrorNicePosition:=CleanCodeXYPosition;
  // raise the exception
  if not RaiseUnhandableExceptions then
    raise ECodeToolError.Create(Self,id,AMessage)
  else
    RaiseCatchableException('['+IntToStr(id)+'] '+AMessage);
end;

procedure TCustomCodeTool.SaveRaiseException(id: int64; const AMessage: string;
  ClearNicePos: boolean);
var
  Node: TCodeTreeNode;
begin
  LastErrorMessage:=AMessage;
  LastErrorCurPos:=CurPos;
  LastErrorValid:=true;
  LastErrorId:=id;
  if ClearNicePos then begin
    LastErrorNicePosition.Code:=nil;
    LastErrorNicePosition.Y:=-1;
  end else begin
    LastErrorNicePosition:=ErrorNicePosition;
  end;

  Node:=CurNode;
  while (Node<>nil) do begin
    if (ctnsNeedJITParsing and Node.SubDesc)>0 then begin
      SetNodeParserError(Node,AMessage,CurPos.StartPos,
                         ErrorNicePosition);
      break;
    end;
    Node:=Node.Parent;
  end;

  RaiseException(id,AMessage,ClearNicePos);
end;

procedure TCustomCodeTool.SaveRaiseExceptionFmt(id: int64;
  const AMessage: string; const args: array of const; ClearNicePos: boolean);
begin
  SaveRaiseException(id,Format(AMessage,args),ClearNicePos);
end;

procedure TCustomCodeTool.SetNiceErrorPos(CleanPos: integer);
var
  CaretXY: TCodeXYPosition;
begin
  // convert cleanpos to caret pos, which is more human readable
  if (CleanPos>SrcLen) and (SrcLen>0) then CleanPos:=SrcLen;
  if (CleanPosToCaret(CleanPos,CaretXY))
  and (CaretXY.Code<>nil) then begin
    ErrorNicePosition:=CaretXY;
  end else if (Scanner<>nil) and (Scanner.MainCode<>nil) then begin
    ErrorNicePosition.Code:=TCodeBuffer(Scanner.MainCode);
    ErrorNicePosition.Y:=-1;
  end else begin
    ErrorNicePosition.Code:=nil;
    ErrorNicePosition.Y:=-1;
  end;
end;

procedure TCustomCodeTool.ClearLastError;
begin
  LastErrorValid:=false;
  LastErrorCheckedForIgnored:=false;
  LastErrorNicePosition.Code:=nil;
  ErrorNicePosition.Code:=nil;
end;

procedure TCustomCodeTool.RaiseLastError;
begin
  MoveCursorToCleanPos(LastErrorCurPos.StartPos);
  CurPos:=LastErrorCurPos;
  ErrorNicePosition:=LastErrorNicePosition;
  SaveRaiseException(LastErrorId,LastErrorMessage,false);
end;

procedure TCustomCodeTool.DoProgress;
begin
  // Check every 1.000.000 chars
  if (FLastProgressPos-CurPos.StartPos)<1000000 then exit;
  NotifyAboutProgress;
end;

procedure TCustomCodeTool.NotifyAboutProgress;
begin
  FLastProgressPos:=CurPos.StartPos;

  if Assigned(OnParserProgress) then begin
    if OnParserProgress(Self) then exit;
    // raise the abort exception to stop the parsing
    RaiseExceptionClass(20170421194502,'Abort',EParserAbort,true);
  end;
end;

procedure TCustomCodeTool.FetchScannerSource;
begin
  // update scanned code
  if FLastScannerChangeStep=Scanner.ChangeStep then begin
    if LastErrorValid then
      RaiseLastError;
  end else begin
    // code has changed
    FLastScannerChangeStep:=Scanner.ChangeStep;
    ClearLastError;
    Src:=Scanner.CleanedSrc;
    SrcLen:=length(Src);
    LastAtoms.SrcLen:=SrcLen;
    {$IFDEF VerboseUpdateNeeded}
    DebugLn(['TCustomCodeTool.BeginParsing ',MainFilename]);
    {$ENDIF}
    FRangeValidTill:=lsrInit;
  end;

  // delete nodes
  if Tree<>nil then
    DoDeleteNodes(Tree.Root);
end;

function TCustomCodeTool.InternalAtomIsIdentifier: boolean;
var
  p: PChar;
begin
  if (CurPos.StartPos<=SrcLen) then begin
    p:=@Src[CurPos.StartPos];
    if IsIdentStartChar[p^] then begin
      if not WordIsKeyWordFuncList.DoIdentifier(p) then
        exit(true);
    end else if (p^='&') and (IsIdentChar[p[1]]) then begin
      exit(true);
    end;
  end;
  Result:=false;
end;

procedure TCustomCodeTool.RaiseUndoImpossible(id: int64);
begin
  RaiseException(id,'TCustomCodeTool.UndoReadNextAtom impossible',true);
end;

procedure TCustomCodeTool.SetScanner(NewScanner: TLinkScanner);
begin
  if NewScanner=FScanner then exit;
  LastErrorCheckedForIgnored:=false;
  Clear;
  FScanner:=NewScanner;
  if Scanner<>nil then begin
    FLastScannerChangeStep:=Scanner.ChangeStep;
    Scanner.SetIgnoreErrorAfter(IgnoreErrorAfter.P,IgnoreErrorAfter.Code);
  end;
  {$IFDEF VerboseUpdateNeeded}
  DebugLn(['TCustomCodeTool.SetScanner ',MainFilename]);
  {$ENDIF}
  FRangeValidTill:=lsrNone;
end;

function TCustomCodeTool.NodeDescToStr(Desc: integer): string;
begin
  Result:=NodeDescriptionAsString(TCodeTreeNodeDesc(Desc));
end;

function TCustomCodeTool.NodeSubDescToStr(Desc, SubDesc: integer): string;
begin
  if SubDesc<>0 then
    Result:=Format(ctsUnknownSubDescriptor,[IntToStr(SubDesc)])
  else
    Result:='';
  case Desc of
  ctnProcedure:
    begin
      if (SubDesc and ctnsForwardDeclaration)>0 then Result:=ctsForward;
    end;
  ctnProcedureHead, ctnBeginBlock:
    begin
      if (SubDesc and ctnsNeedJITParsing)>0 then Result:=ctsUnparsed;
    end;
  ctnClass,ctnObject,ctnRecordType,ctnObjCClass,ctnObjCCategory,ctnObjCProtocol,
  ctnCPPClass,ctnClassInterface,ctnDispinterface,
  ctnTypeHelper,ctnRecordHelper,ctnClassHelper:
    begin
      Result:='';
      if (SubDesc and ctnsForwardDeclaration)>0 then Result:=ctsForward;
      if (SubDesc and ctnsNeedJITParsing)>0 then Result:=Result+ctsUnparsed;
    end;
  end;
  if (SubDesc and ctnsHasParseError)>0 then Result:=Result+','+ctsHasError;
end;

function TCustomCodeTool.AtomIs(const AnAtom: shortstring): boolean;
var AnAtomLen,i : integer;
begin
  Result:=false;
  if (CurPos.StartPos<=SrcLen) and (CurPos.EndPos<=SrcLen+1)
  and (CurPos.StartPos>=1) then begin
    AnAtomLen:=length(AnAtom);
    if AnAtomLen=CurPos.EndPos-CurPos.StartPos then begin
      for i:=1 to AnAtomLen do
        if AnAtom[i]<>Src[CurPos.StartPos-1+i] then exit;
      Result:=true;
    end;
  end;
end;

function TCustomCodeTool.UpAtomIs(const AnAtom: shortstring): boolean;
var
  AnAtomLen, i: integer;
  p: PChar;
begin
  Result:=false;
  AnAtomLen:=length(AnAtom);
  if AnAtomLen<>CurPos.EndPos-CurPos.StartPos then exit;
  if (CurPos.EndPos<=SrcLen+1) and (CurPos.StartPos>=1) then begin
    p:=@Src[CurPos.StartPos];
    for i:=1 to AnAtomLen do begin
      if AnAtom[i]<>UpChars[p^] then exit;
      inc(p);
    end;
    Result:=true;
  end;
end;

function TCustomCodeTool.UpAtomIs(const AtomPos: TAtomPosition;
  const AnAtom: shortstring): boolean;
var
  AnAtomLen, i: integer;
  p: PChar;
begin
  Result:=false;
  AnAtomLen:=length(AnAtom);
  if AnAtomLen<>AtomPos.EndPos-AtomPos.StartPos then exit;
  if (AtomPos.EndPos<=SrcLen+1) and (AtomPos.StartPos>=1) then begin
    p:=@Src[AtomPos.StartPos];
    for i:=1 to AnAtomLen do begin
      if AnAtom[i]<>UpChars[p^] then exit;
      inc(p);
    end;
    Result:=true;
  end;
end;

function TCustomCodeTool.AtomIsIdentifier(Identifier: PChar): boolean;
begin
  Result:=(CurPos.StartPos<=SrcLen)
      and (CompareIdentifiers(Identifier,@Src[CurPos.StartPos])=0);
end;

function TCustomCodeTool.ReadNextAtomIs(const AnAtom: shortstring): boolean;
begin
  ReadNextAtom;
  Result:=AtomIs(AnAtom);
end;

function TCustomCodeTool.ReadNextAtomIsIdentifier(Identifier: PChar): boolean;
begin
  ReadNextAtom;
  Result:=AtomIsIdentifier(Identifier);
end;

function TCustomCodeTool.ReadNextAtomIsChar(const c: char): boolean;
begin
  ReadNextAtom;
  Result:=AtomIsChar(c);
end;

function TCustomCodeTool.ReadNextUpAtomIs(const AnAtom: shortstring): boolean;
begin
  ReadNextAtom;
  Result:=UpAtomIs(AnAtom);
end;

function TCustomCodeTool.CompareNodeIdentChars(ANode: TCodeTreeNode;
  const AnUpperIdent: string): integer;
var
  AnIdentLen, i, NodeSrcLen, MinLen: integer;
  p: PChar;
begin
  {$IFDEF CheckNodeTool}CheckNodeTool(ANode);{$ENDIF}
  if (ANode.StartPos<=SrcLen) and (ANode.EndPos<=SrcLen+1)
  and (ANode.StartPos>=1) then begin
    AnIdentLen:=length(AnUpperIdent);
    NodeSrcLen:=ANode.EndPos-ANode.StartPos;
    if AnIdentLen<NodeSrcLen then
      MinLen:=AnIdentLen
    else
      MinLen:=NodeSrcLen;
    i:=1;
    p:=@Src[ANode.StartPos];
    while (i<=MinLen) and (IsIdentChar[p^]) do begin
      if AnUpperIdent[i]<>UpChars[p^] then begin
        // identifiers different in one letter
        if UpChars[p^]>AnUpperIdent[i] then
          Result:=-1
        else
          Result:=1;
        exit;
      end;
      inc(i);
      inc(p);
    end;
    if (i>MinLen) and (i>AnIdentLen) then begin
      // node is longer than AnUpperIdent
      if (i>NodeSrcLen) or (not IsIdentChar[p^]) then
        // node identifier is equal to AnUpperIdent
        Result:=0
      else
        // node Identifier is longer than AnUpperIdent
        Result:=-1;
    end else
      // node identifier is shorter than AnUpperIdent
      Result:=1
  end else
    Result:=1;
end;

function TCustomCodeTool.CompareSrcIdentifiers(
  CleanStartPos1, CleanStartPos2: integer): boolean;
var
  p1: PChar;
  p2: PChar;
begin
  if (CleanStartPos1<1) or (CleanStartPos1>SrcLen)
     or (CleanStartPos2<1) or (CleanStartPos2>SrcLen)
  then
    exit(false);
  p1:=@Src[CleanStartPos1];
  p2:=@Src[CleanStartPos2];
  while IsIdentChar[p1^] do begin
    if (UpChars[p1^]<>UpChars[p2^]) then
      exit(false);
    inc(CleanStartPos1);
    inc(p1);
    inc(p2);
  end;
  Result:=(not IsIdentChar[p2^]);
end;

function TCustomCodeTool.AtomIsChar(const c: char): boolean;
begin
  Result:=(CurPos.StartPos<=SrcLen)
      and (CurPos.EndPos-CurPos.StartPos=1)
      and (Src[CurPos.StartPos]=c);
end;

function TCustomCodeTool.AtomIsKeyWord: boolean;
begin
  Result:=(CurPos.StartPos<=SrcLen)
      and (IsIdentStartChar[Src[CurPos.StartPos]])
      and (WordIsKeyWordFuncList.DoItCaseInsensitive(Src,CurPos.StartPos,
             CurPos.EndPos-CurPos.StartPos));
end;

function TCustomCodeTool.AtomIsIdentifier:boolean;
begin
  Result:=InternalAtomIsIdentifier;
end;

procedure TCustomCodeTool.AtomIsIdentifierE;

  procedure RaiseEOFFound;
  begin
    RaiseExceptionFmt(20170421194604,ctsIdentExpectedButEOFFound,[GetAtom],true);
  end;

  procedure RaiseAtomFound;
  begin
    RaiseExceptionFmt(20170421194607,ctsIdentExpectedButAtomFound,[GetAtom],true);
  end;

begin
  if InternalAtomIsIdentifier then exit;
  if CurPos.StartPos>SrcLen then
    RaiseEOFFound
  else
    RaiseAtomFound;
end;

function TCustomCodeTool.AtomIsIdentifierE(ExceptionOnNotFound: boolean): boolean;
begin
  if InternalAtomIsIdentifier then exit(true);
  Result:=false;
  if not ExceptionOnNotFound then exit;
  AtomIsIdentifierE();
end;

procedure TCustomCodeTool.AtomIsIdentifierSaveE(id: int64);

  procedure SaveRaiseIdentExpectedButEOFFound;
  begin
    SaveRaiseExceptionFmt(id,ctsIdentExpectedButEOFFound,[GetAtom]);
  end;

begin
  if InternalAtomIsIdentifier then exit;
  if CurPos.StartPos>SrcLen then
    SaveRaiseIdentExpectedButEOFFound
  else
    SaveRaiseIdentExpectedButAtomFound(id);
end;

function TCustomCodeTool.AtomIsCustomOperator(AllowIdentifier,
  ExceptionOnNotFound, SaveE: boolean): boolean;

  procedure RaiseOperatorExpected;
  begin
    if CurPos.StartPos>SrcLen then begin
      if SaveE then
        SaveRaiseException(20170421194635,ctsOperatorExpectedButEOFFound)
      else
        RaiseException(20170421194649,ctsOperatorExpectedButEOFFound)
    end else begin
      if SaveE then
        SaveRaiseExceptionFmt(20170421194701,ctsOperatorExpectedButAtomFound,[GetAtom])
      else
        RaiseExceptionFmt(20170421194704,ctsOperatorExpectedButAtomFound,[GetAtom])
    end;
  end;

begin
  Result:=false;
  if (CurPos.StartPos<=SrcLen) then begin
    if WordIsCustomOperator.DoItCaseInsensitive(
      Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
    or AllowIdentifier and AtomIsIdentifier then
      exit(true);
  end;
  if not ExceptionOnNotFound then
    exit(false);
  RaiseOperatorExpected;
end;

function TCustomCodeTool.AtomIsNumber: boolean;
var
  p: PChar;
begin
  if CurPos.StartPos>SrcLen then exit(false);
  p:=@Src[CurPos.StartPos];
  if p^ in ['0'..'9','%','$'] then exit(true);
  if (p^='&') and IsOctNumberChar[p[1]] then exit(true);
  Result:=false;
end;

function TCustomCodeTool.AtomIsRealNumber: boolean;
var i: integer;
begin
  Result:=false;
  i:=CurPos.StartPos;
  if (i<=SrcLen) and (IsNumberChar[Src[i]]) then begin
    while (i<=SrcLen) and (IsNumberChar[Src[i]]) do
      inc(i);
    if (i<SrcLen) and (Src[i]='.') and (IsNumberChar[Src[i+1]]) then
      Result:=true;
  end;
end;

function TCustomCodeTool.AtomIsStringConstant: boolean;
var
  p: PChar;
begin
  if (CurPos.StartPos<1) or (CurPos.StartPos>SrcLen) then exit(false);
  p:=@Src[CurPos.StartPos];
  Result:=(p^ in ['''','#']) or ((p^='^') and (p[1] in ['A'..'Z']));
end;

function TCustomCodeTool.AtomIsCharConstant: boolean;
var
  p: PChar;
begin
  Result:=false;
  if (CurPos.StartPos<=SrcLen) then begin
    p:=@Src[CurPos.StartPos];
    case p^ of
    
    '#':
      begin
        inc(p);
        if IsNumberChar[p^] then begin
          // decimal
          while IsNumberChar[p^] do
            inc(p);
        end else if p^='$' then begin
          // hexadecimal
          Inc(p);
          while IsHexNumberChar[p^] do
            inc(p);
        end;
      end;

    '''':
      begin
        inc(p);
        if p^='''' then begin
          // could be ''''
          if (p[1]<>'''') or (p[2]<>'''') then exit;
          inc(p,3);
        end else begin
          // could be 'a'
          if p[1]<>'''' then exit;
          inc(p,2);
        end;
      end;

    '^':
      begin
        if not (p[1] in ['A'..'Z']) then exit;
        inc(p,2);
      end;

    end;
    // check that no second character is following
    Result:=not (p^ in ['''','#','^']);
  end;
end;

function TCustomCodeTool.AtomIsEmptyStringConstant: boolean;
var
  p: LongInt;
begin
  p:=CurPos.StartPos;
  while (p<=SrcLen) and (Src[p]='''') do inc(p);
  dec(p,CurPos.StartPos);
  Result:=(p>0) and ((p and 1)=0);
end;

function TCustomCodeTool.LastAtomIs(BackIndex: integer;
  const AnAtom: shortstring): boolean;
var ap: TAtomPosition;
  AnAtomLen: integer;
  i: integer;
begin
  ap:=LastAtoms.GetAtomAt(-BackIndex);
  if ap.StartPos>=ap.EndPos then exit(false);
  if (ap.EndPos<=SrcLen+1) then begin
    AnAtomLen:=length(AnAtom);
    if AnAtomLen<>ap.EndPos-ap.StartPos then exit(false);
    for i:=1 to AnAtomLen do
      if AnAtom[i]<>Src[ap.StartPos-1+i] then exit(false);
    exit(true);
  end;
  Result:=false;
end;

function TCustomCodeTool.LastUpAtomIs(BackIndex: integer;
  const AnAtom: shortstring): boolean;
var ap: TAtomPosition;
  AnAtomLen: integer;
  i: integer;
  p: PChar;
begin
  ap:=LastAtoms.GetAtomAt(-BackIndex);
  if ap.StartPos>=ap.EndPos then exit(false);
  if (ap.EndPos<=SrcLen+1) then begin
    AnAtomLen:=length(AnAtom);
    if AnAtomLen<>ap.EndPos-ap.StartPos then exit(false);
    p:=@Src[ap.StartPos];
    for i:=1 to AnAtomLen do begin
      if AnAtom[i]<>UpChars[p^] then exit(false);
      inc(p);
    end;
    exit(true);
  end;
  Result:=false;
end;

function TCustomCodeTool.GetAtom: string;
begin
  Result:=copy(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
end;

function TCustomCodeTool.GetUpAtom: string;
begin
  Result:=UpperCaseStr(copy(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos));
end;

function TCustomCodeTool.GetAtom(const Atom: TAtomPosition): string;
begin
  Result:=copy(Src,Atom.StartPos,Atom.EndPos-Atom.StartPos);
end;

function TCustomCodeTool.GetUpAtom(const Atom: TAtomPosition): string;
begin
  Result:=UpperCaseStr(copy(Src,Atom.StartPos,Atom.EndPos-Atom.StartPos));
end;

function TCustomCodeTool.FreeUpAtomIs(const FreeAtomPos: TAtomPosition;
  const AnAtom: shortstring): boolean;
var AnAtomLen,i : integer;
  p: PChar;
begin
  Result:=false;
  if (FreeAtomPos.StartPos>SrcLen) or (FreeAtomPos.EndPos>SrcLen+1)
  or (FreeAtomPos.StartPos<1) then
    exit;
  AnAtomLen:=length(AnAtom);
  if AnAtomLen<>FreeAtomPos.EndPos-FreeAtomPos.StartPos then exit;
  p:=@Src[FreeAtomPos.StartPos];
  for i:=1 to AnAtomLen do begin
    if AnAtom[i]<>UpChars[p^] then exit;
    inc(p);
  end;
  Result:=true;
end;

{$IFOPT R+}{$DEFINE RangeChecking}{$ENDIF}
{$R-}
procedure TCustomCodeTool.ReadNextAtom;
var
  c1, c2: char;
  CommentLvl: integer;
  p: PChar;
begin
  if LastAtoms.HasNext then begin
    //debugln(['TCustomCodeTool.ReadNextAtom HASNEXT ',LastAtoms.NextCount]);
    LastAtoms.MoveToNext(CurPos);
    //debugln(['TCustomCodeTool.ReadNextAtom ',GetAtom,' ',CurPos.StartPos,'-',CurPos.EndPos,' ',SrcLen]);
    exit;
  end;

  CurPos.StartPos:=CurPos.EndPos;
  CurPos.Flag:=cafNone;
  if CurPos.StartPos>SrcLen then begin
    if (not LastAtoms.Empty) and (LastAtoms.GetPriorAtom.StartPos<CurPos.StartPos)
    then
      LastAtoms.Add(CurPos);
    exit;
  end;
  // Skip all spaces and comments
  p:=@Src[CurPos.StartPos];
  while true do begin
    case p^ of
    #0:
      begin
        CurPos.StartPos:=p-PChar(Src)+1;
        if CurPos.StartPos>SrcLen then
          break
        else
          inc(p);
      end;
    #1..#32:
      inc(p);
    #$EF:
      if (p[1]=#$BB)
      and (p[2]=#$BF) then begin
        // skip UTF BOM
        inc(p,3);
      end else begin
        break;
      end;
    '{': // pascal comment
      begin
        inc(p);
        if p^=#3 then begin
          // codetools skip comment {#3 #3}
          repeat
            case p^ of
            #0:
              begin
                CurPos.StartPos:=p-PChar(Src)+1;
                if CurPos.StartPos>SrcLen then break;
              end;
            #3:
              if p[1]='}' then begin
                inc(p,2);
                break;
              end;
            end;
            inc(p);
          until false;
        end else begin
          // pascal comment {}
          CommentLvl:=1;
          while true do begin
            case p^ of
            #0:
              begin
                CurPos.StartPos:=p-PChar(Src)+1;
                if CurPos.StartPos>SrcLen then break;
              end;
            '{':
              if Scanner.NestedComments then
                inc(CommentLvl);
            '}':
              begin
                dec(CommentLvl);
                if CommentLvl=0 then begin
                  inc(p);
                  break;
                end;
              end;
            end;
            inc(p);
          end;
        end;
      end;
    '/':  // Delphi comment
      if p[1]<>'/' then begin
        break;
      end else begin
        inc(p,2);
        while not (p^ in [#10,#13,#0]) do
          inc(p);
      end;
    '(': // old turbo pascal comment
      if p[1]<>'*' then begin
        break;
      end else begin
        inc(p,2);
        CommentLvl:=1;
        while true do begin
          case p^ of
          #0:
            begin
              CurPos.StartPos:=p-PChar(Src)+1;
              if CurPos.StartPos>SrcLen then break;
            end;
          '(':
            if (p[1]='*') and Scanner.NestedComments then begin
              //debugln('TCustomCodeTool.ReadNextAtom ',copy(Src,CurPos.StartPos,CurPos.StartPos-CurPos.EndPos));
              inc(CommentLvl);
              inc(p);
            end;
          '*':
            if p[1]=')' then begin
              dec(CommentLvl);
              if CommentLvl=0 then begin
                inc(p,2);
                break;
              end;
              inc(p);
            end;
          end;
          inc(p);
        end;
      end;
    else
      break;
    end;
  end;
  CurPos.StartPos:=p-PChar(Src)+1;
  CurPos.EndPos:=CurPos.StartPos;
  // read atom
  c1:=p^;
  case c1 of
  #0: ;
  '_','A'..'Z','a'..'z':
    begin
      inc(p);
      while IsIdentChar[p^] do
        inc(p);
      CurPos.Flag:=cafWord;
      CurPos.EndPos:=p-PChar(Src)+1;
      case c1 of
      'e','E':
        if (CurPos.EndPos-CurPos.StartPos=3)
        and (Src[CurPos.StartPos+1] in ['n','N'])
        and (Src[CurPos.StartPos+2] in ['d','D'])
        and ((CurPos.StartPos=1) or (Src[CurPos.StartPos-1]<>'@'))
        then
          CurPos.Flag:=cafEnd;
      end;
    end;
  '''','#':
    begin
      // string constant
      while true do begin
        case p^ of
        '#':
          begin
            inc(p);
            if IsNumberChar[p^] then begin
              // decimal
              repeat
                inc(p);
              until not IsNumberChar[p^];
            end else if p^='$' then begin
              // hexadecimal
              repeat
                inc(p);
              until not IsHexNumberChar[p^];
            end;
          end;
        '''':
          begin
            inc(p);
            while true do begin
              case p^ of
              '''':
                begin
                  inc(p);
                  break;
                end;
              #0,#10,#13:
                break;
              else
                inc(p);
              end;
            end;
          end;
        '^':
          begin
            inc(p);
            if not (p^ in ['A'..'Z']) then break;
            inc(p);
          end;
        else
          break;
        end;
      end;
      CurPos.EndPos:=p-PChar(Src)+1;
    end;
  '0'..'9':
    begin
      inc(p);
      while IsNumberChar[p^] do
        inc(p);
      if (p^='.') and IsAfterFloatPointChar[p[1]] then begin
        // real type number
        inc(p);
        while IsNumberChar[p^] do
          inc(p);
      end;
      if p^ in ['e','E'] then begin
        // read exponent
        inc(p);
        if p^ in ['-','+'] then inc(p);
        while IsNumberChar[p^] do
          inc(p);
      end;
      CurPos.EndPos:=p-PChar(Src)+1;
    end;
  '%': // binary number
    begin
      inc(p);
      while p^ in ['0'..'1'] do
        inc(p);
      CurPos.EndPos:=p-PChar(Src)+1;
    end;
  '&': // octal number or keyword as identifier
    begin
      inc(p);
      if IsOctNumberChar[p^] then begin
        while IsOctNumberChar[p^] do
          inc(p);
      end else if IsIdentStartChar[p^] then begin
        CurPos.Flag:=cafWord;
        while IsIdentChar[p^] do
          inc(p);
      end;
      CurPos.EndPos:=p-PChar(Src)+1;
    end;
  '$': // hex number
    begin
      inc(p);
      while IsHexNumberChar[p^] do
        inc(p);
      CurPos.EndPos:=p-PChar(Src)+1;
    end;
  ';':
    begin
      inc(CurPos.EndPos);
      CurPos.Flag:=cafSemicolon;
    end;
  ',':
    begin
      inc(CurPos.EndPos);
      CurPos.Flag:=cafComma;
    end;
  '=':
    begin
      inc(CurPos.EndPos);
      CurPos.Flag:=cafEqual;
    end;
  '(':
    begin
      inc(CurPos.EndPos);
      CurPos.Flag:=cafRoundBracketOpen;
    end;
  ')':
    begin
      inc(CurPos.EndPos);
      CurPos.Flag:=cafRoundBracketClose;
    end;
  '[':
    begin
      inc(CurPos.EndPos);
      CurPos.Flag:=cafEdgedBracketOpen;
    end;
  ']':
    begin
      inc(CurPos.EndPos);
      CurPos.Flag:=cafEdgedBracketClose;
    end;
  ':':
    begin
      inc(CurPos.EndPos);
      if (Src[CurPos.EndPos]<>'=') then begin
        CurPos.Flag:=cafColon;
      end else begin
        // :=
        inc(CurPos.EndPos);
        CurPos.Flag:=cafAssignment;
      end;
    end;
  '.':
    begin
      inc(CurPos.EndPos);
      if (Src[CurPos.EndPos]<>'.') then begin
        // '.'
        CurPos.Flag:=cafPoint;
      end else begin
        inc(CurPos.EndPos);
        if (Src[CurPos.EndPos]<>'.') then begin
          // '..'
        end else begin
          // '...'
          inc(CurPos.EndPos);
        end;
      end;
    end;
  #192..#255:
    begin
      // read UTF8 character
      inc(p);
      if ((ord(c1) and %11100000) = %11000000) then begin
        // could be 2 byte character
        if (ord(p[0]) and %11000000) = %10000000 then
          inc(p);
      end
      else if ((ord(c1) and %11110000) = %11100000) then begin
        // could be 3 byte character
        if ((ord(p[0]) and %11000000) = %10000000)
        and ((ord(p[1]) and %11000000) = %10000000) then
          inc(p,2);
      end
      else if ((ord(c1) and %11111000) = %11110000) then begin
        // could be 4 byte character
        if ((ord(p[0]) and %11000000) = %10000000)
        and ((ord(p[1]) and %11000000) = %10000000)
        and ((ord(p[2]) and %11000000) = %10000000) then
          inc(p,3);
      end;
      CurPos.EndPos:=p-PChar(Src)+1;
    end;
  else
    inc(CurPos.EndPos);
    c2:=Src[CurPos.EndPos];
    // test for double char operators :=, +=, -=, /=, *=, <>, <=, >=, **, ><
    if ((c2='=') and  (IsEqualOperatorStartChar[c1]))
      or ((c1='<') and (c2='>')) // <> not equal
      or ((c1='>') and (c2='<')) // >< symmetric diff for sets
      or ((c1='.') and (c2='.')) // .. subrange
      or ((c1='*') and (c2='*')) // ** power
      then begin
        // 2 character operator/symbol
        inc(CurPos.EndPos);
    end
    else if ((c1='@') and (c2='@')) then begin
      // @@ label
      repeat
        inc(CurPos.EndPos);
      until (CurPos.EndPos>SrcLen) or (not IsIdentChar[Src[CurPos.EndPos]]);
    end;
  end;
  LastAtoms.Add(CurPos);
end;
{$IFDEF RangeChecking}{$R+}{$UNDEF RangeChecking}{$ENDIF}

procedure TCustomCodeTool.ReadPriorAtom;
var
  CommentLvl, PrePos, OldPrePos: integer;
  IsStringConstant: boolean;

  procedure ReadStringConstantBackward;
  var PrePos: integer;
  begin
    while (CurPos.StartPos>1) do begin
      case Src[CurPos.StartPos-1] of
      '''':
        begin
          dec(CurPos.StartPos);
          repeat
            dec(CurPos.StartPos);
          until (CurPos.StartPos<1) or (Src[CurPos.StartPos] in [#0,#10,#13,'''']);
        end;
      '0'..'9','A'..'Z','a'..'z':
        begin
          // test if char constant
          PrePos:=CurPos.StartPos-1;
          while (PrePos>1) and (IsHexNumberChar[Src[PrePos]]) do
            dec(PrePos);
          if (PrePos<1) then break;
          if (Src[PrePos]='$') then begin
            dec(PrePos);
            if (PrePos<1) then break;
          end;
          if (Src[PrePos]='#') then
            CurPos.StartPos:=PrePos
          else
            break;
        end;
      else
        break;
      end;
    end;
  end;
  
  procedure ReadBackTilCodeLineEnd;
  begin
    dec(CurPos.StartPos);
    if (CurPos.StartPos>=1) and (Src[CurPos.StartPos] in [#10,#13])
    and (Src[CurPos.StartPos+1]<>Src[CurPos.StartPos]) then
      dec(CurPos.StartPos);

    // read backwards till line start
    PrePos:=CurPos.StartPos;
    while (PrePos>=1) and (not (Src[PrePos] in [#10,#13])) do
      dec(PrePos);
    // read line forward to find out,
    // if line ends in comment or string constant
    IsStringConstant:=false;
    repeat
      inc(PrePos);
      case Src[PrePos] of

      '/':
        if Src[PrePos+1]='/' then begin
          // this was a delphi comment -> skip comment
          CurPos.StartPos:=PrePos-1;
          break;
        end;

      '{':
        begin
          inc(PrePos);
          if (PrePos<=CurPos.StartPos) and (Src[PrePos]=#3) then begin
            // skip codetools comment
            inc(PrePos);
            while (PrePos<=CurPos.StartPos) do begin
              if (Src[PrePos]=#3) and (PrePos<CurPos.StartPos)
              and (Src[PrePos+1]='}') then begin
                inc(PrePos,2);
                break;
              end;
              inc(PrePos);
            end;
          end else begin
            // skip pascal comment
            CommentLvl:=1;
            while (PrePos<=CurPos.StartPos) do begin
              case Src[PrePos] of
              '{': if Scanner.NestedComments then inc(CommentLvl);
              '}':
                begin
                  dec(CommentLvl);
                  if CommentLvl=0 then break;
                end;
              end;
              inc(PrePos);
            end;
          end;
        end;

      '(':
        if Src[PrePos+1]='*' then begin
          // skip turbo pascal comment
          inc(PrePos,2);
          while (PrePos<CurPos.StartPos)
          and ((Src[PrePos]<>'*') or (Src[PrePos+1]<>')')) do
            inc(PrePos);
          inc(PrePos);
        end;

      '''':
        begin
          // a string constant -> skip it
          OldPrePos:=PrePos;
          while (PrePos<CurPos.StartPos) do begin
            inc(PrePos);
            case Src[PrePos] of
            '''':
              break;

            #0,#10,#13:
              begin
                // string constant right border is the line end
                // -> last atom of line found
                IsStringConstant:=true;
                break;
              end;

            end;
          end;
          if IsStringConstant then break;
        end;

      #10,#13:
        // no comment and no string constant found
        break;

      end;
    until PrePos>=CurPos.StartPos;
  end;

type
  TNumberType = (ntDecimal, ntHexadecimal, ntBinary, ntIdentifier,
    ntCharConstant, ntFloat, ntFloatWithExponent);
  TNumberTypes = set of TNumberType;

const
  AllNumberTypes: TNumberTypes = [ntDecimal, ntHexadecimal, ntBinary,
    ntIdentifier, ntCharConstant, ntFloat, ntFloatWithExponent];

var c1, c2: char;
  ForbiddenNumberTypes: TNumberTypes;
begin
  if LastAtoms.HasPrior then begin
    LastAtoms.GoBack(CurPos);
    exit;
  end;
  // Skip all spaces and comments
  CommentLvl:=0;
  dec(CurPos.StartPos);
  CurPos.Flag:=cafNone;
  IsStringConstant:=false;
  OldPrePos:=0;
  while CurPos.StartPos>=1 do begin
    if IsCommentEndChar[Src[CurPos.StartPos]] then begin
      case Src[CurPos.StartPos] of
      
      '}':
        begin
          dec(CurPos.StartPos);
          if (CurPos.StartPos>=1) and (Src[CurPos.StartPos]=#3) then begin
            // codetools skip comment {#3 #3}
            dec(CurPos.StartPos);
            while (CurPos.StartPos>=1) do begin
              if (Src[CurPos.StartPos]=#3) and (CurPos.StartPos>1)
              and (Src[CurPos.StartPos-1]='{') then begin
                dec(CurPos.StartPos,2);
                break;
              end;
              dec(CurPos.StartPos);
            end;
          end else begin
            // pascal comment {}
            CommentLvl:=1;
            while (CurPos.StartPos>=1) and (CommentLvl>0) do begin
              case Src[CurPos.StartPos] of
              '}': if Scanner.NestedComments then inc(CommentLvl);
              '{': dec(CommentLvl);
              end;
              dec(CurPos.StartPos);
            end;
          end;
        end;
        
      #10,#13: // possible Delphi comment
        ReadBackTilCodeLineEnd;

      ')': // old turbo pascal comment
        if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]='*') then begin
          dec(CurPos.StartPos,3);
          while (CurPos.StartPos>=1)
          and ((Src[CurPos.StartPos]<>'(') or (Src[CurPos.StartPos+1]<>'*')) do
            dec(CurPos.StartPos);
          dec(CurPos.StartPos);
        end else
          break;
          
      end;
    end else if IsSpaceChar[Src[CurPos.StartPos]] then begin
      repeat
        dec(CurPos.StartPos);
      until (CurPos.StartPos<1) or (Src[CurPos.StartPos] in [#10,#13])
      or (not (IsSpaceChar[Src[CurPos.StartPos]]));
    end else begin
      break;
    end;
  end;
  // CurPos.StartPos now points to the last char of the prior atom
  CurPos.EndPos:=CurPos.StartPos+1;
  if CurPos.StartPos<1 then begin
    CurPos.StartPos:=1;
    CurPos.EndPos:=1;
    LastAtoms.Clear;
    exit;
  end;
  // read atom
  if IsStringConstant then begin
    CurPos.StartPos:=OldPrePos;
    if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]='''') then begin
      ReadStringConstantBackward;
    end;
    LastAtoms.AddReverse(CurPos);
    exit;
  end;
  c2:=Src[CurPos.StartPos];
  case c2 of
    '_','A'..'Z','a'..'z':
      begin
        // identifier or keyword or hexnumber
        while (CurPos.StartPos>1) do begin
          if (IsIdentChar[Src[CurPos.StartPos-1]]) then
            dec(CurPos.StartPos)
          else begin
            case UpChars[Src[CurPos.StartPos-1]] of
            '@':
              // assembler label
              if (CurPos.StartPos>2)
              and (Src[CurPos.StartPos-2]='@') then
                dec(CurPos.StartPos,2);
            '$':
              // hex number
              dec(CurPos.StartPos);
            else
              case UpChars[Src[CurPos.StartPos]] of
              'E':
                if CompareSrcIdentifiers(CurPos.StartPos,'END') then
                  CurPos.Flag:=cafEnd
                else
                  CurPos.Flag:=cafWord;
              else
                CurPos.Flag:=cafWord;
              end;
            end;
            break;
          end;
        end;
      end;
    '''':
      begin
        inc(CurPos.StartPos);
        ReadStringConstantBackward;
      end;
    '0'..'9':
      begin
        // could be a decimal number, an identifier, a hex number,
        // a binary number, a char constant, a float, a float with exponent
        ForbiddenNumberTypes:=[];
        while true do begin
          case UpChars[Src[CurPos.StartPos]] of
          '0'..'1':
            ;
          '2'..'9':
            ForbiddenNumberTypes:=ForbiddenNumberTypes+[ntBinary];
          'A'..'D','F':
            ForbiddenNumberTypes:=ForbiddenNumberTypes
               +[ntBinary,ntDecimal,ntCharConstant,ntFloat,ntFloatWithExponent];
          'E':
            ForbiddenNumberTypes:=ForbiddenNumberTypes
               +[ntBinary,ntDecimal,ntCharConstant,ntFloat];
          'G'..'Z','_':
            ForbiddenNumberTypes:=AllNumberTypes-[ntIdentifier];
          '.':
            begin
              // could be the point of a float
              if (ntFloat in ForbiddenNumberTypes)
              or (CurPos.StartPos<=1) or (Src[CurPos.StartPos-1]='.') then begin
                inc(CurPos.StartPos);
                break;
              end;
              dec(CurPos.StartPos);
              // this was the part of a float after the point
              //  -> read decimal in front
              ForbiddenNumberTypes:=AllNumberTypes-[ntDecimal];
            end;
          '+','-':
            begin
              // could be part of an exponent
              if (ntFloatWithExponent in ForbiddenNumberTypes)
              or (CurPos.StartPos<=1)
              or (not (Src[CurPos.StartPos-1] in ['e','E']))
              then begin
                inc(CurPos.StartPos);
                break;
              end;
              dec(CurPos.StartPos);
              // this was the exponent of a float -> read the float
              ForbiddenNumberTypes:=AllNumberTypes-[ntFloat];
            end;
          '#': // char constant found
            begin
              if (ntCharConstant in ForbiddenNumberTypes) then
                inc(CurPos.StartPos);
              ReadStringConstantBackward;
              break;
            end;
          '$':
            begin
              // hexadecimal number found
              if (ntHexadecimal in ForbiddenNumberTypes) then
                inc(CurPos.StartPos);
              break;
            end;
          '%':
            begin
              // binary number found
              if (ntBinary in ForbiddenNumberTypes) then
                inc(CurPos.StartPos);
              break;
            end;
          '@':
            begin
              if (CurPos.StartPos=1) or (Src[CurPos.StartPos-1]<>'@')
              or (([ntIdentifier,ntDecimal]*ForbiddenNumberTypes)=[]) then
                // atom start found
                inc(CurPos.StartPos)
              else
                // label found
                dec(CurPos.StartPos);
              break;
            end;
          else
            begin
              inc(CurPos.StartPos);
              break;
            end;
          end;
          if ForbiddenNumberTypes=AllNumberTypes then begin
            inc(CurPos.StartPos);
            break;
          end;
          if CurPos.StartPos<=1 then break;
          dec(CurPos.StartPos);
        end;
        if IsIdentStartChar[Src[CurPos.StartPos]] then begin
          // it is an identifier
          CurPos.Flag:=cafWord;
          case UpChars[Src[CurPos.StartPos]] of
          'E':
            if CompareSrcIdentifiers(CurPos.StartPos,'END') then
              CurPos.Flag:=cafEnd;
          end;
        end;
      end;
      
    ';': CurPos.Flag:=cafSemicolon;
    ':': CurPos.Flag:=cafColon;
    ',': CurPos.Flag:=cafComma;
    '(': CurPos.Flag:=cafRoundBracketOpen;
    ')': CurPos.Flag:=cafRoundBracketClose;
    '[': CurPos.Flag:=cafEdgedBracketOpen;
    ']': CurPos.Flag:=cafEdgedBracketClose;

    else
      begin
        if CurPos.StartPos>1 then begin
          c1:=Src[CurPos.StartPos-1];
          // test for double char operators :=, +=, -=, /=, *=, <>, <=, >=, **, ><
          if ((c2='=') and (c1=':')) then
          begin
            dec(CurPos.StartPos);
            CurPos.Flag:=cafAssignment;
          end else
          if ((c2='=') and (IsEqualOperatorStartChar[c1]))
          or ((c1='<') and (c2='>'))
          or ((c1='>') and (c2='<'))
          or ((c1='.') and (c2='.'))
          or ((c1='*') and (c2='*'))
          or ((c1='@') and (c2='@'))
          then begin
            dec(CurPos.StartPos);
            CurPos.Flag:=cafOtherOperator;
          end else begin
            case c2 of
            '=': CurPos.Flag:=cafEqual;
            '.': CurPos.Flag:=cafPoint;
            end;
          end;
        end else begin
          case c2 of
          '=': CurPos.Flag:=cafEqual;
          '.': CurPos.Flag:=cafPoint;
          end;
        end;
      end;
  end;
  LastAtoms.AddReverse(CurPos);
end;

procedure TCustomCodeTool.ReadPriorAtomSafe(CleanPos: integer);
var
  Node: TCodeTreeNode;
begin
  // find a clean pos in front
  Node:=FindDeepestNodeAtPos(CleanPos,false);
  repeat
    repeat
      if Node=nil then begin
        CurPos:=CleanAtomPosition;
        exit;
      end;
      if Node.EndPos<CleanPos then begin
        MoveCursorToCleanPos(Node.EndPos);
        break;
      end else if Node.StartPos<CleanPos then begin
        MoveCursorToCleanPos(Node.StartPos);
        break;
      end;
      Node:=Node.Prior;
    until false;
    ReadNextAtom;
    if CurPos.StartPos<CleanPos then
      break;
    // first atom of node is behind CleanPos => try prior node
    Node:=Node.Prior;
  until false;
  if CurPos.EndPos>CleanPos then begin
    CurPos:=CleanAtomPosition;
    exit;
  end;
  if CurPos.EndPos=CleanPos then
    exit;
  repeat
    ReadNextAtom;
    if CurPos.EndPos>=CleanPos then begin
      if CurPos.EndPos>CleanPos then
        UndoReadNextAtom;
      exit;
    end;
  until false;
end;

procedure TCustomCodeTool.ReadAsStringConstant;
var
  p: PChar;
begin
  CurPos.Flag:=cafNone;
  if CurPos.StartPos>SrcLen then begin
    LastAtoms.ClearCurrent;
    CurPos.EndPos:=CurPos.StartPos;
    exit;
  end;
  p:=@Src[CurPos.StartPos];
  // string constant
  while true do begin
    case p^ of
    '#':
      begin
        inc(p);
        if IsNumberChar[p^] then begin
          // decimal
          repeat
            inc(p);
          until not IsNumberChar[p^];
        end else if p^='$' then begin
          // hexadecimal
          repeat
            inc(p);
          until not IsHexNumberChar[p^];
        end;
      end;
    '''':
      begin
        inc(p);
        while true do begin
          case p^ of
          '''':
            begin
              inc(p);
              break;
            end;

          #0,#10,#13:
            break;

          else
            inc(p);
          end;
        end;
      end;
    '^':
      begin
        inc(p);
        if not (p^ in ['A'..'Z']) then break;
        inc(p);
      end;
    else
      break;
    end;
  end;
  CurPos.EndPos:=p-PChar(Src)+1;
  LastAtoms.SetCurrent(CurPos);
end;

procedure TCustomCodeTool.UndoReadNextAtom;
begin
  if not LastAtoms.GoBack(CurPos) then
    RaiseUndoImpossible(20170421194733);
end;

function TCustomCodeTool.ReadTilBracketClose(
  ExceptionOnNotFound: boolean): boolean;
// reads code brackets (not comment brackets)
// after call cursor is on the closing bracket
var CloseBracket, AntiCloseBracket: TCommonAtomFlag;
  Start: TAtomPosition;
  Node: TCodeTreeNode;
  
  procedure RaiseBracketNotFound;
  begin
    if CloseBracket=cafRoundBracketClose then
      SaveRaiseExceptionFmt(20170421194736,ctsBracketNotFound,[')'],false)
    else
      SaveRaiseExceptionFmt(20170421194740,ctsBracketNotFound,[']'],false);
  end;

  procedure RaiseAtNicePos;
  begin
    SetNiceErrorPos(Start.StartPos);
    if ExceptionOnNotFound then
      RaiseBracketNotFound;
  end;
  
begin
  Result:=false;
  if (Curpos.Flag=cafRoundBracketOpen) then begin
    CloseBracket:=cafRoundBracketClose;
    AntiCloseBracket:=cafEdgedBracketClose;
  end else if (Curpos.Flag=cafEdgedBracketOpen) then begin
    CloseBracket:=cafEdgedBracketClose;
    AntiCloseBracket:=cafRoundBracketClose;
  end else begin
    if ExceptionOnNotFound then
      SaveRaiseBracketOpenExpectedButAtomFound(20170421194744);
    exit;
  end;
  Start:=CurPos;
  repeat
    ReadNextAtom;
    if (CurPos.Flag=CloseBracket) then break;
    if (CurPos.StartPos>SrcLen)
    or (CurPos.Flag in [cafEnd,AntiCloseBracket])
    then begin
      RaiseAtNicePos;
      exit;
    end;
    if (CurPos.Flag=cafWord) and (UpAtomIs('PROCEDURE') or UpAtomIs('FUNCTION'))
    then begin
      // check for anonymous function
      Node:=FindDeepestNodeAtPos(CurPos.StartPos+1,false);
      if (Node<>nil) and (Node.Desc=ctnProcedure) then
      begin
        MoveCursorToCleanPos(Node.EndPos);
      end else begin
        RaiseAtNicePos;
        exit;
      end;
    end;
    if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen]) then begin
      if not ReadTilBracketClose(ExceptionOnNotFound) then exit;
    end;
  until false;
  Result:=true;
end;

function TCustomCodeTool.ReadBackTilBracketOpen(
  ExceptionOnNotFound: boolean): boolean;
// reads code brackets (not comment brackets)
var OpenBracket: TCommonAtomFlag;

  procedure RaiseBracketNotFound;
  begin
    if OpenBracket=cafRoundBracketOpen then
      SaveRaiseExceptionFmt(20170421194747,ctsBracketNotFound,['('])
    else
      SaveRaiseExceptionFmt(20170421194749,ctsBracketNotFound,['[']);
  end;
  
var
  AntiOpenBracket: TCommonAtomFlag;
  Start: TAtomPosition;
  Node: TCodeTreeNode;
begin
  Result:=false;
  if (CurPos.Flag=cafRoundBracketClose) then begin
    OpenBracket:=cafRoundBracketOpen;
    AntiOpenBracket:=cafEdgedBracketOpen;
  end else if (CurPos.Flag=cafEdgedBracketClose) then begin
    OpenBracket:=cafEdgedBracketOpen;
    AntiOpenBracket:=cafRoundBracketOpen;
  end else begin
    if ExceptionOnNotFound then
      SaveRaiseBracketCloseExpectedButAtomFound(20170421194752);
    exit;
  end;
  Start:=CurPos;
  while CurPos.StartPos>1 do begin
    ReadPriorAtom;
    if (CurPos.Flag=OpenBracket) then exit(true);
    if (CurPos.StartPos<1)
    or (CurPos.Flag=AntiOpenBracket) then
      break;
    if (CurPos.Flag=cafEnd) then begin
      // check if anonymous function
      Node:=FindDeepestNodeAtPos(CurPos.StartPos,true);
      if (Node<>nil) and (Node.EndPos=CurPos.EndPos)
      and (Node.Desc in [ctnBeginBlock,ctnAsmBlock])
      and (Node.Parent.Desc=ctnProcedure) then
        // ToDo: check if Node is anonymous procedure
        MoveCursorToCleanPos(Node.Parent.StartPos)
      else
        break;
    end;
    if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then begin
      if not ReadBackTilBracketOpen(ExceptionOnNotFound) then exit;
    end;
  end;
  CurPos:=Start;
  if ExceptionOnNotFound then
    RaiseBracketNotFound;
  Result:=false;
end;

procedure TCustomCodeTool.ReadTillCommentEnd;
begin
  CurPos.StartPos:=FindCommentEnd(Src,CurPos.StartPos,Scanner.NestedComments);
  LastAtoms.SetCurrent(CurPos);
end;

procedure TCustomCodeTool.BeginParsing(Range: TLinkScannerRange);
begin
  // scan
  FLastProgressPos:=0;
  Scanner.Scan(Range,CheckFilesOnDisk);
  FetchScannerSource;
  // init parsing values
  CurPos:=StartAtomPosition;
  LastAtoms.Clear;
  if CurPos.StartPos<CurPos.EndPos then
    LastAtoms.Add(CurPos);
  CurNode:=nil;
end;

procedure TCustomCodeTool.BeginParsingAndGetCleanPos(Range: TLinkScannerRange;
  CursorPos: TCodeXYPosition; out CleanCursorPos: integer);
var
  Dummy: integer;
begin
  if UpdateNeeded(Range) then
    BeginParsing(Range);
  // find the CursorPos in cleaned source
  Dummy:=CaretToCleanPos(CursorPos, CleanCursorPos);
  if (Dummy<>0) and (Dummy<>-1) then begin
    MoveCursorToCleanPos(1);
    RaiseException(20170421194754,ctsCursorPosOutsideOfCode,true);
  end;
end;

function TCustomCodeTool.IgnoreErrorAfterPositionIsInFrontOfLastErrMessage: boolean;
var
  IgnoreErrorAfterCleanPos: integer;
begin
  //DebugLn('TCustomCodeTool.IgnoreErrorAfterPositionIsInFrontOfLastErrMessage ',
  //  ' LastErrorCheckedForIgnored='+dbgs(LastErrorCheckedForIgnored),
  //  ' LastErrorBehindIgnorePosition='+dbgs(LastErrorBehindIgnorePosition));
  if LastErrorCheckedForIgnored then begin
    Result:=LastErrorBehindIgnorePosition;
  end else begin
    if (Scanner<>nil) then begin
      IgnoreErrorAfterCleanPos:=Scanner.IgnoreErrorAfterCleanedPos;
      //DebugLn(['  IgnoreErrorAfterCleanPos=',IgnoreErrorAfterCleanPos,' "',copy(Src,IgnoreErrorAfterCleanPos-6,6),'"',
      //  ' LastErrorCurPos.StartPos=',LastErrorCurPos.StartPos,' "',copy(Src,LastErrorCurPos.StartPos-6,6),'"',
      //  ' ']);
      if IgnoreErrorAfterCleanPos>0 then begin
        // ignore position in scanned code
        // -> check if last error is behind or equal ignore position
        if (not LastErrorValid)
        or (IgnoreErrorAfterCleanPos<=LastErrorCurPos.StartPos) then
          Result:=true
        else
          Result:=false;
      end else
        Result:=false;
    end else
      Result:=false;
    LastErrorBehindIgnorePosition:=Result;
    LastErrorCheckedForIgnored:=true;
  end;
  {$IFDEF ShowIgnoreErrorAfter}
  DebugLn('TCustomCodeTool.IgnoreErrAfterPositionIsInFrontOfLastErrMessage ',dbgs(Result));
  {$ENDIF}
end;

function TCustomCodeTool.IgnoreErrorAfterValid: boolean;
begin
  Result:=(Scanner<>nil) and (Scanner.IgnoreErrorAfterValid);
  {$IFDEF ShowIgnoreErrorAfter}
  DebugLn('TCustomCodeTool.IgnoreErrorAfterValid ',dbgs(Result));
  {$ENDIF}
end;

function TCustomCodeTool.IgnoreErrorAfterCleanedPos: integer;
begin
  if Scanner<>nil then
    Result:=Scanner.IgnoreErrorAfterCleanedPos
  else
    Result:=-1;
  {$IFDEF ShowIgnoreErrorAfter}
  DebugLn('TCustomCodeTool.IgnoreErrorAfterCleanedPos ',dbgs(Result));
  {$ENDIF}
end;

function TCustomCodeTool.CleanPosIsAfterIgnorePos(CleanPos: integer): boolean;
begin
  Result:=(Scanner<>nil) and Scanner.CleanPosIsAfterIgnorePos(CleanPos);
end;

function TCustomCodeTool.LastErrorIsInFrontOfCleanedPos(ACleanedPos: integer
  ): boolean;
begin
  if (Scanner<>nil) and Scanner.LastErrorIsInFrontOfCleanedPos(ACleanedPos)
  then
    Result:=true
  else if LastErrorValid
  and (LastErrorCurPos.StartPos<ACleanedPos) then
    Result:=true
  else
    Result:=false;
  {$IFDEF ShowIgnoreErrorAfter}
  DebugLn('TCustomCodeTool.LastErrorsInFrontOfCleanedPos ACleanedPos=',dbgs(ACleanedPos),' ',dbgs(Result));
  {$ENDIF}
end;

procedure TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos(
  ACleanedPos: integer);
begin
  {$IFDEF ShowIgnoreErrorAfter}
  DebugLn('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos A ACleanedPos=',dbgs(ACleanedPos));
  {$ENDIF}
  if Scanner<>nil then Scanner.RaiseLastErrorIfInFrontOfCleanedPos(ACleanedPos);
  //DebugLn('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos B ',LastErrorCurPos.EndPos);
  if LastErrorValid
  and (LastErrorCurPos.StartPos<ACleanedPos) then
    RaiseLastError;
  //DebugLn('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos END ');
end;

function TCustomCodeTool.GetNodeParserError(Node: TCodeTreeNode
  ): TCodeTreeNodeParseError;
var
  AVLNode: TAVLTreeNode;
begin
  if (Node=nil) or (FNodeParseErrors=nil) then
    Result:=nil
  else begin
    AVLNode:=FNodeParseErrors.FindKey(Node,@CompareNodeWithCodeTreeNodeParserError);
    if AVLNode<>nil then
      Result:=TCodeTreeNodeParseError(AVLNode.Data)
    else
      Result:=nil;
  end;
end;

function TCustomCodeTool.SetNodeParserError(Node: TCodeTreeNode;
  const ErrorMsg: string; const ErrorCleanPos: integer;
  const ErrorNiceCleanPos: TCodeXYPosition): TCodeTreeNodeParseError;
var
  AVLNode: TAVLTreeNode;
begin
  //debugln(['TCustomCodeTool.SetNodeParserError ',Node.DescAsString,' Msg="',ErrorMsg,'" ',CleanPosToStr(ErrorCleanPos)]);
  if Node=nil then
    RaiseCatchableException('');
  if FNodeParseErrors=nil then
    FNodeParseErrors:=TAVLTree.Create(@CompareCodeTreeNodeParserError);
  AVLNode:=FNodeParseErrors.FindKey(Node,@CompareNodeWithCodeTreeNodeParserError);
  if AVLNode<>nil then begin
    Result:=TCodeTreeNodeParseError(AVLNode.Data)
  end else begin
    Result:=TCodeTreeNodeParseError.Create(Node);
    FNodeParseErrors.Add(Result);
  end;
  Node.SubDesc:=Node.SubDesc or ctnsHasParseError;
  Result.Msg:=ErrorMsg;
  Result.CleanPos:=ErrorCleanPos;
  Result.NicePos:=ErrorNiceCleanPos;
end;

procedure TCustomCodeTool.RaiseNodeParserError(Node: TCodeTreeNode);
var
  NodeError: TCodeTreeNodeParseError;
begin
  //debugln(['TCustomCodeTool.SetNodeParserError ',Node.DescAsString,' ',(ctnsHasParseError and Node.SubDesc)>0]);
  if (ctnsHasParseError and Node.SubDesc)=0 then exit;
  NodeError:=GetNodeParserError(Node);
  if CleanPosIsAfterIgnorePos(NodeError.CleanPos) then exit;
  //debugln(['TCustomCodeTool.RaiseNodeParserError ',Node.DescAsString,' Msg="',NodeError.Msg,'" ',CleanPosToStr(NodeError.CleanPos)]);
  MoveCursorToCleanPos(NodeError.CleanPos);
  ErrorNicePosition:=NodeError.NicePos;
  RaiseException(20170421194759,NodeError.Msg,false);
end;

procedure TCustomCodeTool.RaiseCursorOutsideCode(CursorPos: TCodeXYPosition);
var
  Msg: String;
  p: integer;
  CleanPos: integer;
  r: Integer;
  i: Integer;
  Link: TSourceLink;
  NearestScanPos: Integer;
  Node: TCodeTreeNode;
  LastPos: Integer;
begin
  ErrorPosition:=CursorPos;
  Msg:='';
  // check position in code buffer
  if CursorPos.Code=nil then
    Msg:='cursor position without code buffer'
  else if (CursorPos.Y<1) or (CursorPos.Y>CursorPos.Code.LineCount+1) then
    Msg:='invalid line number '+IntToStr(CursorPos.Y)
  else if (CursorPos.X<1) then
    Msg:='invalid column number '+IntToStr(CursorPos.Y)
  else begin
    CursorPos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,p);
    if p<1 then
      Msg:='cursor position is outside of code'
    else begin
      // check position in scanner
      if Scanner=nil then
        Msg:='missing scanner (called wrong or no pascal)'
      else begin
        r:=Scanner.CursorToCleanPos(p,CursorPos.Code,CleanPos);
        if r<>0 then begin
          NearestScanPos:=0;
          for i:=0 to Scanner.LinkCount-1 do begin
            Link:=Scanner.Links[i];
            if Link.Code=nil then continue;
            if Link.Code<>Pointer(CursorPos.Code) then continue;
            if Link.SrcPos>p then continue;
            NearestScanPos:=Link.SrcPos+Scanner.LinkSize(i);
          end;
          if NearestScanPos=0 then
            Msg:='file was not reached by scanner'
          else begin
            if r=-1 then
              Msg:='cursor position was skipped by scanner'
            else
              Msg:='cursor position is beyond scan range';
            Msg:=Msg+' (last at '+CursorPos.Code.AbsoluteToLineColStr(NearestScanPos)+')'
          end;
        end else begin
          // check position in tree
          if (Tree=nil) or (Tree.Root=nil) then
            Msg:='No pascal found (maybe function was called before BuildTree)'
          else if CleanPos<Tree.Root.StartPos then begin
            // in front of parsed code
            Msg:='In front of code.';
            if Tree.Root.StartPos<=SrcLen then begin
              MoveCursorToCleanPos(Tree.Root.StartPos);
              ReadNextAtom;
              Msg:=Msg+' (pascal code starts with "'+GetAtom+'" at '
                      +CleanPosToStr(Tree.Root.StartPos)+')';
            end else begin
              Node:=Tree.Root;
              while Node.NextBrother<>nil do Node:=Node.NextBrother;
              if (Node.EndPos>0) and (p>Node.EndPos) then
                LastPos:=Node.EndPos
              else
                LastPos:=Node.StartPos;
              if p>LastPos then begin
                Msg:='behind code (last token at '+CleanPosToStr(LastPos)+')';
              end else begin
                Msg:='inconsistency: the position is in code, but caller thinks it is not.'
              end;
            end;
          end;
        end;
      end;
    end;
  end;
  RaiseExceptionAtErrorPos(20170421194801,Msg);
end;

function TCustomCodeTool.StringIsKeyWord(const Word: string): boolean;
begin
  Result:=(Word<>'') and IsIdentStartChar[Word[1]]
                   and WordIsKeyWordFuncList.DoItUpperCase(Word,1,length(Word));
end;

procedure TCustomCodeTool.MoveCursorToNodeStart(ANode: TCodeTreeNode);
begin
  {$IFDEF CheckNodeTool}CheckNodeTool(ANode);{$ENDIF}
  MoveCursorToCleanPos(ANode.StartPos);
  CurNode:=ANode;
end;

procedure TCustomCodeTool.MoveCursorToCleanPos(ACleanPos: integer);
begin
  CurPos.StartPos:=ACleanPos;
  CurPos.EndPos:=ACleanPos;
  CurPos.Flag:=cafNone;
  LastAtoms.Clear;
end;

procedure TCustomCodeTool.MoveCursorToCleanPos(ACleanPos: PChar);

  procedure RaiseSrcEmpty;
  begin
    RaiseException(20170421194805,'[TCustomCodeTool.MoveCursorToCleanPos - PChar] Src empty',true);
  end;
  
  procedure RaiseNotInSrc;
  begin
    RaiseException(20170421194809,'[TCustomCodeTool.MoveCursorToCleanPos - PChar] '
      +'CleanPos not in Src',true);
  end;

var NewPos: integer;
begin
  if Src='' then
    RaiseSrcEmpty;
  NewPos:=PtrInt({%H-}PtrUInt(ACleanPos))-PtrInt({%H-}PtrUInt(@Src[1]))+1;
  if (NewPos<1) or (NewPos>SrcLen) then
    RaiseNotInSrc;
  MoveCursorToCleanPos(NewPos);
end;

procedure TCustomCodeTool.MoveCursorToAtomPos(const AnAtomPos: TAtomPosition);
var
  i: Integer;
begin
  if (AnAtomPos.StartPos<AnAtomPos.EndPos)
  and LastAtoms.IndexOf(AnAtomPos.StartPos,i) then begin
    //debugln(['TCustomCodeTool.MoveCursorToAtomPos jump to index ',i,' Atom="',GetAtom(AnAtomPos),'"(',AnAtomPos.StartPos,'-',AnAtomPos.EndPos,')']);
    //debugln(['TCustomCodeTool.MoveCursorToAtomPos ',LastAtoms.GetAtomAt(0).StartPos,'-',LastAtoms.GetAtomAt(0).EndPos]);
    LastAtoms.SetIndex(i);
  end
  else begin
    //debugln(['TCustomCodeTool.MoveCursorToAtomPos clearing LastAtoms Atom="',GetAtom(AnAtomPos),'"(',AnAtomPos.StartPos,'-',AnAtomPos.EndPos,')']);
    MoveCursorToCleanPos(AnAtomPos.StartPos);
  end;
  CurPos:=AnAtomPos;
end;

procedure TCustomCodeTool.MoveCursorToNearestAtom(ACleanPos: integer);
var
  ANode: TCodeTreeNode;
  BestPos: Integer;
begin
  ANode:=FindDeepestNodeAtPos(ACleanPos,true);
  if ANode=nil then
    RaiseException(20170421194812,'TCustomCodeTool.MoveCursorToNearestAtom internal error',true);
  MoveCursorToNodeStart(ANode);
  BestPos:=CurPos.StartPos;
  while (CurPos.StartPos<=ACleanPos) and (CurPos.StartPos<=SrcLen) do begin
    BestPos:=CurPos.StartPos;
    ReadNextAtom;
  end;
  MoveCursorToCleanPos(BestPos);
end;

procedure TCustomCodeTool.MoveCursorToLastNodeAtom(ANode: TCodeTreeNode);
var
  BestPos: LongInt;
begin
  MoveCursorToNodeStart(ANode);
  BestPos:=CurPos.StartPos;
  while (CurPos.EndPos<=ANode.EndPos) and (CurPos.StartPos<=SrcLen) do begin
    BestPos:=CurPos.StartPos;
    ReadNextAtom;
  end;
  MoveCursorToCleanPos(BestPos);
end;

function TCustomCodeTool.IsPCharInSrc(ACleanPos: PChar): boolean;
// Note: the ending #0 is a valid position
var
  p: PChar;
begin
  Result:=false;
  if Src='' then exit;
  p:=PChar(Src);
  if p>ACleanPos then exit;
  if ACleanPos>p+SrcLen then exit;
  Result:=true;
end;

procedure TCustomCodeTool.CreateChildNode;
var NewNode: TCodeTreeNode;
begin
  NewNode:=TCodeTreeNode.Create;
  Tree.AddNodeAsLastChild(CurNode,NewNode);
  CurNode:=NewNode;
  CurNode.StartPos:=CurPos.StartPos;
end;

procedure TCustomCodeTool.EndChildNode;
begin
  CurNode:=CurNode.Parent;
end;

procedure TCustomCodeTool.BuildDefaultKeyWordFunctions;
begin
  KeyWordFuncList.Clear;
  KeyWordFuncList.DefaultKeyWordFunction:=
    {$ifdef FPC}@{$endif}DefaultKeyWordFunc;
end;

function TCustomCodeTool.DoAtom: boolean;
begin
  if (CurPos.StartPos>SrcLen) or (CurPos.EndPos<=CurPos.StartPos) then
    Result:=false
  else if IsIdentStartChar[Src[CurPos.StartPos]] then
    Result:=KeyWordFuncList.DoItCaseInsensitive(Src,CurPos.StartPos,
            CurPos.EndPos-CurPos.StartPos)
  else
    Result:=true;
end;

procedure TCustomCodeTool.SetIgnoreErrorAfter(const AValue: TCodePosition);
begin
  if (IgnoreErrorAfter.Code=AValue.Code)
  and (IgnoreErrorAfter.P=AValue.P) then exit;
  FIgnoreErrorAfter:=AValue;
  LastErrorCheckedForIgnored:=false;
  {$IFDEF ShowIgnoreErrorAfter}
  DebugLn('TCustomCodeTool.SetIgnoreErrorAfter FIgnoreErrorAfter=',dbgs(FIgnoreErrorAfter));
  {$ENDIF}
  if Scanner<>nil then
    Scanner.SetIgnoreErrorAfter(IgnoreErrorAfter.P,IgnoreErrorAfter.Code);
end;

procedure TCustomCodeTool.IncreaseTreeChangeStep(NodesDeleting: boolean);
begin
  //DebugLn(['TCustomCodeTool.IncreaseTreeChangeStep ',DbgSName(Self),' NodesDeleting=',NodesDeleting]);
  if FTreeChangeStep=High(integer) then
    FTreeChangeStep:=Low(integer)
  else
    inc(FTreeChangeStep);
  if NodesDeleting then begin
    //DebugLn(['TCustomCodeTool.IncreaseTreeChangeStep NodesDeleting ',MainFilename,' ',Tree<>nil,' ',(Tree<>nil) and (Tree.Root<>nil)]);
    if FNodesDeletedChangeStep=High(integer) then
      FNodesDeletedChangeStep:=Low(integer)
    else
      inc(FNodesDeletedChangeStep);
  end;
  if FOnTreeChange<>nil then
    FOnTreeChange(Self,NodesDeleting);
end;

procedure TCustomCodeTool.RaiseExceptionInstance(TheException: ECodeToolError;
  ClearNicePos: boolean);
var
  CaretXY: TCodeXYPosition;
  CursorPos: integer;
begin
  ErrorPosition.Code:=nil;
  CursorPos:=CurPos.StartPos;
  if CursorPos<1 then LastAtoms.Clear;
  //DebugLn('TCustomCodeTool.RaiseExceptionInstance CursorPos=',dbgs(CursorPos),' "',copy(Src,CursorPos-6,6),'"');
  
  if ClearNicePos then begin
    ErrorNicePosition.Code:=nil;
    ErrorNicePosition.Y:=-1;
  end;

  // close all open nodes, so that FindDeepestNodeAtPos works in the code
  // already parsed
  CloseUnfinishedNodes;
  // convert cursor pos to caret pos, which is more human readable
  if (CursorPos>SrcLen) and (SrcLen>0) then CursorPos:=SrcLen;
  if (CleanPosToCaret(CursorPos,CaretXY))
  and (CaretXY.Code<>nil) then begin
    ErrorPosition:=CaretXY;
  end else if (Scanner<>nil) and (Scanner.MainCode<>nil) then begin
    ErrorPosition.Code:=TCodeBuffer(Scanner.MainCode);
    ErrorPosition.Y:=-1;
  end;
  // raise the exception
  if not RaiseUnhandableExceptions then
    raise TheException
  else begin
    TheException.Free;
    RaiseCatchableException(TheException.Message);
  end;
end;

procedure TCustomCodeTool.RaiseExceptionClass(id: int64;
  const AMessage: string; ExceptionClass: ECodeToolErrors; ClearNicePos: boolean
  );
begin
  RaiseExceptionInstance(ExceptionClass.Create(Self,id,AMessage),ClearNicePos);
end;

function TCustomCodeTool.DefaultKeyWordFunc: boolean;
begin
  Result:=true;
end;

procedure TCustomCodeTool.ConsistencyCheck;
begin
  Tree.ConsistencyCheck;
end;

procedure TCustomCodeTool.WriteDebugTreeReport;

  procedure WriteSrcSubString(A,Len: integer);
  var i: integer;
  begin
    DbgOut('"');
    for i:=A to A+Len-1 do begin
      if (i>0) and (i<SrcLen) and (ord(Src[i])>31) then
        DbgOut(Src[i]);
    end;
    DbgOut('"');
  end;

  procedure WriteSubTree(RootNode: TCodeTreeNode; Indent: string);
  begin
    while RootNode<>nil do begin
      DbgOut(Indent);
      with RootNode do begin
        DbgOut(NodeDescToStr(Desc)+'('+NodeSubDescToStr(Desc,SubDesc)+')  ');
        DbgOut(' Start='+DbgS(StartPos),' ');
        WriteSrcSubString(StartPos,5);
        DbgOut(' End='+DbgS(EndPos)+' ');
        WriteSrcSubString(EndPos-5,5);
        {$ifdef fpc}
        DbgOut(' Self=',DbgS(RootNode));
        DbgOut(' P=',DbgS(Parent));
        DbgOut(' NB=',DbgS(NextBrother));
        //write(' PB=',DbgS(PriorBrother));
        //write(' FC=',DbgS(FirstChild));
        //write(' LC=',DbgS(LastChild));
        {$endif}
      end;
      DebugLn('');
      WriteSubTree(RootNode.FirstChild,Indent+'  ');
      RootNode:=RootNode.NextBrother;
    end;
  end;

begin
  DebugLn('[TCustomCodeTool.WriteDebugTreeReport]');
  WriteSubTree(Tree.Root,'  ');
  ConsistencyCheck;
end;

procedure TCustomCodeTool.CalcMemSize(Stats: TCTMemStats);
begin
  Stats.Add(ClassName,InstanceSize);
  Stats.Add('TCustomCodeTool',MemSizeString(LastErrorMessage));
  if FScanner<>nil then
    FScanner.CalcMemSize(Stats);
  if (FScanner=nil) or (Pointer(FScanner.CleanedSrc)<>Pointer(Src)) then
    Stats.Add('TCustomCodeTool.Src',
      MemSizeString(Src));
  if KeyWordFuncList<>nil then
    Stats.Add('TCustomCodeTool.KeyWordFuncList',
      KeyWordFuncList.CalcMemSize);
  // Note: WordIsKeyWordFuncList is using the global list
  if Tree<>nil then
    Stats.Add('TCustomCodeTool.Tree',
      Tree.NodeCount*TCodeTreeNode.InstanceSize);
  if LastAtoms<>nil then
    Stats.Add('TCustomCodeTool.LastAtoms',
      LastAtoms.CalcMemSize);
end;

procedure TCustomCodeTool.CheckNodeTool(Node: TCodeTreeNode);

  procedure RaiseForeignNode;
  begin
    RaiseCatchableException('TCustomCodeTool.CheckNodeTool '+DbgSName(Self)+' '+Node.DescAsString);
  end;

begin
  if Node=nil then exit;
  while Node.Parent<>nil do Node:=Node.Parent;
  while Node.PriorBrother<>nil do Node:=Node.PriorBrother;
  if (Tree=nil) or (Tree.Root<>Node) then
    RaiseForeignNode;
end;

function TCustomCodeTool.FindDeepestNodeAtPos(P: integer;
  ExceptionOnNotFound: boolean): TCodeTreeNode;
begin
  Result:=FindDeepestNodeAtPos(Tree.Root,P,ExceptionOnNotFound);
end;

function TCustomCodeTool.FindDeepestNodeAtPos(StartNode: TCodeTreeNode;
  P: integer; ExceptionOnNotFound: boolean): TCodeTreeNode;
  
  procedure RaiseNoNodeFoundAtCursor;
  var
    Msg: String;
    Node: TCodeTreeNode;
    LastPos: Integer;
  begin
    //DebugLn('RaiseNoNodeFoundAtCursor ',MainFilename);
    MoveCursorToCleanPos(P);
    // check if p is in parsed code
    if (Tree=nil) or (Tree.Root=nil) then begin
      debugln(['TCustomCodeTool.FindDeepestNodeAtPos there are no nodes, maybe you forgot to parse?']);
      CTDumpStack;
      RaiseException(20170421194833,'no pascal code or not yet parsed');
    end;
    if p<Tree.Root.StartPos then begin
      // in front of parsed code
      Msg:='In front of code.';
      if Tree.Root.StartPos<=SrcLen then begin
        MoveCursorToCleanPos(Tree.Root.StartPos);
        ReadNextAtom;
        Msg:=Msg+' (The pascal code starts with "'+GetAtom+'" at '
                +CleanPosToStr(Tree.Root.StartPos)+')';
      end;
      MoveCursorToCleanPos(P);
      RaiseException(20170421194836,Msg);
    end;
    // behind parsed code
    Node:=Tree.Root;
    while Node.NextBrother<>nil do Node:=Node.NextBrother;
    if (Node.EndPos>0) and (p>Node.EndPos) then
      LastPos:=Node.EndPos
    else
      LastPos:=Node.StartPos;
    if p>LastPos then begin
      Msg:='Behind code (last token at '+CleanPosToStr(LastPos)+')';
      {$IFDEF VerboseNoNodeAtCursor}
      debugln(['RaiseNoNodeFoundAtCursor CleanSrcEnd=',CleanPosToStr(SrcLen),' ...',dbgstr(RightStr(Src,50))]);
      debugln(['   Scanner.ScannedRange=',dbgs(Scanner.ScannedRange)]);
      debugln(['   Scanner.CleanedSrc=',dbgstr(RightStr(Scanner.CleanedSrc,50))]);
      debugln(['   Node.StartPos=',CleanPosToStr(Node.StartPos),' EndPos=',CleanPosToStr(Node.EndPos)]);
      Node:=Node.GetLastNode;
      debugln(['   LastNode=',Node.DescAsString,' StartPos=',CleanPosToStr(Node.StartPos),' EndPos=',CleanPosToStr(Node.EndPos)]);
      {$ENDIF}
      RaiseException(20170421194838,Msg);
    end;

    // p is in parsed code, the StartNode is wrong
    CTDumpStack;
    if (StartNode<>nil) then
      RaiseException(20170421194842,'Invalid search. The search for pascal started at '
                     +CleanPosToStr(StartNode.StartPos)+'. Invalid search')
    else
      RaiseException(20170421194846,'Inconsistency error in TCustomCodeTool.FindDeepestNodeAtPos');
  end;
  
var
  ChildNode: TCodeTreeNode;
  Brother: TCodeTreeNode;
  Node: TCodeTreeNode;
begin
  {$IFDEF CheckNodeTool}CheckNodeTool(StartNode);{$ENDIF}
  Result:=nil;
  Node:=StartNode;
  while Node<>nil do begin
    //DebugLn('SearchInNode ',NodeDescriptionAsString(ANode.Desc),
    //',',ANode.StartPos,',',ANode.EndPos,', p=',p,
    //' "',copy(Src,ANode.StartPos,4),'" - "',copy(Src,ANode.EndPos-5,4),'"');
    if (Node.StartPos<=P)
    and ((Node.EndPos>P) or (Node.EndPos<1)) then begin
      // StartNode contains P
      Result:=Node;
      // -> search for a child that contains P
      Brother:=Node;
      while (Brother<>nil)
      and (Brother.StartPos<=P) do begin
        // brother also contains P
        if Brother.FirstChild<>nil then begin
          ChildNode:=FindDeepestNodeAtPos(Brother.FirstChild,P,false);
          if ChildNode<>nil then begin
            Result:=ChildNode;
            exit;
          end else
            Result:=Brother;
        end;
        Brother:=Brother.NextBrother;
      end;
      break;
    end else begin
      // search in next node
      Node:=Node.NextBrother;
    end;
  end;
  if (Result=nil) and (Tree.Root<>nil) then begin
    Node:=Tree.Root;
    while Node.NextBrother<>nil do
      Node:=Node.NextBrother;
    if (Node<>nil) and (Node.EndPos=p) then begin
      // cursor at end of source
      Result:=Node;
      while (Result.LastChild<>nil) and (Result.LastChild.EndPos=p) do
        Result:=Result.LastChild;
      exit;
    end;
  end;

  if (Result=nil) and ExceptionOnNotFound then begin
    RaiseNoNodeFoundAtCursor;
  end;
end;

function TCustomCodeTool.CaretToCleanPos(const Caret: TCodeXYPosition;
  out CleanPos: integer): integer;
begin
  if Caret.Code=nil then begin
    CleanPos:=0;
    exit(-2);
  end;
  //DebugLn(['TCustomCodeTool.CaretToCleanPos A ',Caret.Code.Filename,' ',Caret.Y,',',Caret.X,' SourceLength=',Caret.Code.SourceLength]);
  Caret.Code.LineColToPosition(Caret.Y,Caret.X,CleanPos);
  //DebugLn(['TCustomCodeTool.CaretToCleanPos B Clean=',CleanPos,',Y=',Caret.Y,',X=',Caret.X,' ',dbgstr(copy(Caret.Code.Source,CleanPos-20,20)),'|',dbgstr(copy(Caret.Code.Source,CleanPos,20))]);
  if (CleanPos>=1) then
    Result:=Scanner.CursorToCleanPos(CleanPos,Caret.Code,CleanPos)
  else
    Result:=-2; // x,y beyond source
  //DebugLn(['TCustomCodeTool.CaretToCleanPos C CleanPos=',CleanPos,' Result=',Result]);
end;

function TCustomCodeTool.CodePosToCleanPos(const CodePos: TCodePosition; out
  CleanPos: integer): integer;
begin
  Result:=Scanner.CursorToCleanPos(CodePos.P,CodePos.Code,CleanPos);
end;

function TCustomCodeTool.CleanPosToCodePos(CleanPos: integer;
  out CodePos: TCodePosition): boolean;
var
  ACode: pointer;
begin
  Result:=Scanner.CleanedPosToCursor(CleanPos,CodePos.p,ACode);
  CodePos.Code:=TCodeBuffer(ACode);
end;

function TCustomCodeTool.CleanPosToCaret(CleanPos: integer;
  out Caret:TCodeXYPosition): boolean; // true=ok, false=invalid CleanPos
var p: integer;
  Code: Pointer;
begin
  Caret:=CleanCodeXYPosition;
  Result:=Scanner.CleanedPosToCursor(CleanPos,p,Code);
  if Result then begin
    Caret.Code:=TCodeBuffer(Code);
    if Caret.Code.IsDeleted then begin
      debugln(['TCustomCodeTool.CleanPosToCaret IsDeleted: ',Caret.Code.Filename,' SourceLength=',Caret.Code.SourceLength]);
      exit(false);
    end;
    TCodeBuffer(Code).AbsoluteToLineCol(p,Caret.Y,Caret.X);
    Result:=(Caret.Y>=0);
  end;
end;

function TCustomCodeTool.CleanPosToCaretAndTopLine(CleanPos: integer;
  out Caret:TCodeXYPosition; out NewTopLine: integer): boolean;
// true=ok, false=invalid CleanPos
begin
  Caret:=CleanCodeXYPosition;
  NewTopLine:=0;
  Result:=CleanPosToCaret(CleanPos,Caret);
  if Result then begin
    if JumpSingleLinePos>0 then begin
      NewTopLine:=Caret.Y-(VisibleEditorLines*JumpSingleLinePos div 100);
      if NewTopLine<1 then NewTopLine:=1;
    end else
      NewTopLine:=Caret.Y;
  end;
end;

function TCustomCodeTool.CleanPosToStr(CleanPos: integer;
  WithFilename: boolean): string;
var
  CodePos: TCodeXYPosition;
begin
  if CleanPosToCaret(CleanPos,CodePos) then begin
    Result:=CodeXYToStr(CodePos,WithFilename);
  end else
    Result:='outside scan range, pos='+IntToStr(CleanPos)+'('+dbgstr(copy(Src,CleanPos-5,5)+'|'+copy(Src,CleanPos,5))+')';
end;

function TCustomCodeTool.CodeXYToStr(const CodePos: TCodeXYPosition;
  WithFilename: boolean): string;
begin
  Result:='';
  if WithFilename then
    Result:=ExtractRelativepath(ExtractFilePath(MainFilename),CodePos.Code.Filename)+',';
  Result:=Result+'line '+IntToStr(CodePos.Y)+', column '+IntToStr(CodePos.X);
end;

function TCustomCodeTool.CleanPosToRelativeStr(CleanPos: integer;
  const BaseFilename: string): string;
var
  CodePos: TCodeXYPosition;
begin
  if not CleanPosToCaret(CleanPos,CodePos) then
    Result:='(?)'
  else begin
    if (BaseFilename='') or (not FilenameIsAbsolute(BaseFilename)) then
      Result:=CodePos.Code.Filename
    else if CompareFilenames(CodePos.Code.Filename,BaseFilename)<>0 then
      Result:=CreateRelativePath(CodePos.Code.Filename,
                                 ExtractFilePath(BaseFilename))
    else
      Result:='';
    Result:=Result+'('+IntToStr(CodePos.Y)+','+IntToStr(CodePos.X)+')';
  end;
end;

procedure TCustomCodeTool.GetCleanPosInfo(CodePosInFront, CleanPos: integer;
  ResolveComments: boolean; out SameArea: TAtomPosition);
{ Use this function to safely find out if a position is in a comment,
  a string constant, an atom or is in space

  CodePosInFront: a position in code, where parsing starts
                  If -1 it uses FindDeepestNodeAtPos
  CleanPos: target position
  ResolveComments: if CleanPos is in a comment, parse again in the comment (not recursive)
  SameArea: area around CleanPos, either an atom, comment, directive or space
            if CleanPos<CodePosInFront then CleanAtomPosition
            if CleanPos>SrcLen then SameArea.StartPos>SrcLen
}
var
  ANode: TCodeTreeNode;
begin
  SameArea:=CleanAtomPosition;
  if CodePosInFront<1 then begin
    ANode:=FindDeepestNodeAtPos(CleanPos,True);
    CodePosInFront:=ANode.StartPos;
  end;
  if CodePosInFront>CleanPos then
    exit;
  MoveCursorToCleanPos(CodePosInFront);
  repeat
    ReadNextAtom;
    //DebugLn(['TCustomCodeTool.GetCleanPosInfo A Atom=',GetAtom,' CleanPos=',CleanPos,' CurPos.StartPos=',CurPos.StartPos]);
    if (CleanPos>=CurPos.StartPos) and (CleanPos<CurPos.EndPos) then begin
      // clean pos on token
      SameArea:=CurPos;
      exit;
    end;
    if CleanPos<CurPos.StartPos then begin
      // clean pos between tokens
      SameArea.Flag:=cafNone;
      // get range of space behind last atom
      if LastAtoms.HasPrior then begin
        SameArea.StartPos:=LastAtoms.GetPriorAtom.EndPos;
      end else begin
        SameArea.StartPos:=CodePosInFront;
      end;
      SameArea.EndPos:=SameArea.StartPos;
      repeat
        //DebugLn(['TCustomCodeTool.GetCleanPosInfo B CleanPos=',CleanPos,' SameArea.StartPos=',SameArea.StartPos,' SameArea.EndPos=',SameArea.EndPos]);
        while (SameArea.EndPos<=SrcLen)
        and (IsSpaceChar[Src[SameArea.EndPos]]) do
          inc(SameArea.EndPos);
        if (SameArea.EndPos>CleanPos) or (SameArea.EndPos>SrcLen) then begin
          // cursor is in normal space (i.e. not comment)
          exit;
        end;
        // still between the two tokens, but end of space
        // -> here starts a comment
        SameArea.StartPos:=SameArea.EndPos;
        MoveCursorToCleanPos(SameArea.StartPos);
        //debugln(['TCustomCodeTool.GetCleanPosInfo C "',dbgstr(Src,SameArea.StartPos,Max(3,FindCommentEnd(Src,SameArea.StartPos,Scanner.NestedComments)-SameArea.StartPos)),'"']);
        ReadTillCommentEnd;
        SameArea.EndPos:=CurPos.StartPos;
        //debugln(['TCustomCodeTool.GetCleanPosInfo D "',dbgstr(Src,SameArea.StartPos,SameArea.EndPos-SameArea.StartPos),'"']);
        if (SameArea.StartPos=SameArea.EndPos) then
          // inconsistency: some non space and non comment between two tokens
          RaiseException(20170421194850,'TCustomCodeTool.GetCleanPosInfo Internal Error A');
        if CleanPos<SameArea.EndPos then begin
          // cursor is in comment
          if ResolveComments then begin
            // take comment as normal code and search again
            CodePosInFront:=SameArea.StartPos;
            case Src[CodePosInFront] of
            '{':
              begin
                inc(CodePosInFront);
                if (CodePosInFront<=SrcLen) and (Src[CodePosInFront+1]=#3) then
                  inc(CodePosInFront);
              end;
            '(','/': inc(CodePosInFront,2);
            else
              RaiseException(20170421194855,'TCustomCodeTool.GetCleanPosInfo Internal Error B '
                +dbgstr(Src[CodePosInFront])+' at '+CleanPosToStr(CodePosInFront,true));
            end;
            if CodePosInFront>CleanPos then
              // CleanPos at start of comment => return comment
              exit;
            GetCleanPosInfo(CodePosInFront,CleanPos,true,SameArea);
          end;
          exit;
        end;
        SameArea.StartPos:=SameArea.EndPos;
      until false;
    end;
  until (CurPos.EndPos>CleanPos) or (CurPos.StartPos>SrcLen);
  SameArea:=CurPos;
end;

procedure TCustomCodeTool.GetLineInfo(ACleanPos: integer;
  out ALineStart, ALineEnd, AFirstAtomStart, ALastAtomEnd: integer);
begin
  if ACleanPos>=1 then begin
    if ACleanPos<=SrcLen then begin
      // search line start
      ALineStart:=ACleanPos;
      while (ALineStart>1) and (not (Src[ALineStart-1] in [#10,#13])) do
        dec(ALineStart);
      // search line end
      ALineEnd:=ACleanPos;
      while (ALineEnd<=SrcLen) and (not (Src[ALineEnd] in [#10,#13])) do
        inc(ALineEnd);
      // search first atom in line
      MoveCursorToCleanPos(ALineStart);
      ReadNextAtom;
      AFirstAtomStart:=CurPos.StartPos;
      // search last atom in line
      repeat
        ALastAtomEnd:=CurPos.EndPos;
        ReadNextAtom;
      until (CurPos.EndPos>ALineEnd) or (CurPos.StartPos>SrcLen);
    end else begin
      ALineStart:=Srclen+1;
      ALineEnd:=Srclen+1;
      AFirstAtomStart:=Srclen+1;
      ALastAtomEnd:=Srclen+1;
    end;
  end else begin
    ALineStart:=1;
    ALineEnd:=1;
    AFirstAtomStart:=1;
    ALastAtomEnd:=1;
  end;
end;

function TCustomCodeTool.FindLineEndOrCodeAfterPosition(StartPos: integer;
  SkipEmptyLines: boolean; IncludeLineEnd: boolean): integer;
{ Searches a nice position in the cleaned source after StartPos.
  It will skip any space and comments (not directives) till next
  line end or compiler directive or code or include file end.
}
var
  LinkIndex, LinkEnd: integer;
begin
  Result:=StartPos;
  LinkIndex:=Scanner.LinkIndexAtCleanPos(StartPos);
  if LinkIndex>=0 then begin
    LinkEnd:=Scanner.LinkCleanedEndPos(LinkIndex);
    if LinkEnd>StartPos then
      Result:=BasicCodeTools.FindLineEndOrCodeAfterPosition(Src,
                    StartPos,LinkEnd-1,Scanner.NestedComments,true,SkipEmptyLines,
                    IncludeLineEnd);
  end;
end;

function TCustomCodeTool.FindLineEndOrCodeInFrontOfPosition(StartPos: integer;
  StopAtDirectives: boolean; SkipEmptyLines: boolean): integer;
{ Searches a nice position in the cleaned source in front of StartPos.
  It will skip any space or comments (not directives) till next
  line end or compiler directive or code or include file end.
}
var
  LinkIndex, LinkStart: integer;
begin
  Result:=StartPos;
  LinkIndex:=Scanner.LinkIndexAtCleanPos(StartPos);
  if LinkIndex>=0 then begin
    LinkStart:=Scanner.Links[LinkIndex].CleanedPos;
    Result:=BasicCodeTools.FindLineEndOrCodeInFrontOfPosition(Src,
              StartPos,LinkStart,Scanner.NestedComments,StopAtDirectives,false,
              SkipEmptyLines);
  end;
end;

function TCustomCodeTool.SkipResourceDirective(StartPos: integer): integer;
var
  LinkIndex, LinkEnd: integer;
begin
  Result:=StartPos;
  LinkIndex:=Scanner.LinkIndexAtCleanPos(StartPos);
  if LinkIndex>=0 then begin
    LinkEnd:=Scanner.LinkCleanedEndPos(LinkIndex);
    Result:=BasicCodeTools.SkipResourceDirective(Src,StartPos,LinkEnd,Scanner.NestedComments);
  end;
end;

procedure TCustomCodeTool.ClearIgnoreErrorAfter;
begin
  IgnoreErrorAfter:=CodePosition(0,nil);
end;

function TCustomCodeTool.UpdateNeeded(Range: TLinkScannerRange): boolean;
begin
  {$IFDEF CTDEBUG}
  DebugLn('TCustomCodeTool.UpdateNeeded A Range=',dbgs(Range),' ',Scanner.MainFilename);
  {$ENDIF}
  if Range=lsrNone then exit(false);
  if (not LastErrorValid) and (ord(FRangeValidTill)<ord(Range)) then begin
    {$IFDEF VerboseUpdateNeeded}
    DebugLn(['TCustomCodeTool.UpdateNeeded because range increased from ',dbgs(FRangeValidTill),' to ',dbgs(Range),' ',MainFilename]);
    {$ENDIF}
    exit(true);
  end;
  if (FLastScannerChangeStep<>Scanner.ChangeStep) then begin
    {$IFDEF VerboseUpdateNeeded}
    DebugLn(['TCustomCodeTool.UpdateNeeded because FLastScannerChangeStep<>Scanner.ChangeStep ',MainFilename]);
    {$ENDIF}
    FRangeValidTill:=lsrNone;
    Result:=true;
  end else begin
    Result:=Scanner.UpdateNeeded(Range, CheckFilesOnDisk);
    if Result then begin
      {$IFDEF VerboseUpdateNeeded}
      DebugLn(['TCustomCodeTool.UpdateNeeded because Scanner.UpdateNeeded ',MainFilename]);
      {$ENDIF}
      // decrease valid range
      FRangeValidTill:=Pred(Range);
      ClearLastError;
    end;
  end;
  {$IFDEF CTDEBUG}
  DebugLn('TCustomCodeTool.UpdateNeeded END  Result=',dbgs(Result));
  {$ENDIF}
end;

function TCustomCodeTool.CompareSrcIdentifiers(Identifier1, Identifier2: PChar
  ): boolean;
begin
  Result:=false;
  if (Identifier1=nil) or (Identifier2=nil) then exit;
  while IsIdentChar[Identifier1^] do begin
    if (UpChars[Identifier1^]=UpChars[Identifier2^]) then begin
      inc(Identifier1);
      inc(Identifier2);
    end else
      exit(false);
  end;
  Result:=not IsIdentChar[Identifier2^];
end;

function TCustomCodeTool.CompareSrcIdentifiers(CleanStartPos: integer;
  AnIdentifier: PChar): boolean;
begin
  Result:=false;
  if (AnIdentifier=nil) or (CleanStartPos<1) or (CleanStartPos>SrcLen) then
    exit;
  while IsIdentChar[AnIdentifier^] do begin
    if (UpChars[AnIdentifier^]=UpChars[Src[CleanStartPos]]) then begin
      inc(AnIdentifier);
      inc(CleanStartPos);
      if CleanStartPos>SrcLen then begin
        Result:=not IsIdentChar[AnIdentifier^];
        exit;
      end;
    end else
      exit(false);
  end;
  Result:=not IsIdentChar[Src[CleanStartPos]];
end;

function TCustomCodeTool.CompareSrcIdentifiersMethod(Identifier1,
  Identifier2: Pointer): integer;
begin
  Result:=CompareIdentifiers(Identifier1,Identifier2);
end;

function TCustomCodeTool.ExtractIdentifier(CleanStartPos: integer): string;
var len: integer;
begin
  if (CleanStartPos>=1) then begin
    len:=0;
    while (CleanStartPos<=SrcLen)
    and (IsIdentChar[Src[CleanStartPos+len]]) do
      inc(len);
    SetLength(Result,len);
    if len>0 then
      Move(Src[CleanStartPos],Result[1],len);
  end else
    Result:='';
end;

function TCustomCodeTool.ExtractDottedIdentifier(CleanStartPos: integer): string;
begin
  Result:=GetDottedIdentifier(@Src[CleanStartPos]);
end;

procedure TCustomCodeTool.DoDeleteNodes(StartNode: TCodeTreeNode);
// delete Node and all following nodes
var
  AVLNode: TAVLTreeNode;
  NextAVLNode: TAVLTreeNode;
  Node: TCodeTreeNode;
begin
  if StartNode<>nil then begin
    //debugln(['TCustomCodeTool.DoDeleteNodes Node=',StartNode.DescAsString,' ',MainFilename]);
    //DebugLn(['TCustomCodeTool.DoDeleteNodes ',MainFilename]);
    // first notify, so that references could be deleted clean
    IncreaseTreeChangeStep(true);
    if (CurNode<>nil) and (StartNode.StartPos<=CurNode.StartPos) then
      CurNode:=nil;

    // free errors and nodes
    if StartNode=Tree.Root then begin
      DisposeAVLTree(FNodeParseErrors);
      Tree.Clear;
    end else begin
      if (FNodeParseErrors<>nil) then begin
        AVLNode:=FNodeParseErrors.FindLowest;
        while AVLNode<>nil do begin
          NextAVLNode:=FNodeParseErrors.FindSuccessor(AVLNode);
          if TCodeTreeNodeParseError(AVLNode.Data).Node.StartPos>=StartNode.StartPos
          then
            FNodeParseErrors.FreeAndDelete(AVLNode);
          AVLNode:=NextAVLNode;
        end;
      end;
      Node:=StartNode;
      repeat
        while Node.NextBrother<>nil do
          Tree.DeleteNode(Node.NextBrother);
        Node:=Node.Parent;
      until Node=nil;
      Tree.DeleteNode(StartNode);
    end;
  end;
end;

procedure TCustomCodeTool.CloseUnfinishedNodes;
var
  p: LongInt;
begin
  if CurNode=nil then exit;
  // close all unfinished nodes
  p:=CurPos.StartPos;
  if p>SrcLen then p:=SrcLen+1;
  while CurNode<>nil do begin
    //debugln(['TCustomCodeTool.CloseUnfinishedNodes BEFORE ',CurNode.DescAsString,' CurNode.EndPos=',CurNode.EndPos]);
    if CurNode.EndPos<1 then begin
      if CurNode.StartPos>p then p:=CurNode.StartPos;
      CurNode.EndPos:=p;
    end else if p<CurNode.EndPos then begin
      p:=CurNode.EndPos;
    end else if (CurNode.LastChild<>nil) and (CurNode.EndPos<CurNode.LastChild.EndPos) then
      CurNode.EndPos:=CurNode.LastChild.EndPos;
    //debugln(['TCustomCodeTool.CloseUnfinishedNodes AFTER ',CurNode.DescAsString,' CurNode.EndPos=',CleanPosToStr(CurNode.EndPos)]);
    CurNode:=CurNode.Parent;
  end;
end;

procedure TCustomCodeTool.SaveRaiseIdentExpectedButAtomFound(id: int64);
begin
  SaveRaiseExceptionFmt(id,ctsIdentExpectedButAtomFound,[GetAtom]);
end;

procedure TCustomCodeTool.SaveRaiseBracketOpenExpectedButAtomFound(id: int64);
begin
  SaveRaiseExceptionFmt(id,ctsBracketOpenExpectedButAtomFound,[GetAtom]);
end;

procedure TCustomCodeTool.SaveRaiseBracketCloseExpectedButAtomFound(id: int64);
begin
  if CurPos.StartPos<SrcLen then
    SaveRaiseExceptionFmt(id,ctsBracketCloseExpectedButAtomFound,[GetAtom])
  else
    SaveRaiseExceptionFmt(id,ctsBracketNotFound,[])
end;

procedure TCustomCodeTool.ActivateGlobalWriteLock;
begin
  if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(true);
end;

procedure TCustomCodeTool.DeactivateGlobalWriteLock;
begin
  if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(false);
end;

function TCustomCodeTool.MainFilename: string;
begin
  if (Scanner<>nil) and (Scanner.MainCode<>nil) then
    Result:=TCodeBuffer(Scanner.MainCode).Filename
  else
    Result:=ctsUnknownMainFilename;
end;

{ ECodeToolError }

constructor ECodeToolError.Create(ASender: TCustomCodeTool; TheId: int64;
  const AMessage: string);
begin
  inherited Create(AMessage);
  Sender:=ASender;
  Id:=TheId;
end;

{ ECodeToolFileNotFound }

constructor ECodeToolFileNotFound.Create(ASender: TCustomCodeTool;
  TheId: int64; const AMessage, AFilename: string);
begin
  inherited Create(ASender,TheId,AMessage);
  Filename:=AFilename;
end;

{ TCodeTreeNodeParseError }

constructor TCodeTreeNodeParseError.Create(ANode: TCodeTreeNode);
begin
  Node:=ANode;
end;

initialization
  RaiseUnhandableExceptions:=false;

end.