mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-25 03:19:36 +02:00
3338 lines
99 KiB
ObjectPascal
3338 lines
99 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
TCustomCodeTool is the ancestor class for code tools which parses code
|
|
beginning with the Main Source code. It can parse atoms, the smallest code
|
|
elements in source code, create new code tree nodes and provides several
|
|
useful functions for parsing and changing code.
|
|
|
|
}
|
|
unit CustomCodeTool;
|
|
|
|
{$ifdef FPC}{$mode objfpc}{$endif}{$H+}
|
|
{$inline on}
|
|
|
|
interface
|
|
|
|
{$I codetools.inc}
|
|
|
|
{ $DEFINE ShowIgnoreError}
|
|
{ $DEFINE VerboseUpdateNeeded}
|
|
|
|
uses
|
|
{$IFDEF MEM_CHECK}
|
|
MemCheck,
|
|
{$ENDIF}
|
|
Classes, SysUtils, AVL_Tree,
|
|
// Codetools
|
|
FileProcs, CodeToolsStrConsts, CodeTree, CodeAtom,
|
|
KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache,
|
|
// LazUtils
|
|
LazFileUtils, LazUtilities, LazDbgLog;
|
|
|
|
type
|
|
TCodeToolPhase = (
|
|
ctpNone,
|
|
ctpScan,
|
|
ctpParse,
|
|
ctpTool
|
|
);
|
|
|
|
TCustomCodeTool = class;
|
|
|
|
|
|
// types for errors
|
|
|
|
{ ECodeToolError }
|
|
|
|
ECodeToolError = class(Exception)
|
|
Sender: TCustomCodeTool;
|
|
Id: int64;
|
|
constructor Create(ASender: TCustomCodeTool; TheId: int64; const AMessage: string);
|
|
end;
|
|
|
|
ECodeToolErrors = class of ECodeToolError;
|
|
|
|
{ ECodeToolFileNotFound }
|
|
|
|
ECodeToolFileNotFound = class(ECodeToolError)
|
|
Filename: string;
|
|
constructor Create(ASender: TCustomCodeTool; TheId: int64;
|
|
const AMessage, AFilename: string);
|
|
end;
|
|
|
|
|
|
// types for user aborts
|
|
TOnParserProgress = function(Tool: TCustomCodeTool): boolean of object;
|
|
TCodeTreeChangeEvent = procedure(Tool: TCustomCodeTool;
|
|
NodesDeleting: boolean) of object;
|
|
TGetChangeStepEvent = procedure(out ChangeStep: integer) of object;
|
|
|
|
EParserAbort = class(ECodeToolError)
|
|
end;
|
|
|
|
{ TCodeTreeNodeParseError }
|
|
|
|
TCodeTreeNodeParseError = class
|
|
public
|
|
Node: TCodeTreeNode;
|
|
CleanPos: integer;
|
|
NicePos: TCodeXYPosition;
|
|
Msg: string;
|
|
constructor Create(ANode: TCodeTreeNode);
|
|
end;
|
|
|
|
{ TCustomCodeTool }
|
|
|
|
TCustomCodeTool = class(TObject)
|
|
private
|
|
FLastProgressPos: integer;
|
|
FNodesDeletedChangeStep: integer;
|
|
FOnParserProgress: TOnParserProgress;
|
|
FOnSetGlobalWriteLock: TOnSetWriteLock;
|
|
FScanner: TLinkScanner;
|
|
FOnTreeChange: TCodeTreeChangeEvent;
|
|
FTreeChangeStep: integer;
|
|
FNodeParseErrors: TAVLTree; // tree of TCodeTreeNodeParseError
|
|
protected
|
|
FLastScannerChangeStep: integer;
|
|
FIgnoreErrorAfter: TCodePosition;
|
|
KeyWordFuncList: TKeyWordFunctionList;
|
|
WordIsKeyWordFuncList: TKeyWordFunctionList;
|
|
FRangeValidTill: TLinkScannerRange; // if there was an error, it excludes the last section
|
|
function DefaultKeyWordFunc: boolean;
|
|
procedure BuildDefaultKeyWordFunctions; virtual;
|
|
procedure SetScanner(NewScanner: TLinkScanner); virtual;
|
|
procedure DoDeleteNodes(StartNode: TCodeTreeNode); virtual;
|
|
procedure CloseUnfinishedNodes;
|
|
procedure SaveRaiseIdentExpectedButAtomFound(id: int64);
|
|
procedure SaveRaiseBracketOpenExpectedButAtomFound(id: int64);
|
|
procedure SaveRaiseBracketCloseExpectedButAtomFound(id: int64);
|
|
procedure RaiseUndoImpossible(id: int64);
|
|
procedure SetIgnoreErrorAfter(const AValue: TCodePosition); virtual;
|
|
procedure IncreaseTreeChangeStep(NodesDeleting: boolean);
|
|
protected
|
|
LastErrorMessage: string;
|
|
LastErrorCurPos: TAtomPosition;
|
|
LastErrorValid: boolean;
|
|
LastErrorBehindIgnorePosition: boolean;
|
|
LastErrorCheckedForIgnored: boolean;
|
|
LastErrorNicePosition: TCodeXYPosition;
|
|
LastErrorId: int64;
|
|
procedure ClearLastError;
|
|
procedure RaiseLastError;
|
|
procedure DoProgress; inline;
|
|
procedure NotifyAboutProgress;
|
|
procedure FetchScannerSource; virtual;
|
|
function InternalAtomIsIdentifier: boolean; inline;
|
|
public
|
|
Tree: TCodeTree;
|
|
|
|
// current Values, Position, Node ...
|
|
CurPos: TAtomPosition;
|
|
Src: string;
|
|
SrcLen: integer;
|
|
CurNode: TCodeTreeNode;
|
|
LastAtoms: TAtomRing;
|
|
|
|
CheckFilesOnDisk: boolean;
|
|
IndentSize: integer;
|
|
VisibleEditorLines: integer;
|
|
JumpSingleLinePos: integer; // in percent 0..100
|
|
JumpCodeBlockPos: integer; // in percent 0..100
|
|
CursorBeyondEOL: boolean;
|
|
|
|
ErrorPosition: TCodeXYPosition;
|
|
ErrorNicePosition: TCodeXYPosition;// if NiceErrorPosition is set, then it is in front of ErrorPosition
|
|
|
|
property Scanner: TLinkScanner read FScanner write SetScanner;
|
|
function MainFilename: string;
|
|
property TreeChangeStep: integer read FTreeChangeStep;
|
|
property NodesDeletedChangeStep: integer read FNodesDeletedChangeStep;
|
|
property OnTreeChange: TCodeTreeChangeEvent read FOnTreeChange
|
|
write FOnTreeChange;
|
|
|
|
function FindDeepestNodeAtPos(P: integer;
|
|
ExceptionOnNotFound: boolean): TCodeTreeNode; {$IFDEF UseInline}inline;{$ENDIF}
|
|
function FindDeepestNodeAtPos(StartNode: TCodeTreeNode; P: integer;
|
|
ExceptionOnNotFound: boolean): TCodeTreeNode;
|
|
function CaretToCleanPos(const Caret: TCodeXYPosition;
|
|
out CleanPos: integer): integer; // 0=valid CleanPos
|
|
//-1=CursorPos was skipped, CleanPos between two links
|
|
// 1=CursorPos beyond scanned code
|
|
//-2=X,Y beyond source
|
|
function CodePosToCleanPos(const CodePos: TCodePosition;
|
|
out CleanPos: integer): integer; // 0=valid CleanPos
|
|
//-1=CursorPos was skipped, CleanPos between two links
|
|
// 1=CursorPos beyond scanned code
|
|
function CleanPosToCodePos(CleanPos: integer;
|
|
out CodePos:TCodePosition): boolean; // true=ok, false=invalid CleanPos
|
|
function CleanPosToCaret(CleanPos: integer;
|
|
out Caret:TCodeXYPosition): boolean; // true=ok, false=invalid CleanPos
|
|
function CleanPosToCaretAndTopLine(CleanPos: integer;
|
|
out Caret:TCodeXYPosition; out NewTopLine: integer): boolean; // true=ok, false=invalid CleanPos
|
|
function CleanPosToStr(CleanPos: integer; WithFilename: boolean = false): string;
|
|
function CodeXYToStr(const CodePos: TCodeXYPosition; WithFilename: boolean = false): string;
|
|
function CleanPosToRelativeStr(CleanPos: integer;
|
|
const BaseFilename: string): string;
|
|
procedure GetCleanPosInfo(CodePosInFront, CleanPos: integer;
|
|
ResolveComments: boolean; out SameArea: TAtomPosition);
|
|
procedure GetLineInfo(ACleanPos: integer;
|
|
out ALineStart, ALineEnd, AFirstAtomStart, ALastAtomEnd: integer);
|
|
function FindLineEndOrCodeAfterPosition(StartPos: integer;
|
|
SkipEmptyLines: boolean = false; IncludeLineEnd: boolean = false): integer;
|
|
function FindLineEndOrCodeInFrontOfPosition(StartPos: integer;
|
|
StopAtDirectives: boolean = true; SkipEmptyLines: boolean = false): integer;
|
|
function SkipResourceDirective(StartPos: integer): integer;
|
|
|
|
function UpdateNeeded(Range: TLinkScannerRange): boolean;
|
|
procedure BeginParsing(Range: TLinkScannerRange); virtual;
|
|
procedure BeginParsingAndGetCleanPos(
|
|
Range: TLinkScannerRange; CursorPos: TCodeXYPosition;
|
|
out CleanCursorPos: integer);
|
|
|
|
function StringIsKeyWord(const Word: string): boolean;
|
|
|
|
// cursor moving
|
|
procedure MoveCursorToNodeStart(ANode: TCodeTreeNode); {$IFDEF UseInline}inline;{$ENDIF}
|
|
procedure MoveCursorToCleanPos(ACleanPos: integer);
|
|
procedure MoveCursorToCleanPos(ACleanPos: PChar);
|
|
procedure MoveCursorToAtomPos(const AnAtomPos: TAtomPosition);
|
|
procedure MoveCursorToNearestAtom(ACleanPos: integer);
|
|
procedure MoveCursorToLastNodeAtom(ANode: TCodeTreeNode);
|
|
function IsPCharInSrc(ACleanPos: PChar): boolean;
|
|
|
|
// read atoms
|
|
procedure ReadNextAtom;
|
|
procedure UndoReadNextAtom;
|
|
procedure ReadPriorAtom;
|
|
procedure ReadPriorAtomSafe(CleanPos: integer);
|
|
procedure ReadAsStringConstant; // start at CurPos.StartPos
|
|
|
|
// read blocks
|
|
function ReadTilBracketClose(ExceptionOnNotFound: boolean): boolean;
|
|
function ReadBackTilBracketOpen(ExceptionOnNotFound: boolean): boolean;
|
|
procedure ReadTillCommentEnd;
|
|
|
|
// read atoms
|
|
function AtomIs(const AnAtom: shortstring): boolean; // case sensitive
|
|
function UpAtomIs(const AnAtom: shortstring): boolean; // compare to uppercase
|
|
function UpAtomIs(const AtomPos: TAtomPosition; const AnAtom: shortstring): boolean; overload;
|
|
function ReadNextAtomIs(const AnAtom: shortstring): boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
function ReadNextAtomIsIdentifier(Identifier: PChar): boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
function ReadNextUpAtomIs(const AnAtom: shortstring): boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
function ReadNextAtomIsChar(const c: char): boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
function AtomIsChar(const c: char): boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
function AtomIsKeyWord: boolean;
|
|
function AtomIsNumber: boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
function AtomIsRealNumber: boolean;
|
|
function AtomIsStringConstant: boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
function AtomIsCharConstant: boolean;
|
|
function AtomIsEmptyStringConstant: boolean;
|
|
function AtomIsIdentifier(Identifier: PChar): boolean;
|
|
function AtomIsIdentifier: boolean;
|
|
procedure AtomIsIdentifierE; overload;
|
|
function AtomIsIdentifierE(ExceptionOnNotFound: boolean): boolean; overload;
|
|
procedure AtomIsIdentifierSaveE(id: int64);
|
|
function AtomIsCustomOperator(AllowIdentifier, ExceptionOnNotFound, SaveE: boolean): boolean;
|
|
function LastAtomIs(BackIndex: integer;
|
|
const AnAtom: shortstring): boolean; // 0=current, 1=prior current, ...
|
|
function LastUpAtomIs(BackIndex: integer;
|
|
const AnAtom: shortstring): boolean; // 0=current, 1=prior current, ...
|
|
function GetAtom: string;
|
|
function GetUpAtom: string;
|
|
function GetAtom(const Atom: TAtomPosition): string;
|
|
function GetUpAtom(const Atom: TAtomPosition): string;
|
|
function FreeUpAtomIs(const FreeAtomPos: TAtomPosition;
|
|
const AnAtom: shortstring): boolean;
|
|
function GetAtomIdentifier: string;
|
|
|
|
// 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 CompareDottedSrcIdentifiers(CleanStartPos: integer;
|
|
AnIdentifier: PChar): boolean;
|
|
function CompareSrcIdentifiersMethod(Identifier1, Identifier2: Pointer): integer;
|
|
function ExtractIdentifier(CleanStartPos: integer): string;
|
|
function ExtractDottedIdentifier(CleanStartPos: integer): string;
|
|
|
|
procedure CreateChildNode;
|
|
procedure EndChildNode; {$IFDEF UseInline}inline;{$ENDIF}
|
|
function DoAtom: boolean; virtual;
|
|
|
|
// write lock
|
|
procedure ActivateGlobalWriteLock; virtual;
|
|
procedure DeactivateGlobalWriteLock; virtual;
|
|
property OnSetGlobalWriteLock: TOnSetWriteLock
|
|
read FOnSetGlobalWriteLock write FOnSetGlobalWriteLock;
|
|
|
|
// error handling
|
|
procedure RaiseExceptionInstance(TheException: ECodeToolError;
|
|
ClearNicePos: boolean = true); virtual;
|
|
procedure RaiseExceptionClass(id: int64; const AMessage: string;
|
|
ExceptionClass: ECodeToolErrors; ClearNicePos: boolean); virtual;
|
|
procedure RaiseException(id: int64; const AMessage: string;
|
|
ClearNicePos: boolean = true); virtual;
|
|
procedure RaiseExceptionFmt(id: int64; const AMessage: string;
|
|
const args: array of const; ClearNicePos: boolean = true);
|
|
procedure RaiseExceptionAtCleanPos(id: int64; const AMessage: string;
|
|
CleanPos: integer); virtual;
|
|
procedure RaiseExceptionAtErrorPos(id: int64; const AMessage: string;
|
|
ClearNicePos: boolean = true); virtual; // set ErrorPosition before calling this
|
|
// permanent errors, that the parser will raise again
|
|
procedure SaveRaiseException(id: int64; const AMessage: string;
|
|
ClearNicePos: boolean = true); virtual;
|
|
procedure SaveRaiseExceptionFmt(id: int64; const AMessage: string;
|
|
const args: array of const; ClearNicePos: boolean = true);
|
|
procedure SetNiceErrorPos(CleanPos: integer);
|
|
property IgnoreErrorAfter: TCodePosition
|
|
read FIgnoreErrorAfter write SetIgnoreErrorAfter;
|
|
procedure ClearIgnoreErrorAfter;
|
|
function IgnoreErrorAfterPositionIsInFrontOfLastErrMessage: boolean;
|
|
function IgnoreErrorAfterValid: boolean;
|
|
function IgnoreErrorAfterCleanedPos: integer;
|
|
function CleanPosIsAfterIgnorePos(CleanPos: integer): boolean;
|
|
function LastErrorIsInFrontOfCleanedPos(ACleanedPos: integer): boolean;
|
|
procedure RaiseLastErrorIfInFrontOfCleanedPos(ACleanedPos: integer);
|
|
function GetNodeParserError(Node: TCodeTreeNode): TCodeTreeNodeParseError;
|
|
function SetNodeParserError(Node: TCodeTreeNode; const ErrorMsg: string;
|
|
const ErrorCleanPos: integer;
|
|
const ErrorNiceCleanPos: TCodeXYPosition
|
|
): TCodeTreeNodeParseError;
|
|
procedure RaiseNodeParserError(Node: TCodeTreeNode);
|
|
procedure RaiseCursorOutsideCode(CursorPos: TCodeXYPosition);
|
|
property OnParserProgress: TOnParserProgress
|
|
read FOnParserProgress write FOnParserProgress;
|
|
|
|
// debugging
|
|
procedure Clear; virtual;
|
|
function NodeDescToStr(Desc: integer): string;
|
|
function NodeSubDescToStr(Desc, SubDesc: integer): string;
|
|
procedure ConsistencyCheck; virtual;
|
|
procedure WriteDebugTreeReport;
|
|
procedure CalcMemSize(Stats: TCTMemStats); virtual;
|
|
procedure CheckNodeTool(Node: TCodeTreeNode);
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
var
|
|
RaiseUnhandableExceptions: boolean;
|
|
|
|
function CompareCodeTreeNodeParserError(Error1, Error2: Pointer): integer;
|
|
function CompareNodeWithCodeTreeNodeParserError(Node, Error: Pointer): integer;
|
|
|
|
implementation
|
|
|
|
function CompareCodeTreeNodeParserError(Error1, Error2: Pointer): integer;
|
|
var
|
|
AnError1: TCodeTreeNodeParseError absolute Error1;
|
|
AnError2: TCodeTreeNodeParseError absolute Error2;
|
|
begin
|
|
Result:=ComparePointers(AnError1.Node,AnError2.Node);
|
|
end;
|
|
|
|
function CompareNodeWithCodeTreeNodeParserError(Node, Error: Pointer): integer;
|
|
var
|
|
AnError: TCodeTreeNodeParseError absolute Error;
|
|
begin
|
|
Result:=ComparePointers(Node,AnError.Node);
|
|
end;
|
|
|
|
{ TCustomCodeTool }
|
|
|
|
constructor TCustomCodeTool.Create;
|
|
begin
|
|
inherited Create;
|
|
Tree:=TCodeTree.Create;
|
|
KeyWordFuncList:=TKeyWordFunctionList.Create('TCustomCodeTool.KeyWordFuncList');
|
|
BuildDefaultKeyWordFunctions;
|
|
WordIsKeyWordFuncList:=WordIsKeyWord;
|
|
LastAtoms:=TAtomRing.Create;
|
|
IndentSize:=2;
|
|
VisibleEditorLines:=20;
|
|
CursorBeyondEOL:=true;
|
|
Clear;
|
|
end;
|
|
|
|
destructor TCustomCodeTool.Destroy;
|
|
begin
|
|
Clear;
|
|
FreeAndNil(LastAtoms);
|
|
FreeAndNil(Tree);
|
|
FreeAndNil(KeyWordFuncList);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.Clear;
|
|
begin
|
|
if Tree<>nil then DoDeleteNodes(Tree.Root);
|
|
CurPos:=StartAtomPosition;
|
|
LastAtoms.Clear;
|
|
ClearLastError;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.RaiseException(id: int64; const AMessage: string;
|
|
ClearNicePos: boolean);
|
|
begin
|
|
RaiseExceptionClass(id,AMessage,ECodeToolError,ClearNicePos);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.RaiseExceptionFmt(id: int64; const AMessage: string;
|
|
const args: array of const; ClearNicePos: boolean);
|
|
begin
|
|
RaiseException(id,Format(AMessage,args),ClearNicePos);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.RaiseExceptionAtCleanPos(id: int64;
|
|
const AMessage: string; CleanPos: integer);
|
|
begin
|
|
MoveCursorToCleanPos(CleanPos);
|
|
RaiseException(id,AMessage);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.RaiseExceptionAtErrorPos(id: int64;
|
|
const AMessage: string; ClearNicePos: boolean);
|
|
begin
|
|
if ClearNicePos then
|
|
ErrorNicePosition:=CleanCodeXYPosition;
|
|
// raise the exception
|
|
if not RaiseUnhandableExceptions then
|
|
raise ECodeToolError.Create(Self,id,AMessage)
|
|
else
|
|
RaiseCatchableException('['+IntToStr(id)+'] '+AMessage);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.SaveRaiseException(id: int64; const AMessage: string;
|
|
ClearNicePos: boolean);
|
|
var
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
LastErrorMessage:=AMessage;
|
|
LastErrorCurPos:=CurPos;
|
|
LastErrorValid:=true;
|
|
LastErrorId:=id;
|
|
if ClearNicePos then begin
|
|
LastErrorNicePosition.Code:=nil;
|
|
LastErrorNicePosition.Y:=-1;
|
|
end else begin
|
|
LastErrorNicePosition:=ErrorNicePosition;
|
|
end;
|
|
|
|
Node:=CurNode;
|
|
while (Node<>nil) do begin
|
|
if (ctnsNeedJITParsing and Node.SubDesc)>0 then begin
|
|
SetNodeParserError(Node,AMessage,CurPos.StartPos,
|
|
ErrorNicePosition);
|
|
break;
|
|
end;
|
|
Node:=Node.Parent;
|
|
end;
|
|
|
|
RaiseException(id,AMessage,ClearNicePos);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.SaveRaiseExceptionFmt(id: int64;
|
|
const AMessage: string; const args: array of const; ClearNicePos: boolean);
|
|
begin
|
|
SaveRaiseException(id,Format(AMessage,args),ClearNicePos);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.SetNiceErrorPos(CleanPos: integer);
|
|
var
|
|
CaretXY: TCodeXYPosition;
|
|
begin
|
|
// convert cleanpos to caret pos, which is more human readable
|
|
if (CleanPos>SrcLen) and (SrcLen>0) then CleanPos:=SrcLen;
|
|
if (CleanPosToCaret(CleanPos,CaretXY))
|
|
and (CaretXY.Code<>nil) then begin
|
|
ErrorNicePosition:=CaretXY;
|
|
end else if (Scanner<>nil) and (Scanner.MainCode<>nil) then begin
|
|
ErrorNicePosition.Code:=TCodeBuffer(Scanner.MainCode);
|
|
ErrorNicePosition.Y:=-1;
|
|
end else begin
|
|
ErrorNicePosition.Code:=nil;
|
|
ErrorNicePosition.Y:=-1;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.ClearLastError;
|
|
begin
|
|
LastErrorValid:=false;
|
|
LastErrorCheckedForIgnored:=false;
|
|
LastErrorNicePosition.Code:=nil;
|
|
ErrorNicePosition.Code:=nil;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.RaiseLastError;
|
|
begin
|
|
MoveCursorToCleanPos(LastErrorCurPos.StartPos);
|
|
CurPos:=LastErrorCurPos;
|
|
ErrorNicePosition:=LastErrorNicePosition;
|
|
SaveRaiseException(LastErrorId,LastErrorMessage,false);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.DoProgress;
|
|
begin
|
|
// Check every 1.000.000 chars
|
|
if (FLastProgressPos-CurPos.StartPos)<1000000 then exit;
|
|
NotifyAboutProgress;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.NotifyAboutProgress;
|
|
begin
|
|
FLastProgressPos:=CurPos.StartPos;
|
|
|
|
if Assigned(OnParserProgress) then begin
|
|
if OnParserProgress(Self) then exit;
|
|
// raise the abort exception to stop the parsing
|
|
RaiseExceptionClass(20170421194502,'Abort',EParserAbort,true);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.FetchScannerSource;
|
|
begin
|
|
// update scanned code
|
|
if FLastScannerChangeStep=Scanner.ChangeStep then begin
|
|
if LastErrorValid then
|
|
RaiseLastError;
|
|
end else begin
|
|
// code has changed
|
|
FLastScannerChangeStep:=Scanner.ChangeStep;
|
|
ClearLastError;
|
|
Src:=Scanner.CleanedSrc;
|
|
SrcLen:=length(Src);
|
|
LastAtoms.SrcLen:=SrcLen;
|
|
{$IFDEF VerboseUpdateNeeded}
|
|
DebugLn(['TCustomCodeTool.BeginParsing ',MainFilename]);
|
|
{$ENDIF}
|
|
FRangeValidTill:=lsrInit;
|
|
end;
|
|
|
|
// delete nodes
|
|
if Tree<>nil then
|
|
DoDeleteNodes(Tree.Root);
|
|
end;
|
|
|
|
function TCustomCodeTool.InternalAtomIsIdentifier: boolean;
|
|
var
|
|
p: PChar;
|
|
begin
|
|
if (CurPos.StartPos<=SrcLen) then begin
|
|
p:=@Src[CurPos.StartPos];
|
|
if IsIdentStartChar[p^] then begin
|
|
if not WordIsKeyWordFuncList.DoIdentifier(p) then
|
|
exit(true);
|
|
end else if (p^='&') and (IsIdentStartChar[p[1]]) then begin
|
|
exit(true);
|
|
end;
|
|
end;
|
|
Result:=false;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.RaiseUndoImpossible(id: int64);
|
|
begin
|
|
RaiseException(id,'TCustomCodeTool.UndoReadNextAtom impossible',true);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.SetScanner(NewScanner: TLinkScanner);
|
|
begin
|
|
if NewScanner=FScanner then exit;
|
|
LastErrorCheckedForIgnored:=false;
|
|
Clear;
|
|
FScanner:=NewScanner;
|
|
if Scanner<>nil then begin
|
|
FLastScannerChangeStep:=Scanner.ChangeStep;
|
|
Scanner.SetIgnoreErrorAfter(IgnoreErrorAfter.P,IgnoreErrorAfter.Code);
|
|
end;
|
|
{$IFDEF VerboseUpdateNeeded}
|
|
DebugLn(['TCustomCodeTool.SetScanner ',MainFilename]);
|
|
{$ENDIF}
|
|
FRangeValidTill:=lsrNone;
|
|
end;
|
|
|
|
function TCustomCodeTool.NodeDescToStr(Desc: integer): string;
|
|
begin
|
|
Result:=NodeDescriptionAsString(TCodeTreeNodeDesc(Desc));
|
|
end;
|
|
|
|
function TCustomCodeTool.NodeSubDescToStr(Desc, SubDesc: integer): string;
|
|
begin
|
|
if SubDesc<>0 then
|
|
Result:=Format(ctsUnknownSubDescriptor,[IntToStr(SubDesc)])
|
|
else
|
|
Result:='';
|
|
case Desc of
|
|
ctnProcedure:
|
|
begin
|
|
if (SubDesc and ctnsForwardDeclaration)>0 then Result:=ctsForward;
|
|
end;
|
|
ctnProcedureHead, ctnBeginBlock:
|
|
begin
|
|
if (SubDesc and ctnsNeedJITParsing)>0 then Result:=ctsUnparsed;
|
|
end;
|
|
ctnClass,ctnObject,ctnRecordType,ctnObjCClass,ctnObjCCategory,ctnObjCProtocol,
|
|
ctnCPPClass,ctnClassInterface,ctnDispinterface,
|
|
ctnTypeHelper,ctnRecordHelper,ctnClassHelper:
|
|
begin
|
|
Result:='';
|
|
if (SubDesc and ctnsForwardDeclaration)>0 then Result:=ctsForward;
|
|
if (SubDesc and ctnsNeedJITParsing)>0 then Result:=Result+ctsUnparsed;
|
|
end;
|
|
end;
|
|
if (SubDesc and ctnsHasParseError)>0 then Result:=Result+','+ctsHasError;
|
|
end;
|
|
|
|
function TCustomCodeTool.AtomIs(const AnAtom: shortstring): boolean;
|
|
var AnAtomLen,i : integer;
|
|
begin
|
|
Result:=false;
|
|
if (CurPos.StartPos<=SrcLen) and (CurPos.EndPos<=SrcLen+1)
|
|
and (CurPos.StartPos>=1) then begin
|
|
AnAtomLen:=length(AnAtom);
|
|
if AnAtomLen=CurPos.EndPos-CurPos.StartPos then begin
|
|
for i:=1 to AnAtomLen do
|
|
if AnAtom[i]<>Src[CurPos.StartPos-1+i] then exit;
|
|
Result:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.UpAtomIs(const AnAtom: shortstring): boolean;
|
|
var
|
|
AnAtomLen, i: integer;
|
|
p: PChar;
|
|
begin
|
|
Result:=false;
|
|
AnAtomLen:=length(AnAtom);
|
|
if AnAtomLen<>CurPos.EndPos-CurPos.StartPos then exit;
|
|
if (CurPos.EndPos<=SrcLen+1) and (CurPos.StartPos>=1) then begin
|
|
p:=@Src[CurPos.StartPos];
|
|
for i:=1 to AnAtomLen do begin
|
|
if AnAtom[i]<>UpChars[p^] then exit;
|
|
inc(p);
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.UpAtomIs(const AtomPos: TAtomPosition;
|
|
const AnAtom: shortstring): boolean;
|
|
var
|
|
AnAtomLen, i: integer;
|
|
p: PChar;
|
|
begin
|
|
Result:=false;
|
|
AnAtomLen:=length(AnAtom);
|
|
if AnAtomLen<>AtomPos.EndPos-AtomPos.StartPos then exit;
|
|
if (AtomPos.EndPos<=SrcLen+1) and (AtomPos.StartPos>=1) then begin
|
|
p:=@Src[AtomPos.StartPos];
|
|
for i:=1 to AnAtomLen do begin
|
|
if AnAtom[i]<>UpChars[p^] then exit;
|
|
inc(p);
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.AtomIsIdentifier(Identifier: PChar): boolean;
|
|
begin
|
|
Result:=(CurPos.StartPos<=SrcLen)
|
|
and (CompareIdentifiers(Identifier,@Src[CurPos.StartPos])=0);
|
|
end;
|
|
|
|
function TCustomCodeTool.ReadNextAtomIs(const AnAtom: shortstring): boolean;
|
|
begin
|
|
ReadNextAtom;
|
|
Result:=AtomIs(AnAtom);
|
|
end;
|
|
|
|
function TCustomCodeTool.ReadNextAtomIsIdentifier(Identifier: PChar): boolean;
|
|
begin
|
|
ReadNextAtom;
|
|
Result:=AtomIsIdentifier(Identifier);
|
|
end;
|
|
|
|
function TCustomCodeTool.ReadNextAtomIsChar(const c: char): boolean;
|
|
begin
|
|
ReadNextAtom;
|
|
Result:=AtomIsChar(c);
|
|
end;
|
|
|
|
function TCustomCodeTool.ReadNextUpAtomIs(const AnAtom: shortstring): boolean;
|
|
begin
|
|
ReadNextAtom;
|
|
Result:=UpAtomIs(AnAtom);
|
|
end;
|
|
|
|
function TCustomCodeTool.CompareNodeIdentChars(ANode: TCodeTreeNode;
|
|
const AnUpperIdent: string): integer;
|
|
var
|
|
AnIdentLen, i, NodeSrcLen, MinLen: integer;
|
|
p: PChar;
|
|
begin
|
|
{$IFDEF CheckNodeTool}CheckNodeTool(ANode);{$ENDIF}
|
|
if (ANode.StartPos<=SrcLen) and (ANode.EndPos<=SrcLen+1)
|
|
and (ANode.StartPos>=1) then begin
|
|
AnIdentLen:=length(AnUpperIdent);
|
|
NodeSrcLen:=ANode.EndPos-ANode.StartPos;
|
|
if AnIdentLen<NodeSrcLen then
|
|
MinLen:=AnIdentLen
|
|
else
|
|
MinLen:=NodeSrcLen;
|
|
i:=1;
|
|
p:=@Src[ANode.StartPos];
|
|
while (i<=MinLen) and (IsIdentChar[p^]) do begin
|
|
if AnUpperIdent[i]<>UpChars[p^] then begin
|
|
// identifiers different in one letter
|
|
if UpChars[p^]>AnUpperIdent[i] then
|
|
Result:=-1
|
|
else
|
|
Result:=1;
|
|
exit;
|
|
end;
|
|
inc(i);
|
|
inc(p);
|
|
end;
|
|
if (i>MinLen) and (i>AnIdentLen) then begin
|
|
// node is longer than AnUpperIdent
|
|
if (i>NodeSrcLen) or (not IsIdentChar[p^]) then
|
|
// node identifier is equal to AnUpperIdent
|
|
Result:=0
|
|
else
|
|
// node Identifier is longer than AnUpperIdent
|
|
Result:=-1;
|
|
end else
|
|
// node identifier is shorter than AnUpperIdent
|
|
Result:=1
|
|
end else
|
|
Result:=1;
|
|
end;
|
|
|
|
function TCustomCodeTool.CompareSrcIdentifiers(
|
|
CleanStartPos1, CleanStartPos2: integer): boolean;
|
|
var
|
|
p1: PChar;
|
|
p2: PChar;
|
|
begin
|
|
if (CleanStartPos1<1) or (CleanStartPos1>SrcLen)
|
|
or (CleanStartPos2<1) or (CleanStartPos2>SrcLen)
|
|
then
|
|
exit(false);
|
|
p1:=@Src[CleanStartPos1];
|
|
p2:=@Src[CleanStartPos2];
|
|
if p1^='&' then
|
|
Inc(p1);
|
|
if p2^='&' then
|
|
Inc(p2);
|
|
while IsIdentChar[p1^] do begin
|
|
if (UpChars[p1^]<>UpChars[p2^]) then
|
|
exit(false);
|
|
inc(CleanStartPos1);
|
|
inc(p1);
|
|
inc(p2);
|
|
end;
|
|
Result:=(not IsIdentChar[p2^]);
|
|
end;
|
|
|
|
function TCustomCodeTool.AtomIsChar(const c: char): boolean;
|
|
begin
|
|
Result:=(CurPos.StartPos<=SrcLen)
|
|
and (CurPos.EndPos-CurPos.StartPos=1)
|
|
and (Src[CurPos.StartPos]=c);
|
|
end;
|
|
|
|
function TCustomCodeTool.AtomIsKeyWord: boolean;
|
|
begin
|
|
Result:=(CurPos.StartPos<=SrcLen)
|
|
and (IsIdentStartChar[Src[CurPos.StartPos]])
|
|
and (WordIsKeyWordFuncList.DoItCaseInsensitive(Src,CurPos.StartPos,
|
|
CurPos.EndPos-CurPos.StartPos));
|
|
end;
|
|
|
|
function TCustomCodeTool.AtomIsIdentifier:boolean;
|
|
begin
|
|
Result:=InternalAtomIsIdentifier;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.AtomIsIdentifierE;
|
|
|
|
procedure RaiseEOFFound;
|
|
begin
|
|
RaiseExceptionFmt(20170421194604,ctsIdentExpectedButEOFFound,[GetAtom],true);
|
|
end;
|
|
|
|
procedure RaiseAtomFound;
|
|
begin
|
|
RaiseExceptionFmt(20170421194607,ctsIdentExpectedButAtomFound,[GetAtom],true);
|
|
end;
|
|
|
|
begin
|
|
if InternalAtomIsIdentifier then exit;
|
|
if CurPos.StartPos>SrcLen then
|
|
RaiseEOFFound
|
|
else
|
|
RaiseAtomFound;
|
|
end;
|
|
|
|
function TCustomCodeTool.AtomIsIdentifierE(ExceptionOnNotFound: boolean): boolean;
|
|
begin
|
|
if InternalAtomIsIdentifier then exit(true);
|
|
Result:=false;
|
|
if not ExceptionOnNotFound then exit;
|
|
AtomIsIdentifierE();
|
|
end;
|
|
|
|
procedure TCustomCodeTool.AtomIsIdentifierSaveE(id: int64);
|
|
|
|
procedure SaveRaiseIdentExpectedButEOFFound;
|
|
begin
|
|
SaveRaiseExceptionFmt(id,ctsIdentExpectedButEOFFound,[GetAtom]);
|
|
end;
|
|
|
|
begin
|
|
if InternalAtomIsIdentifier then exit;
|
|
if CurPos.StartPos>SrcLen then
|
|
SaveRaiseIdentExpectedButEOFFound
|
|
else
|
|
SaveRaiseIdentExpectedButAtomFound(id);
|
|
end;
|
|
|
|
function TCustomCodeTool.AtomIsCustomOperator(AllowIdentifier,
|
|
ExceptionOnNotFound, SaveE: boolean): boolean;
|
|
|
|
procedure RaiseOperatorExpected;
|
|
begin
|
|
if CurPos.StartPos>SrcLen then begin
|
|
if SaveE then
|
|
SaveRaiseException(20170421194635,ctsOperatorExpectedButEOFFound)
|
|
else
|
|
RaiseException(20170421194649,ctsOperatorExpectedButEOFFound)
|
|
end else begin
|
|
if SaveE then
|
|
SaveRaiseExceptionFmt(20170421194701,ctsOperatorExpectedButAtomFound,[GetAtom])
|
|
else
|
|
RaiseExceptionFmt(20170421194704,ctsOperatorExpectedButAtomFound,[GetAtom])
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
if (CurPos.StartPos<=SrcLen) then begin
|
|
if WordIsCustomOperator.DoItCaseInsensitive(
|
|
Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
|
|
or AllowIdentifier and AtomIsIdentifier then
|
|
exit(true);
|
|
end;
|
|
if not ExceptionOnNotFound then
|
|
exit(false);
|
|
RaiseOperatorExpected;
|
|
end;
|
|
|
|
function TCustomCodeTool.AtomIsNumber: boolean;
|
|
var
|
|
p: PChar;
|
|
begin
|
|
if CurPos.StartPos>SrcLen then exit(false);
|
|
p:=@Src[CurPos.StartPos];
|
|
if p^ in ['0'..'9','%','$'] then exit(true);
|
|
if (p^='&') and IsOctNumberChar[p[1]] then exit(true);
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCustomCodeTool.AtomIsRealNumber: boolean;
|
|
var i: integer;
|
|
begin
|
|
Result:=false;
|
|
i:=CurPos.StartPos;
|
|
if (i<=SrcLen) and (IsNumberChar[Src[i]]) then begin
|
|
while (i<=SrcLen) and (IsNumberOrSepChar[Src[i]]) do
|
|
inc(i);
|
|
if (i<SrcLen) and (Src[i]='.') and (IsNumberChar[Src[i+1]]) then
|
|
Result:=true;
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.AtomIsStringConstant: boolean;
|
|
var
|
|
p: PChar;
|
|
begin
|
|
if (CurPos.StartPos<1) or (CurPos.StartPos>SrcLen) then exit(false);
|
|
p:=@Src[CurPos.StartPos];
|
|
Result:=(p^ in ['''','#','`']) or ((p^='^') and (p[1] in ['A'..'Z']));
|
|
end;
|
|
|
|
function TCustomCodeTool.AtomIsCharConstant: boolean;
|
|
var
|
|
p: PChar;
|
|
begin
|
|
Result:=false;
|
|
if (CurPos.StartPos<=SrcLen) then begin
|
|
p:=@Src[CurPos.StartPos];
|
|
case p^ of
|
|
|
|
'#':
|
|
begin
|
|
inc(p);
|
|
if IsNumberChar[p^] then begin
|
|
// decimal
|
|
while IsNumberChar[p^] do
|
|
inc(p);
|
|
end else if p^='$' then begin
|
|
// hexadecimal
|
|
Inc(p);
|
|
while IsHexNumberChar[p^] do
|
|
inc(p);
|
|
end;
|
|
end;
|
|
|
|
'''':
|
|
begin
|
|
inc(p);
|
|
if p^='''' then begin
|
|
// could be ''''
|
|
if (p[1]<>'''') or (p[2]<>'''') then exit;
|
|
inc(p,3);
|
|
end else begin
|
|
// could be 'a'
|
|
if p[1]<>'''' then exit;
|
|
inc(p,2);
|
|
end;
|
|
end;
|
|
|
|
'`':
|
|
begin
|
|
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;
|
|
c: Char;
|
|
begin
|
|
p:=CurPos.StartPos;
|
|
if (p>SrcLen) then exit(false);
|
|
c:=Src[p];
|
|
if not (c in ['''','`']) then exit(false);
|
|
inc(p);
|
|
if (p>SrcLen) then exit(true);
|
|
if Src[p]<>c then exit(false);
|
|
inc(p);
|
|
if (p>SrcLen) then exit(true);
|
|
if Src[p] in ['''','`','#'] then exit(false);
|
|
end;
|
|
|
|
function TCustomCodeTool.LastAtomIs(BackIndex: integer;
|
|
const AnAtom: shortstring): boolean;
|
|
var ap: TAtomPosition;
|
|
AnAtomLen: integer;
|
|
i: integer;
|
|
begin
|
|
ap:=LastAtoms.GetAtomAt(-BackIndex);
|
|
if ap.StartPos>=ap.EndPos then exit(false);
|
|
if (ap.EndPos<=SrcLen+1) then begin
|
|
AnAtomLen:=length(AnAtom);
|
|
if AnAtomLen<>ap.EndPos-ap.StartPos then exit(false);
|
|
for i:=1 to AnAtomLen do
|
|
if AnAtom[i]<>Src[ap.StartPos-1+i] then exit(false);
|
|
exit(true);
|
|
end;
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCustomCodeTool.LastUpAtomIs(BackIndex: integer;
|
|
const AnAtom: shortstring): boolean;
|
|
var ap: TAtomPosition;
|
|
AnAtomLen: integer;
|
|
i: integer;
|
|
p: PChar;
|
|
begin
|
|
ap:=LastAtoms.GetAtomAt(-BackIndex);
|
|
if ap.StartPos>=ap.EndPos then exit(false);
|
|
if (ap.EndPos<=SrcLen+1) then begin
|
|
AnAtomLen:=length(AnAtom);
|
|
if AnAtomLen<>ap.EndPos-ap.StartPos then exit(false);
|
|
p:=@Src[ap.StartPos];
|
|
for i:=1 to AnAtomLen do begin
|
|
if AnAtom[i]<>UpChars[p^] then exit(false);
|
|
inc(p);
|
|
end;
|
|
exit(true);
|
|
end;
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCustomCodeTool.GetAtom: string;
|
|
begin
|
|
Result:=copy(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
|
|
end;
|
|
|
|
function TCustomCodeTool.GetUpAtom: string;
|
|
begin
|
|
Result:=UpperCaseStr(copy(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos));
|
|
end;
|
|
|
|
function TCustomCodeTool.GetAtom(const Atom: TAtomPosition): string;
|
|
begin
|
|
Result:=copy(Src,Atom.StartPos,Atom.EndPos-Atom.StartPos);
|
|
end;
|
|
|
|
function TCustomCodeTool.GetUpAtom(const Atom: TAtomPosition): string;
|
|
begin
|
|
Result:=UpperCaseStr(copy(Src,Atom.StartPos,Atom.EndPos-Atom.StartPos));
|
|
end;
|
|
|
|
function TCustomCodeTool.FreeUpAtomIs(const FreeAtomPos: TAtomPosition;
|
|
const AnAtom: shortstring): boolean;
|
|
var AnAtomLen,i : integer;
|
|
p: PChar;
|
|
begin
|
|
Result:=false;
|
|
if (FreeAtomPos.StartPos>SrcLen) or (FreeAtomPos.EndPos>SrcLen+1)
|
|
or (FreeAtomPos.StartPos<1) then
|
|
exit;
|
|
AnAtomLen:=length(AnAtom);
|
|
if AnAtomLen<>FreeAtomPos.EndPos-FreeAtomPos.StartPos then exit;
|
|
p:=@Src[FreeAtomPos.StartPos];
|
|
for i:=1 to AnAtomLen do begin
|
|
if AnAtom[i]<>UpChars[p^] then exit;
|
|
inc(p);
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TCustomCodeTool.GetAtomIdentifier: string;
|
|
begin
|
|
Result:=copy(Src,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
|
|
if (Result<>'') and (Result[1]='&') then
|
|
System.Delete(Result,1,1);
|
|
end;
|
|
|
|
{$IFOPT R+}{$DEFINE RangeChecking}{$ENDIF}
|
|
{$R-}
|
|
procedure TCustomCodeTool.ReadNextAtom;
|
|
var
|
|
c1, c2: char;
|
|
CommentLvl: integer;
|
|
p: PChar;
|
|
begin
|
|
if LastAtoms.HasNext then begin
|
|
//debugln(['TCustomCodeTool.ReadNextAtom HASNEXT ',LastAtoms.NextCount]);
|
|
LastAtoms.MoveToNext(CurPos);
|
|
//debugln(['TCustomCodeTool.ReadNextAtom ',GetAtom,' ',CurPos.StartPos,'-',CurPos.EndPos,' ',SrcLen]);
|
|
exit;
|
|
end;
|
|
|
|
CurPos.StartPos:=CurPos.EndPos;
|
|
CurPos.Flag:=cafNone;
|
|
if CurPos.StartPos>SrcLen then begin
|
|
if (not LastAtoms.Empty) and (LastAtoms.GetPriorAtom.StartPos<CurPos.StartPos)
|
|
then
|
|
LastAtoms.Add(CurPos);
|
|
exit;
|
|
end;
|
|
// Skip all spaces and comments
|
|
p:=@Src[CurPos.StartPos];
|
|
while true do begin
|
|
case p^ of
|
|
#0:
|
|
begin
|
|
CurPos.StartPos:=p-PChar(Src)+1;
|
|
if CurPos.StartPos>SrcLen then
|
|
break
|
|
else
|
|
inc(p);
|
|
end;
|
|
#1..#32:
|
|
inc(p);
|
|
#$EF:
|
|
if (p[1]=#$BB)
|
|
and (p[2]=#$BF) then begin
|
|
// skip UTF BOM
|
|
inc(p,3);
|
|
end else begin
|
|
break;
|
|
end;
|
|
'{': // pascal comment
|
|
begin
|
|
inc(p);
|
|
if p^=#3 then begin
|
|
// codetools skip comment {#3 #3}
|
|
repeat
|
|
case p^ of
|
|
#0:
|
|
begin
|
|
CurPos.StartPos:=p-PChar(Src)+1;
|
|
if CurPos.StartPos>SrcLen then break;
|
|
end;
|
|
#3:
|
|
if p[1]='}' then begin
|
|
inc(p,2);
|
|
break;
|
|
end;
|
|
end;
|
|
inc(p);
|
|
until false;
|
|
end else begin
|
|
// pascal comment {}
|
|
CommentLvl:=1;
|
|
while true do begin
|
|
case p^ of
|
|
#0:
|
|
begin
|
|
CurPos.StartPos:=p-PChar(Src)+1;
|
|
if CurPos.StartPos>SrcLen then break;
|
|
end;
|
|
'{':
|
|
if Scanner.NestedComments then
|
|
inc(CommentLvl);
|
|
'}':
|
|
begin
|
|
dec(CommentLvl);
|
|
if CommentLvl=0 then begin
|
|
inc(p);
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
inc(p);
|
|
end;
|
|
end;
|
|
end;
|
|
'/': // Delphi comment
|
|
if p[1]<>'/' then begin
|
|
break;
|
|
end else begin
|
|
inc(p,2);
|
|
while not (p^ in [#10,#13,#0]) do
|
|
inc(p);
|
|
end;
|
|
'(': // old turbo pascal comment
|
|
if p[1]<>'*' then begin
|
|
break;
|
|
end else begin
|
|
inc(p,2);
|
|
CommentLvl:=1;
|
|
while true do begin
|
|
case p^ of
|
|
#0:
|
|
begin
|
|
CurPos.StartPos:=p-PChar(Src)+1;
|
|
if CurPos.StartPos>SrcLen then break;
|
|
end;
|
|
'(':
|
|
if (p[1]='*') and Scanner.NestedComments then begin
|
|
//debugln('TCustomCodeTool.ReadNextAtom ',copy(Src,CurPos.StartPos,CurPos.StartPos-CurPos.EndPos));
|
|
inc(CommentLvl);
|
|
inc(p);
|
|
end;
|
|
'*':
|
|
if p[1]=')' then begin
|
|
dec(CommentLvl);
|
|
if CommentLvl=0 then begin
|
|
inc(p,2);
|
|
break;
|
|
end;
|
|
inc(p);
|
|
end;
|
|
end;
|
|
inc(p);
|
|
end;
|
|
end;
|
|
else
|
|
break;
|
|
end;
|
|
end;
|
|
CurPos.StartPos:=p-PChar(Src)+1;
|
|
CurPos.EndPos:=CurPos.StartPos;
|
|
// read atom
|
|
c1:=p^;
|
|
case c1 of
|
|
#0: ;
|
|
'_','A'..'Z','a'..'z':
|
|
begin
|
|
inc(p);
|
|
while IsIdentChar[p^] do
|
|
inc(p);
|
|
CurPos.Flag:=cafWord;
|
|
CurPos.EndPos:=p-PChar(Src)+1;
|
|
case c1 of
|
|
'e','E':
|
|
if (CurPos.EndPos-CurPos.StartPos=3)
|
|
and (Src[CurPos.StartPos+1] in ['n','N'])
|
|
and (Src[CurPos.StartPos+2] in ['d','D'])
|
|
and ((CurPos.StartPos=1) or (Src[CurPos.StartPos-1]<>'@'))
|
|
then
|
|
CurPos.Flag:=cafEnd;
|
|
end;
|
|
end;
|
|
'''','#','`':
|
|
begin
|
|
// string constant
|
|
while true do begin
|
|
case p^ of
|
|
'#':
|
|
begin
|
|
inc(p);
|
|
if IsNumberChar[p^] then begin
|
|
// decimal
|
|
repeat
|
|
inc(p);
|
|
until not IsNumberChar[p^];
|
|
end else if p^='$' then begin
|
|
// hexadecimal
|
|
repeat
|
|
inc(p);
|
|
until not IsHexNumberChar[p^];
|
|
end;
|
|
end;
|
|
'''':
|
|
begin
|
|
inc(p);
|
|
while true do begin
|
|
case p^ of
|
|
'''':
|
|
begin
|
|
inc(p);
|
|
break;
|
|
end;
|
|
#0,#10,#13:
|
|
break;
|
|
else
|
|
inc(p);
|
|
end;
|
|
end;
|
|
end;
|
|
'`':
|
|
begin
|
|
inc(p);
|
|
while true do begin
|
|
case p^ of
|
|
'`':
|
|
begin
|
|
inc(p);
|
|
break;
|
|
end;
|
|
#0:
|
|
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 IsNumberOrSepChar[p^] do
|
|
inc(p);
|
|
if (p^='.') and IsAfterFloatPointChar[p[1]] then begin
|
|
// real type number
|
|
inc(p);
|
|
while IsNumberOrSepChar[p^] do
|
|
inc(p);
|
|
end;
|
|
if p^ in ['e','E'] then begin
|
|
// read exponent
|
|
inc(p);
|
|
if p^ in ['-','+'] then inc(p);
|
|
if IsNumberChar[p^] then
|
|
inc(p);
|
|
while IsNumberOrSepChar[p^] do
|
|
inc(p);
|
|
end;
|
|
CurPos.EndPos:=p-PChar(Src)+1;
|
|
end;
|
|
'%': // binary number
|
|
begin
|
|
inc(p);
|
|
while p^ in ['0'..'1'] do
|
|
inc(p);
|
|
CurPos.EndPos:=p-PChar(Src)+1;
|
|
end;
|
|
'&': // octal number or keyword as identifier
|
|
begin
|
|
inc(p);
|
|
if IsOctNumberChar[p^] then begin
|
|
while IsOctNumberChar[p^] do
|
|
inc(p);
|
|
end else if IsIdentStartChar[p^] then begin
|
|
CurPos.Flag:=cafWord;
|
|
while IsIdentChar[p^] do
|
|
inc(p);
|
|
end;
|
|
CurPos.EndPos:=p-PChar(Src)+1;
|
|
end;
|
|
'$': // hex number
|
|
begin
|
|
inc(p);
|
|
while IsHexNumberChar[p^] do
|
|
inc(p);
|
|
CurPos.EndPos:=p-PChar(Src)+1;
|
|
end;
|
|
';':
|
|
begin
|
|
inc(CurPos.EndPos);
|
|
CurPos.Flag:=cafSemicolon;
|
|
end;
|
|
',':
|
|
begin
|
|
inc(CurPos.EndPos);
|
|
CurPos.Flag:=cafComma;
|
|
end;
|
|
'=':
|
|
begin
|
|
inc(CurPos.EndPos);
|
|
CurPos.Flag:=cafEqual;
|
|
end;
|
|
'(':
|
|
begin
|
|
inc(CurPos.EndPos);
|
|
CurPos.Flag:=cafRoundBracketOpen;
|
|
end;
|
|
')':
|
|
begin
|
|
inc(CurPos.EndPos);
|
|
CurPos.Flag:=cafRoundBracketClose;
|
|
end;
|
|
'[':
|
|
begin
|
|
inc(CurPos.EndPos);
|
|
CurPos.Flag:=cafEdgedBracketOpen;
|
|
end;
|
|
']':
|
|
begin
|
|
inc(CurPos.EndPos);
|
|
CurPos.Flag:=cafEdgedBracketClose;
|
|
end;
|
|
':':
|
|
begin
|
|
inc(CurPos.EndPos);
|
|
if (Src[CurPos.EndPos]<>'=') then begin
|
|
CurPos.Flag:=cafColon;
|
|
end else begin
|
|
// :=
|
|
inc(CurPos.EndPos);
|
|
CurPos.Flag:=cafAssignment;
|
|
end;
|
|
end;
|
|
'.':
|
|
begin
|
|
inc(CurPos.EndPos);
|
|
if (Src[CurPos.EndPos]<>'.') then begin
|
|
// '.'
|
|
CurPos.Flag:=cafPoint;
|
|
end else begin
|
|
inc(CurPos.EndPos);
|
|
if (Src[CurPos.EndPos]<>'.') then begin
|
|
// '..'
|
|
end else begin
|
|
// '...'
|
|
inc(CurPos.EndPos);
|
|
end;
|
|
end;
|
|
end;
|
|
#192..#255:
|
|
begin
|
|
// read UTF8 character
|
|
inc(p);
|
|
if ((ord(c1) and %11100000) = %11000000) then begin
|
|
// could be 2 byte character
|
|
if (ord(p[0]) and %11000000) = %10000000 then
|
|
inc(p);
|
|
end
|
|
else if ((ord(c1) and %11110000) = %11100000) then begin
|
|
// could be 3 byte character
|
|
if ((ord(p[0]) and %11000000) = %10000000)
|
|
and ((ord(p[1]) and %11000000) = %10000000) then
|
|
inc(p,2);
|
|
end
|
|
else if ((ord(c1) and %11111000) = %11110000) then begin
|
|
// could be 4 byte character
|
|
if ((ord(p[0]) and %11000000) = %10000000)
|
|
and ((ord(p[1]) and %11000000) = %10000000)
|
|
and ((ord(p[2]) and %11000000) = %10000000) then
|
|
inc(p,3);
|
|
end;
|
|
CurPos.EndPos:=p-PChar(Src)+1;
|
|
end;
|
|
else
|
|
inc(CurPos.EndPos);
|
|
c2:=Src[CurPos.EndPos];
|
|
// test for double char operators :=, +=, -=, /=, *=, <>, <=, >=, **, ><
|
|
if ((c2='=') and (IsEqualOperatorStartChar[c1]))
|
|
or ((c1='<') and (c2='>')) // <> not equal
|
|
or ((c1='>') and (c2='<')) // >< symmetric diff for sets
|
|
or ((c1='.') and (c2='.')) // .. subrange
|
|
or ((c1='*') and (c2='*')) // ** power
|
|
then begin
|
|
// 2 character operator/symbol
|
|
inc(CurPos.EndPos);
|
|
end
|
|
else if ((c1='@') and (c2='@')) then begin
|
|
// @@ label
|
|
repeat
|
|
inc(CurPos.EndPos);
|
|
until (CurPos.EndPos>SrcLen) or (not IsIdentChar[Src[CurPos.EndPos]]);
|
|
end;
|
|
end;
|
|
LastAtoms.Add(CurPos);
|
|
end;
|
|
{$IFDEF RangeChecking}{$R+}{$UNDEF RangeChecking}{$ENDIF}
|
|
|
|
procedure TCustomCodeTool.ReadPriorAtom;
|
|
var
|
|
CommentLvl, PrePos, OldPrePos: integer;
|
|
IsStringConstant: boolean;
|
|
|
|
procedure ReadStringConstantBackward;
|
|
var PrePos: integer;
|
|
begin
|
|
while (CurPos.StartPos>1) do begin
|
|
case Src[CurPos.StartPos-1] of
|
|
'''':
|
|
begin
|
|
dec(CurPos.StartPos);
|
|
repeat
|
|
dec(CurPos.StartPos);
|
|
until (CurPos.StartPos<1) or (Src[CurPos.StartPos] in [#0,#10,#13,'''']);
|
|
end;
|
|
'`':
|
|
begin
|
|
dec(CurPos.StartPos);
|
|
repeat
|
|
dec(CurPos.StartPos);
|
|
until (CurPos.StartPos<1) or (Src[CurPos.StartPos] in [#0,'`']);
|
|
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 ReadeNumberBackward;
|
|
var
|
|
FoundExponent, FoundFloat: Boolean;
|
|
LastChar, c: Char;
|
|
p, AtomStart, StartP: PChar;
|
|
MaxP: Pointer;
|
|
begin
|
|
FoundExponent:=false;
|
|
FoundFloat:=false;
|
|
LastChar:=#0;
|
|
while (CurPos.StartPos>1) do begin
|
|
c:=Src[CurPos.StartPos-1];
|
|
case c of
|
|
'0'..'9','a'..'z','A'..'Z','_': dec(CurPos.StartPos);
|
|
'+','-':
|
|
if (not FoundExponent)
|
|
and (not FoundFloat)
|
|
and (CurPos.StartPos>3)
|
|
and (Src[CurPos.StartPos-2] in ['e','E'])
|
|
and (LastChar in ['+','-','0'..'9'])
|
|
and (Src[CurPos.StartPos-3] in ['0'..'9']) then
|
|
begin
|
|
// exponent
|
|
FoundExponent:=true;
|
|
dec(CurNode.StartPos,3);
|
|
end else
|
|
break;
|
|
'.':
|
|
if (not FoundFloat)
|
|
and (CurPos.StartPos>2)
|
|
and (LastChar in ['0'..'9','e','E'])
|
|
and (Src[CurPos.StartPos-2] in ['0'..'9']) then
|
|
begin
|
|
// float
|
|
FoundFloat:=true;
|
|
dec(CurNode.StartPos,2);
|
|
end else
|
|
break;
|
|
'&','$','%':
|
|
begin
|
|
dec(CurPos.StartPos);
|
|
break;
|
|
end;
|
|
'@':
|
|
begin
|
|
if (CurPos.StartPos>2) and (Src[CurPos.StartPos-2]='@') then
|
|
dec(CurPos.StartPos,2);
|
|
break;
|
|
end;
|
|
'#':
|
|
begin
|
|
ReadStringConstantBackward;
|
|
break;
|
|
end
|
|
else
|
|
break;
|
|
end;
|
|
LastChar:=c;
|
|
end;
|
|
|
|
StartP:=PChar(Src);
|
|
p:=StartP+CurPos.StartPos-1;
|
|
MaxP:=StartP+CurPos.EndPos-1;
|
|
repeat
|
|
ReadRawNextPascalAtom(p,AtomStart);
|
|
if AtomStart<MaxP then
|
|
CurPos.StartPos:=AtomStart-StartP+1;
|
|
until (p>MaxP) or (p=AtomStart);
|
|
end;
|
|
|
|
procedure ReadBackTilCodeLineEnd;
|
|
begin
|
|
dec(CurPos.StartPos);
|
|
if (CurPos.StartPos>=1) and (Src[CurPos.StartPos] in [#10,#13])
|
|
and (Src[CurPos.StartPos+1]<>Src[CurPos.StartPos]) then
|
|
dec(CurPos.StartPos);
|
|
|
|
// read backwards till line start
|
|
PrePos:=CurPos.StartPos;
|
|
while (PrePos>=1) and (not (Src[PrePos] in [#10,#13])) do
|
|
dec(PrePos);
|
|
// read line forward to find out,
|
|
// if line ends in comment or string constant
|
|
IsStringConstant:=false;
|
|
repeat
|
|
inc(PrePos);
|
|
case Src[PrePos] of
|
|
|
|
'/':
|
|
if Src[PrePos+1]='/' then begin
|
|
// this was a delphi comment -> skip comment
|
|
CurPos.StartPos:=PrePos-1;
|
|
break;
|
|
end;
|
|
|
|
'{':
|
|
begin
|
|
inc(PrePos);
|
|
if (PrePos<=CurPos.StartPos) and (Src[PrePos]=#3) then begin
|
|
// skip codetools comment
|
|
inc(PrePos);
|
|
while (PrePos<=CurPos.StartPos) do begin
|
|
if (Src[PrePos]=#3) and (PrePos<CurPos.StartPos)
|
|
and (Src[PrePos+1]='}') then begin
|
|
inc(PrePos,2);
|
|
break;
|
|
end;
|
|
inc(PrePos);
|
|
end;
|
|
end else begin
|
|
// skip pascal comment
|
|
CommentLvl:=1;
|
|
while (PrePos<=CurPos.StartPos) do begin
|
|
case Src[PrePos] of
|
|
'{': if Scanner.NestedComments then inc(CommentLvl);
|
|
'}':
|
|
begin
|
|
dec(CommentLvl);
|
|
if CommentLvl=0 then break;
|
|
end;
|
|
end;
|
|
inc(PrePos);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
'(':
|
|
if Src[PrePos+1]='*' then begin
|
|
// skip turbo pascal comment
|
|
inc(PrePos,2);
|
|
while (PrePos<CurPos.StartPos)
|
|
and ((Src[PrePos]<>'*') or (Src[PrePos+1]<>')')) do
|
|
inc(PrePos);
|
|
inc(PrePos);
|
|
end;
|
|
|
|
'''':
|
|
begin
|
|
// a string constant -> skip it
|
|
OldPrePos:=PrePos;
|
|
while (PrePos<CurPos.StartPos) do begin
|
|
inc(PrePos);
|
|
case Src[PrePos] of
|
|
'''':
|
|
break;
|
|
|
|
#0,#10,#13:
|
|
begin
|
|
// string constant right border is the line end
|
|
// -> last atom of line found
|
|
IsStringConstant:=true;
|
|
break;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
if IsStringConstant then break;
|
|
end;
|
|
|
|
'`':
|
|
begin
|
|
// a multiline string constant -> skip it
|
|
OldPrePos:=PrePos;
|
|
while (PrePos<CurPos.StartPos) do begin
|
|
inc(PrePos);
|
|
case Src[PrePos] of
|
|
'`':
|
|
break;
|
|
|
|
#0:
|
|
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;
|
|
|
|
var c1, c2: char;
|
|
begin
|
|
if LastAtoms.HasPrior then begin
|
|
LastAtoms.GoBack(CurPos);
|
|
exit;
|
|
end;
|
|
// Skip all spaces and comments
|
|
CommentLvl:=0;
|
|
dec(CurPos.StartPos);
|
|
CurPos.Flag:=cafNone;
|
|
IsStringConstant:=false;
|
|
OldPrePos:=0;
|
|
while CurPos.StartPos>=1 do begin
|
|
if IsCommentEndChar[Src[CurPos.StartPos]] then begin
|
|
case Src[CurPos.StartPos] of
|
|
|
|
'}':
|
|
begin
|
|
dec(CurPos.StartPos);
|
|
if (CurPos.StartPos>=1) and (Src[CurPos.StartPos]=#3) then begin
|
|
// codetools skip comment {#3 #3}
|
|
dec(CurPos.StartPos);
|
|
while (CurPos.StartPos>=1) do begin
|
|
if (Src[CurPos.StartPos]=#3) and (CurPos.StartPos>1)
|
|
and (Src[CurPos.StartPos-1]='{') then begin
|
|
dec(CurPos.StartPos,2);
|
|
break;
|
|
end;
|
|
dec(CurPos.StartPos);
|
|
end;
|
|
end else begin
|
|
// pascal comment {}
|
|
CommentLvl:=1;
|
|
while (CurPos.StartPos>=1) and (CommentLvl>0) do begin
|
|
case Src[CurPos.StartPos] of
|
|
'}': if Scanner.NestedComments then inc(CommentLvl);
|
|
'{': dec(CommentLvl);
|
|
end;
|
|
dec(CurPos.StartPos);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
#10,#13: // possible Delphi comment
|
|
ReadBackTilCodeLineEnd;
|
|
|
|
')': // old turbo pascal comment
|
|
if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]='*') then begin
|
|
dec(CurPos.StartPos,3);
|
|
while (CurPos.StartPos>=1)
|
|
and ((Src[CurPos.StartPos]<>'(') or (Src[CurPos.StartPos+1]<>'*')) do
|
|
dec(CurPos.StartPos);
|
|
dec(CurPos.StartPos);
|
|
end else
|
|
break;
|
|
|
|
end;
|
|
end else if IsSpaceChar[Src[CurPos.StartPos]] then begin
|
|
repeat
|
|
dec(CurPos.StartPos);
|
|
until (CurPos.StartPos<1) or (Src[CurPos.StartPos] in [#10,#13])
|
|
or (not (IsSpaceChar[Src[CurPos.StartPos]]));
|
|
end else begin
|
|
break;
|
|
end;
|
|
end;
|
|
// CurPos.StartPos now points to the last char of the prior atom
|
|
CurPos.EndPos:=CurPos.StartPos+1;
|
|
if CurPos.StartPos<1 then begin
|
|
CurPos.StartPos:=1;
|
|
CurPos.EndPos:=1;
|
|
LastAtoms.Clear;
|
|
exit;
|
|
end;
|
|
// read atom
|
|
if IsStringConstant then begin
|
|
CurPos.StartPos:=OldPrePos;
|
|
if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1] in ['''','`']) then begin
|
|
ReadStringConstantBackward;
|
|
end;
|
|
LastAtoms.AddReverse(CurPos);
|
|
exit;
|
|
end;
|
|
c2:=Src[CurPos.StartPos];
|
|
case c2 of
|
|
'A'..'Z','a'..'z':
|
|
begin
|
|
// identifier or keyword or hexnumber
|
|
while (CurPos.StartPos>1) do begin
|
|
if (IsIdentChar[Src[CurPos.StartPos-1]]) then
|
|
dec(CurPos.StartPos)
|
|
else begin
|
|
case Src[CurPos.StartPos-1] of
|
|
'@':
|
|
if (CurPos.StartPos>2)
|
|
and (Src[CurPos.StartPos-2]='@') then
|
|
// assembler label
|
|
dec(CurPos.StartPos,2);
|
|
'$':
|
|
// hex number
|
|
dec(CurPos.StartPos);
|
|
'&': // &-identifier
|
|
if IsIdentStartChar[Src[CurPos.StartPos]] then
|
|
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, identifier, hex/binary/octal number,
|
|
// char constant, float, float with exponent
|
|
ReadeNumberBackward;
|
|
end;
|
|
';': CurPos.Flag:=cafSemicolon;
|
|
':': CurPos.Flag:=cafColon;
|
|
',': CurPos.Flag:=cafComma;
|
|
'(': CurPos.Flag:=cafRoundBracketOpen;
|
|
')': CurPos.Flag:=cafRoundBracketClose;
|
|
'[': CurPos.Flag:=cafEdgedBracketOpen;
|
|
']': CurPos.Flag:=cafEdgedBracketClose;
|
|
|
|
else
|
|
begin
|
|
if CurPos.StartPos>1 then begin
|
|
c1:=Src[CurPos.StartPos-1];
|
|
// test for double char operators :=, +=, -=, /=, *=, <>, <=, >=, **, ><
|
|
if ((c2='=') and (c1=':')) then
|
|
begin
|
|
dec(CurPos.StartPos);
|
|
CurPos.Flag:=cafAssignment;
|
|
end else
|
|
if ((c2='=') and (IsEqualOperatorStartChar[c1]))
|
|
or ((c1='<') and (c2='>'))
|
|
or ((c1='>') and (c2='<'))
|
|
or ((c1='.') and (c2='.'))
|
|
or ((c1='*') and (c2='*'))
|
|
or ((c1='@') and (c2='@'))
|
|
then begin
|
|
dec(CurPos.StartPos);
|
|
CurPos.Flag:=cafOtherOperator;
|
|
end else begin
|
|
case c2 of
|
|
'=': CurPos.Flag:=cafEqual;
|
|
'.': CurPos.Flag:=cafPoint;
|
|
end;
|
|
end;
|
|
end else begin
|
|
case c2 of
|
|
'=': CurPos.Flag:=cafEqual;
|
|
'.': CurPos.Flag:=cafPoint;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
LastAtoms.AddReverse(CurPos);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.ReadPriorAtomSafe(CleanPos: integer);
|
|
var
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
// find a clean pos in front
|
|
Node:=FindDeepestNodeAtPos(CleanPos,false);
|
|
repeat
|
|
repeat
|
|
if Node=nil then begin
|
|
CurPos:=CleanAtomPosition;
|
|
exit;
|
|
end;
|
|
if Node.EndPos<CleanPos then begin
|
|
MoveCursorToCleanPos(Node.EndPos);
|
|
break;
|
|
end else if Node.StartPos<CleanPos then begin
|
|
MoveCursorToCleanPos(Node.StartPos);
|
|
break;
|
|
end;
|
|
Node:=Node.Prior;
|
|
until false;
|
|
ReadNextAtom;
|
|
if CurPos.StartPos<CleanPos then
|
|
break;
|
|
// first atom of node is behind CleanPos => try prior node
|
|
Node:=Node.Prior;
|
|
until false;
|
|
if CurPos.EndPos>CleanPos then begin
|
|
CurPos:=CleanAtomPosition;
|
|
exit;
|
|
end;
|
|
if CurPos.EndPos=CleanPos then
|
|
exit;
|
|
repeat
|
|
ReadNextAtom;
|
|
if CurPos.EndPos>=CleanPos then begin
|
|
if CurPos.EndPos>CleanPos then
|
|
UndoReadNextAtom;
|
|
exit;
|
|
end;
|
|
until false;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.ReadAsStringConstant;
|
|
var
|
|
p: PChar;
|
|
begin
|
|
CurPos.Flag:=cafNone;
|
|
if CurPos.StartPos>SrcLen then begin
|
|
LastAtoms.ClearCurrent;
|
|
CurPos.EndPos:=CurPos.StartPos;
|
|
exit;
|
|
end;
|
|
p:=@Src[CurPos.StartPos];
|
|
// string constant
|
|
while true do begin
|
|
case p^ of
|
|
'#':
|
|
begin
|
|
inc(p);
|
|
if IsNumberChar[p^] then begin
|
|
// decimal
|
|
repeat
|
|
inc(p);
|
|
until not IsNumberChar[p^];
|
|
end else if p^='$' then begin
|
|
// hexadecimal
|
|
repeat
|
|
inc(p);
|
|
until not IsHexNumberChar[p^];
|
|
end;
|
|
end;
|
|
'''':
|
|
begin
|
|
inc(p);
|
|
while true do begin
|
|
case p^ of
|
|
'''':
|
|
begin
|
|
inc(p);
|
|
break;
|
|
end;
|
|
|
|
#0,#10,#13:
|
|
break;
|
|
|
|
else
|
|
inc(p);
|
|
end;
|
|
end;
|
|
end;
|
|
'`':
|
|
begin
|
|
inc(p);
|
|
while true do begin
|
|
case p^ of
|
|
'`':
|
|
begin
|
|
inc(p);
|
|
break;
|
|
end;
|
|
|
|
#0:
|
|
break;
|
|
|
|
else
|
|
inc(p);
|
|
end;
|
|
end;
|
|
end;
|
|
'^':
|
|
begin
|
|
inc(p);
|
|
if not (p^ in ['A'..'Z']) then break;
|
|
inc(p);
|
|
end;
|
|
else
|
|
break;
|
|
end;
|
|
end;
|
|
CurPos.EndPos:=p-PChar(Src)+1;
|
|
LastAtoms.SetCurrent(CurPos);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.UndoReadNextAtom;
|
|
begin
|
|
if not LastAtoms.GoBack(CurPos) then
|
|
RaiseUndoImpossible(20170421194733);
|
|
end;
|
|
|
|
function TCustomCodeTool.ReadTilBracketClose(
|
|
ExceptionOnNotFound: boolean): boolean;
|
|
// reads code brackets (not comment brackets)
|
|
// after call cursor is on the closing bracket
|
|
var CloseBracket, AntiCloseBracket: TCommonAtomFlag;
|
|
Start: TAtomPosition;
|
|
Node: TCodeTreeNode;
|
|
|
|
procedure RaiseBracketNotFound;
|
|
begin
|
|
if CloseBracket=cafRoundBracketClose then
|
|
SaveRaiseExceptionFmt(20170421194736,ctsBracketNotFound,[')'],false)
|
|
else
|
|
SaveRaiseExceptionFmt(20170421194740,ctsBracketNotFound,[']'],false);
|
|
end;
|
|
|
|
procedure RaiseAtNicePos;
|
|
begin
|
|
SetNiceErrorPos(Start.StartPos);
|
|
if ExceptionOnNotFound then
|
|
RaiseBracketNotFound;
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
if (Curpos.Flag=cafRoundBracketOpen) then begin
|
|
CloseBracket:=cafRoundBracketClose;
|
|
AntiCloseBracket:=cafEdgedBracketClose;
|
|
end else if (Curpos.Flag=cafEdgedBracketOpen) then begin
|
|
CloseBracket:=cafEdgedBracketClose;
|
|
AntiCloseBracket:=cafRoundBracketClose;
|
|
end else begin
|
|
if ExceptionOnNotFound then
|
|
SaveRaiseBracketOpenExpectedButAtomFound(20170421194744);
|
|
exit;
|
|
end;
|
|
Start:=CurPos;
|
|
repeat
|
|
ReadNextAtom;
|
|
if (CurPos.Flag=CloseBracket) then break;
|
|
if (CurPos.StartPos>SrcLen)
|
|
or (CurPos.Flag in [cafEnd,AntiCloseBracket])
|
|
then begin
|
|
RaiseAtNicePos;
|
|
exit;
|
|
end;
|
|
if (CurPos.Flag=cafWord) and (UpAtomIs('PROCEDURE') or UpAtomIs('FUNCTION'))
|
|
then begin
|
|
// check for anonymous function
|
|
Node:=FindDeepestNodeAtPos(CurPos.StartPos+1,false);
|
|
if (Node<>nil) and (Node.Desc=ctnProcedure) then
|
|
begin
|
|
MoveCursorToCleanPos(Node.EndPos);
|
|
end else begin
|
|
RaiseAtNicePos;
|
|
exit;
|
|
end;
|
|
end;
|
|
if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen]) then begin
|
|
if not ReadTilBracketClose(ExceptionOnNotFound) then exit;
|
|
end;
|
|
until false;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TCustomCodeTool.ReadBackTilBracketOpen(
|
|
ExceptionOnNotFound: boolean): boolean;
|
|
// reads code brackets (not comment brackets)
|
|
var OpenBracket: TCommonAtomFlag;
|
|
|
|
procedure RaiseBracketNotFound;
|
|
begin
|
|
if OpenBracket=cafRoundBracketOpen then
|
|
SaveRaiseExceptionFmt(20170421194747,ctsBracketNotFound,['('])
|
|
else
|
|
SaveRaiseExceptionFmt(20170421194749,ctsBracketNotFound,['[']);
|
|
end;
|
|
|
|
var
|
|
AntiOpenBracket: TCommonAtomFlag;
|
|
Start: TAtomPosition;
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
if (CurPos.Flag=cafRoundBracketClose) then begin
|
|
OpenBracket:=cafRoundBracketOpen;
|
|
AntiOpenBracket:=cafEdgedBracketOpen;
|
|
end else if (CurPos.Flag=cafEdgedBracketClose) then begin
|
|
OpenBracket:=cafEdgedBracketOpen;
|
|
AntiOpenBracket:=cafRoundBracketOpen;
|
|
end else begin
|
|
if ExceptionOnNotFound then
|
|
SaveRaiseBracketCloseExpectedButAtomFound(20170421194752);
|
|
exit;
|
|
end;
|
|
Start:=CurPos;
|
|
while CurPos.StartPos>1 do begin
|
|
ReadPriorAtom;
|
|
if (CurPos.Flag=OpenBracket) then exit(true);
|
|
if (CurPos.StartPos<1)
|
|
or (CurPos.Flag=AntiOpenBracket) then
|
|
break;
|
|
if (CurPos.Flag=cafEnd) then begin
|
|
// check if anonymous function
|
|
Node:=FindDeepestNodeAtPos(CurPos.StartPos,true);
|
|
if (Node<>nil) and (Node.EndPos=CurPos.EndPos)
|
|
and (Node.Desc in [ctnBeginBlock,ctnAsmBlock])
|
|
and (Node.Parent.Desc=ctnProcedure) then
|
|
// ToDo: check if Node is anonymous procedure
|
|
MoveCursorToCleanPos(Node.Parent.StartPos)
|
|
else
|
|
break;
|
|
end;
|
|
if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then begin
|
|
if not ReadBackTilBracketOpen(ExceptionOnNotFound) then exit;
|
|
end;
|
|
end;
|
|
CurPos:=Start;
|
|
if ExceptionOnNotFound then
|
|
RaiseBracketNotFound;
|
|
Result:=false;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.ReadTillCommentEnd;
|
|
begin
|
|
CurPos.StartPos:=FindCommentEnd(Src,CurPos.StartPos,Scanner.NestedComments);
|
|
LastAtoms.SetCurrent(CurPos);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.BeginParsing(Range: TLinkScannerRange);
|
|
begin
|
|
// scan
|
|
FLastProgressPos:=0;
|
|
Scanner.Scan(Range,CheckFilesOnDisk);
|
|
FetchScannerSource;
|
|
// init parsing values
|
|
CurPos:=StartAtomPosition;
|
|
LastAtoms.Clear;
|
|
if CurPos.StartPos<CurPos.EndPos then
|
|
LastAtoms.Add(CurPos);
|
|
CurNode:=nil;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.BeginParsingAndGetCleanPos(Range: TLinkScannerRange;
|
|
CursorPos: TCodeXYPosition; out CleanCursorPos: integer);
|
|
var
|
|
Dummy: integer;
|
|
begin
|
|
if UpdateNeeded(Range) then
|
|
BeginParsing(Range);
|
|
// find the CursorPos in cleaned source
|
|
Dummy:=CaretToCleanPos(CursorPos, CleanCursorPos);
|
|
if (Dummy<>0) and (Dummy<>-1) then begin
|
|
MoveCursorToCleanPos(1);
|
|
RaiseException(20170421194754,ctsCursorPosOutsideOfCode,true);
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.IgnoreErrorAfterPositionIsInFrontOfLastErrMessage: boolean;
|
|
var
|
|
IgnoreErrorAfterCleanPos: integer;
|
|
begin
|
|
//DebugLn('TCustomCodeTool.IgnoreErrorAfterPositionIsInFrontOfLastErrMessage ',
|
|
// ' LastErrorCheckedForIgnored='+dbgs(LastErrorCheckedForIgnored),
|
|
// ' LastErrorBehindIgnorePosition='+dbgs(LastErrorBehindIgnorePosition));
|
|
if LastErrorCheckedForIgnored then begin
|
|
Result:=LastErrorBehindIgnorePosition;
|
|
end else begin
|
|
if (Scanner<>nil) then begin
|
|
IgnoreErrorAfterCleanPos:=Scanner.IgnoreErrorAfterCleanedPos;
|
|
//DebugLn([' IgnoreErrorAfterCleanPos=',IgnoreErrorAfterCleanPos,' "',copy(Src,IgnoreErrorAfterCleanPos-6,6),'"',
|
|
// ' LastErrorCurPos.StartPos=',LastErrorCurPos.StartPos,' "',copy(Src,LastErrorCurPos.StartPos-6,6),'"',
|
|
// ' ']);
|
|
if IgnoreErrorAfterCleanPos>0 then begin
|
|
// ignore position in scanned code
|
|
// -> check if last error is behind or equal ignore position
|
|
if (not LastErrorValid)
|
|
or (IgnoreErrorAfterCleanPos<=LastErrorCurPos.StartPos) then
|
|
Result:=true
|
|
else
|
|
Result:=false;
|
|
end else
|
|
Result:=false;
|
|
end else
|
|
Result:=false;
|
|
LastErrorBehindIgnorePosition:=Result;
|
|
LastErrorCheckedForIgnored:=true;
|
|
end;
|
|
{$IFDEF ShowIgnoreErrorAfter}
|
|
DebugLn('TCustomCodeTool.IgnoreErrAfterPositionIsInFrontOfLastErrMessage ',dbgs(Result));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCustomCodeTool.IgnoreErrorAfterValid: boolean;
|
|
begin
|
|
Result:=(Scanner<>nil) and (Scanner.IgnoreErrorAfterValid);
|
|
{$IFDEF ShowIgnoreErrorAfter}
|
|
DebugLn('TCustomCodeTool.IgnoreErrorAfterValid ',dbgs(Result));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCustomCodeTool.IgnoreErrorAfterCleanedPos: integer;
|
|
begin
|
|
if Scanner<>nil then
|
|
Result:=Scanner.IgnoreErrorAfterCleanedPos
|
|
else
|
|
Result:=-1;
|
|
{$IFDEF ShowIgnoreErrorAfter}
|
|
DebugLn('TCustomCodeTool.IgnoreErrorAfterCleanedPos ',dbgs(Result));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCustomCodeTool.CleanPosIsAfterIgnorePos(CleanPos: integer): boolean;
|
|
begin
|
|
Result:=(Scanner<>nil) and Scanner.CleanPosIsAfterIgnorePos(CleanPos);
|
|
end;
|
|
|
|
function TCustomCodeTool.LastErrorIsInFrontOfCleanedPos(ACleanedPos: integer
|
|
): boolean;
|
|
begin
|
|
if (Scanner<>nil) and Scanner.LastErrorIsInFrontOfCleanedPos(ACleanedPos)
|
|
then
|
|
Result:=true
|
|
else if LastErrorValid
|
|
and (LastErrorCurPos.StartPos<ACleanedPos) then
|
|
Result:=true
|
|
else
|
|
Result:=false;
|
|
{$IFDEF ShowIgnoreErrorAfter}
|
|
DebugLn('TCustomCodeTool.LastErrorsInFrontOfCleanedPos ACleanedPos=',dbgs(ACleanedPos),' ',dbgs(Result));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos(
|
|
ACleanedPos: integer);
|
|
begin
|
|
{$IFDEF ShowIgnoreErrorAfter}
|
|
DebugLn('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos A ACleanedPos=',dbgs(ACleanedPos));
|
|
{$ENDIF}
|
|
if Scanner<>nil then Scanner.RaiseLastErrorIfInFrontOfCleanedPos(ACleanedPos);
|
|
//DebugLn('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos B ',LastErrorCurPos.EndPos);
|
|
if LastErrorValid
|
|
and (LastErrorCurPos.StartPos<ACleanedPos) then
|
|
RaiseLastError;
|
|
//DebugLn('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos END ');
|
|
end;
|
|
|
|
function TCustomCodeTool.GetNodeParserError(Node: TCodeTreeNode
|
|
): TCodeTreeNodeParseError;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
begin
|
|
if (Node=nil) or (FNodeParseErrors=nil) then
|
|
Result:=nil
|
|
else begin
|
|
AVLNode:=FNodeParseErrors.FindKey(Node,@CompareNodeWithCodeTreeNodeParserError);
|
|
if AVLNode<>nil then
|
|
Result:=TCodeTreeNodeParseError(AVLNode.Data)
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.SetNodeParserError(Node: TCodeTreeNode;
|
|
const ErrorMsg: string; const ErrorCleanPos: integer;
|
|
const ErrorNiceCleanPos: TCodeXYPosition): TCodeTreeNodeParseError;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
begin
|
|
//debugln(['TCustomCodeTool.SetNodeParserError ',Node.DescAsString,' Msg="',ErrorMsg,'" ',CleanPosToStr(ErrorCleanPos)]);
|
|
if Node=nil then
|
|
RaiseCatchableException('');
|
|
if FNodeParseErrors=nil then
|
|
FNodeParseErrors:=TAVLTree.Create(@CompareCodeTreeNodeParserError);
|
|
AVLNode:=FNodeParseErrors.FindKey(Node,@CompareNodeWithCodeTreeNodeParserError);
|
|
if AVLNode<>nil then begin
|
|
Result:=TCodeTreeNodeParseError(AVLNode.Data)
|
|
end else begin
|
|
Result:=TCodeTreeNodeParseError.Create(Node);
|
|
FNodeParseErrors.Add(Result);
|
|
end;
|
|
Node.SubDesc:=Node.SubDesc or ctnsHasParseError;
|
|
Result.Msg:=ErrorMsg;
|
|
Result.CleanPos:=ErrorCleanPos;
|
|
Result.NicePos:=ErrorNiceCleanPos;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.RaiseNodeParserError(Node: TCodeTreeNode);
|
|
var
|
|
NodeError: TCodeTreeNodeParseError;
|
|
begin
|
|
//debugln(['TCustomCodeTool.SetNodeParserError ',Node.DescAsString,' ',(ctnsHasParseError and Node.SubDesc)>0]);
|
|
if (ctnsHasParseError and Node.SubDesc)=0 then exit;
|
|
NodeError:=GetNodeParserError(Node);
|
|
if CleanPosIsAfterIgnorePos(NodeError.CleanPos) then exit;
|
|
//debugln(['TCustomCodeTool.RaiseNodeParserError ',Node.DescAsString,' Msg="',NodeError.Msg,'" ',CleanPosToStr(NodeError.CleanPos)]);
|
|
MoveCursorToCleanPos(NodeError.CleanPos);
|
|
ErrorNicePosition:=NodeError.NicePos;
|
|
RaiseException(20170421194759,NodeError.Msg,false);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.RaiseCursorOutsideCode(CursorPos: TCodeXYPosition);
|
|
var
|
|
Msg: String;
|
|
p: integer;
|
|
CleanPos: integer;
|
|
r: Integer;
|
|
i: Integer;
|
|
Link: TSourceLink;
|
|
NearestScanPos: Integer;
|
|
Node: TCodeTreeNode;
|
|
LastPos: Integer;
|
|
begin
|
|
ErrorPosition:=CursorPos;
|
|
Msg:='';
|
|
// check position in code buffer
|
|
if CursorPos.Code=nil then
|
|
Msg:='cursor position without code buffer'
|
|
else if (CursorPos.Y<1) or (CursorPos.Y>CursorPos.Code.LineCount+1) then
|
|
Msg:='invalid line number '+IntToStr(CursorPos.Y)
|
|
else if (CursorPos.X<1) then
|
|
Msg:='invalid column number '+IntToStr(CursorPos.Y)
|
|
else begin
|
|
CursorPos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,p);
|
|
if p<1 then
|
|
Msg:='cursor position is outside of code'
|
|
else begin
|
|
// check position in scanner
|
|
if Scanner=nil then
|
|
Msg:='missing scanner (called wrong or no pascal)'
|
|
else begin
|
|
r:=Scanner.CursorToCleanPos(p,CursorPos.Code,CleanPos);
|
|
if r<>0 then begin
|
|
NearestScanPos:=0;
|
|
for i:=0 to Scanner.LinkCount-1 do begin
|
|
Link:=Scanner.Links[i];
|
|
if Link.Code=nil then continue;
|
|
if Link.Code<>CursorPos.Code then continue;
|
|
if Link.SrcPos>p then continue;
|
|
NearestScanPos:=Link.SrcPos+Scanner.LinkSize(i);
|
|
end;
|
|
if NearestScanPos=0 then
|
|
Msg:='file was not reached by scanner'
|
|
else begin
|
|
if r=-1 then
|
|
Msg:='cursor position was skipped by scanner'
|
|
else
|
|
Msg:='cursor position is beyond scan range';
|
|
Msg:=Msg+' (last at '+CursorPos.Code.AbsoluteToLineColStr(NearestScanPos)+')'
|
|
end;
|
|
end else begin
|
|
// check position in tree
|
|
if (Tree=nil) or (Tree.Root=nil) then
|
|
Msg:='No pascal found (maybe function was called before BuildTree)'
|
|
else if CleanPos<Tree.Root.StartPos then begin
|
|
// in front of parsed code
|
|
Msg:='In front of code.';
|
|
if Tree.Root.StartPos<=SrcLen then begin
|
|
MoveCursorToCleanPos(Tree.Root.StartPos);
|
|
ReadNextAtom;
|
|
Msg:=Msg+' (pascal code starts with "'+GetAtom+'" at '
|
|
+CleanPosToStr(Tree.Root.StartPos)+')';
|
|
end else begin
|
|
Node:=Tree.Root;
|
|
while Node.NextBrother<>nil do Node:=Node.NextBrother;
|
|
if (Node.EndPos>0) and (p>Node.EndPos) then
|
|
LastPos:=Node.EndPos
|
|
else
|
|
LastPos:=Node.StartPos;
|
|
if p>LastPos then begin
|
|
Msg:='behind code (last token at '+CleanPosToStr(LastPos)+')';
|
|
end else begin
|
|
Msg:='inconsistency: the position is in code, but caller thinks it is not.'
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
RaiseExceptionAtErrorPos(20170421194801,Msg);
|
|
end;
|
|
|
|
function TCustomCodeTool.StringIsKeyWord(const Word: string): boolean;
|
|
begin
|
|
Result:=(Word<>'') and IsIdentStartChar[Word[1]]
|
|
and WordIsKeyWordFuncList.DoItUpperCase(Word,1,length(Word));
|
|
end;
|
|
|
|
procedure TCustomCodeTool.MoveCursorToNodeStart(ANode: TCodeTreeNode);
|
|
begin
|
|
{$IFDEF CheckNodeTool}CheckNodeTool(ANode);{$ENDIF}
|
|
MoveCursorToCleanPos(ANode.StartPos);
|
|
CurNode:=ANode;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.MoveCursorToCleanPos(ACleanPos: integer);
|
|
begin
|
|
CurPos.StartPos:=ACleanPos;
|
|
CurPos.EndPos:=ACleanPos;
|
|
CurPos.Flag:=cafNone;
|
|
LastAtoms.Clear;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.MoveCursorToCleanPos(ACleanPos: PChar);
|
|
|
|
procedure RaiseSrcEmpty;
|
|
begin
|
|
RaiseException(20170421194805,'[TCustomCodeTool.MoveCursorToCleanPos - PChar] Src empty',true);
|
|
end;
|
|
|
|
procedure RaiseNotInSrc;
|
|
begin
|
|
RaiseException(20170421194809,'[TCustomCodeTool.MoveCursorToCleanPos - PChar] '
|
|
+'CleanPos not in Src',true);
|
|
end;
|
|
|
|
var NewPos: integer;
|
|
begin
|
|
if Src='' then
|
|
RaiseSrcEmpty;
|
|
NewPos:=PtrInt({%H-}PtrUInt(ACleanPos))-PtrInt({%H-}PtrUInt(@Src[1]))+1;
|
|
if (NewPos<1) or (NewPos>SrcLen) then
|
|
RaiseNotInSrc;
|
|
MoveCursorToCleanPos(NewPos);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.MoveCursorToAtomPos(const AnAtomPos: TAtomPosition);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if (AnAtomPos.StartPos<AnAtomPos.EndPos)
|
|
and LastAtoms.IndexOf(AnAtomPos.StartPos,i) then begin
|
|
//debugln(['TCustomCodeTool.MoveCursorToAtomPos jump to index ',i,' Atom="',GetAtom(AnAtomPos),'"(',AnAtomPos.StartPos,'-',AnAtomPos.EndPos,')']);
|
|
//debugln(['TCustomCodeTool.MoveCursorToAtomPos ',LastAtoms.GetAtomAt(0).StartPos,'-',LastAtoms.GetAtomAt(0).EndPos]);
|
|
LastAtoms.SetIndex(i);
|
|
end
|
|
else begin
|
|
//debugln(['TCustomCodeTool.MoveCursorToAtomPos clearing LastAtoms Atom="',GetAtom(AnAtomPos),'"(',AnAtomPos.StartPos,'-',AnAtomPos.EndPos,')']);
|
|
MoveCursorToCleanPos(AnAtomPos.StartPos);
|
|
end;
|
|
CurPos:=AnAtomPos;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.MoveCursorToNearestAtom(ACleanPos: integer);
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
BestPos: Integer;
|
|
begin
|
|
ANode:=FindDeepestNodeAtPos(ACleanPos,true);
|
|
if ANode=nil then
|
|
RaiseException(20170421194812,'TCustomCodeTool.MoveCursorToNearestAtom internal error',true);
|
|
MoveCursorToNodeStart(ANode);
|
|
BestPos:=CurPos.StartPos;
|
|
while (CurPos.StartPos<=ACleanPos) and (CurPos.StartPos<=SrcLen) do begin
|
|
BestPos:=CurPos.StartPos;
|
|
ReadNextAtom;
|
|
end;
|
|
MoveCursorToCleanPos(BestPos);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.MoveCursorToLastNodeAtom(ANode: TCodeTreeNode);
|
|
var
|
|
BestPos: LongInt;
|
|
begin
|
|
MoveCursorToNodeStart(ANode);
|
|
BestPos:=CurPos.StartPos;
|
|
while (CurPos.EndPos<=ANode.EndPos) and (CurPos.StartPos<=SrcLen) do begin
|
|
BestPos:=CurPos.StartPos;
|
|
ReadNextAtom;
|
|
end;
|
|
MoveCursorToCleanPos(BestPos);
|
|
end;
|
|
|
|
function TCustomCodeTool.IsPCharInSrc(ACleanPos: PChar): boolean;
|
|
// Note: the ending #0 is a valid position
|
|
var
|
|
p: PChar;
|
|
begin
|
|
Result:=false;
|
|
if Src='' then exit;
|
|
p:=PChar(Src);
|
|
if p>ACleanPos then exit;
|
|
if ACleanPos>p+SrcLen then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.CreateChildNode;
|
|
var NewNode: TCodeTreeNode;
|
|
begin
|
|
NewNode:=TCodeTreeNode.Create;
|
|
Tree.AddNodeAsLastChild(CurNode,NewNode);
|
|
CurNode:=NewNode;
|
|
CurNode.StartPos:=CurPos.StartPos;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.EndChildNode;
|
|
begin
|
|
CurNode:=CurNode.Parent;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.BuildDefaultKeyWordFunctions;
|
|
begin
|
|
KeyWordFuncList.Clear;
|
|
KeyWordFuncList.DefaultKeyWordFunction:=
|
|
{$ifdef FPC}@{$endif}DefaultKeyWordFunc;
|
|
end;
|
|
|
|
function TCustomCodeTool.DoAtom: boolean;
|
|
begin
|
|
if (CurPos.StartPos>SrcLen) or (CurPos.EndPos<=CurPos.StartPos) then
|
|
Result:=false
|
|
else if IsIdentStartChar[Src[CurPos.StartPos]] then
|
|
Result:=KeyWordFuncList.DoItCaseInsensitive(Src,CurPos.StartPos,
|
|
CurPos.EndPos-CurPos.StartPos)
|
|
else
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.SetIgnoreErrorAfter(const AValue: TCodePosition);
|
|
begin
|
|
if (IgnoreErrorAfter.Code=AValue.Code)
|
|
and (IgnoreErrorAfter.P=AValue.P) then exit;
|
|
FIgnoreErrorAfter:=AValue;
|
|
LastErrorCheckedForIgnored:=false;
|
|
{$IFDEF ShowIgnoreErrorAfter}
|
|
DebugLn('TCustomCodeTool.SetIgnoreErrorAfter FIgnoreErrorAfter=',dbgs(FIgnoreErrorAfter));
|
|
{$ENDIF}
|
|
if Scanner<>nil then
|
|
Scanner.SetIgnoreErrorAfter(IgnoreErrorAfter.P,IgnoreErrorAfter.Code);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.IncreaseTreeChangeStep(NodesDeleting: boolean);
|
|
begin
|
|
//DebugLn(['TCustomCodeTool.IncreaseTreeChangeStep ',DbgSName(Self),' NodesDeleting=',NodesDeleting]);
|
|
if FTreeChangeStep=High(integer) then
|
|
FTreeChangeStep:=Low(integer)
|
|
else
|
|
inc(FTreeChangeStep);
|
|
if NodesDeleting then begin
|
|
//DebugLn(['TCustomCodeTool.IncreaseTreeChangeStep NodesDeleting ',MainFilename,' ',Tree<>nil,' ',(Tree<>nil) and (Tree.Root<>nil)]);
|
|
if FNodesDeletedChangeStep=High(integer) then
|
|
FNodesDeletedChangeStep:=Low(integer)
|
|
else
|
|
inc(FNodesDeletedChangeStep);
|
|
end;
|
|
if FOnTreeChange<>nil then
|
|
FOnTreeChange(Self,NodesDeleting);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.RaiseExceptionInstance(TheException: ECodeToolError;
|
|
ClearNicePos: boolean);
|
|
var
|
|
CaretXY: TCodeXYPosition;
|
|
CursorPos: integer;
|
|
begin
|
|
ErrorPosition.Code:=nil;
|
|
CursorPos:=CurPos.StartPos;
|
|
if CursorPos<1 then LastAtoms.Clear;
|
|
//DebugLn('TCustomCodeTool.RaiseExceptionInstance CursorPos=',dbgs(CursorPos),' "',copy(Src,CursorPos-6,6),'"');
|
|
|
|
if ClearNicePos then begin
|
|
ErrorNicePosition.Code:=nil;
|
|
ErrorNicePosition.Y:=-1;
|
|
end;
|
|
|
|
// close all open nodes, so that FindDeepestNodeAtPos works in the code
|
|
// already parsed
|
|
CloseUnfinishedNodes;
|
|
// convert cursor pos to caret pos, which is more human readable
|
|
if (CursorPos>SrcLen) and (SrcLen>0) then CursorPos:=SrcLen;
|
|
if (CleanPosToCaret(CursorPos,CaretXY))
|
|
and (CaretXY.Code<>nil) then begin
|
|
ErrorPosition:=CaretXY;
|
|
end else if (Scanner<>nil) and (Scanner.MainCode<>nil) then begin
|
|
ErrorPosition.Code:=TCodeBuffer(Scanner.MainCode);
|
|
ErrorPosition.Y:=-1;
|
|
end;
|
|
// raise the exception
|
|
if not RaiseUnhandableExceptions then
|
|
raise TheException
|
|
else begin
|
|
TheException.Free;
|
|
RaiseCatchableException(TheException.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.RaiseExceptionClass(id: int64;
|
|
const AMessage: string; ExceptionClass: ECodeToolErrors; ClearNicePos: boolean
|
|
);
|
|
begin
|
|
RaiseExceptionInstance(ExceptionClass.Create(Self,id,AMessage),ClearNicePos);
|
|
end;
|
|
|
|
function TCustomCodeTool.DefaultKeyWordFunc: boolean;
|
|
begin
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.ConsistencyCheck;
|
|
begin
|
|
Tree.ConsistencyCheck;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.WriteDebugTreeReport;
|
|
|
|
procedure WriteSrcSubString(A,Len: integer);
|
|
var i: integer;
|
|
begin
|
|
DbgOut('"');
|
|
for i:=A to A+Len-1 do begin
|
|
if (i>0) and (i<SrcLen) and (ord(Src[i])>31) then
|
|
DbgOut(Src[i]);
|
|
end;
|
|
DbgOut('"');
|
|
end;
|
|
|
|
procedure WriteSubTree(RootNode: TCodeTreeNode; Indent: string);
|
|
begin
|
|
while RootNode<>nil do begin
|
|
DbgOut(Indent);
|
|
with RootNode do begin
|
|
DbgOut(NodeDescToStr(Desc)+'('+NodeSubDescToStr(Desc,SubDesc)+') ');
|
|
DbgOut(' Start='+DbgS(StartPos),' ');
|
|
WriteSrcSubString(StartPos,5);
|
|
DbgOut(' End='+DbgS(EndPos)+' ');
|
|
WriteSrcSubString(EndPos-5,5);
|
|
{$ifdef fpc}
|
|
DbgOut(' Self=',DbgS(RootNode));
|
|
DbgOut(' P=',DbgS(Parent));
|
|
DbgOut(' NB=',DbgS(NextBrother));
|
|
//write(' PB=',DbgS(PriorBrother));
|
|
//write(' FC=',DbgS(FirstChild));
|
|
//write(' LC=',DbgS(LastChild));
|
|
{$endif}
|
|
end;
|
|
DebugLn('');
|
|
WriteSubTree(RootNode.FirstChild,Indent+' ');
|
|
RootNode:=RootNode.NextBrother;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
DebugLn('[TCustomCodeTool.WriteDebugTreeReport]');
|
|
WriteSubTree(Tree.Root,' ');
|
|
ConsistencyCheck;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.CalcMemSize(Stats: TCTMemStats);
|
|
begin
|
|
Stats.Add(ClassName,InstanceSize);
|
|
Stats.Add('TCustomCodeTool',MemSizeString(LastErrorMessage));
|
|
if FScanner<>nil then
|
|
FScanner.CalcMemSize(Stats);
|
|
if (FScanner=nil) or (Pointer(FScanner.CleanedSrc)<>Pointer(Src)) then
|
|
Stats.Add('TCustomCodeTool.Src',
|
|
MemSizeString(Src));
|
|
if KeyWordFuncList<>nil then
|
|
Stats.Add('TCustomCodeTool.KeyWordFuncList',
|
|
KeyWordFuncList.CalcMemSize);
|
|
// Note: WordIsKeyWordFuncList is using the global list
|
|
if Tree<>nil then
|
|
Stats.Add('TCustomCodeTool.Tree',
|
|
Tree.NodeCount*TCodeTreeNode.InstanceSize);
|
|
if LastAtoms<>nil then
|
|
Stats.Add('TCustomCodeTool.LastAtoms',
|
|
LastAtoms.CalcMemSize);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.CheckNodeTool(Node: TCodeTreeNode);
|
|
|
|
procedure RaiseForeignNode;
|
|
begin
|
|
RaiseCatchableException('TCustomCodeTool.CheckNodeTool '+DbgSName(Self)+' '+Node.DescAsString);
|
|
end;
|
|
|
|
begin
|
|
if Node=nil then exit;
|
|
while Node.Parent<>nil do Node:=Node.Parent;
|
|
while Node.PriorBrother<>nil do Node:=Node.PriorBrother;
|
|
if (Tree=nil) or (Tree.Root<>Node) then
|
|
RaiseForeignNode;
|
|
end;
|
|
|
|
function TCustomCodeTool.FindDeepestNodeAtPos(P: integer;
|
|
ExceptionOnNotFound: boolean): TCodeTreeNode;
|
|
begin
|
|
Result:=FindDeepestNodeAtPos(Tree.Root,P,ExceptionOnNotFound);
|
|
end;
|
|
|
|
function TCustomCodeTool.FindDeepestNodeAtPos(StartNode: TCodeTreeNode;
|
|
P: integer; ExceptionOnNotFound: boolean): TCodeTreeNode;
|
|
|
|
procedure RaiseNoNodeFoundAtCursor;
|
|
var
|
|
Msg: String;
|
|
Node: TCodeTreeNode;
|
|
LastPos: Integer;
|
|
begin
|
|
//DebugLn('RaiseNoNodeFoundAtCursor ',MainFilename);
|
|
MoveCursorToCleanPos(P);
|
|
// check if p is in parsed code
|
|
if (Tree=nil) or (Tree.Root=nil) then begin
|
|
debugln(['TCustomCodeTool.FindDeepestNodeAtPos there are no nodes, maybe you forgot to parse?']);
|
|
CTDumpStack;
|
|
RaiseException(20170421194833,'no pascal code or not yet parsed');
|
|
end;
|
|
if p<Tree.Root.StartPos then begin
|
|
// in front of parsed code
|
|
Msg:='In front of code.';
|
|
if Tree.Root.StartPos<=SrcLen then begin
|
|
MoveCursorToCleanPos(Tree.Root.StartPos);
|
|
ReadNextAtom;
|
|
Msg:=Msg+' (The pascal code starts with "'+GetAtom+'" at '
|
|
+CleanPosToStr(Tree.Root.StartPos)+')';
|
|
end;
|
|
MoveCursorToCleanPos(P);
|
|
RaiseException(20170421194836,Msg);
|
|
end;
|
|
// behind parsed code
|
|
Node:=Tree.Root;
|
|
while Node.NextBrother<>nil do Node:=Node.NextBrother;
|
|
if (Node.EndPos>0) and (p>Node.EndPos) then
|
|
LastPos:=Node.EndPos
|
|
else
|
|
LastPos:=Node.StartPos;
|
|
if p>LastPos then begin
|
|
Msg:='Behind code (last token at '+CleanPosToStr(LastPos)+')';
|
|
{$IFDEF VerboseNoNodeAtCursor}
|
|
debugln(['RaiseNoNodeFoundAtCursor CleanSrcEnd=',CleanPosToStr(SrcLen),' ...',dbgstr(RightStr(Src,50))]);
|
|
debugln([' Scanner.ScannedRange=',dbgs(Scanner.ScannedRange)]);
|
|
debugln([' Scanner.CleanedSrc=',dbgstr(RightStr(Scanner.CleanedSrc,50))]);
|
|
debugln([' Node.StartPos=',CleanPosToStr(Node.StartPos),' EndPos=',CleanPosToStr(Node.EndPos)]);
|
|
Node:=Node.GetLastNode;
|
|
debugln([' LastNode=',Node.DescAsString,' StartPos=',CleanPosToStr(Node.StartPos),' EndPos=',CleanPosToStr(Node.EndPos)]);
|
|
{$ENDIF}
|
|
RaiseException(20170421194838,Msg);
|
|
end;
|
|
|
|
// p is in parsed code, the StartNode is wrong
|
|
CTDumpStack;
|
|
if (StartNode<>nil) then
|
|
RaiseException(20170421194842,'Invalid search. The search for pascal started at '
|
|
+CleanPosToStr(StartNode.StartPos)+'. Invalid search')
|
|
else
|
|
RaiseException(20170421194846,'Inconsistency error in TCustomCodeTool.FindDeepestNodeAtPos');
|
|
end;
|
|
|
|
var
|
|
ChildNode: TCodeTreeNode;
|
|
Brother: TCodeTreeNode;
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
{$IFDEF CheckNodeTool}CheckNodeTool(StartNode);{$ENDIF}
|
|
Result:=nil;
|
|
Node:=StartNode;
|
|
while Node<>nil do begin
|
|
//DebugLn('SearchInNode ',NodeDescriptionAsString(ANode.Desc),
|
|
//',',ANode.StartPos,',',ANode.EndPos,', p=',p,
|
|
//' "',copy(Src,ANode.StartPos,4),'" - "',copy(Src,ANode.EndPos-5,4),'"');
|
|
if (Node.StartPos<=P)
|
|
and ((Node.EndPos>P) or (Node.EndPos<1)) then begin
|
|
// StartNode contains P
|
|
Result:=Node;
|
|
// -> search for a child that contains P
|
|
Brother:=Node;
|
|
while (Brother<>nil)
|
|
and (Brother.StartPos<=P) do begin
|
|
// brother also contains P
|
|
if Brother.FirstChild<>nil then begin
|
|
ChildNode:=FindDeepestNodeAtPos(Brother.FirstChild,P,false);
|
|
if ChildNode<>nil then begin
|
|
Result:=ChildNode;
|
|
exit;
|
|
end else
|
|
Result:=Brother;
|
|
end;
|
|
Brother:=Brother.NextBrother;
|
|
end;
|
|
break;
|
|
end else begin
|
|
// search in next node
|
|
Node:=Node.NextBrother;
|
|
end;
|
|
end;
|
|
if (Result=nil) and (Tree.Root<>nil) then begin
|
|
Node:=Tree.Root;
|
|
while Node.NextBrother<>nil do
|
|
Node:=Node.NextBrother;
|
|
if (Node<>nil) and (Node.EndPos=p) then begin
|
|
// cursor at end of source
|
|
Result:=Node;
|
|
while (Result.LastChild<>nil) and (Result.LastChild.EndPos=p) do
|
|
Result:=Result.LastChild;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
if (Result=nil) and ExceptionOnNotFound then begin
|
|
RaiseNoNodeFoundAtCursor;
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.CaretToCleanPos(const Caret: TCodeXYPosition;
|
|
out CleanPos: integer): integer;
|
|
begin
|
|
if Caret.Code=nil then begin
|
|
CleanPos:=0;
|
|
exit(-2);
|
|
end;
|
|
//DebugLn(['TCustomCodeTool.CaretToCleanPos A ',Caret.Code.Filename,' ',Caret.Y,',',Caret.X,' SourceLength=',Caret.Code.SourceLength]);
|
|
Caret.Code.LineColToPosition(Caret.Y,Caret.X,CleanPos);
|
|
//DebugLn(['TCustomCodeTool.CaretToCleanPos B Clean=',CleanPos,',Y=',Caret.Y,',X=',Caret.X,' ',dbgstr(copy(Caret.Code.Source,CleanPos-20,20)),'|',dbgstr(copy(Caret.Code.Source,CleanPos,20))]);
|
|
if (CleanPos>=1) then
|
|
Result:=Scanner.CursorToCleanPos(CleanPos,Caret.Code,CleanPos)
|
|
else
|
|
Result:=-2; // x,y beyond source
|
|
//DebugLn(['TCustomCodeTool.CaretToCleanPos C CleanPos=',CleanPos,' Result=',Result]);
|
|
end;
|
|
|
|
function TCustomCodeTool.CodePosToCleanPos(const CodePos: TCodePosition; out
|
|
CleanPos: integer): integer;
|
|
begin
|
|
Result:=Scanner.CursorToCleanPos(CodePos.P,CodePos.Code,CleanPos);
|
|
end;
|
|
|
|
function TCustomCodeTool.CleanPosToCodePos(CleanPos: integer;
|
|
out CodePos: TCodePosition): boolean;
|
|
var
|
|
ACode: pointer;
|
|
begin
|
|
Result:=Scanner.CleanedPosToCursor(CleanPos,CodePos.p,ACode);
|
|
CodePos.Code:=TCodeBuffer(ACode);
|
|
end;
|
|
|
|
function TCustomCodeTool.CleanPosToCaret(CleanPos: integer;
|
|
out Caret:TCodeXYPosition): boolean; // true=ok, false=invalid CleanPos
|
|
var p: integer;
|
|
Code: Pointer;
|
|
begin
|
|
Caret:=CleanCodeXYPosition;
|
|
Result:=Scanner.CleanedPosToCursor(CleanPos,p,Code);
|
|
if Result then begin
|
|
Caret.Code:=TCodeBuffer(Code);
|
|
if Caret.Code.IsDeleted then begin
|
|
debugln(['TCustomCodeTool.CleanPosToCaret IsDeleted: ',Caret.Code.Filename,' SourceLength=',Caret.Code.SourceLength]);
|
|
exit(false);
|
|
end;
|
|
TCodeBuffer(Code).AbsoluteToLineCol(p,Caret.Y,Caret.X);
|
|
Result:=(Caret.Y>=0);
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.CleanPosToCaretAndTopLine(CleanPos: integer;
|
|
out Caret:TCodeXYPosition; out NewTopLine: integer): boolean;
|
|
// true=ok, false=invalid CleanPos
|
|
begin
|
|
Caret:=CleanCodeXYPosition;
|
|
NewTopLine:=0;
|
|
Result:=CleanPosToCaret(CleanPos,Caret);
|
|
if Result then begin
|
|
if JumpSingleLinePos>0 then begin
|
|
NewTopLine:=Caret.Y-(VisibleEditorLines*JumpSingleLinePos div 100);
|
|
if NewTopLine<1 then NewTopLine:=1;
|
|
end else
|
|
NewTopLine:=Caret.Y;
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.CleanPosToStr(CleanPos: integer;
|
|
WithFilename: boolean): string;
|
|
var
|
|
CodePos: TCodeXYPosition;
|
|
begin
|
|
if CleanPosToCaret(CleanPos,CodePos) then begin
|
|
Result:=CodeXYToStr(CodePos,WithFilename);
|
|
end else
|
|
Result:='outside scan range, pos='+IntToStr(CleanPos)+'('+dbgstr(copy(Src,CleanPos-5,5)+'|'+copy(Src,CleanPos,5))+')';
|
|
end;
|
|
|
|
function TCustomCodeTool.CodeXYToStr(const CodePos: TCodeXYPosition;
|
|
WithFilename: boolean): string;
|
|
begin
|
|
Result:='';
|
|
if WithFilename then
|
|
Result:=ExtractRelativepath(ExtractFilePath(MainFilename),CodePos.Code.Filename)+',';
|
|
Result:=Result+'line '+IntToStr(CodePos.Y)+', column '+IntToStr(CodePos.X);
|
|
end;
|
|
|
|
function TCustomCodeTool.CleanPosToRelativeStr(CleanPos: integer;
|
|
const BaseFilename: string): string;
|
|
var
|
|
CodePos: TCodeXYPosition;
|
|
begin
|
|
if not CleanPosToCaret(CleanPos,CodePos) then
|
|
Result:='(?)'
|
|
else begin
|
|
if (BaseFilename='') or (not FilenameIsAbsolute(BaseFilename)) then
|
|
Result:=CodePos.Code.Filename
|
|
else if CompareFilenames(CodePos.Code.Filename,BaseFilename)<>0 then
|
|
Result:=CreateRelativePath(CodePos.Code.Filename,
|
|
ExtractFilePath(BaseFilename))
|
|
else
|
|
Result:='';
|
|
Result:=Result+'('+IntToStr(CodePos.Y)+','+IntToStr(CodePos.X)+')';
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.GetCleanPosInfo(CodePosInFront, CleanPos: integer;
|
|
ResolveComments: boolean; out SameArea: TAtomPosition);
|
|
{ Use this function to safely find out if a position is in a comment,
|
|
a string constant, an atom or is in space
|
|
|
|
CodePosInFront: a position in code, where parsing starts
|
|
If -1 it uses FindDeepestNodeAtPos
|
|
CleanPos: target position
|
|
ResolveComments: if CleanPos is in a comment, parse again in the comment (not recursive)
|
|
SameArea: area around CleanPos, either an atom, comment, directive or space
|
|
if CleanPos<CodePosInFront then CleanAtomPosition
|
|
if CleanPos>SrcLen then SameArea.StartPos>SrcLen
|
|
}
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
SameArea:=CleanAtomPosition;
|
|
if CodePosInFront<1 then begin
|
|
ANode:=FindDeepestNodeAtPos(CleanPos,True);
|
|
CodePosInFront:=ANode.StartPos;
|
|
end;
|
|
if CodePosInFront>CleanPos then
|
|
exit;
|
|
MoveCursorToCleanPos(CodePosInFront);
|
|
repeat
|
|
ReadNextAtom;
|
|
//DebugLn(['TCustomCodeTool.GetCleanPosInfo A Atom=',GetAtom,' CleanPos=',CleanPos,' CurPos.StartPos=',CurPos.StartPos]);
|
|
if (CleanPos>=CurPos.StartPos) and (CleanPos<CurPos.EndPos) then begin
|
|
// clean pos on token
|
|
SameArea:=CurPos;
|
|
exit;
|
|
end;
|
|
if CleanPos<CurPos.StartPos then begin
|
|
// clean pos between tokens
|
|
SameArea.Flag:=cafNone;
|
|
// get range of space behind last atom
|
|
if LastAtoms.HasPrior then begin
|
|
SameArea.StartPos:=LastAtoms.GetPriorAtom.EndPos;
|
|
end else begin
|
|
SameArea.StartPos:=CodePosInFront;
|
|
end;
|
|
SameArea.EndPos:=SameArea.StartPos;
|
|
repeat
|
|
//DebugLn(['TCustomCodeTool.GetCleanPosInfo B CleanPos=',CleanPos,' SameArea.StartPos=',SameArea.StartPos,' SameArea.EndPos=',SameArea.EndPos]);
|
|
while (SameArea.EndPos<=SrcLen)
|
|
and (IsSpaceChar[Src[SameArea.EndPos]]) do
|
|
inc(SameArea.EndPos);
|
|
if (SameArea.EndPos>CleanPos) or (SameArea.EndPos>SrcLen) then begin
|
|
// cursor is in normal space (i.e. not comment)
|
|
exit;
|
|
end;
|
|
// still between the two tokens, but end of space
|
|
// -> here starts a comment
|
|
SameArea.StartPos:=SameArea.EndPos;
|
|
MoveCursorToCleanPos(SameArea.StartPos);
|
|
//debugln(['TCustomCodeTool.GetCleanPosInfo C "',dbgstr(Src,SameArea.StartPos,Max(3,FindCommentEnd(Src,SameArea.StartPos,Scanner.NestedComments)-SameArea.StartPos)),'"']);
|
|
ReadTillCommentEnd;
|
|
SameArea.EndPos:=CurPos.StartPos;
|
|
//debugln(['TCustomCodeTool.GetCleanPosInfo D "',dbgstr(Src,SameArea.StartPos,SameArea.EndPos-SameArea.StartPos),'"']);
|
|
if (SameArea.StartPos=SameArea.EndPos) then
|
|
// inconsistency: some non space and non comment between two tokens
|
|
RaiseException(20170421194850,'TCustomCodeTool.GetCleanPosInfo Internal Error A');
|
|
if CleanPos<SameArea.EndPos then begin
|
|
// cursor is in comment
|
|
if ResolveComments then begin
|
|
// take comment as normal code and search again
|
|
CodePosInFront:=SameArea.StartPos;
|
|
case Src[CodePosInFront] of
|
|
'{':
|
|
begin
|
|
inc(CodePosInFront);
|
|
if (CodePosInFront<=SrcLen) and (Src[CodePosInFront+1]=#3) then
|
|
inc(CodePosInFront);
|
|
end;
|
|
'(','/': inc(CodePosInFront,2);
|
|
else
|
|
RaiseException(20170421194855,'TCustomCodeTool.GetCleanPosInfo Internal Error B '
|
|
+dbgstr(Src[CodePosInFront])+' at '+CleanPosToStr(CodePosInFront,true));
|
|
end;
|
|
if CodePosInFront>CleanPos then
|
|
// CleanPos at start of comment => return comment
|
|
exit;
|
|
GetCleanPosInfo(CodePosInFront,CleanPos,true,SameArea);
|
|
end;
|
|
exit;
|
|
end;
|
|
SameArea.StartPos:=SameArea.EndPos;
|
|
until false;
|
|
end;
|
|
until (CurPos.EndPos>CleanPos) or (CurPos.StartPos>SrcLen);
|
|
SameArea:=CurPos;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.GetLineInfo(ACleanPos: integer;
|
|
out ALineStart, ALineEnd, AFirstAtomStart, ALastAtomEnd: integer);
|
|
begin
|
|
if ACleanPos>=1 then begin
|
|
if ACleanPos<=SrcLen then begin
|
|
// search line start
|
|
ALineStart:=ACleanPos;
|
|
while (ALineStart>1) and (not (Src[ALineStart-1] in [#10,#13])) do
|
|
dec(ALineStart);
|
|
// search line end
|
|
ALineEnd:=ACleanPos;
|
|
while (ALineEnd<=SrcLen) and (not (Src[ALineEnd] in [#10,#13])) do
|
|
inc(ALineEnd);
|
|
// search first atom in line
|
|
MoveCursorToCleanPos(ALineStart);
|
|
ReadNextAtom;
|
|
AFirstAtomStart:=CurPos.StartPos;
|
|
// search last atom in line
|
|
repeat
|
|
ALastAtomEnd:=CurPos.EndPos;
|
|
ReadNextAtom;
|
|
until (CurPos.EndPos>ALineEnd) or (CurPos.StartPos>SrcLen);
|
|
end else begin
|
|
ALineStart:=Srclen+1;
|
|
ALineEnd:=Srclen+1;
|
|
AFirstAtomStart:=Srclen+1;
|
|
ALastAtomEnd:=Srclen+1;
|
|
end;
|
|
end else begin
|
|
ALineStart:=1;
|
|
ALineEnd:=1;
|
|
AFirstAtomStart:=1;
|
|
ALastAtomEnd:=1;
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.FindLineEndOrCodeAfterPosition(StartPos: integer;
|
|
SkipEmptyLines: boolean; IncludeLineEnd: boolean): integer;
|
|
{ Searches a nice position in the cleaned source after StartPos.
|
|
It will skip any space and comments (not directives) till next
|
|
line end or compiler directive or code or include file end.
|
|
}
|
|
var
|
|
LinkIndex, LinkEnd: integer;
|
|
begin
|
|
Result:=StartPos;
|
|
LinkIndex:=Scanner.LinkIndexAtCleanPos(StartPos);
|
|
if LinkIndex>=0 then begin
|
|
LinkEnd:=Scanner.LinkCleanedEndPos(LinkIndex);
|
|
if LinkEnd>StartPos then
|
|
Result:=BasicCodeTools.FindLineEndOrCodeAfterPosition(Src,
|
|
StartPos,LinkEnd-1,Scanner.NestedComments,true,SkipEmptyLines,
|
|
IncludeLineEnd);
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.FindLineEndOrCodeInFrontOfPosition(StartPos: integer;
|
|
StopAtDirectives: boolean; SkipEmptyLines: boolean): integer;
|
|
{ Searches a nice position in the cleaned source in front of StartPos.
|
|
It will skip any space or comments (not directives) till next
|
|
line end or compiler directive or code or include file end.
|
|
}
|
|
var
|
|
LinkIndex, LinkStart: integer;
|
|
begin
|
|
Result:=StartPos;
|
|
LinkIndex:=Scanner.LinkIndexAtCleanPos(StartPos);
|
|
if LinkIndex>=0 then begin
|
|
LinkStart:=Scanner.Links[LinkIndex].CleanedPos;
|
|
Result:=BasicCodeTools.FindLineEndOrCodeInFrontOfPosition(Src,
|
|
StartPos,LinkStart,Scanner.NestedComments,StopAtDirectives,false,
|
|
SkipEmptyLines);
|
|
end;
|
|
end;
|
|
|
|
function TCustomCodeTool.SkipResourceDirective(StartPos: integer): integer;
|
|
var
|
|
LinkIndex, LinkEnd: integer;
|
|
begin
|
|
Result:=StartPos;
|
|
LinkIndex:=Scanner.LinkIndexAtCleanPos(StartPos);
|
|
if LinkIndex>=0 then begin
|
|
LinkEnd:=Scanner.LinkCleanedEndPos(LinkIndex);
|
|
Result:=BasicCodeTools.SkipResourceDirective(Src,StartPos,LinkEnd,Scanner.NestedComments);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.ClearIgnoreErrorAfter;
|
|
begin
|
|
IgnoreErrorAfter:=CodePosition(0,nil);
|
|
end;
|
|
|
|
function TCustomCodeTool.UpdateNeeded(Range: TLinkScannerRange): boolean;
|
|
begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCustomCodeTool.UpdateNeeded A Range=',dbgs(Range),' ',Scanner.MainFilename);
|
|
{$ENDIF}
|
|
if Range=lsrNone then exit(false);
|
|
if (not LastErrorValid) and (ord(FRangeValidTill)<ord(Range)) then begin
|
|
{$IFDEF VerboseUpdateNeeded}
|
|
DebugLn(['TCustomCodeTool.UpdateNeeded because range increased from ',dbgs(FRangeValidTill),' to ',dbgs(Range),' ',MainFilename]);
|
|
{$ENDIF}
|
|
exit(true);
|
|
end;
|
|
if (FLastScannerChangeStep<>Scanner.ChangeStep) then begin
|
|
{$IFDEF VerboseUpdateNeeded}
|
|
DebugLn(['TCustomCodeTool.UpdateNeeded because FLastScannerChangeStep<>Scanner.ChangeStep ',MainFilename]);
|
|
{$ENDIF}
|
|
FRangeValidTill:=lsrNone;
|
|
Result:=true;
|
|
end else begin
|
|
Result:=Scanner.UpdateNeeded(Range, CheckFilesOnDisk);
|
|
if Result then begin
|
|
{$IFDEF VerboseUpdateNeeded}
|
|
DebugLn(['TCustomCodeTool.UpdateNeeded because Scanner.UpdateNeeded ',MainFilename]);
|
|
{$ENDIF}
|
|
// decrease valid range
|
|
FRangeValidTill:=Pred(Range);
|
|
ClearLastError;
|
|
end;
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TCustomCodeTool.UpdateNeeded END Result=',dbgs(Result));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCustomCodeTool.CompareSrcIdentifiers(Identifier1, Identifier2: PChar
|
|
): boolean;
|
|
begin
|
|
Result:=false;
|
|
if (Identifier1=nil) or (Identifier2=nil) then exit;
|
|
if Identifier1^='&' then
|
|
Inc(Identifier1);
|
|
if Identifier2^='&' then
|
|
Inc(Identifier2);
|
|
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;
|
|
if AnIdentifier^='&' then
|
|
Inc(AnIdentifier);
|
|
if Src[CleanStartPos]='&' then
|
|
begin
|
|
Inc(CleanStartPos);
|
|
if CleanStartPos>SrcLen then
|
|
exit;
|
|
end;
|
|
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.CompareDottedSrcIdentifiers(CleanStartPos: integer;
|
|
AnIdentifier: PChar): boolean;
|
|
begin
|
|
Result:=false;
|
|
if (AnIdentifier=nil) or (CleanStartPos<1) or (CleanStartPos>SrcLen) then
|
|
exit;
|
|
if AnIdentifier^='&' then
|
|
Inc(AnIdentifier);
|
|
if Src[CleanStartPos]='&' then
|
|
begin
|
|
Inc(CleanStartPos);
|
|
if CleanStartPos>SrcLen then
|
|
exit;
|
|
end;
|
|
while IsDottedIdentChar[AnIdentifier^] do begin
|
|
if (UpChars[AnIdentifier^]=UpChars[Src[CleanStartPos]]) then begin
|
|
inc(AnIdentifier);
|
|
inc(CleanStartPos);
|
|
if CleanStartPos>SrcLen then begin
|
|
Result:=not IsDottedIdentChar[AnIdentifier^];
|
|
exit;
|
|
end;
|
|
end else
|
|
exit(false);
|
|
end;
|
|
Result:=not IsDottedIdentChar[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) and (CleanStartPos<=SrcLen) then begin
|
|
len:=0;
|
|
if Src[CleanStartPos]='&' then inc(CleanStartPos);
|
|
while (CleanStartPos<=SrcLen)
|
|
and (IsIdentChar[Src[CleanStartPos+len]]) do
|
|
inc(len);
|
|
SetLength(Result{%H-},len);
|
|
if len>0 then
|
|
Move(Src[CleanStartPos],Result[1],len);
|
|
end else
|
|
Result:='';
|
|
end;
|
|
|
|
function TCustomCodeTool.ExtractDottedIdentifier(CleanStartPos: integer): string;
|
|
begin
|
|
Result:=GetDottedIdentifier(@Src[CleanStartPos]);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.DoDeleteNodes(StartNode: TCodeTreeNode);
|
|
// delete Node and all following nodes
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
NextAVLNode: TAVLTreeNode;
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
if StartNode<>nil then begin
|
|
//debugln(['TCustomCodeTool.DoDeleteNodes Node=',StartNode.DescAsString,' ',MainFilename]);
|
|
//DebugLn(['TCustomCodeTool.DoDeleteNodes ',MainFilename]);
|
|
// first notify, so that references could be deleted clean
|
|
IncreaseTreeChangeStep(true);
|
|
if (CurNode<>nil) and (StartNode.StartPos<=CurNode.StartPos) then
|
|
CurNode:=nil;
|
|
|
|
// free errors and nodes
|
|
if StartNode=Tree.Root then begin
|
|
DisposeAVLTree(FNodeParseErrors);
|
|
Tree.Clear;
|
|
end else begin
|
|
if (FNodeParseErrors<>nil) then begin
|
|
AVLNode:=FNodeParseErrors.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
NextAVLNode:=FNodeParseErrors.FindSuccessor(AVLNode);
|
|
if TCodeTreeNodeParseError(AVLNode.Data).Node.StartPos>=StartNode.StartPos
|
|
then
|
|
FNodeParseErrors.FreeAndDelete(AVLNode);
|
|
AVLNode:=NextAVLNode;
|
|
end;
|
|
end;
|
|
Node:=StartNode;
|
|
repeat
|
|
while Node.NextBrother<>nil do
|
|
Tree.DeleteNode(Node.NextBrother);
|
|
Node:=Node.Parent;
|
|
until Node=nil;
|
|
Tree.DeleteNode(StartNode);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.CloseUnfinishedNodes;
|
|
var
|
|
p: LongInt;
|
|
begin
|
|
if CurNode=nil then exit;
|
|
// close all unfinished nodes
|
|
p:=CurPos.StartPos;
|
|
if p>SrcLen then p:=SrcLen+1;
|
|
while CurNode<>nil do begin
|
|
//debugln(['TCustomCodeTool.CloseUnfinishedNodes BEFORE ',CurNode.DescAsString,' CurNode.EndPos=',CurNode.EndPos]);
|
|
if CurNode.EndPos<1 then begin
|
|
if CurNode.StartPos>p then p:=CurNode.StartPos;
|
|
CurNode.EndPos:=p;
|
|
end else if p<CurNode.EndPos then begin
|
|
p:=CurNode.EndPos;
|
|
end else if (CurNode.LastChild<>nil) and (CurNode.EndPos<CurNode.LastChild.EndPos) then
|
|
CurNode.EndPos:=CurNode.LastChild.EndPos;
|
|
//debugln(['TCustomCodeTool.CloseUnfinishedNodes AFTER ',CurNode.DescAsString,' CurNode.EndPos=',CleanPosToStr(CurNode.EndPos)]);
|
|
CurNode:=CurNode.Parent;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCodeTool.SaveRaiseIdentExpectedButAtomFound(id: int64);
|
|
begin
|
|
SaveRaiseExceptionFmt(id,ctsIdentExpectedButAtomFound,[GetAtom]);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.SaveRaiseBracketOpenExpectedButAtomFound(id: int64);
|
|
begin
|
|
SaveRaiseExceptionFmt(id,ctsBracketOpenExpectedButAtomFound,[GetAtom]);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.SaveRaiseBracketCloseExpectedButAtomFound(id: int64);
|
|
begin
|
|
if CurPos.StartPos<SrcLen then
|
|
SaveRaiseExceptionFmt(id,ctsBracketCloseExpectedButAtomFound,[GetAtom])
|
|
else
|
|
SaveRaiseExceptionFmt(id,ctsBracketNotFound,[])
|
|
end;
|
|
|
|
procedure TCustomCodeTool.ActivateGlobalWriteLock;
|
|
begin
|
|
if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(true);
|
|
end;
|
|
|
|
procedure TCustomCodeTool.DeactivateGlobalWriteLock;
|
|
begin
|
|
if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(false);
|
|
end;
|
|
|
|
function TCustomCodeTool.MainFilename: string;
|
|
begin
|
|
if (Scanner<>nil) and (Scanner.MainCode<>nil) then
|
|
Result:=TCodeBuffer(Scanner.MainCode).Filename
|
|
else
|
|
Result:=ctsUnknownMainFilename;
|
|
end;
|
|
|
|
{ ECodeToolError }
|
|
|
|
constructor ECodeToolError.Create(ASender: TCustomCodeTool; TheId: int64;
|
|
const AMessage: string);
|
|
begin
|
|
inherited Create(AMessage);
|
|
Sender:=ASender;
|
|
Id:=TheId;
|
|
end;
|
|
|
|
{ ECodeToolFileNotFound }
|
|
|
|
constructor ECodeToolFileNotFound.Create(ASender: TCustomCodeTool;
|
|
TheId: int64; const AMessage, AFilename: string);
|
|
begin
|
|
inherited Create(ASender,TheId,AMessage);
|
|
Filename:=AFilename;
|
|
end;
|
|
|
|
{ TCodeTreeNodeParseError }
|
|
|
|
constructor TCodeTreeNodeParseError.Create(ANode: TCodeTreeNode);
|
|
begin
|
|
Node:=ANode;
|
|
end;
|
|
|
|
initialization
|
|
RaiseUnhandableExceptions:=false;
|
|
|
|
end.
|