xtool/contrib/CoreCipher/Source/TextParsing.pas

3291 lines
90 KiB
ObjectPascal

{ ****************************************************************************** }
{ * parsing library,writen by QQ 600585@qq.com * }
{ * https://zpascal.net * }
{ * https://github.com/PassByYou888/zAI * }
{ * https://github.com/PassByYou888/ZServer4D * }
{ * https://github.com/PassByYou888/PascalString * }
{ * https://github.com/PassByYou888/zRasterization * }
{ * https://github.com/PassByYou888/CoreCipher * }
{ * https://github.com/PassByYou888/zSound * }
{ * https://github.com/PassByYou888/zChinese * }
{ * https://github.com/PassByYou888/zExpression * }
{ * https://github.com/PassByYou888/zGameWare * }
{ * https://github.com/PassByYou888/zAnalysis * }
{ * https://github.com/PassByYou888/FFMPEG-Header * }
{ * https://github.com/PassByYou888/zTranslate * }
{ * https://github.com/PassByYou888/InfiniteIoT * }
{ * https://github.com/PassByYou888/FastMD5 * }
{ ****************************************************************************** }
unit TextParsing;
{$INCLUDE zDefine.inc}
interface
uses Types, CoreClasses, PascalStrings, UnicodeMixedLib, ListEngine;
type
TTextStyle = (tsPascal, tsC, tsText);
TTokenType = (ttTextDecl, ttComment, ttNumber, ttSymbol, ttAscii, ttSpecialSymbol, ttUnknow);
TTokenTypes = set of TTokenType;
TTokenStatistics = array [TTokenType] of Integer;
TTextPos = record
bPos, ePos: Integer;
Text: TPascalString;
end;
PTextPos = ^TTextPos;
TTokenData = record
bPos, ePos: Integer;
Text: TPascalString;
tokenType: TTokenType;
Index: Integer;
end;
PTokenData = ^TTokenData;
TTextParsingCache = record
CommentDecls, TextDecls: TCoreClassList; // PTextPos
TokenDataList: TCoreClassList; // PTokenData
CharToken: array of PTokenData;
end;
TTextParsingData = record
Cache: TTextParsingCache;
Text: TPascalString;
Len: Integer;
end;
TSymbolVector = TArrayPascalString;
TSymbolMatrix = array of TSymbolVector;
TTextParsing = class(TCoreClassObject)
public
TextStyle: TTextStyle;
ParsingData: TTextParsingData;
SymbolTable: TPascalString;
TokenStatistics: TTokenStatistics;
SpecialSymbol: TListPascalString;
RebuildCacheBusy: Boolean;
{ compare char }
function ComparePosStr(const cOffset: Integer; const t: TPascalString): Boolean; overload; inline;
function ComparePosStr(const cOffset: Integer; const p: PPascalString): Boolean; overload; inline;
{ compare comment and text declaration: TokenCache }
function CompareCommentGetEndPos(const cOffset: Integer): Integer;
function CompareTextDeclGetEndPos(const cOffset: Integer): Integer;
{ rebuild support }
procedure RebuildParsingCache;
procedure RebuildText;
procedure RebuildToken;
{ automated context on pick: TokenCache }
function GetContextBeginPos(const cOffset: Integer): Integer;
function GetContextEndPos(const cOffset: Integer): Integer;
{ special symbol support: TokenCache }
function isSpecialSymbol(const cOffset: Integer): Boolean; overload;
function isSpecialSymbol(const cOffset: Integer; var speicalSymbolEndPos: Integer): Boolean; overload;
function GetSpecialSymbolEndPos(const cOffset: Integer): Integer;
{ number decl support: TokenCache }
function isNumber(const cOffset: Integer): Boolean; overload;
function isNumber(const cOffset: Integer; var NumberBegin: Integer; var IsHex: Boolean): Boolean; overload;
function GetNumberEndPos(const cOffset: Integer): Integer;
{ text support: TokenCache }
function isTextDecl(const cOffset: Integer): Boolean;
function GetTextDeclEndPos(const cOffset: Integer): Integer;
function GetTextDeclBeginPos(const cOffset: Integer): Integer;
function GetTextBody(const Text_: TPascalString): TPascalString;
function GetTextDeclPos(const cOffset: Integer; var charBeginPos, charEndPos: Integer): Boolean;
{ symbol support: TokenCache }
function isSymbol(const cOffset: Integer): Boolean;
function GetSymbolEndPos(const cOffset: Integer): Integer;
{ ascii support: TokenCache }
function isAscii(const cOffset: Integer): Boolean;
function GetAsciiBeginPos(const cOffset: Integer): Integer;
function GetAsciiEndPos(const cOffset: Integer): Integer;
{ comment support: TokenCache }
function isComment(const cOffset: Integer): Boolean;
function GetCommentEndPos(const cOffset: Integer): Integer;
function GetCommentBeginPos(const cOffset: Integer): Integer;
function GetCommentPos(const cOffset: Integer; var charBeginPos, charEndPos: Integer): Boolean;
function GetDeletedCommentText: TPascalString;
{ text support: TokenCache }
function isTextOrComment(const cOffset: Integer): Boolean;
function isCommentOrText(const cOffset: Integer): Boolean;
{ word support: TokenCache no used }
class function isWordSplitChar(const c: SystemChar; SplitTokenC: TPascalString): Boolean; overload;
class function isWordSplitChar(const c: SystemChar): Boolean; overload;
class function isWordSplitChar(const c: SystemChar; DefaultChar: Boolean; SplitTokenC: TPascalString): Boolean; overload;
function GetWordBeginPos(const cOffset: Integer; SplitTokenC: TPascalString): Integer; overload;
function GetWordBeginPos(const cOffset: Integer): Integer; overload;
function GetWordBeginPos(const cOffset: Integer; BeginDefaultChar: Boolean; SplitTokenC: TPascalString): Integer; overload;
function GetWordEndPos(const cOffset: Integer; SplitTokenC: TPascalString): Integer; overload;
function GetWordEndPos(const cOffset: Integer): Integer; overload;
function GetWordEndPos(const cOffset: Integer; BeginSplitCharSet, EndSplitCharSet: TPascalString): Integer; overload;
function GetWordEndPos(const cOffset: Integer;
BeginDefaultChar: Boolean; BeginSplitCharSet: TPascalString;
EndDefaultChar: Boolean; EndSplitCharSet: TPascalString): Integer; overload;
{ sniffing }
function SniffingNextChar(const cOffset: Integer; declChar: TPascalString): Boolean; overload;
function SniffingNextChar(const cOffset: Integer; declChar: TPascalString; out OutPos: Integer): Boolean; overload;
{ split char }
function SplitChar(const cOffset: Integer; var LastPos: Integer; const SplitTokenC, SplitEndTokenC: TPascalString; var SplitOutput: TSymbolVector): Integer; overload;
function SplitChar(const cOffset: Integer; const SplitTokenC, SplitEndTokenC: TPascalString; var SplitOutput: TSymbolVector): Integer; overload;
{ split string }
function SplitString(const cOffset: Integer; var LastPos: Integer; const SplitTokenS, SplitEndTokenS: TPascalString; var SplitOutput: TSymbolVector): Integer; overload;
function SplitString(const cOffset: Integer; const SplitTokenS, SplitEndTokenS: TPascalString; var SplitOutput: TSymbolVector): Integer; overload;
{ token operation }
function CompareTokenText(const cOffset: Integer; t: TPascalString): Boolean;
function CompareTokenChar(const cOffset: Integer; const c: array of SystemChar): Boolean;
function GetToken(const cOffset: Integer): PTokenData;
property TokenPos[const cOffset: Integer]: PTokenData read GetToken;
function GetTokenIndex(t: TTokenType; idx: Integer): PTokenData;
property TokenIndex[t: TTokenType; idx: Integer]: PTokenData read GetTokenIndex;
function TokenCount: Integer; overload;
function TokenCountT(t: TTokenTypes): Integer; overload;
function GetTokens(idx: Integer): PTokenData;
property Tokens[idx: Integer]: PTokenData read GetTokens; default;
property Token[idx: Integer]: PTokenData read GetTokens;
property Count: Integer read TokenCount;
function FirstToken: PTokenData;
function LastToken: PTokenData;
function NextToken(p: PTokenData): PTokenData;
function PrevToken(p: PTokenData): PTokenData;
function TokenCombine(const bTokenI, eTokenI: Integer; const acceptT: TTokenTypes): TPascalString; overload;
function TokenCombine(const bTokenI, eTokenI: Integer): TPascalString; overload;
function Combine(const bTokenI, eTokenI: Integer; const acceptT: TTokenTypes): TPascalString; overload;
function Combine(const bTokenI, eTokenI: Integer): TPascalString; overload;
{ token probe StartI->Left }
function TokenProbeL(startI: Integer; const acceptT: TTokenTypes): PTokenData; overload;
function TokenProbeL(startI: Integer; const t: TPascalString): PTokenData; overload;
function TokenProbeL(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData; overload;
function TokenProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData; overload;
function TokenProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData; overload;
function TokenProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData; overload;
function TokenProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData; overload;
{ token probe StartI->Right }
function TokenProbeR(startI: Integer; const acceptT: TTokenTypes): PTokenData; overload;
function TokenProbeR(startI: Integer; const t: TPascalString): PTokenData; overload;
function TokenProbeR(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData; overload;
function TokenProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData; overload;
function TokenProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData; overload;
function TokenProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData; overload;
function TokenProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData; overload;
{ token probe alias StartI->Left }
function ProbeL(startI: Integer; const acceptT: TTokenTypes): PTokenData; overload;
function ProbeL(startI: Integer; const t: TPascalString): PTokenData; overload;
function ProbeL(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData; overload;
function ProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData; overload;
function ProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData; overload;
function ProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData; overload;
function ProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData; overload;
function LProbe(startI: Integer; const acceptT: TTokenTypes): PTokenData; overload;
function LProbe(startI: Integer; const t: TPascalString): PTokenData; overload;
function LProbe(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData; overload;
function LProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData; overload;
function LProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData; overload;
function LProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData; overload;
function LProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData; overload;
{ token probe alias StartI->Right }
function ProbeR(startI: Integer; const acceptT: TTokenTypes): PTokenData; overload;
function ProbeR(startI: Integer; const t: TPascalString): PTokenData; overload;
function ProbeR(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData; overload;
function ProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData; overload;
function ProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData; overload;
function ProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData; overload;
function ProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData; overload;
function RProbe(startI: Integer; const acceptT: TTokenTypes): PTokenData; overload;
function RProbe(startI: Integer; const t: TPascalString): PTokenData; overload;
function RProbe(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData; overload;
function RProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData; overload;
function RProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData; overload;
function RProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData; overload;
function RProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData; overload;
{ free to match all strings from Token[StartIndex] left to right, including any symbols. return token }
function TokenFullStringProbe(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData;
function StringProbe(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData;
{ symbol Indent probe for end indent }
function IndentSymbolEndProbeR(startI: Integer; const indent_begin_symbol, indent_end_symbol: TPascalString): PTokenData;
{ symbol Indent probe for begin indent }
function IndentSymbolBeginProbeL(startI: Integer; const indent_begin_symbol, indent_end_symbol: TPascalString): PTokenData;
{ segmention text as symbol vector, L = output }
function DetectSymbolVector: Boolean;
function FillSymbolVector(L: TPascalStringList): Boolean; overload;
function FillSymbolVector: TSymbolVector; overload;
{ segmention text as symbol matrix }
function FillSymbolMatrix(W, H: Integer; var symbolMatrix: TSymbolMatrix): Boolean;
{ misc }
function GetText(const bPos, ePos: Integer): TPascalString; overload;
function GetStr(const bPos, ePos: Integer): TPascalString; overload;
function GetStr(const tp: TTextPos): TPascalString; overload;
function GetWord(const cOffset: Integer): TPascalString; overload;
function GetPoint(const cOffset: Integer): TPoint;
function GetChar(const cOffset: Integer): SystemChar;
property Len: Integer read ParsingData.Len;
property ParseText: TPascalString read ParsingData.Text;
property Text: TPascalString read ParsingData.Text;
procedure DeletePos(const bPos, ePos: Integer); overload;
procedure DeletePos(const tp: TTextPos); overload;
procedure DeletedComment;
procedure InsertTextBlock(const bPos, ePos: Integer; AInsertText: TPascalString); overload;
procedure InsertTextBlock(const tp: TTextPos; AInsertText: TPascalString); overload;
function SearchWordBody(initPos: Integer; wordInfo: TPascalString; var OutPos: TTextPos): Boolean;
{ string declaration }
class function TranslatePascalDeclToText(const Decl: TPascalString): TPascalString;
class function TranslateTextToPascalDecl(const Decl: TPascalString): TPascalString;
class function TranslateTextToPascalDeclWithUnicode(const Decl: TPascalString): TPascalString;
class function TranslateC_DeclToText(const Decl: TPascalString): TPascalString;
class function TranslateTextToC_Decl(const Decl: TPascalString): TPascalString;
{ comment declaration }
class function TranslatePascalDeclCommentToText(const Decl: TPascalString): TPascalString;
class function TranslateTextToPascalDeclComment(const Decl: TPascalString): TPascalString;
class function TranslateC_DeclCommentToText(const Decl: TPascalString): TPascalString;
class function TranslateTextToC_DeclComment(const Decl: TPascalString): TPascalString;
{ structor }
constructor Create(const Text_: TPascalString; Style_: TTextStyle; SpecialSymbol_: TListPascalString; SpacerSymbol_: SystemString); overload;
constructor Create(const Text_: TPascalString; Style_: TTextStyle; SpecialSymbol_: TListPascalString); overload;
constructor Create(const Text_: TPascalString; Style_: TTextStyle); overload;
constructor Create(const Text_: TPascalString); overload;
destructor Destroy; override;
{ external }
procedure Init; virtual;
function Parsing: Boolean; virtual;
{ debug }
procedure Print;
end;
TTextParsingClass = class of TTextParsing;
const
C_SpacerSymbol = #44#46#43#45#42#47#40#41#59#58#61#35#64#94#38#37#33#34#91#93#60#62#63#123#125#39#36#124;
var
SpacerSymbol: TAtomString;
implementation
uses DoStatusIO, TypInfo;
const
NullTokenStatistics: TTokenStatistics = (0, 0, 0, 0, 0, 0, 0);
type
TCTranslateStruct = record
s: SystemChar;
c: SystemString;
end;
const
CTranslateTable: array [0 .. 11] of TCTranslateStruct = (
(s: #007; c: '\a'),
(s: #008; c: '\b'),
(s: #012; c: '\f'),
(s: #010; c: '\n'),
(s: #013; c: '\r'),
(s: #009; c: '\t'),
(s: #011; c: '\v'),
(s: #092; c: '\\'),
(s: #063; c: '\?'),
(s: #039; c: '\'#39),
(s: #034; c: '\"'),
(s: #000; c: '\0'));
function TTextParsing.ComparePosStr(const cOffset: Integer; const t: TPascalString): Boolean;
begin
Result := ParsingData.Text.ComparePos(cOffset, t);
end;
function TTextParsing.ComparePosStr(const cOffset: Integer; const p: PPascalString): Boolean;
begin
Result := ParsingData.Text.ComparePos(cOffset, p);
end;
function TTextParsing.CompareCommentGetEndPos(const cOffset: Integer): Integer;
var
L: Integer;
cPos: Integer;
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
if p^.tokenType = TTokenType.ttComment then
Result := p^.ePos
else
Result := cOffset;
exit;
end;
end;
L := ParsingData.Len;
cPos := cOffset;
if cPos < 1 then
cPos := 1;
if cPos > L then
cPos := L;
Result := cPos;
if (TextStyle <> tsText) and (ComparePosStr(Result, '//')) then
begin
inc(Result, 2);
while ParsingData.Text[Result] <> #10 do
begin
if Result + 1 > L then
Break;
inc(Result);
end;
end
else if (TextStyle = tsC) and (ComparePosStr(Result, '#')) then
begin
inc(Result, 1);
while ParsingData.Text[Result] <> #10 do
begin
if Result + 1 > L then
Break;
inc(Result);
end;
end
else if (TextStyle = tsC) and (ComparePosStr(Result, '/*')) then
begin
inc(Result, 2);
while not ComparePosStr(Result, '*/') do
begin
if Result + 1 > L then
Break;
inc(Result);
end;
inc(Result, 2);
end
else if (TextStyle = tsPascal) and (ComparePosStr(Result, '{')) then
begin
inc(Result, 1);
while ParsingData.Text[Result] <> '}' do
begin
if Result + 1 > L then
Break;
inc(Result);
end;
inc(Result, 1);
end
else if (TextStyle = tsPascal) and (ComparePosStr(Result, '(*')) then
begin
inc(Result, 2);
while not ComparePosStr(Result, '*)') do
begin
if Result + 1 > L then
Break;
inc(Result);
end;
inc(Result, 2);
end;
end;
function TTextParsing.CompareTextDeclGetEndPos(const cOffset: Integer): Integer;
var
L: Integer;
cPos: Integer;
tmpPos: Integer;
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
if p^.tokenType = TTokenType.ttTextDecl then
Result := p^.ePos
else
Result := cOffset;
exit;
end;
end;
L := ParsingData.Len;
cPos := cOffset;
if cPos < 1 then
cPos := 1;
if cPos > L then
cPos := L;
if (cPos + 1 < L)
and (TextStyle = tsPascal)
and (ParsingData.Text[cPos] = #39) then
begin
if ComparePosStr(cPos, #39#39#39#39) then
begin
cPos := CompareTextDeclGetEndPos(cPos + 4);
exit(cPos);
end;
inc(cPos, 1);
while ParsingData.Text[cPos] <> #39 do
begin
if cPos + 1 > L then
Break;
if ParsingData.Text[cPos] = #10 then
exit(cPos);
inc(cPos);
end;
inc(cPos, 1);
end;
if (cPos + 1 < L) and (TextStyle = tsC) and (ParsingData.Text[cPos] = #39) then
begin
inc(cPos, 1);
while ParsingData.Text[cPos] <> #39 do
begin
if ComparePosStr(cPos, '\' + #39) then
inc(cPos, 1);
if cPos + 1 > L then
Break;
if ParsingData.Text[cPos] = #10 then
exit(cPos);
inc(cPos);
end;
inc(cPos, 1);
end;
if (cPos + 1 < L)
and (TextStyle = tsC)
and (ParsingData.Text[cPos] = '"') then
begin
inc(cPos, 1);
while ParsingData.Text[cPos] <> '"' do
begin
if ComparePosStr(cPos, '\"') then
inc(cPos, 1);
if cPos + 1 > L then
Break;
if ParsingData.Text[cPos] = #10 then
exit(cPos);
inc(cPos);
end;
inc(cPos, 1);
end;
if (cPos + 1 < L) and (TextStyle = tsPascal) and (ParsingData.Text[cPos] = '#') then
begin
repeat
inc(cPos, 1);
while isWordSplitChar(ParsingData.Text[cPos]) do
begin
if cPos + 1 > L then
exit(cPos);
inc(cPos);
end;
while CharIn(ParsingData.Text[cPos], [c0to9], '$') do
begin
if cPos + 1 > L then
exit(cPos);
inc(cPos);
end;
tmpPos := cPos;
while isWordSplitChar(ParsingData.Text[cPos]) do
begin
if cPos + 1 > L then
exit(cPos);
inc(cPos);
end;
until not ComparePosStr(cPos, '#');
cPos := CompareTextDeclGetEndPos(tmpPos);
end;
Result := cPos;
end;
procedure TTextParsing.RebuildParsingCache;
var
i, j: Integer;
L: Integer;
bPos: Integer;
ePos: Integer;
textPosPtr: PTextPos;
LastTokenData: PTokenData;
begin
RebuildCacheBusy := True;
if ParsingData.Cache.CommentDecls <> nil then
begin
for i := 0 to ParsingData.Cache.CommentDecls.Count - 1 do
Dispose(PTextPos(ParsingData.Cache.CommentDecls[i]));
DisposeObject(ParsingData.Cache.CommentDecls);
ParsingData.Cache.CommentDecls := nil;
end;
if ParsingData.Cache.TextDecls <> nil then
begin
for i := 0 to ParsingData.Cache.TextDecls.Count - 1 do
Dispose(PTextPos(ParsingData.Cache.TextDecls[i]));
DisposeObject(ParsingData.Cache.TextDecls);
ParsingData.Cache.TextDecls := nil;
end;
if ParsingData.Cache.TokenDataList <> nil then
begin
for i := 0 to ParsingData.Cache.TokenDataList.Count - 1 do
Dispose(PTokenData(ParsingData.Cache.TokenDataList[i]));
DisposeObject(ParsingData.Cache.TokenDataList);
ParsingData.Cache.TokenDataList := nil;
end;
TokenStatistics := NullTokenStatistics;
ParsingData.Cache.CommentDecls := TCoreClassList.Create;
ParsingData.Cache.TextDecls := TCoreClassList.Create;
ParsingData.Cache.TokenDataList := TCoreClassList.Create;
SetLength(ParsingData.Cache.CharToken, 0);
// rebuild comment and text
L := ParsingData.Len;
bPos := 1;
ePos := bPos;
while (bPos <= L) do
begin
ePos := CompareCommentGetEndPos(bPos);
if ePos > bPos then
begin
new(textPosPtr);
textPosPtr^.bPos := bPos;
textPosPtr^.ePos := ePos;
textPosPtr^.Text := GetStr(textPosPtr^);
ParsingData.Cache.CommentDecls.Add(textPosPtr);
bPos := ePos;
end
else
begin
ePos := CompareTextDeclGetEndPos(bPos);
if ePos > bPos then
begin
new(textPosPtr);
textPosPtr^.bPos := bPos;
textPosPtr^.ePos := ePos;
textPosPtr^.Text := GetStr(textPosPtr^);
ParsingData.Cache.TextDecls.Add(textPosPtr);
bPos := ePos;
end
else
begin
inc(bPos);
ePos := bPos;
end;
end;
end;
// rebuild token
bPos := 1;
ePos := bPos;
LastTokenData := nil;
while bPos <= L do
begin
if isSpecialSymbol(bPos, ePos) then
begin
new(LastTokenData);
LastTokenData^.bPos := bPos;
LastTokenData^.ePos := ePos;
LastTokenData^.Text := GetStr(bPos, ePos);
LastTokenData^.tokenType := ttSpecialSymbol;
LastTokenData^.Index := ParsingData.Cache.TokenDataList.Count;
ParsingData.Cache.TokenDataList.Add(LastTokenData);
inc(TokenStatistics[LastTokenData^.tokenType]);
bPos := ePos
end
else if isTextDecl(bPos) then
begin
ePos := GetTextDeclEndPos(bPos);
new(LastTokenData);
LastTokenData^.bPos := bPos;
LastTokenData^.ePos := ePos;
LastTokenData^.Text := GetStr(bPos, ePos);
LastTokenData^.tokenType := ttTextDecl;
LastTokenData^.Index := ParsingData.Cache.TokenDataList.Count;
ParsingData.Cache.TokenDataList.Add(LastTokenData);
inc(TokenStatistics[LastTokenData^.tokenType]);
bPos := ePos
end
else if isComment(bPos) then
begin
ePos := GetCommentEndPos(bPos);
new(LastTokenData);
LastTokenData^.bPos := bPos;
LastTokenData^.ePos := ePos;
LastTokenData^.Text := GetStr(bPos, ePos);
LastTokenData^.tokenType := ttComment;
LastTokenData^.Index := ParsingData.Cache.TokenDataList.Count;
ParsingData.Cache.TokenDataList.Add(LastTokenData);
inc(TokenStatistics[LastTokenData^.tokenType]);
bPos := ePos;
end
else if isNumber(bPos) then
begin
ePos := GetNumberEndPos(bPos);
new(LastTokenData);
LastTokenData^.bPos := bPos;
LastTokenData^.ePos := ePos;
LastTokenData^.Text := GetStr(bPos, ePos);
LastTokenData^.tokenType := ttNumber;
LastTokenData^.Index := ParsingData.Cache.TokenDataList.Count;
ParsingData.Cache.TokenDataList.Add(LastTokenData);
inc(TokenStatistics[LastTokenData^.tokenType]);
bPos := ePos;
end
else if isSymbol(bPos) then
begin
ePos := GetSymbolEndPos(bPos);
new(LastTokenData);
LastTokenData^.bPos := bPos;
LastTokenData^.ePos := ePos;
LastTokenData^.Text := GetStr(bPos, ePos);
LastTokenData^.tokenType := ttSymbol;
LastTokenData^.Index := ParsingData.Cache.TokenDataList.Count;
ParsingData.Cache.TokenDataList.Add(LastTokenData);
inc(TokenStatistics[LastTokenData^.tokenType]);
bPos := ePos;
end
else if isAscii(bPos) then
begin
ePos := GetAsciiEndPos(bPos);
new(LastTokenData);
LastTokenData^.bPos := bPos;
LastTokenData^.ePos := ePos;
LastTokenData^.Text := GetStr(bPos, ePos);
LastTokenData^.tokenType := ttAscii;
LastTokenData^.Index := ParsingData.Cache.TokenDataList.Count;
ParsingData.Cache.TokenDataList.Add(LastTokenData);
inc(TokenStatistics[LastTokenData^.tokenType]);
bPos := ePos;
end
else
begin
ePos := bPos + 1;
if (LastTokenData = nil) or (LastTokenData^.tokenType <> ttUnknow) then
begin
new(LastTokenData);
LastTokenData^.bPos := bPos;
LastTokenData^.ePos := ePos;
LastTokenData^.Text := GetStr(bPos, ePos);
LastTokenData^.tokenType := ttUnknow;
LastTokenData^.Index := ParsingData.Cache.TokenDataList.Count;
ParsingData.Cache.TokenDataList.Add(LastTokenData);
inc(TokenStatistics[LastTokenData^.tokenType]);
end
else
begin
LastTokenData^.ePos := ePos;
LastTokenData^.Text.Append(GetChar(bPos));
end;
bPos := ePos;
end;
end;
SetLength(ParsingData.Cache.CharToken, L);
for i := 0 to ParsingData.Cache.TokenDataList.Count - 1 do
begin
LastTokenData := PTokenData(ParsingData.Cache.TokenDataList[i]);
for j := LastTokenData^.bPos to LastTokenData^.ePos - 1 do
ParsingData.Cache.CharToken[j - 1] := LastTokenData;
end;
RebuildCacheBusy := False;
end;
procedure TTextParsing.RebuildText;
procedure Recompute(bPos, d: Integer);
var
i: Integer;
p: PTextPos;
begin
for i := 0 to ParsingData.Cache.TextDecls.Count - 1 do
begin
p := PTextPos(ParsingData.Cache.TextDecls[i]);
if bPos < p^.bPos then
begin
p^.bPos := p^.bPos - d;
p^.ePos := p^.ePos - d;
end;
end;
for i := 0 to ParsingData.Cache.CommentDecls.Count - 1 do
begin
p := PTextPos(ParsingData.Cache.CommentDecls[i]);
if bPos < p^.bPos then
begin
p^.bPos := p^.bPos - d;
p^.ePos := p^.ePos - d;
end;
end;
end;
var
p: PTextPos;
i: Integer;
begin
for i := 0 to ParsingData.Cache.TextDecls.Count - 1 do
begin
p := PTextPos(ParsingData.Cache.TextDecls[i]);
if p^.ePos - p^.bPos <> (p^.Text.Len) then
Recompute(p^.bPos, (p^.ePos - p^.bPos) - p^.Text.Len);
ParsingData.Text := GetStr(1, p^.bPos) + p^.Text + GetStr(p^.ePos, ParsingData.Text.Len + 1);
ParsingData.Len := ParsingData.Text.Len;
p^.ePos := p^.bPos + p^.Text.Len;
end;
for i := 0 to ParsingData.Cache.CommentDecls.Count - 1 do
begin
p := PTextPos(ParsingData.Cache.CommentDecls[i]);
if p^.ePos - p^.bPos <> (p^.Text.Len) then
Recompute(p^.bPos, (p^.ePos - p^.bPos) - p^.Text.Len);
ParsingData.Text := GetStr(1, p^.bPos) + p^.Text + GetStr(p^.ePos, ParsingData.Text.Len + 1);
ParsingData.Len := ParsingData.Text.Len;
p^.ePos := p^.bPos + p^.Text.Len;
end;
RebuildParsingCache;
end;
procedure TTextParsing.RebuildToken;
var
p: PTokenData;
i: Integer;
begin
ParsingData.Text := '';
for i := 0 to ParsingData.Cache.TokenDataList.Count - 1 do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[i]);
ParsingData.Text.Append(p^.Text);
end;
ParsingData.Len := ParsingData.Text.Len;
RebuildParsingCache;
end;
function TTextParsing.GetContextBeginPos(const cOffset: Integer): Integer;
var
p: PTokenData;
begin
Result := cOffset;
p := TokenPos[cOffset];
if p = nil then
exit;
Result := p^.bPos;
end;
function TTextParsing.GetContextEndPos(const cOffset: Integer): Integer;
var
p: PTokenData;
begin
Result := cOffset;
p := TokenPos[cOffset];
if p = nil then
exit;
Result := p^.ePos;
end;
function TTextParsing.isSpecialSymbol(const cOffset: Integer): Boolean;
var
ePos: Integer;
begin
Result := isSpecialSymbol(cOffset, ePos);
end;
function TTextParsing.isSpecialSymbol(const cOffset: Integer; var speicalSymbolEndPos: Integer): Boolean;
var
i, EP: Integer;
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
Result := p^.tokenType = TTokenType.ttSpecialSymbol;
if Result then
speicalSymbolEndPos := p^.ePos;
exit;
end;
end;
Result := False;
speicalSymbolEndPos := cOffset;
if SpecialSymbol.Count = 0 then
exit;
if isComment(cOffset) then
exit;
if isTextDecl(cOffset) then
exit;
speicalSymbolEndPos := cOffset;
for i := 0 to SpecialSymbol.Count - 1 do
if ComparePosStr(cOffset, SpecialSymbol.Items_PPascalString[i]) then
begin
EP := cOffset + SpecialSymbol[i].Len;
if EP > speicalSymbolEndPos then
speicalSymbolEndPos := EP;
Result := True;
end;
end;
function TTextParsing.GetSpecialSymbolEndPos(const cOffset: Integer): Integer;
begin
if not isSpecialSymbol(cOffset, Result) then
Result := cOffset;
end;
function TTextParsing.isNumber(const cOffset: Integer): Boolean;
var
tmp: Integer;
IsHex: Boolean;
begin
Result := isNumber(cOffset, tmp, IsHex);
end;
function TTextParsing.isNumber(const cOffset: Integer; var NumberBegin: Integer; var IsHex: Boolean): Boolean;
var
c: SystemChar;
L: Integer;
cPos, bkPos: Integer;
NC: Integer;
dotCount: Integer;
eCnt: Integer;
AddSubSymCnt: Integer;
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
Result := p^.tokenType = TTokenType.ttNumber;
if Result then
begin
NumberBegin := p^.bPos;
IsHex := p^.Text.ComparePos(1, '$') or p^.Text.ComparePos(1, '0x');
end;
exit;
end;
end;
Result := False;
cPos := cOffset;
L := ParsingData.Len;
if cPos < 1 then
cPos := 1;
if cPos > L then
cPos := L;
if cPos = L then
exit;
IsHex := False;
try
if (CharIn(ParsingData.Text[cPos], '$')) then
begin
// pascal style hex
IsHex := True;
inc(cPos);
if cPos > L then
exit;
end
else if ComparePosStr(cPos, '0x') then
begin
// c style hex
IsHex := True;
inc(cPos, 2);
if cPos > L then
exit;
end;
except
end;
if IsHex then
begin
bkPos := cPos;
NC := 0;
while True do
begin
cPos := GetTextDeclEndPos(GetCommentEndPos(cPos));
if cPos > L then
Break;
c := ParsingData.Text[cPos];
if isWordSplitChar(c, True, SymbolTable) then
begin
if NC > 0 then
Break;
end
else if CharIn(c, cHex) then
inc(NC)
else
begin
Result := False;
exit;
end;
inc(cPos);
end;
Result := NC > 0;
NumberBegin := bkPos;
exit;
end;
c := ParsingData.Text[cPos];
if CharIn(c, c0to9) then
begin
bkPos := cPos;
NC := 0;
while True do
begin
cPos := GetTextDeclEndPos(GetCommentEndPos(cPos));
if cPos > L then
Break;
c := ParsingData.Text[cPos];
if isWordSplitChar(c, True, SymbolTable) then
begin
Break;
end
else if CharIn(c, cAtoZ) then
begin
Result := False;
exit;
end
else if CharIn(c, c0to9) then
inc(NC);
inc(cPos);
end;
Result := NC > 0;
NumberBegin := bkPos;
exit;
end
else if CharIn(c, '+-.') then
begin
bkPos := cPos;
NC := 0;
while True do
begin
cPos := GetTextDeclEndPos(GetCommentEndPos(cPos));
if cPos > L then
Break;
c := ParsingData.Text[cPos];
if CharIn(c, '+-') then
begin
if NC > 0 then
Break;
end
else if isWordSplitChar(c, True, SymbolTable) then
begin
Break
end
else if CharIn(c, cAtoZ) then
begin
Result := False;
exit;
end
else if CharIn(c, c0to9) then
inc(NC);
inc(cPos);
end;
Result := NC > 0;
NumberBegin := bkPos;
exit;
end;
end;
function TTextParsing.GetNumberEndPos(const cOffset: Integer): Integer;
var
IsHex: Boolean;
L: Integer;
cPos: Integer;
c: SystemChar;
NC: Integer;
dotC: Integer;
eC: Integer;
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
if p^.tokenType = TTokenType.ttNumber then
Result := p^.ePos
else
Result := cOffset;
exit;
end;
end;
L := ParsingData.Len;
cPos := cOffset;
if cPos < 1 then
cPos := 1;
if cPos > L then
cPos := L;
if isNumber(cPos, Result, IsHex) then
begin
NC := 0;
dotC := 0;
eC := 0;
while True do
begin
if isComment(Result) or isTextDecl(Result) then
Break;
c := ParsingData.Text[Result];
if (not CharIn(c, [c0to9])) then
begin
if CharIn(c, '+-') then
begin
if NC > 0 then
begin
if eC = 1 then
inc(eC)
else
exit;
end;
end
else if (not IsHex) and CharIn(c, '.') then
begin
if (dotC > 1) then
exit;
inc(dotC);
end
else if (not IsHex) and CharIn(c, 'eE') then
begin
if (eC > 1) then
exit;
inc(eC);
end
else if (IsHex and (CharIn(c, [cLoAtoF, cHiAtoF]))) then
inc(NC)
else
exit;
end
else
inc(NC);
inc(Result);
if Result > L then
exit;
end;
end
else
Result := cPos;
end;
function TTextParsing.isTextDecl(const cOffset: Integer): Boolean;
var
bPos, ePos: Integer;
begin
Result := GetTextDeclPos(cOffset, bPos, ePos);
end;
function TTextParsing.GetTextDeclEndPos(const cOffset: Integer): Integer;
var
bPos, ePos: Integer;
begin
if GetTextDeclPos(cOffset, bPos, ePos) then
Result := ePos
else
Result := cOffset;
end;
function TTextParsing.GetTextDeclBeginPos(const cOffset: Integer): Integer;
var
bPos, ePos: Integer;
begin
if GetTextDeclPos(cOffset, bPos, ePos) then
Result := bPos
else
Result := cOffset;
end;
function TTextParsing.GetTextBody(const Text_: TPascalString): TPascalString;
begin
if TextStyle = tsPascal then
Result := TranslatePascalDeclToText(Text_)
else if TextStyle = tsC then
Result := TranslateC_DeclToText(Text_)
else
Result := Text_;
end;
function TTextParsing.GetTextDeclPos(const cOffset: Integer; var charBeginPos, charEndPos: Integer): Boolean;
function CompLst(idx: Integer): Integer;
begin
with PTextPos(ParsingData.Cache.TextDecls[idx])^ do
begin
if (cOffset >= bPos) and (cOffset < ePos) then
Result := 0
else if (cOffset >= ePos) then
Result := -1
else if (cOffset < bPos) then
Result := 1
else
Result := -2;
end;
end;
var
cPos, L, r, M: Integer;
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
Result := p^.tokenType = TTokenType.ttTextDecl;
if Result then
begin
charBeginPos := p^.bPos;
charEndPos := p^.ePos;
end;
exit;
end;
end;
cPos := cOffset;
if cPos < 1 then
cPos := 1;
if cPos > ParsingData.Len then
cPos := ParsingData.Len;
if ParsingData.Cache.TextDecls = nil then
RebuildParsingCache;
Result := False;
L := 0;
r := ParsingData.Cache.TextDecls.Count - 1;
while L <= r do
begin
M := (L + r) div 2;
case CompLst(M) of
0:
begin
with PTextPos(ParsingData.Cache.TextDecls[M])^ do
begin
charBeginPos := bPos;
charEndPos := ePos;
end;
Result := True;
exit;
end;
-1: L := M + 1;
1: r := M - 1;
else RaiseInfo('struct error');
end;
end;
end;
function TTextParsing.isSymbol(const cOffset: Integer): Boolean;
var
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
Result := p^.tokenType = TTokenType.ttSymbol;
exit;
end;
end;
Result := CharIn(ParsingData.Text[cOffset], SymbolTable)
end;
function TTextParsing.GetSymbolEndPos(const cOffset: Integer): Integer;
begin
if isSymbol(cOffset) then
Result := cOffset + 1
else
Result := cOffset;
end;
function TTextParsing.isAscii(const cOffset: Integer): Boolean;
var
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
Result := p^.tokenType = TTokenType.ttAscii;
exit;
end;
end;
Result := False;
if isComment(cOffset) then
exit;
if isTextDecl(cOffset) then
exit;
if isSpecialSymbol(cOffset) then
exit;
Result := (not isSymbol(cOffset)) and (not isWordSplitChar(ParsingData.Text[cOffset], True, SymbolTable)) and (not isNumber(cOffset));
end;
function TTextParsing.GetAsciiBeginPos(const cOffset: Integer): Integer;
var
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
if p^.tokenType = TTokenType.ttAscii then
Result := p^.bPos
else
Result := cOffset;
exit;
end;
end;
Result := GetWordBeginPos(cOffset, True, SymbolTable);
end;
function TTextParsing.GetAsciiEndPos(const cOffset: Integer): Integer;
var
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
if p^.tokenType = TTokenType.ttAscii then
Result := p^.ePos
else
Result := cOffset;
exit;
end;
end;
Result := GetWordEndPos(cOffset, True, SymbolTable, True, SymbolTable);
end;
function TTextParsing.isComment(const cOffset: Integer): Boolean;
var
bPos, ePos: Integer;
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
Result := p^.tokenType = TTokenType.ttComment;
exit;
end;
end;
Result := GetCommentPos(cOffset, bPos, ePos);
end;
function TTextParsing.GetCommentEndPos(const cOffset: Integer): Integer;
var
bPos, ePos: Integer;
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
if p^.tokenType = TTokenType.ttComment then
Result := p^.ePos
else
Result := cOffset;
exit;
end;
end;
if GetCommentPos(cOffset, bPos, ePos) then
Result := ePos
else
Result := cOffset;
end;
function TTextParsing.GetCommentBeginPos(const cOffset: Integer): Integer;
var
bPos, ePos: Integer;
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
if p^.tokenType = TTokenType.ttComment then
Result := p^.bPos
else
Result := cOffset;
exit;
end;
end;
if GetCommentPos(cOffset, bPos, ePos) then
Result := bPos
else
Result := cOffset;
end;
function TTextParsing.GetCommentPos(const cOffset: Integer; var charBeginPos, charEndPos: Integer): Boolean;
function CompLst(idx: Integer): Integer;
begin
with PTextPos(ParsingData.Cache.CommentDecls[idx])^ do
begin
if (cOffset >= bPos) and (cOffset < ePos) then
Result := 0
else if (cOffset >= ePos) then
Result := -1
else if (cOffset < bPos) then
Result := 1
else
Result := -2;
end;
end;
var
cPos, L, r, M: Integer;
p: PTokenData;
begin
if not RebuildCacheBusy then
begin
p := TokenPos[cOffset];
if p <> nil then
begin
Result := p^.tokenType = TTokenType.ttComment;
if Result then
begin
charBeginPos := p^.bPos;
charEndPos := p^.ePos;
end;
exit;
end;
end;
cPos := cOffset;
if cPos < 1 then
cPos := 1;
if cPos > ParsingData.Len then
cPos := ParsingData.Len;
if ParsingData.Cache.CommentDecls = nil then
RebuildParsingCache;
Result := False;
L := 0;
r := ParsingData.Cache.CommentDecls.Count - 1;
while L <= r do
begin
M := (L + r) div 2;
case CompLst(M) of
0:
begin
with PTextPos(ParsingData.Cache.CommentDecls[M])^ do
begin
charBeginPos := bPos;
charEndPos := ePos;
end;
Result := True;
exit;
end;
-1: L := M + 1;
1: r := M - 1;
else RaiseInfo('struct error');
end;
end;
end;
function TTextParsing.GetDeletedCommentText: TPascalString;
var
oriPos, cPos, nPos: Integer;
begin
Result := '';
cPos := 1;
oriPos := cPos;
while cPos < ParsingData.Len do
begin
nPos := CompareCommentGetEndPos(cPos);
if nPos > cPos then
begin
Result := Result + GetStr(oriPos, cPos);
cPos := nPos;
oriPos := cPos;
end
else
begin
inc(cPos);
end;
end;
if oriPos <= ParsingData.Len then
Result := Result + GetStr(oriPos, ParsingData.Len + 1);
Result := Result.TrimChar(#32);
end;
function TTextParsing.isTextOrComment(const cOffset: Integer): Boolean;
begin
Result := isTextDecl(cOffset) or isComment(cOffset);
end;
function TTextParsing.isCommentOrText(const cOffset: Integer): Boolean;
begin
Result := isComment(cOffset) or isTextDecl(cOffset);
end;
class function TTextParsing.isWordSplitChar(const c: SystemChar; SplitTokenC: TPascalString): Boolean;
begin
Result := isWordSplitChar(c, True, SplitTokenC);
end;
class function TTextParsing.isWordSplitChar(const c: SystemChar): Boolean;
begin
Result := isWordSplitChar(c, True, '');
end;
class function TTextParsing.isWordSplitChar(const c: SystemChar; DefaultChar: Boolean; SplitTokenC: TPascalString): Boolean;
begin
if DefaultChar then
Result := CharIn(c, [c0to32], SplitTokenC)
else
Result := CharIn(c, SplitTokenC);
end;
function TTextParsing.GetWordBeginPos(const cOffset: Integer; SplitTokenC: TPascalString): Integer;
begin
Result := GetWordBeginPos(cOffset, True, SplitTokenC);
end;
function TTextParsing.GetWordBeginPos(const cOffset: Integer): Integer;
begin
Result := GetWordBeginPos(cOffset, True, '');
end;
function TTextParsing.GetWordBeginPos(const cOffset: Integer; BeginDefaultChar: Boolean; SplitTokenC: TPascalString): Integer;
var
L: Integer;
cPos: Integer;
tbPos: Integer;
begin
L := ParsingData.Len;
cPos := cOffset;
if cPos < 1 then
exit(1);
if cPos > L then
exit(L);
repeat
cPos := GetCommentEndPos(cPos);
tbPos := GetTextDeclBeginPos(cPos);
if tbPos <> cPos then
exit(tbPos);
while (isWordSplitChar(ParsingData.Text[cPos], BeginDefaultChar, SplitTokenC)) do
begin
if cPos >= L then
Break;
inc(cPos);
end;
until not isComment(cPos);
Result := cPos;
while (not isWordSplitChar(ParsingData.Text[Result], BeginDefaultChar, SplitTokenC)) do
begin
if Result - 1 <= 0 then
Break;
dec(Result);
end;
if isWordSplitChar(ParsingData.Text[Result], SplitTokenC) then
inc(Result);
end;
function TTextParsing.GetWordEndPos(const cOffset: Integer; SplitTokenC: TPascalString): Integer;
begin
Result := GetWordEndPos(cOffset, True, SplitTokenC, True, SplitTokenC);
end;
function TTextParsing.GetWordEndPos(const cOffset: Integer): Integer;
begin
Result := GetWordEndPos(cOffset, True, '', True, '');
end;
function TTextParsing.GetWordEndPos(const cOffset: Integer; BeginSplitCharSet, EndSplitCharSet: TPascalString): Integer;
begin
Result := GetWordEndPos(cOffset, True, BeginSplitCharSet, True, EndSplitCharSet);
end;
function TTextParsing.GetWordEndPos(const cOffset: Integer;
BeginDefaultChar: Boolean; BeginSplitCharSet: TPascalString;
EndDefaultChar: Boolean; EndSplitCharSet: TPascalString): Integer;
var
L: Integer;
begin
L := ParsingData.Len;
if cOffset < 1 then
exit(1);
if cOffset > L then
exit(L);
Result := GetWordBeginPos(cOffset, BeginDefaultChar, BeginSplitCharSet);
while (not isWordSplitChar(ParsingData.Text[Result], EndDefaultChar, EndSplitCharSet)) do
begin
inc(Result);
if Result > L then
Break;
end;
end;
function TTextParsing.SniffingNextChar(const cOffset: Integer; declChar: TPascalString): Boolean;
var
tmp: Integer;
begin
Result := SniffingNextChar(cOffset, declChar, tmp);
end;
function TTextParsing.SniffingNextChar(const cOffset: Integer; declChar: TPascalString; out OutPos: Integer): Boolean;
var
L: Integer;
cPos: Integer;
begin
L := ParsingData.Len;
cPos := cOffset;
if cPos < 1 then
cPos := 1;
if cPos > L then
exit(False);
while isWordSplitChar(ParsingData.Text[cPos]) or (isTextOrComment(cPos)) do
begin
inc(cPos);
if cPos > L then
exit(False);
end;
if (cPos < L) then
Result := CharIn(ParsingData.Text[cPos], declChar)
else
Result := False;
if Result then
OutPos := cPos;
end;
function TTextParsing.SplitChar(const cOffset: Integer; var LastPos: Integer; const SplitTokenC, SplitEndTokenC: TPascalString; var SplitOutput: TSymbolVector): Integer;
procedure AddS(const s: TPascalString);
var
n: TPascalString;
L: Integer;
begin
n := s.TrimChar(#32#0);
if n.Len = 0 then
exit;
L := Length(SplitOutput);
SetLength(SplitOutput, L + 1);
SplitOutput[L] := n;
inc(Result);
end;
type
TLastSym = (lsBody, lsNone);
var
L: Integer;
c: SystemChar;
cPos, bPos, ePos: Integer;
LastSym: TLastSym;
begin
Result := 0;
SetLength(SplitOutput, 0);
LastPos := cOffset;
L := ParsingData.Len;
cPos := cOffset;
if cPos < 1 then
cPos := 1;
if cPos > L then
exit;
bPos := cPos;
ePos := bPos;
LastSym := lsNone;
while (cPos <= L) do
begin
if isComment(cPos) then
begin
cPos := GetCommentEndPos(cPos);
Continue;
end;
if isTextDecl(cPos) then
begin
cPos := GetTextDeclEndPos(cPos);
Continue;
end;
c := ParsingData.Text[cPos];
if isWordSplitChar(c, True, SplitTokenC) then
begin
if LastSym = lsBody then
begin
ePos := cPos;
AddS(GetStr(bPos, ePos));
LastSym := lsNone;
end;
inc(cPos);
Continue;
end;
if (isWordSplitChar(c, False, SplitEndTokenC)) then
begin
if LastSym = lsBody then
begin
ePos := cPos;
AddS(GetStr(bPos, ePos));
LastSym := lsNone;
end;
LastPos := cPos;
exit;
end;
if LastSym = lsNone then
begin
bPos := cPos;
LastSym := lsBody;
end;
inc(cPos);
end;
if LastSym = lsBody then
begin
ePos := cPos;
AddS(GetStr(bPos, ePos));
LastSym := lsNone;
end;
LastPos := cPos;
end;
function TTextParsing.SplitChar(const cOffset: Integer; const SplitTokenC, SplitEndTokenC: TPascalString; var SplitOutput: TSymbolVector): Integer;
var
t: Integer;
begin
Result := SplitChar(cOffset, t, SplitTokenC, SplitEndTokenC, SplitOutput);
end;
function TTextParsing.SplitString(const cOffset: Integer; var LastPos: Integer; const SplitTokenS, SplitEndTokenS: TPascalString; var SplitOutput: TSymbolVector): Integer;
procedure AddS(s: TPascalString);
var
L: Integer;
begin
s := s.TrimChar(#32#0);
if s.Len = 0 then
exit;
L := Length(SplitOutput);
SetLength(SplitOutput, L + 1);
SplitOutput[L] := s;
inc(Result);
end;
type
TLastSym = (lsBody, lsNone);
var
L: Integer;
c: SystemChar;
cPos, bPos, ePos: Integer;
LastSym: TLastSym;
begin
Result := 0;
SetLength(SplitOutput, 0);
LastPos := cOffset;
L := ParsingData.Len;
cPos := cOffset;
if cPos < 1 then
cPos := 1;
if cPos > L then
exit;
bPos := cPos;
ePos := bPos;
LastSym := lsNone;
while (cPos <= L) do
begin
if isComment(cPos) then
begin
cPos := GetCommentEndPos(cPos);
Continue;
end;
if isTextDecl(cPos) then
begin
cPos := GetTextDeclEndPos(cPos);
Continue;
end;
if ComparePosStr(cPos, SplitTokenS) then
begin
if LastSym = lsBody then
begin
ePos := cPos;
AddS(GetStr(bPos, ePos));
LastSym := lsNone;
end;
inc(cPos, SplitTokenS.Len);
Continue;
end;
if ComparePosStr(cPos, SplitEndTokenS) then
begin
if LastSym = lsBody then
begin
ePos := cPos;
AddS(GetStr(bPos, ePos));
LastSym := lsNone;
end;
LastPos := cPos;
exit;
end;
if LastSym = lsNone then
begin
bPos := cPos;
LastSym := lsBody;
end;
inc(cPos);
end;
if LastSym = lsBody then
begin
ePos := cPos;
AddS(GetStr(bPos, ePos));
LastSym := lsNone;
end;
LastPos := cPos;
end;
function TTextParsing.SplitString(const cOffset: Integer; const SplitTokenS, SplitEndTokenS: TPascalString; var SplitOutput: TSymbolVector): Integer;
var
t: Integer;
begin
Result := SplitString(cOffset, t, SplitTokenS, SplitEndTokenS, SplitOutput);
end;
function TTextParsing.CompareTokenText(const cOffset: Integer; t: TPascalString): Boolean;
var
p: PTokenData;
begin
Result := False;
p := GetToken(cOffset);
if p = nil then
exit;
Result := p^.Text.Same(t);
end;
function TTextParsing.CompareTokenChar(const cOffset: Integer; const c: array of SystemChar): Boolean;
var
p: PTokenData;
begin
Result := False;
p := GetToken(cOffset);
if p = nil then
exit;
if p^.Text.Len <> 1 then
exit;
Result := CharIn(p^.Text.First, c);
end;
function TTextParsing.GetToken(const cOffset: Integer): PTokenData;
begin
if (cOffset - 1 >= 0) and (cOffset - 1 < Length(ParsingData.Cache.CharToken)) then
Result := ParsingData.Cache.CharToken[cOffset - 1]
else
Result := nil;
end;
function TTextParsing.GetTokenIndex(t: TTokenType; idx: Integer): PTokenData;
var
i, c: Integer;
p: PTokenData;
begin
Result := nil;
c := 0;
for i := 0 to ParsingData.Cache.TokenDataList.Count - 1 do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[i]);
if p^.tokenType = t then
begin
if c = idx then
exit(p)
else
inc(c);
end;
end;
end;
function TTextParsing.TokenCount: Integer;
begin
Result := ParsingData.Cache.TokenDataList.Count;
end;
function TTextParsing.TokenCountT(t: TTokenTypes): Integer;
var
i: Integer;
begin
Result := 0;
for i := ParsingData.Cache.TokenDataList.Count - 1 downto 0 do
if GetTokens(i)^.tokenType in t then
inc(Result);
end;
function TTextParsing.GetTokens(idx: Integer): PTokenData;
begin
Result := PTokenData(ParsingData.Cache.TokenDataList[idx]);
end;
function TTextParsing.FirstToken: PTokenData;
begin
Result := GetTokens(0);
end;
function TTextParsing.LastToken: PTokenData;
begin
Result := GetTokens(TokenCount - 1);
end;
function TTextParsing.NextToken(p: PTokenData): PTokenData;
begin
Result := nil;
if (p = nil) or (p^.Index + 1 >= TokenCount) then
exit;
Result := Tokens[p^.Index + 1];
end;
function TTextParsing.PrevToken(p: PTokenData): PTokenData;
begin
Result := nil;
if (p = nil) or (p^.Index - 1 >= 0) then
exit;
Result := Tokens[p^.Index - 1];
end;
function TTextParsing.TokenCombine(const bTokenI, eTokenI: Integer; const acceptT: TTokenTypes): TPascalString;
var
bi, ei: Integer;
p: PTokenData;
begin
Result := '';
if (bTokenI < 0) or (eTokenI < 0) then
exit;
if bTokenI > eTokenI then
begin
bi := eTokenI;
ei := bTokenI;
end
else
begin
bi := bTokenI;
ei := eTokenI;
end;
while (bi <= ei) and (bi < TokenCount) do
begin
p := Tokens[bi];
if p^.tokenType in acceptT then
Result.Append(p^.Text);
inc(bi);
end;
if (bi >= TokenCount) then
begin
while (Result.Len > 0) and (Result.Last = #0) do
Result.DeleteLast;
if (Result.Len > 0) and (Result.Last = #32) then
Result.DeleteLast;
end;
end;
function TTextParsing.TokenCombine(const bTokenI, eTokenI: Integer): TPascalString;
begin
Result := TokenCombine(bTokenI, eTokenI, [ttTextDecl, ttComment, ttNumber, ttSymbol, ttAscii, ttSpecialSymbol, ttUnknow]);
end;
function TTextParsing.Combine(const bTokenI, eTokenI: Integer; const acceptT: TTokenTypes): TPascalString;
begin
Result := TokenCombine(bTokenI, eTokenI, acceptT);
end;
function TTextParsing.Combine(const bTokenI, eTokenI: Integer): TPascalString;
begin
Result := TokenCombine(bTokenI, eTokenI);
end;
function TTextParsing.TokenProbeL(startI: Integer; const acceptT: TTokenTypes): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx >= 0 do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) then
begin
Result := p;
exit;
end
else
dec(idx);
end;
end;
function TTextParsing.TokenProbeL(startI: Integer; const t: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx >= 0 do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.Text.Same(t)) then
begin
Result := p;
exit;
end
else
dec(idx);
end;
end;
function TTextParsing.TokenProbeL(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx >= 0 do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) and (p^.Text.Same(t)) then
begin
Result := p;
exit;
end
else
dec(idx);
end;
end;
function TTextParsing.TokenProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx >= 0 do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) and (p^.Text.Same(t1, t2)) then
begin
Result := p;
exit;
end
else
dec(idx);
end;
end;
function TTextParsing.TokenProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx >= 0 do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) and (p^.Text.Same(t1, t2, t3)) then
begin
Result := p;
exit;
end
else
dec(idx);
end;
end;
function TTextParsing.TokenProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx >= 0 do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) and (p^.Text.Same(t1, t2, t3, t4)) then
begin
Result := p;
exit;
end
else
dec(idx);
end;
end;
function TTextParsing.TokenProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx >= 0 do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) and (p^.Text.Same(t1, t2, t3, t4, t5)) then
begin
Result := p;
exit;
end
else
dec(idx);
end;
end;
function TTextParsing.TokenProbeR(startI: Integer; const acceptT: TTokenTypes): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx < ParsingData.Cache.TokenDataList.Count do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) then
begin
Result := p;
exit;
end
else
inc(idx);
end;
end;
function TTextParsing.TokenProbeR(startI: Integer; const t: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx < ParsingData.Cache.TokenDataList.Count do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.Text.Same(t)) then
begin
Result := p;
exit;
end
else
inc(idx);
end;
end;
function TTextParsing.TokenProbeR(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx < ParsingData.Cache.TokenDataList.Count do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) and (p^.Text.Same(t)) then
begin
Result := p;
exit;
end
else
inc(idx);
end;
end;
function TTextParsing.TokenProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx < ParsingData.Cache.TokenDataList.Count do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) and (p^.Text.Same(t1, t2)) then
begin
Result := p;
exit;
end
else
inc(idx);
end;
end;
function TTextParsing.TokenProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx < ParsingData.Cache.TokenDataList.Count do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) and (p^.Text.Same(t1, t2, t3)) then
begin
Result := p;
exit;
end
else
inc(idx);
end;
end;
function TTextParsing.TokenProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx < ParsingData.Cache.TokenDataList.Count do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) and (p^.Text.Same(t1, t2, t3, t4)) then
begin
Result := p;
exit;
end
else
inc(idx);
end;
end;
function TTextParsing.TokenProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx < ParsingData.Cache.TokenDataList.Count do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) and (p^.Text.Same(t1, t2, t3, t4, t5)) then
begin
Result := p;
exit;
end
else
inc(idx);
end;
end;
function TTextParsing.ProbeL(startI: Integer; const acceptT: TTokenTypes): PTokenData;
begin
Result := TokenProbeL(startI, acceptT);
end;
function TTextParsing.ProbeL(startI: Integer; const t: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, t);
end;
function TTextParsing.ProbeL(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, acceptT, t);
end;
function TTextParsing.ProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, acceptT, t1, t2);
end;
function TTextParsing.ProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, acceptT, t1, t2, t3);
end;
function TTextParsing.ProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, acceptT, t1, t2, t3, t4);
end;
function TTextParsing.ProbeL(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, acceptT, t1, t2, t3, t4, t5);
end;
function TTextParsing.LProbe(startI: Integer; const acceptT: TTokenTypes): PTokenData;
begin
Result := TokenProbeL(startI, acceptT);
end;
function TTextParsing.LProbe(startI: Integer; const t: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, t);
end;
function TTextParsing.LProbe(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, acceptT, t);
end;
function TTextParsing.LProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, acceptT, t1, t2);
end;
function TTextParsing.LProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, acceptT, t1, t2, t3);
end;
function TTextParsing.LProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, acceptT, t1, t2, t3, t4);
end;
function TTextParsing.LProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData;
begin
Result := TokenProbeL(startI, acceptT, t1, t2, t3, t4, t5);
end;
function TTextParsing.ProbeR(startI: Integer; const acceptT: TTokenTypes): PTokenData;
begin
Result := TokenProbeR(startI, acceptT);
end;
function TTextParsing.ProbeR(startI: Integer; const t: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, t);
end;
function TTextParsing.ProbeR(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, acceptT, t);
end;
function TTextParsing.ProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, acceptT, t1, t2);
end;
function TTextParsing.ProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, acceptT, t1, t2, t3);
end;
function TTextParsing.ProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, acceptT, t1, t2, t3, t4);
end;
function TTextParsing.ProbeR(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, acceptT, t1, t2, t3, t4, t5);
end;
function TTextParsing.RProbe(startI: Integer; const acceptT: TTokenTypes): PTokenData;
begin
Result := TokenProbeR(startI, acceptT);
end;
function TTextParsing.RProbe(startI: Integer; const t: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, t);
end;
function TTextParsing.RProbe(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, acceptT, t);
end;
function TTextParsing.RProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, acceptT, t1, t2);
end;
function TTextParsing.RProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, acceptT, t1, t2, t3);
end;
function TTextParsing.RProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, acceptT, t1, t2, t3, t4);
end;
function TTextParsing.RProbe(startI: Integer; const acceptT: TTokenTypes; const t1, t2, t3, t4, t5: TPascalString): PTokenData;
begin
Result := TokenProbeR(startI, acceptT, t1, t2, t3, t4, t5);
end;
function TTextParsing.StringProbe(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData;
var
idx: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
while idx < ParsingData.Cache.TokenDataList.Count do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if (p^.tokenType in acceptT) and (ComparePosStr(p^.bPos, t)) then
begin
Result := p;
exit;
end
else
inc(idx);
end;
end;
function TTextParsing.TokenFullStringProbe(startI: Integer; const acceptT: TTokenTypes; const t: TPascalString): PTokenData;
begin
Result := StringProbe(startI, acceptT, t);
end;
function TTextParsing.IndentSymbolEndProbeR(startI: Integer; const indent_begin_symbol, indent_end_symbol: TPascalString): PTokenData;
var
idx, bC, eC: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
bC := 0;
eC := 0;
while idx < ParsingData.Cache.TokenDataList.Count do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if indent_begin_symbol.Exists(p^.Text.buff) then
inc(bC)
else if indent_end_symbol.Exists(p^.Text.buff) then
inc(eC);
if (bC > 0) and (eC = bC) then
begin
Result := p;
exit;
end;
inc(idx);
end;
end;
function TTextParsing.IndentSymbolBeginProbeL(startI: Integer; const indent_begin_symbol, indent_end_symbol: TPascalString): PTokenData;
var
idx, bC, eC: Integer;
p: PTokenData;
begin
Result := nil;
if ParsingData.Cache.TokenDataList.Count <= 0 then
exit;
idx := startI;
bC := 0;
eC := 0;
while idx >= 0 do
begin
p := PTokenData(ParsingData.Cache.TokenDataList[idx]);
if indent_begin_symbol.Exists(p^.Text.buff) then
inc(bC)
else if indent_end_symbol.Exists(p^.Text.buff) then
inc(eC);
if (eC > 0) and (eC = bC) then
begin
Result := p;
exit;
end;
dec(idx);
end;
end;
function TTextParsing.DetectSymbolVector: Boolean;
var
i: Integer;
p1, p2, paramB, paramE: PTokenData;
vExp: U_String;
VectorNum: Integer;
begin
Result := False;
i := 0;
p1 := nil;
p2 := nil;
paramB := FirstToken;
paramE := paramB;
VectorNum := 0;
while i < TokenCount do
begin
p1 := TokenProbeR(i, [ttSymbol]);
if p1 = nil then
begin
// successed
inc(VectorNum);
Break;
end;
if p1^.Text.Same(',', ';') then
begin
paramE := p1;
inc(VectorNum);
paramB := NextToken(paramE);
// successed
if paramB = nil then
Break;
// do loop.
paramE := paramB;
i := paramB^.Index;
end
else if p1^.Text.Same('(') then
begin
p2 := IndentSymbolEndProbeR(p1^.Index, '(', ')');
// error
if p2 = nil then
exit;
// do loop.
paramE := paramB;
i := p2^.Index + 1;
end
else if p1^.Text.Same('[') then
begin
p2 := IndentSymbolEndProbeR(p1^.Index, '[', ']');
// error
if p2 = nil then
exit;
// do loop.
paramE := paramB;
i := p2^.Index + 1;
end
else
inc(i);
end;
Result := VectorNum > 1;
end;
function TTextParsing.FillSymbolVector(L: TPascalStringList): Boolean;
var
i: Integer;
p1, p2, paramB, paramE: PTokenData;
vExp: U_String;
begin
Result := False;
i := 0;
p1 := nil;
p2 := nil;
paramB := FirstToken;
paramE := paramB;
while i < TokenCount do
begin
p1 := TokenProbeR(i, [ttSymbol]);
if p1 = nil then
begin
// successed
vExp := TokenCombine(paramB^.Index, TokenCount - 1);
L.Add(vExp);
Break;
end;
if p1^.Text.Same(',', ';') then
begin
paramE := p1;
if paramB <> paramE then
vExp := TokenCombine(paramB^.Index, paramE^.Index - 1)
else
vExp := '';
L.Add(vExp);
paramB := NextToken(paramE);
// successed
if paramB = nil then
Break;
// do loop.
paramE := paramB;
i := paramB^.Index;
end
else if p1^.Text.Same('(') then
begin
p2 := IndentSymbolEndProbeR(p1^.Index, '(', ')');
// error
if p2 = nil then
exit;
// do loop.
paramE := paramB;
i := p2^.Index + 1;
end
else if p1^.Text.Same('[') then
begin
p2 := IndentSymbolEndProbeR(p1^.Index, '[', ']');
// error
if p2 = nil then
exit;
// do loop.
paramE := paramB;
i := p2^.Index + 1;
end
else
inc(i);
end;
Result := True;
end;
function TTextParsing.FillSymbolVector: TSymbolVector;
var
L: TPascalStringList;
begin
L := TPascalStringList.Create;
if FillSymbolVector(L) then
L.FillTo(Result)
else
SetLength(Result, 0);
DisposeObject(L);
end;
function TTextParsing.FillSymbolMatrix(W, H: Integer; var symbolMatrix: TSymbolMatrix): Boolean;
var
L: TPascalStringList;
i, j, k: Integer;
begin
SetLength(symbolMatrix, 0, 0);
L := TPascalStringList.Create;
Result := FillSymbolVector(L);
if L.Count >= W * H then
begin
SetLength(symbolMatrix, H, W);
k := 0;
for j := 0 to H - 1 do
for i := 0 to W - 1 do
begin
symbolMatrix[j, i] := L[k];
inc(k);
end;
end;
DisposeObject(L);
end;
function TTextParsing.GetText(const bPos, ePos: Integer): TPascalString;
begin
Result := GetStr(bPos, ePos);
end;
function TTextParsing.GetStr(const bPos, ePos: Integer): TPascalString;
begin
if ePos >= ParsingData.Len then
begin
Result := ParsingData.Text.GetString(bPos, ePos + 1);
while (Result.Len > 0) and (Result.Last = #0) do
Result.DeleteLast;
if (Result.Len > 0) and (Result.Last = #32) then
Result.DeleteLast;
end
else
Result := ParsingData.Text.GetString(bPos, ePos);
end;
function TTextParsing.GetStr(const tp: TTextPos): TPascalString;
begin
Result := GetStr(tp.bPos, tp.ePos);
end;
function TTextParsing.GetWord(const cOffset: Integer): TPascalString;
begin
Result := GetStr(GetAsciiBeginPos(cOffset), GetAsciiEndPos(cOffset));
end;
function TTextParsing.GetPoint(const cOffset: Integer): TPoint;
var
i: Integer;
cPos: Integer;
begin
cPos := cOffset;
Result := Point(1, 1);
if cPos > ParsingData.Len then
cPos := ParsingData.Len;
for i := 1 to cPos - 1 do
begin
if ParsingData.Text[i] = #10 then
begin
inc(Result.y);
Result.x := 0;
end
else if not CharIn(ParsingData.Text[i], [#13]) then
inc(Result.x);
end;
end;
function TTextParsing.GetChar(const cOffset: Integer): SystemChar;
begin
Result := ParsingData.Text[cOffset];
end;
procedure TTextParsing.DeletePos(const bPos, ePos: Integer);
begin
ParsingData.Text := GetStr(1, bPos) + GetStr(ePos, Len);
ParsingData.Len := ParsingData.Text.Len;
RebuildParsingCache;
end;
procedure TTextParsing.DeletePos(const tp: TTextPos);
begin
DeletePos(tp.bPos, tp.ePos);
end;
procedure TTextParsing.DeletedComment;
begin
ParsingData.Text := GetDeletedCommentText.TrimChar(#32);
ParsingData.Len := ParsingData.Text.Len;
RebuildParsingCache;
end;
procedure TTextParsing.InsertTextBlock(const bPos, ePos: Integer; AInsertText: TPascalString);
begin
ParsingData.Text := GetStr(1, bPos) + AInsertText + GetStr(ePos, Len + 1);
ParsingData.Len := ParsingData.Text.Len;
RebuildParsingCache;
end;
procedure TTextParsing.InsertTextBlock(const tp: TTextPos; AInsertText: TPascalString);
begin
InsertTextBlock(tp.bPos, tp.ePos, AInsertText);
end;
function TTextParsing.SearchWordBody(initPos: Integer; wordInfo: TPascalString; var OutPos: TTextPos): Boolean;
var
cp: Integer;
ePos: Integer;
begin
Result := False;
cp := initPos;
while cp <= ParsingData.Len do
begin
if isTextDecl(cp) then
begin
ePos := GetTextDeclEndPos(cp);
cp := ePos;
end
else if isComment(cp) then
begin
ePos := GetCommentEndPos(cp);
cp := ePos;
end
else if isNumber(cp) then
begin
ePos := GetNumberEndPos(cp);
if GetStr(cp, ePos).Same(wordInfo) then
begin
OutPos.bPos := cp;
OutPos.ePos := ePos;
Result := True;
Break;
end;
cp := ePos;
end
else if isSymbol(cp) then
begin
ePos := GetSymbolEndPos(cp);
cp := ePos;
end
else if isAscii(cp) then
begin
ePos := GetAsciiEndPos(cp);
if GetStr(cp, ePos).Same(wordInfo) then
begin
OutPos.bPos := cp;
OutPos.ePos := ePos;
Result := True;
Break;
end;
cp := ePos;
end
else
inc(cp);
end;
end;
class function TTextParsing.TranslatePascalDeclToText(const Decl: TPascalString): TPascalString;
var
cPos: Integer;
// ext decl begin flag
VIsTextDecl: Boolean;
nText: TPascalString;
begin
cPos := 1;
VIsTextDecl := False;
Result := '';
while cPos <= Decl.Len do
begin
if Decl.ComparePos(cPos, #39#39#39#39) then
begin
Result.Append(#39);
inc(cPos, 4);
end
else if Decl[cPos] = #39 then
begin
VIsTextDecl := not VIsTextDecl;
inc(cPos);
end
else
begin
if VIsTextDecl then
begin
Result.Append(Decl[cPos]);
inc(cPos);
end
else if Decl[cPos] = '#' then
begin
nText := '';
inc(cPos);
while cPos <= Decl.Len do
begin
if CharIn(Decl[cPos], [cHex], '$') then
begin
nText.Append(Decl[cPos]);
inc(cPos);
end
else
Break;
end;
Result.Append(SystemChar(umlStrToInt(nText, 0)));
end
else
inc(cPos);
end;
end;
end;
class function TTextParsing.TranslateTextToPascalDecl(const Decl: TPascalString): TPascalString;
var
cPos: Integer;
c: SystemChar;
LastIsOrdChar: Boolean;
ordCharInfo: TPascalString;
begin
if Decl.Len = 0 then
begin
Result := #39#39;
exit;
end;
ordCharInfo.Len := 32;
for cPos := 0 to 31 do
ordCharInfo.buff[cPos] := SystemChar(Ord(cPos));
ordCharInfo[32] := #39;
Result := '';
LastIsOrdChar := False;
for cPos := 1 to Decl.Len do
begin
c := Decl[cPos];
if CharIn(c, ordCharInfo) then
begin
if Result.Len = 0 then
Result := '#' + umlIntToStr(Ord(c))
else if LastIsOrdChar then
Result.Append('#' + umlIntToStr(Ord(c)))
else
Result.Append(#39 + '#' + umlIntToStr(Ord(c)));
LastIsOrdChar := True;
end
else
begin
if Result.Len = 0 then
Result := #39 + c
else if LastIsOrdChar then
Result.Append(#39 + c)
else
Result.Append(c);
LastIsOrdChar := False;
end;
end;
if not LastIsOrdChar then
Result.Append(#39);
end;
class function TTextParsing.TranslateTextToPascalDeclWithUnicode(const Decl: TPascalString): TPascalString;
var
cPos: Integer;
c: SystemChar;
LastIsOrdChar: Boolean;
ordCharInfo: TPascalString;
begin
if Decl.Len = 0 then
begin
Result := #39#39;
exit;
end;
ordCharInfo.Len := 32 + 1;
for cPos := 0 to 31 do
ordCharInfo[cPos + 1] := SystemChar(Ord(cPos));
ordCharInfo[33] := #39;
Result := '';
LastIsOrdChar := False;
for cPos := 1 to Decl.Len do
begin
c := Decl[cPos];
if CharIn(c, ordCharInfo) or (Ord(c) >= $80) then
begin
if Result.Len = 0 then
Result := '#' + umlIntToStr(Ord(c))
else if LastIsOrdChar then
Result.Append('#' + umlIntToStr(Ord(c)))
else
Result.Append(#39 + '#' + umlIntToStr(Ord(c)));
LastIsOrdChar := True;
end
else
begin
if Result.Len = 0 then
Result := #39 + c
else if LastIsOrdChar then
Result.Append(#39 + c)
else
Result.Append(c);
LastIsOrdChar := False;
end;
end;
if not LastIsOrdChar then
Result.Append(#39);
end;
class function TTextParsing.TranslateC_DeclToText(const Decl: TPascalString): TPascalString;
var
cPos: Integer;
i: Integer;
// ext decl begin flag
VIsCharDecl: Boolean;
VIsTextDecl: Boolean;
nText: TPascalString;
wasC: Boolean;
begin
cPos := 1;
VIsCharDecl := False;
VIsTextDecl := False;
Result := '';
while cPos <= Decl.Len do
begin
if Decl[cPos] = #39 then
begin
VIsCharDecl := not VIsCharDecl;
inc(cPos);
end
else if Decl[cPos] = '"' then
begin
VIsTextDecl := not VIsTextDecl;
inc(cPos);
end
else
begin
wasC := False;
for i := low(CTranslateTable) to high(CTranslateTable) do
begin
if Decl.ComparePos(cPos, CTranslateTable[i].c) then
begin
inc(cPos, Length(CTranslateTable[i].c));
Result.Append(CTranslateTable[i].s);
wasC := True;
Break;
end;
end;
if (not wasC) then
begin
if VIsTextDecl or VIsCharDecl then
Result.Append(Decl[cPos]);
inc(cPos);
end;
end;
end;
end;
class function TTextParsing.TranslateTextToC_Decl(const Decl: TPascalString): TPascalString;
function GetCStyle(const c: SystemChar): SystemString; inline;
var
i: Integer;
begin
Result := '';
for i := low(CTranslateTable) to high(CTranslateTable) do
if c = CTranslateTable[i].s then
begin
Result := CTranslateTable[i].c;
Break;
end;
end;
var
cPos: Integer;
c: SystemChar;
LastIsOrdChar: Boolean;
n: SystemString;
begin
if Decl.Len = 0 then
begin
Result := '""';
exit;
end;
Result := '';
LastIsOrdChar := False;
for cPos := 1 to Decl.Len do
begin
c := Decl[cPos];
if Result.Len = 0 then
Result := '"' + c
else
begin
n := GetCStyle(c);
if n <> '' then
Result.Append(n)
else
Result.Append(c);
end;
end;
if not LastIsOrdChar then
Result.Append('"');
end;
class function TTextParsing.TranslatePascalDeclCommentToText(const Decl: TPascalString): TPascalString;
begin
Result := umlTrimSpace(Decl);
if umlMultipleMatch(False, '{*}', Result) then
begin
Result.DeleteFirst;
Result.DeleteLast;
if umlMultipleMatch(False, '$*', umlTrimSpace(Result)) then
Result := Decl;
end
else if umlMultipleMatch(False, '(*?*)', Result, '?', '') then
begin
Result.DeleteFirst;
Result.DeleteFirst;
Result.DeleteLast;
Result.DeleteLast;
end
else if umlMultipleMatch(False, '////*', Result) then
begin
Result.DeleteFirst;
Result.DeleteFirst;
Result.DeleteFirst;
Result.DeleteFirst;
end
else if umlMultipleMatch(False, '///*', Result) then
begin
Result.DeleteFirst;
Result.DeleteFirst;
Result.DeleteFirst;
end
else if umlMultipleMatch(False, '//*', Result) then
begin
Result.DeleteFirst;
Result.DeleteFirst;
end;
end;
class function TTextParsing.TranslateTextToPascalDeclComment(const Decl: TPascalString): TPascalString;
var
n: TPascalString;
begin
n := umlTrimSpace(Decl);
if umlMultipleMatch(False, '(*?*)', n, '?', '') then
Result := Decl
else if umlMultipleMatch(False, '{*}', n) then
Result := Decl
else if n.Exists(['{', '}']) then
Result := '(* ' + Decl + ' *)'
else
Result := '{ ' + Decl + ' }';
end;
class function TTextParsing.TranslateC_DeclCommentToText(const Decl: TPascalString): TPascalString;
begin
Result := umlTrimSpace(Decl);
if umlMultipleMatch(False, '#*', Result) then
begin
Result := Decl;
end
else if umlMultipleMatch(False, '/*?*/', Result, '?', '') then
begin
Result.DeleteFirst;
Result.DeleteFirst;
Result.DeleteLast;
Result.DeleteLast;
end
else if umlMultipleMatch(False, '////*', Result) then
begin
Result.DeleteFirst;
Result.DeleteFirst;
Result.DeleteFirst;
Result.DeleteFirst;
end
else if umlMultipleMatch(False, '///*', Result) then
begin
Result.DeleteFirst;
Result.DeleteFirst;
Result.DeleteFirst;
end
else if umlMultipleMatch(False, '//*', Result) then
begin
Result.DeleteFirst;
Result.DeleteFirst;
end;
end;
class function TTextParsing.TranslateTextToC_DeclComment(const Decl: TPascalString): TPascalString;
var
n: TPascalString;
begin
n := umlTrimSpace(Decl);
if umlMultipleMatch(False, '#*', n) then
Result := Decl
else
Result := '/* ' + n + ' */';
end;
constructor TTextParsing.Create(const Text_: TPascalString; Style_: TTextStyle; SpecialSymbol_: TListPascalString; SpacerSymbol_: SystemString);
begin
inherited Create;
ParsingData.Cache.CommentDecls := nil;
ParsingData.Cache.TextDecls := nil;
ParsingData.Cache.TokenDataList := nil;
SetLength(ParsingData.Cache.CharToken, 0);
if Text_.Len = 0 then
ParsingData.Text := #13#10
else
ParsingData.Text := Text_ + #32;
ParsingData.Len := ParsingData.Text.Len + 1;
TextStyle := Style_;
SymbolTable := SpacerSymbol_;
TokenStatistics := NullTokenStatistics;
SpecialSymbol := TListPascalString.Create;
if SpecialSymbol_ <> nil then
SpecialSymbol.Assign(SpecialSymbol_);
RebuildCacheBusy := False;
RebuildParsingCache;
Init;
end;
constructor TTextParsing.Create(const Text_: TPascalString; Style_: TTextStyle; SpecialSymbol_: TListPascalString);
begin
Create(Text_, Style_, SpecialSymbol_, SpacerSymbol.V);
end;
constructor TTextParsing.Create(const Text_: TPascalString; Style_: TTextStyle);
begin
Create(Text_, Style_, nil, SpacerSymbol.V);
end;
constructor TTextParsing.Create(const Text_: TPascalString);
begin
Create(Text_, tsText, nil, SpacerSymbol.V);
end;
destructor TTextParsing.Destroy;
var
i: Integer;
begin
if ParsingData.Cache.CommentDecls <> nil then
begin
for i := 0 to ParsingData.Cache.CommentDecls.Count - 1 do
Dispose(PTextPos(ParsingData.Cache.CommentDecls[i]));
DisposeObject(ParsingData.Cache.CommentDecls);
ParsingData.Cache.CommentDecls := nil;
end;
if ParsingData.Cache.TextDecls <> nil then
begin
for i := 0 to ParsingData.Cache.TextDecls.Count - 1 do
Dispose(PTextPos(ParsingData.Cache.TextDecls[i]));
DisposeObject(ParsingData.Cache.TextDecls);
ParsingData.Cache.TextDecls := nil;
end;
if ParsingData.Cache.TokenDataList <> nil then
begin
for i := 0 to ParsingData.Cache.TokenDataList.Count - 1 do
Dispose(PTokenData(ParsingData.Cache.TokenDataList[i]));
DisposeObject(ParsingData.Cache.TokenDataList);
ParsingData.Cache.TokenDataList := nil;
end;
SetLength(ParsingData.Cache.CharToken, 0);
TokenStatistics := NullTokenStatistics;
DisposeObject(SpecialSymbol);
inherited Destroy;
end;
procedure TTextParsing.Init;
begin
end;
function TTextParsing.Parsing: Boolean;
begin
Result := False;
end;
procedure TTextParsing.Print;
var
i: Integer;
pt: PTokenData;
begin
for i := 0 to ParsingData.Cache.TokenDataList.Count - 1 do
begin
pt := ParsingData.Cache.TokenDataList[i];
DoStatus(PFormat('index: %d type: %s value: %s', [i, GetEnumName(TypeInfo(TTokenType), Ord(pt^.tokenType)), pt^.Text.Text]));
end;
end;
procedure FillSymbol_Test_;
var
t: TTextParsing;
SM: TSymbolMatrix;
begin
t := TTextParsing.Create('1,2,3,4,5,6,7,8,9', tsPascal);
t.FillSymbolMatrix(3, 2, SM);
DisposeObject(t);
end;
initialization
SpacerSymbol := TAtomString.Create(C_SpacerSymbol);
finalization
DisposeObjectAndNil(SpacerSymbol);
end.