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

  Author: Mattias Gaertner

  Abstract:
    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}
{$DEFINE ShowDirtySrc}

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

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

  TCustomCodeTool = class;


  // types for errors
  ECodeToolError = class(Exception)
    Sender: TCustomCodeTool;
    constructor Create(ASender: TCustomCodeTool; const AMessage: string);
  end;
  
  ECodeToolErrors = class of ECodeToolError;
  
  ECodeToolFileNotFound = class(ECodeToolError)
    Filename: string;
    constructor Create(ASender: TCustomCodeTool;
      const AMessage, AFilename: string);
  end;
  
  
  { TDirtySource - class to store a dirty source }

  TDirtySource = class
  public
    CursorPos: TCodeXYPosition;
    Src: string;
    GapSrc: string;
    Code: TCodeBuffer;
    Valid: boolean;
    CurPos: TAtomPosition;
    StartPos: integer;
    GapStart: integer;
    GapEnd: integer;
    LockCount: integer;
    Owner: TCustomCodeTool;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure SetGap(const NewCursorPos: TCodeXYPosition;
                   NewDirtyStartPos, NewDirtyGapStart, NewDirtyGapEnd: integer);
    constructor Create(TheOwner: TCustomCodeTool);
    procedure Clear;
    procedure SetCursorToIdentStartEndAtPosition;
    function GetCursorSrcPos: PChar;
    function IsPCharInSrc(p: PChar): boolean;
    procedure MoveCursorToPos(APos: integer);
    procedure MoveCursorToPos(APos: PChar);
    function CalcMemSize: PtrUInt;
  end;
  
  THybridCursorType = (
    hcClean,
    hcDirty
    );


  // 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;
    function DefaultKeyWordFunc: boolean;
    procedure BuildDefaultKeyWordFunctions; virtual;
    procedure SetScanner(NewScanner: TLinkScanner); virtual;
    procedure DoDeleteNodes(StartNode: TCodeTreeNode); virtual;
    procedure CloseUnfinishedNodes;
    procedure SaveRaiseIdentExpectedButAtomFound;
    procedure SaveRaiseBracketOpenExpectedButAtomFound;
    procedure SaveRaiseBracketCloseExpectedButAtomFound;
    procedure RaiseUndoImpossible;
    procedure SetIgnoreErrorAfter(const AValue: TCodePosition); virtual;
    procedure IncreaseTreeChangeStep(NodesDeleting: boolean);
  protected
    LastErrorMessage: string;
    LastErrorCurPos: TAtomPosition;
    LastErrorValid: boolean;
    LastErrorBehindIgnorePosition: boolean;
    LastErrorCheckedForIgnored: boolean;
    LastErrorNicePosition: TCodeXYPosition;
    procedure ClearLastError;
    procedure RaiseLastError;
    procedure DoProgress; inline;
    procedure NotifyAboutProgress;
    // dirty/dead source
    procedure LoadDirtySource(const CursorPos: TCodeXYPosition);
    procedure FetchScannerSource(Range: TLinkScannerRange); virtual;
    function InternalAtomIsIdentifier: boolean; inline;
  public
    Tree: TCodeTree;

    // current Values, Position, Node ...
    CurPos: TAtomPosition;
    Src: string;
    SrcLen: integer;
    CurNode: TCodeTreeNode;
    LastAtoms: TAtomRing;
    NextPos: TAtomPosition;
    
    CheckFilesOnDisk: boolean;
    IndentSize: integer;
    VisibleEditorLines: integer;
    JumpCentered: boolean;
    CursorBeyondEOL: boolean;
    
    DirtySrc: TDirtySource;
    HybridCursorType: THybridCursorType;

    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 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 UpdateNeeded(Range: TLinkScannerRange): boolean;
    function UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean; deprecated; // use UpdateNeeded(lsrImplementationStart) or UpdateNeeded(lsrEnd)
    procedure BeginParsing(Range: TLinkScannerRange); virtual;
    procedure BeginParsingAndGetCleanPos(
        Range: TLinkScannerRange; CursorPos: TCodeXYPosition;
        out CleanCursorPos: integer);
    procedure BeginParsingAndGetCleanPosOLD(
        OnlyInterfaceNeeded: boolean; CursorPos: TCodeXYPosition;
        out CleanCursorPos: integer);
    function IsDirtySrcValid: boolean;

    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;
    procedure MoveHybridCursorToPos(DirtyPos: PChar);
    function GetHybridCursorStart: integer;
    
    // 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;
    function UpAtomIs(const AnAtom: shortstring): boolean;
    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;
    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;

    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(const AMessage: string;
      ExceptionClass: ECodeToolErrors; ClearNicePos: boolean); virtual;
    procedure RaiseException(const AMessage: string;
      ClearNicePos: boolean = true); virtual;
    procedure RaiseExceptionFmt(const AMessage: string;
      const args: array of const; ClearNicePos: boolean = true);
    procedure RaiseExceptionAtErrorPos(const AMessage: string;
      ClearNicePos: boolean = true); virtual;
    // permanent errors, that the parser will raise again
    procedure SaveRaiseException(const AMessage: string;
      ClearNicePos: boolean = true); virtual;
    procedure SaveRaiseExceptionFmt(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;
      CheckIgnoreErrorPos: boolean = true);
    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);
  FreeAndNil(DirtySrc);
  inherited Destroy;
end;

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

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

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

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

procedure TCustomCodeTool.SaveRaiseException(const AMessage: string;
  ClearNicePos: boolean);
var
  Node: TCodeTreeNode;
begin
  LastErrorMessage:=AMessage;
  LastErrorCurPos:=CurPos;
  LastErrorValid:=true;
  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(AMessage,ClearNicePos);
end;

procedure TCustomCodeTool.SaveRaiseExceptionFmt(const AMessage: string;
  const args: array of const; ClearNicePos: boolean);
begin
  SaveRaiseException(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(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('Abort',EParserAbort,true);
  end;
end;

procedure TCustomCodeTool.LoadDirtySource(const CursorPos: TCodeXYPosition);
// - create the DirtySrc object
// - load the unparsed source at CursorPos
// - find the gap bounds
var
  NewDirtyStartPos: integer;
  NewDirtyGapStart: integer;
  NewDirtyGapEnd: integer;
  CursorInLink: Boolean;
  BestLinkIndex: Integer;
  BestLink: TSourceLink;
begin
  DebugLn('TCustomCodeTool.LoadDirtySource X=',dbgs(CursorPos.X),' Y=',dbgs(CursorPos.Y),
    ' ',ExtractFilename(CursorPos.Code.Filename));
  if DirtySrc=nil then DirtySrc:=TDirtySource.Create(Self);
  CursorPos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,NewDirtyStartPos);
  if NewDirtyStartPos<1 then
    RaiseCatchableException('NewDirtyStartPos<1');
  CursorInLink:=false;
  BestLinkIndex:=Scanner.LinkIndexNearCursorPos(NewDirtyStartPos,
                                                CursorPos.Code,CursorInLink);
  if BestLinkIndex<0 then
    RaiseCatchableException('BestLinkIndex<0');
  if CursorInLink then
    RaiseCatchableException('CursorInLink');
  BestLink:=Scanner.Links[BestLinkIndex];
  NewDirtyGapStart:=BestLink.SrcPos+Scanner.LinkSize(BestLinkIndex);
  if BestLinkIndex<Scanner.LinkCount then
    NewDirtyGapEnd:=Scanner.Links[BestLinkIndex+1].SrcPos
  else
    NewDirtyGapEnd:=CursorPos.Code.SourceLength;
  DirtySrc.SetGap(CursorPos,NewDirtyStartPos,NewDirtyGapStart,NewDirtyGapEnd);
end;

procedure TCustomCodeTool.FetchScannerSource(Range: TLinkScannerRange);
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);
    {$IFDEF VerboseUpdateNeeded}
    DebugLn(['TCustomCodeTool.BeginParsing ',MainFilename]);
    {$ENDIF}
    FRangeValidTill:=lsrInit;
    DirtySrc.Free;
    DirtySrc:=nil;
  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;
begin
  RaiseException('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:
    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 (CleanStartPos1<=SrcLen) and 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(ctsIdentExpectedButEOFFound,[GetAtom],true);
  end;

  procedure RaiseAtomFound;
  begin
    RaiseExceptionFmt(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;

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

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

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

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

begin
  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 (p[1] in ['0'..'7']) 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
          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
  Result:=false;
  if (BackIndex>=0) and (BackIndex<LastAtoms.Count) then begin
    ap:=LastAtoms.GetValueAt(BackIndex);
    Result:=false;
    if (ap.StartPos<SrcLen) and (ap.EndPos<=SrcLen+1)
    and (ap.StartPos>=1) then begin
      AnAtomLen:=length(AnAtom);
      if AnAtomLen=ap.EndPos-ap.StartPos then begin
        for i:=1 to AnAtomLen do
          if AnAtom[i]<>Src[ap.StartPos-1+i] then exit;
        Result:=true;
      end;
    end;
  end;
end;

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

procedure TCustomCodeTool.ReadNextAtom;
var
  c1, c2: char;
  CommentLvl: integer;
  p: PChar;
begin
  {$IFOPT R+}{$DEFINE RangeChecking}{$ENDIF}
  {$R-}
  if (CurPos.StartPos<CurPos.EndPos) then
    LastAtoms.Add(CurPos);
  if NextPos.StartPos<1 then begin
    CurPos.StartPos:=CurPos.EndPos;
    CurPos.Flag:=cafNone;
    if CurPos.StartPos>SrcLen then
      exit;
    // 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
          CommentLvl:=1;
          while true do begin
            inc(p);
            case p^ of
            #0:
              begin
                CurPos.StartPos:=p-PChar(Src)+1;
                if CurPos.StartPos>SrcLen then break;
              end;
            '{':
              if Scanner.NestedComments then begin
                //debugln('TCustomCodeTool.ReadNextAtom ',copy(Src,CurPos.StartPos,CurPos.StartPos-CurPos.EndPos));
                inc(CommentLvl);
              end;
            '}':
              begin
                dec(CommentLvl);
                if CommentLvl=0 then begin
                  inc(p);
                  break;
                end;
              end;
            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 p^ in ['0'..'7'] then begin
          while p^ in ['0'..'7'] do
            inc(p);
        end else if IsIdentChar[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);
        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;
  end else begin
    CurPos:=NextPos;
    NextPos.StartPos:=-1;
  end;
  {$IFDEF RangeChecking}{$R+}{$UNDEF RangeChecking}{$ENDIF}
end;

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
          // skip pascal comment
          CommentLvl:=1;
          inc(PrePos);
          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;

      '(':
        begin
          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;
        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.Count>0 then begin
    UndoReadNextAtom;
    exit;
  end;
  NextPos:=CurPos;
  // 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
      
      '}': // pascal comment
        begin
          CommentLvl:=1;
          dec(CurPos.StartPos);
          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;
        
      #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
    exit;
  // read atom
  if IsStringConstant then begin
    CurPos.StartPos:=OldPrePos;
    if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]='''') then begin
      ReadStringConstantBackward;
    end;
    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  (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:=cafNone;
          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;
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;
  repeat
    ReadNextAtom;
    if CurPos.EndPos>=CleanPos then begin
      UndoReadNextAtom;
      exit;
    end;
  until false;
end;

procedure TCustomCodeTool.ReadAsStringConstant;
var
  p: PChar;
begin
  CurPos.Flag:=cafNone;
  NextPos.StartPos:=-1;
  if CurPos.StartPos>SrcLen then begin
    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;
end;

procedure TCustomCodeTool.UndoReadNextAtom;
begin
  if LastAtoms.Count>0 then begin
    NextPos:=CurPos;
    CurPos:=LastAtoms.GetValueAt(0);
    LastAtoms.UndoLastAdd;
  end else
    RaiseUndoImpossible;
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;
  
  procedure RaiseBracketNotFound;
  begin
    if CloseBracket=cafRoundBracketClose then
      SaveRaiseExceptionFmt(ctsBracketNotFound,[')'],false)
    else
      SaveRaiseExceptionFmt(ctsBracketNotFound,[']'],false);
  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;
    exit;
  end;
  Start:=CurPos;
  repeat
    ReadNextAtom;
    if (CurPos.Flag=CloseBracket) then break;
    if (CurPos.StartPos>SrcLen)
    or (CurPos.Flag in [cafEnd,AntiCloseBracket])
    then begin
      SetNiceErrorPos(Start.StartPos);
      if ExceptionOnNotFound then begin
        RaiseBracketNotFound;
      end;
      exit;
    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, AntiOpenBracket: TCommonAtomFlag;
  Start: TAtomPosition;
  
  procedure RaiseBracketNotFound;
  begin
    if OpenBracket=cafRoundBracketOpen then
      SaveRaiseExceptionFmt(ctsBracketNotFound,['('],true)
    else
      SaveRaiseExceptionFmt(ctsBracketNotFound,['['],true);
  end;
  
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;
    exit;
  end;
  Start:=CurPos;
  repeat
    ReadPriorAtom;
    if (CurPos.Flag=OpenBracket) then break;
    if (CurPos.StartPos<1)
    or (CurPos.Flag in [AntiOpenBracket,cafEND])
    or ((CurPos.Flag=cafWord)
        and UnexpectedKeyWordInBrackets.DoItCaseInsensitive(Src,
             CurPos.StartPos,CurPos.EndPos-CurPos.StartPos))
    then begin
      CurPos:=Start;
      if ExceptionOnNotFound then
        RaiseBracketNotFound;
      exit;
    end;
    if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then begin
      if not ReadBackTilBracketOpen(ExceptionOnNotFound) then exit;
    end;
  until false;
  Result:=true;
end;

procedure TCustomCodeTool.ReadTillCommentEnd;
var
  CommentLvl: Integer;
begin
  {$IFOPT R+}{$DEFINE RangeChecking}{$ENDIF}
  {$R-}
  case Src[CurPos.StartPos] of
  '{': // pascal comment
    begin
      CommentLvl:=1;
      inc(CurPos.StartPos);
      while true do begin
        case Src[CurPos.StartPos] of
        #0:  if CurPos.StartPos>SrcLen then break;
        '{': if Scanner.NestedComments then inc(CommentLvl);
        '}':
          begin
            dec(CommentLvl);
            if CommentLvl=0 then break;
          end;
        end;
        inc(CurPos.StartPos);
      end;
      inc(CurPos.StartPos);
    end;
  '/':  // Delphi comment
    if (Src[CurPos.StartPos+1]='/') then begin
      inc(CurPos.StartPos,2);
      while (not (Src[CurPos.StartPos] in [#10,#13,#0])) do
        inc(CurPos.StartPos);
      inc(CurPos.StartPos);
      if (CurPos.StartPos<=SrcLen) and (Src[CurPos.StartPos] in [#10,#13])
      and (Src[CurPos.StartPos-1]<>Src[CurPos.StartPos]) then
        inc(CurPos.StartPos);
    end;
  '(': // old turbo pascal comment
    if (Src[CurPos.StartPos+1]='*') then begin
      inc(CurPos.StartPos,3);
      while (CurPos.StartPos<=SrcLen)
      and ((Src[CurPos.StartPos-1]<>'*') or (Src[CurPos.StartPos]<>')')) do
        inc(CurPos.StartPos);
      inc(CurPos.StartPos);
    end;
  end;
  {$IFDEF RangeChecking}{$R+}{$UNDEF RangeChecking}{$ENDIF}
end;

procedure TCustomCodeTool.BeginParsing(Range: TLinkScannerRange);
begin
  // scan
  FLastProgressPos:=0;
  Scanner.Scan(Range,CheckFilesOnDisk);
  FetchScannerSource(Range);
  // init parsing values
  CurPos:=StartAtomPosition;
  LastAtoms.Clear;
  NextPos.StartPos:=-1;
  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(ctsCursorPosOutsideOfCode,true);
  end;
end;

procedure TCustomCodeTool.BeginParsingAndGetCleanPosOLD(
  OnlyInterfaceNeeded: boolean; CursorPos: TCodeXYPosition;
  out CleanCursorPos: integer);
var
  Range: TLinkScannerRange;
begin
  if OnlyInterfaceNeeded then
    Range:=lsrImplementationStart
  else
    Range:=lsrEnd;
  BeginParsingAndGetCleanPos(Range,CursorPos,CleanCursorPos);
end;

function TCustomCodeTool.IsDirtySrcValid: boolean;
begin
  Result:=(DirtySrc<>nil) and (DirtySrc.Code<>nil);
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;
  CheckIgnoreErrorPos: boolean);
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(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;
  // 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<>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 scanned'
          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(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;
  NextPos.StartPos:=-1;
  CurNode:=nil;
  HybridCursorType:=hcClean;
end;

procedure TCustomCodeTool.MoveCursorToCleanPos(ACleanPos: PChar);

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

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

procedure TCustomCodeTool.MoveCursorToAtomPos(const AnAtomPos: TAtomPosition);
begin
  MoveCursorToCleanPos(AnAtomPos.StartPos);
  CurPos:=AnAtomPos;
end;

procedure TCustomCodeTool.MoveCursorToNearestAtom(ACleanPos: integer);
var
  ANode: TCodeTreeNode;
  BestPos: Integer;
begin
  ANode:=FindDeepestNodeAtPos(ACleanPos,true);
  if ANode=nil then
    RaiseException('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;
var NewPos: integer;
begin
  Result:=false;
  if Src='' then exit;
  NewPos:=PtrInt(PtrUInt(ACleanPos))-PtrInt(PtrUInt(@Src[1]))+1;
  if (NewPos<1) or (NewPos>SrcLen) then exit;
  Result:=true;
end;

procedure TCustomCodeTool.MoveHybridCursorToPos(DirtyPos: PChar);
begin
  if IsDirtySrcValid and (not IsPCharInSrc(DirtyPos)) then begin
    DirtySrc.MoveCursorToPos(DirtyPos);
    HybridCursorType:=hcDirty;
  end else
    MoveCursorToCleanPos(DirtyPos);
end;

function TCustomCodeTool.GetHybridCursorStart: integer;
begin
  if HybridCursorType=hcDirty then
    Result:=DirtySrc.CurPos.StartPos
  else
    Result:=CurPos.StartPos;
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;
  //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(const AMessage: string;
  ExceptionClass: ECodeToolErrors; ClearNicePos: boolean);
begin
  RaiseExceptionInstance(ExceptionClass.Create(Self,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);
  if DirtySrc<>nil then
    Stats.Add('TCustomCodeTool.DirtySrc',
      DirtySrc.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('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(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)+')';
      RaiseException(Msg);
    end;

    // p is in parsed code, the StartNode is wrong
    CTDumpStack;
    if (StartNode<>nil) then
      RaiseException('Invalid search. The search for pascal started at '
                     +CleanPosToStr(StartNode.StartPos)+'. Invalid search')
    else
      RaiseException('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,' ',Caret.Code.SourceLength]);
  Caret.Code.LineColToPosition(Caret.Y,Caret.X,CleanPos);
  //DebugLn(['TCustomCodeTool.CaretToCleanPos B ',CleanPos,',',Caret.Y,',',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 JumpCentered then begin
      NewTopLine:=Caret.Y-(VisibleEditorLines shr 1);
      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:='';
    if WithFilename then
      Result:=ExtractRelativepath(ExtractFilePath(MainFilename),CodePos.Code.Filename)+',';
    Result:=Result+'line '+IntToStr(CodePos.Y)+', column '+IntToStr(CodePos.X);
  end else
    Result:='outside scan range, pos='+IntToStr(CleanPos)+'('+dbgstr(copy(Src,CleanPos-5,5)+'|'+copy(Src,CleanPos,5))+')';
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);
var
  ANode: TCodeTreeNode;
begin
  SameArea:=CleanAtomPosition;
  if CodePosInFront<1 then begin
    ANode:=FindDeepestNodeAtPos(CleanPos,True);
    CodePosInFront:=ANode.StartPos;
  end;
  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.Count>0 then begin
        SameArea.StartPos:=LastAtoms.GetValueAt(0).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);
        ReadTillCommentEnd;
        SameArea.EndPos:=CurPos.StartPos;
        if (SameArea.StartPos=SameArea.EndPos) then
          RaiseException('TCustomCodeTool.GetCleanPosInfo Internal Error A',true);
        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
            '{': inc(CodePosInFront);
            '(','/': inc(CodePosInFront,2);
            else
              RaiseException('TCustomCodeTool.GetCleanPosInfo Internal Error B',true);
            end;
            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;

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}
    Result:=true;
    exit;
  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);
    end;
  end;
  {$IFDEF CTDEBUG}
  DebugLn('TCustomCodeTool.UpdateNeeded END  Result=',dbgs(Result));
  {$ENDIF}
end;

function TCustomCodeTool.UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean;
begin
  if OnlyInterfaceNeeded then
    Result:=UpdateNeeded(lsrImplementationStart)
  else
    Result:=UpdateNeeded(lsrEnd);
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;

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
      p:=CurNode.EndPos;
    //debugln(['TCustomCodeTool.CloseUnfinishedNodes AFTER ',CurNode.DescAsString,' CurNode.EndPos=',CleanPosToStr(CurNode.EndPos)]);
    CurNode:=CurNode.Parent;
  end;
end;

procedure TCustomCodeTool.SaveRaiseIdentExpectedButAtomFound;
begin
  SaveRaiseExceptionFmt(ctsIdentExpectedButAtomFound,[GetAtom],true);
end;

procedure TCustomCodeTool.SaveRaiseBracketOpenExpectedButAtomFound;
begin
  SaveRaiseExceptionFmt(ctsBracketOpenExpectedButAtomFound,[GetAtom],true);
end;

procedure TCustomCodeTool.SaveRaiseBracketCloseExpectedButAtomFound;
begin
  if CurPos.StartPos<SrcLen then
    SaveRaiseExceptionFmt(ctsBracketCloseExpectedButAtomFound,[GetAtom],true)
  else
    SaveRaiseExceptionFmt(ctsBracketNotFound,[],true)
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;
  const AMessage: string);
begin
  inherited Create(AMessage);
  Sender:=ASender;
end;

{ ECodeToolFileNotFound }

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

{ TDirtySource }

procedure TDirtySource.BeginUpdate;
begin
  inc(LockCount);
end;

procedure TDirtySource.EndUpdate;
begin
  if LockCount<=0 then
    RaiseCatchableException('TDirtySource.EndUpdate');
  dec(LockCount);
end;

procedure TDirtySource.SetGap(const NewCursorPos: TCodeXYPosition;
  NewDirtyStartPos, NewDirtyGapStart, NewDirtyGapEnd: integer);
begin
  // check for conflicts
  if (LockCount>0) then begin
    if (Code<>nil) and (Code<>NewCursorPos.Code) then
      RaiseCatchableException('TDirtySource.SetGap Code change');
    if (GapStart>0) then
      if (NewDirtyStartPos<>StartPos)
      or (NewDirtyGapStart<>GapStart)
      or (NewDirtyGapEnd<>GapEnd) then
        RaiseCatchableException('TDirtySource.SetGap Gap change');
  end;
  if (NewDirtyGapStart>NewDirtyStartPos)
  or (NewDirtyStartPos>NewDirtyGapEnd) then
    RaiseCatchableException('TDirtySource.SetGap Gap Bounds');

  // set values
  CursorPos:=NewCursorPos;
  Code:=CursorPos.Code;
  StartPos:=NewDirtyStartPos;
  GapStart:=NewDirtyGapStart;
  GapEnd:=NewDirtyGapEnd;
  CurPos.StartPos:=StartPos;
  CurPos.EndPos:=StartPos;
  CurPos.Flag:=cafNone;

  // get source
  if Code<>nil then
    Src:=Code.Source
  else
    Src:='';
  if (GapStart>0) then begin
    GapSrc:=copy(Src,GapStart,GapEnd-GapStart);
    {$IFDEF ShowDirtySrc}
    DebugLn('TDirtySource.SetGap Owner=',ExtractFilename(Owner.MainFilename),
      ' Code=',ExtractFilename(Code.Filename),
      ' Gap('+dbgs(GapStart)+','+dbgs(StartPos)+','+dbgs(GapEnd)+')',
      '"',StringToPascalConst(copy(GapSrc,1,20)),'"..',
      '"',StringToPascalConst(copy(GapSrc,length(GapSrc)-19,20)),'"'
      );
    {$ENDIF}
  end else begin
    GapSrc:='';
  end;
end;

constructor TDirtySource.Create(TheOwner: TCustomCodeTool);
begin
  Owner:=TheOwner;
end;

procedure TDirtySource.Clear;
begin
  SetGap(CodeXYPosition(0,0,nil),0,0,0);
end;

procedure TDirtySource.SetCursorToIdentStartEndAtPosition;
begin
  GetIdentStartEndAtPosition(GapSrc,CurPos.StartPos,
                             CurPos.StartPos,CurPos.EndPos);
end;

function TDirtySource.GetCursorSrcPos: PChar;
begin
  Result:=@Src[CurPos.StartPos];
end;

function TDirtySource.IsPCharInSrc(p: PChar): boolean;
var NewPos: integer;
begin
  Result:=false;
  if Src='' then exit;
  NewPos:=PtrInt(PtrUInt(p))-PtrInt(PtrUInt(@Src[1]))+1;
  if (NewPos<1) or (NewPos>length(Src)) then exit;
  Result:=true;
end;

procedure TDirtySource.MoveCursorToPos(APos: integer);
begin
  CurPos.StartPos:=APos;
  CurPos.EndPos:=APos;
  CurPos.Flag:=cafNone;
end;

procedure TDirtySource.MoveCursorToPos(APos: PChar);

  procedure RaiseSrcEmpty;
  begin
    RaiseCatchableException('[TDirtySource.MoveCursorToPos - PChar] Src empty');
  end;

  procedure RaiseNotInSrc;
  begin
    RaiseCatchableException('[TDirtySource.MoveCursorToPos - PChar] Pos not in Src');
  end;

var NewPos: integer;
begin
  if Src='' then
    RaiseSrcEmpty;
  NewPos:=PtrInt(PtrUInt(APos))-PtrInt(PtrUInt(@Src[1]))+1;
  if (NewPos<1) or (NewPos>length(Src)) then
    RaiseNotInSrc;
  MoveCursorToPos(NewPos);
end;

function TDirtySource.CalcMemSize: PtrUInt;
begin
  Result:=PtrUInt(InstanceSize)
    +MemSizeString(Src)
    +MemSizeString(GapSrc);
end;

{ TCodeTreeNodeParseError }

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

initialization
  RaiseUnhandableExceptions:=false;

end.
