paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-21 03:21:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: More textmate Highlighting

Browse Source
This commit is contained in:
Martin 2023-09-15 11:56:43 +02:00
parent a7451ae903
commit 56ac6a45b6
8 changed files with 1220 additions and 314 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

217
components/lazedit/test/testtextmategrammar.pas
View File

@ -5,19 +5,24 @@ unit TestTextMateGrammar;
interface interface
uses uses
Classes, SysUtils, fpcunit, testutils, testregistry, Classes, SysUtils, fgl, fpcunit, testutils, testregistry,
TextMateGrammar, LazLoggerBase; TextMateGrammar, LazLoggerBase;
type type
TCaptIdx = (c0, c1, c2, c3, c4, c5, c6); TCaptIdx = (c0, c1, c2, c3, c4, c5, c6);
TCaptSet = set of TCaptIdx; TCaptSet = set of TCaptIdx;
TGrammarMap = specialize TFPGMapObject<string, TTextMateGrammar>;
{ TTestTextMateGrammar } { TTestTextMateGrammar }
TTestTextMateGrammar = class(TTestCase) TTestTextMateGrammar = class(TTestCase)
private private
procedure DoCheckAttributeInfo(Sender: TTextMatePattern; procedure DoCheckAttributeInfo(Sender: TTextMatePattern;
const AnAttribInfo: TSynAttributeInfo; out AnUseId, AnUseObject: Boolean); const AnAttribInfo: TSynAttributeInfo; out AnUseId, AnUseObject: Boolean);
function DoGetIncludedGrammar(Sender: TTextMateGrammar; AScopeName: string
): TTextMateGrammar;
//TODO: separate FNames for each grammar
procedure DoPopulateAttributeInfo(Sender: TTextMateGrammar; procedure DoPopulateAttributeInfo(Sender: TTextMateGrammar;
APattern: TTextMatePattern; AContextName: String; APattern: TTextMatePattern; AContextName: String;
var AnAttribInfo: TSynAttributeInfo); var AnAttribInfo: TSynAttributeInfo);
@ -39,29 +44,36 @@ type
function GetTestNest(ASubPatterns: array of String): String; function GetTestNest(ASubPatterns: array of String): String;
function Join(const APatterns: array of String): String; function Join(const APatterns: array of String): String;
function Include(const AName: String): String; function Include(const AName: String; SkipHash: Boolean = False): String;
function BuildPatterns(const APatterns: array of String; AMore: String = ''; LeadComma: boolean = True): String; function BuildPatterns(const APatterns: array of String; AMore: String = ''; LeadComma: boolean = True): String;
procedure SetGrammar(AText: String); procedure SetGrammar(AText: String);
procedure SetGrammar(const ARootPatterns, ARepository: array of String); procedure SetGrammar(const ARootPatterns, ARepository: array of String);
procedure SetGrammar(const AScopeName: String; ARootPatterns, ARepository: array of String);
function RunGrammar(ATestName, ATextLine: String; out LastPatternIndex: Integer; AStartPatternIndex: integer = -1): String; function RunGrammar(ATestName, ATextLine: String; out LastPatternIndex: Integer; AStartPatternIndex: integer = -1): String;
procedure RunNextToEol(ATestName, ATextLine: String; out LastPatternIndex: Integer; AStartPatternIndex: integer = -1); procedure RunNextToEol(ATestName, ATextLine: String; out LastPatternIndex: Integer; AStartPatternIndex: integer = -1);
function TestLine(ATestName, ATextLine, Expect: String; AStartPatternIndex: integer = -1): Integer; function TestLine(ATestName, ATextLine, Expect: String; AStartPatternIndex: integer = -1): Integer;
function TestLine(ATestName, ATextLine, Expect: String; AStartPatternName: String): Integer; function TestLine(ATestName, ATextLine, Expect: String; AStartPatternName: String): Integer;
private
FNewScopeName: String;
FGrammarMap: TGrammarMap;
protected protected
FGrammar: TTextMateGrammar; FGrammar: TTextMateGrammar;
FGrammarText: String; FGrammarText: String;
FNames: TStringList; FNames: TStringList;
procedure SetUp; override; procedure SetUp; override;
procedure TearDown; override; procedure TearDown; override;
procedure ResetGramarMap;
published published
procedure TestFlatNested; procedure TestFlatNested;
procedure TestInclude;
procedure TestBeginEnd; procedure TestBeginEnd;
procedure TestBeginEndInCapture; procedure TestBeginEndInCapture;
procedure TestWhile; procedure TestWhile;
procedure TestForwarder; procedure TestForwarder;
procedure TestRecurse; procedure TestRecurse;
procedure TestIncludeOtherGrammar;
procedure TestVarious; procedure TestVarious;
end; end;
@ -74,6 +86,14 @@ begin
AnUseObject := True; AnUseObject := True;
end; end;
function TTestTextMateGrammar.DoGetIncludedGrammar(Sender: TTextMateGrammar;
AScopeName: string): TTextMateGrammar;
begin
Result := nil;
if FGrammarMap.IndexOf(AScopeName) >= 0 then
Result := FGrammarMap[AScopeName];
end;
procedure TTestTextMateGrammar.DoPopulateAttributeInfo( procedure TTestTextMateGrammar.DoPopulateAttributeInfo(
Sender: TTextMateGrammar; APattern: TTextMatePattern; AContextName: String; Sender: TTextMateGrammar; APattern: TTextMatePattern; AContextName: String;
var AnAttribInfo: TSynAttributeInfo); var AnAttribInfo: TSynAttributeInfo);
@ -285,8 +305,12 @@ begin
end; end;
end; end;
function TTestTextMateGrammar.Include(const AName: String): String; function TTestTextMateGrammar.Include(const AName: String; SkipHash: Boolean
): String;
begin begin
if SkipHash or (pos('#', AName) > 0) or (pos('$', AName) > 0) then
Result := '{ "include": "'+AName+'" }'
else
Result := '{ "include": "#'+AName+'" }'; Result := '{ "include": "#'+AName+'" }';
end; end;
@ -305,6 +329,7 @@ begin
FGrammar.ClearGrammar; FGrammar.ClearGrammar;
FGrammarText := AText; FGrammarText := AText;
FGrammar.ParseGrammar(AText); FGrammar.ParseGrammar(AText);
AssertTrue('no missing includes', FGrammar.MissingIncludes = '');
if FGrammar.ParserError = '' then if FGrammar.ParserError = '' then
debugln(FGrammar.DebugDump()); debugln(FGrammar.DebugDump());
@ -324,7 +349,7 @@ begin
SetGrammar( SetGrammar(
'{ "name": "root",'+ '{ "name": "root",'+
' "scopeName": "source" '+ ' "scopeName": "'+FNewScopeName+'" '+
BuildPatterns(ARootPatterns) + BuildPatterns(ARootPatterns) +
' , "repository": {' + ' , "repository": {' +
RepoPtn + RepoPtn +
@ -333,6 +358,26 @@ begin
); );
end; end;
procedure TTestTextMateGrammar.SetGrammar(const AScopeName: String;
ARootPatterns, ARepository: array of String);
var
t: TTextMateGrammar;
begin
t := FGrammar;
FNewScopeName := 'source.'+AScopeName;
FGrammar := TTextMateGrammar.Create;
FGrammarMap.Add(FNewScopeName, FGrammar);
FGrammar.OnPopulateAttributeInfo := @DoPopulateAttributeInfo;
FGrammar.OnCheckAttributeInfo := @DoCheckAttributeInfo;
FGrammar.OnGetIncludedGrammar := @DoGetIncludedGrammar;
SetGrammar(ARootPatterns, ARepository);
FGrammar := t;
FNewScopeName := 'source.maintest';
end;
function TTestTextMateGrammar.RunGrammar(ATestName, ATextLine: String; out function TTestTextMateGrammar.RunGrammar(ATestName, ATextLine: String; out
LastPatternIndex: Integer; AStartPatternIndex: integer): String; LastPatternIndex: Integer; AStartPatternIndex: integer): String;
var var
@ -421,19 +466,30 @@ end;
procedure TTestTextMateGrammar.SetUp; procedure TTestTextMateGrammar.SetUp;
begin begin
inherited SetUp; inherited SetUp;
FNewScopeName := 'source.maintest';
FGrammarMap := TGrammarMap.Create(True);
FGrammar := TTextMateGrammar.Create; FGrammar := TTextMateGrammar.Create;
FGrammarMap.Add(FNewScopeName, FGrammar);
FGrammar.OnPopulateAttributeInfo := @DoPopulateAttributeInfo; FGrammar.OnPopulateAttributeInfo := @DoPopulateAttributeInfo;
FGrammar.OnCheckAttributeInfo := @DoCheckAttributeInfo; FGrammar.OnCheckAttributeInfo := @DoCheckAttributeInfo;
FGrammar.OnGetIncludedGrammar := @DoGetIncludedGrammar;
FNames := TStringList.Create; FNames := TStringList.Create;
end; end;
procedure TTestTextMateGrammar.TearDown; procedure TTestTextMateGrammar.TearDown;
begin begin
inherited TearDown; inherited TearDown;
FGrammar.Free; //FGrammar.Free;
FGrammarMap.Free;
FNames.Free; FNames.Free;
end; end;
procedure TTestTextMateGrammar.ResetGramarMap;
begin
TearDown;
SetUp;
end;
procedure TTestTextMateGrammar.TestFlatNested; procedure TTestTextMateGrammar.TestFlatNested;
begin begin
SetGrammar([GetTestA1(False, [ GetTestNest( [GetTestC1([]) ] ), SetGrammar([GetTestA1(False, [ GetTestNest( [GetTestC1([]) ] ),
@ -473,6 +529,67 @@ begin
end; end;
procedure TTestTextMateGrammar.TestInclude;
begin
SetGrammar(
[ Include('Foo') ],
[ 'Foo', GetTestA1(False, [Include('Bar')]),
'Bar', GetTestC1([])
]
);
TestLine('simple', 'a<a1><c1></c1></a1>c', '1:-,2:a1,6:c1,15:a1,20:-/root/0');
SetGrammar(
[ Include('$self#Foo') ],
[ 'Foo', GetTestA1(False, [Include('$self#Bar')]),
'Bar', GetTestC1([])
]
);
TestLine('simple', 'a<a1><c1></c1></a1>c', '1:-,2:a1,6:c1,15:a1,20:-/root/0');
SetGrammar(
[ Include('$base#Foo') ],
[ 'Foo', GetTestA1(False, [Include('$base#Bar')]),
'Bar', GetTestC1([])
]
);
TestLine('simple', 'a<a1><c1></c1></a1>c', '1:-,2:a1,6:c1,15:a1,20:-/root/0');
// Forward include
SetGrammar(
[ Include('FooX') ],
[ 'AFoo', Include('Foo'),
'Foo', GetTestA1(False, [Include('BarX')]),
'FooX', Include('AFoo'),
'ABar', Include('Bar'),
'Bar', GetTestC1([]),
'BarX', Include('ABar')
]
);
TestLine('simple', 'a<a1><c1></c1></a1>c', '1:-,2:a1,6:c1,15:a1,20:-/root/0');
// Full self include
SetGrammar(
[ Include('Foo'), GetTestC1([]) ],
[ 'Foo', GetTestA1(False, [Include('$self')])
]
);
TestLine('simple', 'a<a1><c1></c1></a1>c', '1:-,2:a1,6:c1,15:a1,20:-/root/0');
TestLine('simple', 'a<a1><a1>', '1:-,2:a1,6:a1/a1/2');
SetGrammar(
[ Include('Foo'), GetTestC1([]) ],
[ 'Foo', GetTestA1(False, [Include('$base')])
]
);
TestLine('simple', 'a<a1><c1></c1></a1>c', '1:-,2:a1,6:c1,15:a1,20:-/root/0');
TestLine('simple', 'a<a1><a1>', '1:-,2:a1,6:a1/a1/2');
end;
procedure TTestTextMateGrammar.TestBeginEnd; procedure TTestTextMateGrammar.TestBeginEnd;
procedure TestNoCtxName; procedure TestNoCtxName;
@ -896,6 +1013,96 @@ begin
end; end;
procedure TTestTextMateGrammar.TestIncludeOtherGrammar;
begin
SetGrammar(
[ Include('source.foo', True)
],
[ 'Main1', Include('source.foo#FooA1', True),
'Main2', Include('source.foo#FooA2', True),
'RepoC1', GetTestC1([])
]
);
SetGrammar('foo',
[ Include('source.maintest#Main1', True)
],
[ 'FooA1', Include('source.maintest#Main2', True),
'FooA2', Include('source.maintest#RepoC1', True),
'RepoA1', GetTestA1(False, [])
]
);
FGrammar.ResolveExternalIncludes;
AssertTrue('no missing includes', FGrammar.MissingIncludes = '');
writeln( '###########');
writeln( FGrammar.DebugDump());
TestLine('', '<a1><c1>', '1:-,5:c1/c1/1');
///////////////
/// miss incl
ResetGramarMap;
SetGrammar(
[ Include('source.foo', True), GetTestC1([]) ],
[]
);
FGrammar.ResolveExternalIncludes;
AssertTrue('missing includes', pos('source.foo',FGrammar.MissingIncludes) > 0);
ResetGramarMap;
SetGrammar(
[ Include('source.foo#Bar', True), GetTestC1([]) ],
[]
);
SetGrammar('foo',
[ GetTestC1([]) ],
[ 'RepoA1', GetTestA1(False, [])
]
);
FGrammar.ResolveExternalIncludes;
AssertTrue('missing includes', pos('source.foo#Bar',FGrammar.MissingIncludes) > 0);
ResetGramarMap;
SetGrammar(
[ Include('source.foo#RepoA1', True), GetTestC1([]) ],
[]
);
SetGrammar('foo',
[ GetTestC1([]) ],
[ 'RepoA1', GetTestA1(False, [Include('source.foo#What', True)])
]
);
FGrammar.ResolveExternalIncludes;
AssertTrue('missing includes', pos('source.foo#What',FGrammar.MissingIncludes) > 0);
///////////////
/// recursions
ResetGramarMap;
SetGrammar(
[ Include('source.foo#RepoA1', True)
],
[ 'RepoA1', Include('source.foo', True),
'RepoB1', Include('source.foo#RepoB1', True)
]
);
SetGrammar('foo',
[ Include('#RepoB1', True)
],
[ 'RepoA1', Include('source.maintest#RepoB1', True),
'RepoB1', Include('source.maintest#RepoA1', True)
]
);
FGrammar.ResolveExternalIncludes;
AssertTrue('Got error', FGrammar.ParserError <> '');
end;
procedure TTestTextMateGrammar.TestVarious; procedure TTestTextMateGrammar.TestVarious;
var var
p: Integer; p: Integer;

457
components/lazedit/textmategrammar.pas
View File

@ -29,7 +29,7 @@ uses
// LazUtils // LazUtils
Laz2_DOM, Laz2_XMLRead, PList2JSon, Laz2_DOM, Laz2_XMLRead, PList2JSon,
//LazLoggerBase, //LazLoggerBase,
LazLoggerDummy, LazLoggerDummy, LazClasses,
// LazEdit // LazEdit
xregexpr; xregexpr;
@ -52,6 +52,9 @@ type
end; end;
TTextMatePattern = class; TTextMatePattern = class;
TTextMatePatternClass = class of TTextMatePattern;
TTextMatePatternList = specialize TFPGObjectList<TTextMatePattern>;
TTextMatePatternMap = specialize TFPGMapObject<string, TTextMatePattern>;
TTextMatePatternArray = array of TTextMatePattern; TTextMatePatternArray = array of TTextMatePattern;
TTextMatePatternBaseNested = class; TTextMatePatternBaseNested = class;
TTextMateGrammar = class; TTextMateGrammar = class;
@ -66,6 +69,7 @@ type
TCheckAttributeInfoProc = procedure (Sender: TTextMatePattern; TCheckAttributeInfoProc = procedure (Sender: TTextMatePattern;
const AnAttribInfo: TSynAttributeInfo; const AnAttribInfo: TSynAttributeInfo;
out AnUseId, AnUseObject: Boolean) of object; out AnUseId, AnUseObject: Boolean) of object;
TGetIncludedGrammar = function(Sender: TTextMateGrammar; AScopeName: string): TTextMateGrammar of object;
TTextMateFoundCaptureBounds = record TTextMateFoundCaptureBounds = record
@ -167,7 +171,9 @@ type
protected protected
function GetForwardTarget: TTextMatePatternBaseNested; virtual; function GetForwardTarget: TTextMatePatternBaseNested; virtual;
procedure FlattenNested; virtual; procedure FlattenNested(AGrammar: TTextMateGrammar; ARemoveMissingIncludes: boolean); virtual;
class function GetCopyFor(AnOther:TTextMatePattern; AnIndexOffset: Integer; ANewList: TTextMatePatternList): TTextMatePattern;
procedure CopyFrom(AnOther:TTextMatePattern; AnIndexOffset: Integer; ANewList: TTextMatePatternList); virtual;
procedure DoInitRegex(var ARegEx: TRegExpr; const AText: string; AnErrKey: String); procedure DoInitRegex(var ARegEx: TRegExpr; const AText: string; AnErrKey: String);
public public
procedure InitRegEx; virtual; procedure InitRegEx; virtual;
@ -195,7 +201,7 @@ type
private private
FParent: TTextMatePattern; // TTextMatePatternState.Parent takes precedence FParent: TTextMatePattern; // TTextMatePatternState.Parent takes precedence
FRecurseMatchPos: integer; FRecurseMatchPos: integer;
Patterns: TTextMatePatternArray; Patterns, UnFlatPatterns: TTextMatePatternArray;
protected protected
procedure InitStates(const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState; procedure InitStates(const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState;
AParent: TTextMatePattern; const AText: String; ADepth: Integer); override; AParent: TTextMatePattern; const AText: String; ADepth: Integer); override;
@ -210,7 +216,9 @@ type
AMatchMustStartBefore: integer = 0): Boolean; override; AMatchMustStartBefore: integer = 0): Boolean; override;
function GetForwardTarget: TTextMatePatternBaseNested; override; function GetForwardTarget: TTextMatePatternBaseNested; override;
procedure FlattenNested; override; procedure FlattenNested(AGrammar: TTextMateGrammar; ARemoveMissingIncludes: boolean); override;
procedure CopyFrom(AnOther: TTextMatePattern; AnIndexOffset: Integer;
ANewList: TTextMatePatternList); override;
public public
procedure NextToken(var AStates: TTextMatePatternState; const AText: String; procedure NextToken(var AStates: TTextMatePatternState; const AText: String;
ACurTokenPos: integer; out ANextTokenPos: integer; ACurTokenPos: integer; out ANextTokenPos: integer;
@ -223,11 +231,30 @@ type
{ TTextMatePatternNested } { TTextMatePatternNested }
TTextMatePatternNested = class(TTextMatePatternBaseNested) TTextMatePatternNested = class(TTextMatePatternBaseNested)
end;
{ TTextMatePatternNestedList }
TTextMatePatternNestedList = class(TTextMatePatternNested)
protected protected
procedure InitStates(const AGrammar: TTextMateGrammar; procedure InitStates(const AGrammar: TTextMateGrammar;
var AStates: TTextMatePatternState; AParent: TTextMatePattern; var AStates: TTextMatePatternState; AParent: TTextMatePattern;
const AText: String; ADepth: Integer); override; const AText: String; ADepth: Integer); override;
procedure FlattenNested; override; procedure FlattenNested(AGrammar: TTextMateGrammar; ARemoveMissingIncludes: boolean); override;
end;
//TTextMatePatternInclude = class(TTextMatePatternNestedList)
TTextMatePatternInclude = class(TTextMatePattern)
protected
FSourceScope, FSourceKey: String;
procedure CopyFrom(AnOther: TTextMatePattern; AnIndexOffset: Integer;
ANewList: TTextMatePatternList); override;
protected
function GetFirstMatchPos(const AText: String;
const ATextStartOffset: integer;
AStateEntryP: PTextMatePatternStateEntry; out APattern: TTextMatePattern;
out AFoundStartPos: integer; AMatchMustStartBefore: integer = 0
): Boolean; override;
end; end;
{ TTextMatePatternCapture } { TTextMatePatternCapture }
@ -249,6 +276,8 @@ type
ATextStartOffset: integer; ATextStartOffset: integer;
const AFoundCapturePosList: TTextMateFoundCaptureBoundsArray; const AFoundCapturePosList: TTextMateFoundCaptureBoundsArray;
out ACaptureInfo: TTextMateMatchInfo): boolean; out ACaptureInfo: TTextMateMatchInfo): boolean;
procedure CopyFrom(AnOther: TTextMatePatternCaptures; AnIndexOffset: Integer;
ANewList: TTextMatePatternList);
end; end;
{ TTextMatePatternMatch } { TTextMatePatternMatch }
@ -258,6 +287,9 @@ type
FRegExMatch: TRegExpr; FRegExMatch: TRegExpr;
Match: String; Match: String;
Captures: TTextMatePatternCaptures; Captures: TTextMatePatternCaptures;
protected
procedure CopyFrom(AnOther: TTextMatePattern; AnIndexOffset: Integer;
ANewList: TTextMatePatternList); override;
protected protected
procedure InitStates(const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState; AParent: TTextMatePattern; procedure InitStates(const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState; AParent: TTextMatePattern;
const AText: String; ADepth: Integer); override; const AText: String; ADepth: Integer); override;
@ -284,6 +316,9 @@ type
ContentAttribInfo: TSynAttributeInfo; ContentAttribInfo: TSynAttributeInfo;
EndPatternLast: Boolean; EndPatternLast: Boolean;
Captures, CapturesBegin, CapturesEnd: TTextMatePatternCaptures; Captures, CapturesBegin, CapturesEnd: TTextMatePatternCaptures;
protected
procedure CopyFrom(AnOther: TTextMatePattern; AnIndexOffset: Integer;
ANewList: TTextMatePatternList); override;
protected protected
procedure InitStates(const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState; AParent: TTextMatePattern; procedure InitStates(const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState; AParent: TTextMatePattern;
const AText: String; ADepth: Integer); override; const AText: String; ADepth: Integer); override;
@ -308,6 +343,9 @@ type
ContentName: String; ContentName: String;
ContentAttribInfo: TSynAttributeInfo; ContentAttribInfo: TSynAttributeInfo;
Captures, CapturesBegin, CapturesWhile: TTextMatePatternCaptures; Captures, CapturesBegin, CapturesWhile: TTextMatePatternCaptures;
protected
procedure CopyFrom(AnOther: TTextMatePattern; AnIndexOffset: Integer;
ANewList: TTextMatePatternList); override;
protected protected
procedure InitStates(const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState; AParent: TTextMatePattern; procedure InitStates(const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState; AParent: TTextMatePattern;
const AText: String; ADepth: Integer); override; const AText: String; ADepth: Integer); override;
@ -326,8 +364,10 @@ type
{ TTextMatePatternRoot } { TTextMatePatternRoot }
TTextMatePatternRoot = class(TTextMatePatternBaseNested) TTextMatePatternRoot = class(TTextMatePatternNested)
protected protected
procedure CopyFrom(AnOther: TTextMatePattern; AnIndexOffset: Integer;
ANewList: TTextMatePatternList); override;
procedure InitStates(const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState; AParent: TTextMatePattern; procedure InitStates(const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState; AParent: TTextMatePattern;
const AText: String; ADepth: Integer); override; const AText: String; ADepth: Integer); override;
public public
@ -339,6 +379,9 @@ type
TTextMatePatternForwarder = class(TTextMatePatternBaseNested) TTextMatePatternForwarder = class(TTextMatePatternBaseNested)
private private
FForwardTo: TTextMatePatternBaseNested; FForwardTo: TTextMatePatternBaseNested;
protected
procedure CopyFrom(AnOther: TTextMatePattern; AnIndexOffset: Integer;
ANewList: TTextMatePatternList); override;
protected protected
procedure ClearDeepestRecurseData; override; procedure ClearDeepestRecurseData; override;
function GetForwardTarget: TTextMatePatternBaseNested; override; function GetForwardTarget: TTextMatePatternBaseNested; override;
@ -357,13 +400,11 @@ type
function DebugDump(AnIndent: Integer = 2; AnIncludeNested: Boolean = True; APrefix: string = ''): string; override; function DebugDump(AnIndent: Integer = 2; AnIncludeNested: Boolean = True; APrefix: string = ''): string; override;
end; end;
TTextMatePatternClass = class of TTextMatePattern;
TTextMatePatternList = specialize TFPGObjectList<TTextMatePattern>;
TTextMatePatternMap = specialize TFPGMapObject<string, TTextMatePattern>;
{ TTextMateGrammar } { TTextMateGrammar }
TTextMateGrammar = class TTextMateGrammar = class(TFreeNotifyingObject)
private type
TOtherGrammarMap = specialize TFPGMapObject<string, TTextMateGrammar>;
private private
FOnCheckAttributeInfo: TCheckAttributeInfoProc; FOnCheckAttributeInfo: TCheckAttributeInfoProc;
FOnPopulateAttributeInfo: TPopulateAttributeInfoProc; FOnPopulateAttributeInfo: TPopulateAttributeInfoProc;
@ -372,18 +413,24 @@ type
FSampleTextFile: String; FSampleTextFile: String;
FLangName: string; FLangName: string;
FMainPatternCount: integer;
FMainPatternList: TTextMatePatternList; FMainPatternList: TTextMatePatternList;
FPatternRepo: TTextMatePatternMap; FPatternRepo: TTextMatePatternMap;
FRootPattern: TTextMatePatternRoot; FRootPattern: TTextMatePatternRoot;
FTheEmptyPattern: TTextMatePattern;
FOtherGrammars: TOtherGrammarMap;
procedure ClearAttributeInfo(var AnAttribInfo: TSynAttributeInfo); procedure ClearAttributeInfo(var AnAttribInfo: TSynAttributeInfo);
function CreatePatternObject(AClass: TTextMatePatternClass): TTextMatePattern; function CreatePatternObject(AClass: TTextMatePatternClass): TTextMatePattern;
procedure DoOtherGrammarFreed(Sender: TObject);
function GetJson(AGrammarDef: String): TJSONObject; function GetJson(AGrammarDef: String): TJSONObject;
procedure ParseLanguage(ALangDef: TJSONData); procedure ParseLanguage(ALangDef: TJSONData);
function IsInclude(APatternJson: TJSONObject): boolean; function IsInclude(APatternJson: TJSONObject): boolean;
function IncludeName(APatternJson: TJSONObject): string; function IncludeName(APatternJson: TJSONObject; out AnOtherScopeName: string): string;
function ResolveInclude(APatternJson: TJSONObject): TTextMatePattern; function ResolveInclude(APatternJson: TJSONObject): TTextMatePattern;
procedure CopyPatterns(AnOtherGrammar: TTextMateGrammar; AnIncludeName: String);
function CreatePattern(AParent: TTextMatePattern; APatternJson: TJSONObject; AllowPatternOnly: Boolean = False): TTextMatePattern; function CreatePattern(AParent: TTextMatePattern; APatternJson: TJSONObject; AllowPatternOnly: Boolean = False): TTextMatePattern;
procedure ReadPattern(APattern: TTextMatePattern; APatternJson: TJSONObject); procedure ReadPattern(APattern: TTextMatePattern; APatternJson: TJSONObject);
function ParsePattern(AParent: TTextMatePattern; APatternJson: TJSONObject): TTextMatePattern; function ParsePattern(AParent: TTextMatePattern; APatternJson: TJSONObject): TTextMatePattern;
@ -392,10 +439,13 @@ type
private private
FCurrentPattern: TTextMatePattern; FCurrentPattern: TTextMatePattern;
FCurrentState: TTextMatePatternState; FCurrentState: TTextMatePatternState;
FLanguageScopeName: String;
FLineText: String; FLineText: String;
FCurrentTokenPos, FNextTokenPos: Integer; FCurrentTokenPos, FNextTokenPos: Integer;
FMissingIncludes: String;
FCurrentTokenKind: integer; FCurrentTokenKind: integer;
FCurrentAttrib: TObject; FCurrentAttrib: TObject;
FOnGetIncludedGrammar: TGetIncludedGrammar;
function GetCurrentPatternIndex: Integer; function GetCurrentPatternIndex: Integer;
function GetCurrentTokenLen: integer; inline; function GetCurrentTokenLen: integer; inline;
@ -403,6 +453,8 @@ type
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure ParseGrammar(AGrammarDef: String); procedure ParseGrammar(AGrammarDef: String);
// ResolveExternalIncludes: Call only what all other grammars have done the initial ParseGrammar
procedure ResolveExternalIncludes;
procedure ClearGrammar; procedure ClearGrammar;
function DebugDump(AnIndent: Integer = 2; AnIncludeNested: Boolean = True): string; function DebugDump(AnIndent: Integer = 2; AnIncludeNested: Boolean = True): string;
@ -422,15 +474,18 @@ type
property CurrentState: TTextMatePatternState read FCurrentState; property CurrentState: TTextMatePatternState read FCurrentState;
property LanguageName: String read FLangName write FLangName; property LanguageName: String read FLangName write FLangName;
property LanguageScopeName: String read FLanguageScopeName;
property SampleText: String read FSampleText write FSampleText; property SampleText: String read FSampleText write FSampleText;
property SampleTextFile: String read FSampleTextFile; property SampleTextFile: String read FSampleTextFile;
property ParserError: String read FParserError; property ParserError: String read FParserError;
property MissingIncludes: String read FMissingIncludes;
property RootPattern: TTextMatePatternRoot read FRootPattern; property RootPattern: TTextMatePatternRoot read FRootPattern;
property MainPatternList: TTextMatePatternList read FMainPatternList; property MainPatternList: TTextMatePatternList read FMainPatternList;
property OnPopulateAttributeInfo: TPopulateAttributeInfoProc read FOnPopulateAttributeInfo write FOnPopulateAttributeInfo; property OnPopulateAttributeInfo: TPopulateAttributeInfoProc read FOnPopulateAttributeInfo write FOnPopulateAttributeInfo;
property OnCheckAttributeInfo: TCheckAttributeInfoProc read FOnCheckAttributeInfo write FOnCheckAttributeInfo; property OnCheckAttributeInfo: TCheckAttributeInfoProc read FOnCheckAttributeInfo write FOnCheckAttributeInfo;
property OnGetIncludedGrammar: TGetIncludedGrammar read FOnGetIncludedGrammar write FOnGetIncludedGrammar;
end; end;
implementation implementation
@ -855,11 +910,30 @@ begin
//Result := Self; //Result := Self;
end; end;
procedure TTextMatePattern.FlattenNested; procedure TTextMatePattern.FlattenNested(AGrammar: TTextMateGrammar;
ARemoveMissingIncludes: boolean);
begin begin
// //
end; end;
class function TTextMatePattern.GetCopyFor(AnOther: TTextMatePattern;
AnIndexOffset: Integer; ANewList: TTextMatePatternList): TTextMatePattern;
begin
Result := nil;
if AnOther = nil then
exit;
Result := ANewList[AnOther.Index + AnIndexOffset];
end;
procedure TTextMatePattern.CopyFrom(AnOther: TTextMatePattern;
AnIndexOffset: Integer; ANewList: TTextMatePatternList);
begin
FComment := AnOther.FComment;
FName := AnOther.FName;
FDebugName := AnOther.FDebugName;
FAttribInfo := AnOther.FAttribInfo;
end;
procedure TTextMatePattern.DoInitRegex(var ARegEx: TRegExpr; procedure TTextMatePattern.DoInitRegex(var ARegEx: TRegExpr;
const AText: string; AnErrKey: String); const AText: string; AnErrKey: String);
var var
@ -868,6 +942,8 @@ begin
ARegEx.Free; ARegEx.Free;
ARegEx := TRegExpr.Create(AText); ARegEx := TRegExpr.Create(AText);
ARegEx.AllowBraceWithoutMin := True; ARegEx.AllowBraceWithoutMin := True;
ARegEx.AllowLiteralBraceWithoutRange := True;
//ARegEx.AllowUnsafeLookBehind := True;
try try
ARegEx.Compile; ARegEx.Compile;
except except
@ -911,7 +987,6 @@ begin
exit; exit;
if ATextStartOffset = FRecurseMatchPos then begin if ATextStartOffset = FRecurseMatchPos then begin
debugln('########################xxxxxxxxxxxxxxx');
{$IFDEF TMATE_MATCHING} debugln(['FindPatternForNextMatchPos - Recurse at ', ATextStartOffset, ' -- ', DebugName]); {$ENDIF} {$IFDEF TMATE_MATCHING} debugln(['FindPatternForNextMatchPos - Recurse at ', ATextStartOffset, ' -- ', DebugName]); {$ENDIF}
exit; exit;
end; end;
@ -961,40 +1036,106 @@ begin
Result := Self; Result := Self;
end; end;
procedure TTextMatePatternBaseNested.FlattenNested; procedure TTextMatePatternBaseNested.FlattenNested(AGrammar: TTextMateGrammar;
ARemoveMissingIncludes: boolean);
var var
NewPtnList: TTextMatePatternArray; NewPtnList: TTextMatePatternArray;
NewPtnIdx: integer; NewPtnIdx: integer;
procedure InsertInto(ASrcList: TTextMatePatternArray); procedure InsertInto(ASrcList: TTextMatePatternArray);
var var
i: Integer; i, j: Integer;
p: TTextMatePatternNested; PNest: TTextMatePatternNested;
PIncl: TTextMatePatternInclude;
Src: TTextMatePattern;
k: String;
begin begin
SetLength(NewPtnList, Length(NewPtnList) + Length(ASrcList) - 1); SetLength(NewPtnList, Length(NewPtnList) + Length(ASrcList) - 1);
for i := 0 to Length(ASrcList) - 1 do begin for i := 0 to Length(ASrcList) - 1 do begin
if ASrcList[i] is TTextMatePatternNested then begin Src := ASrcList[i];
p := TTextMatePatternNested(ASrcList[i]); PNest := nil;
if p.FParent = Self then if (Src is TTextMatePatternInclude) then begin
j := 0;
repeat
PIncl := TTextMatePatternInclude(Src);
if (PIncl.FSourceScope = '$base') or (PIncl.FSourceScope = AGrammar.FLanguageScopeName) then
k := PIncl.FSourceKey
else
k := PIncl.FSourceScope + '#' + PIncl.FSourceKey;
if k = '' then begin
Src := AGrammar.FRootPattern;
Break;
end;
if AGrammar.FPatternRepo.IndexOf(k) >= 0 then begin
Src := AGrammar.FPatternRepo[k];
if Src is TTextMatePatternInclude then begin
inc(j);
if j > AGrammar.MainPatternList.Count then
raise TTextMateGrammarException.Create('Invalid nested pattern'); raise TTextMateGrammarException.Create('Invalid nested pattern');
p.FParent := Self; continue;
InsertInto(p.Patterns); end;
p.FParent := nil;
end end
else begin else begin
NewPtnList[NewPtnIdx] := ASrcList[i]; if (ARemoveMissingIncludes) then begin
Src := nil;
if (AGrammar.FOtherGrammars.IndexOf(PIncl.FSourceScope) >= 0) and
(AGrammar.FOtherGrammars[PIncl.FSourceScope] <> nil)
then begin
if AGrammar.FMissingIncludes <> '' then AGrammar.FMissingIncludes := AGrammar.FMissingIncludes + ', ';
AGrammar.FMissingIncludes := AGrammar.FMissingIncludes + k;
end;
end;
end;
break;
until False;
end;
if Src is TTextMatePatternNested then begin
PNest := TTextMatePatternNested(Src);
end;
if PNest <> nil then begin
if PNest.FParent = Self then
raise TTextMateGrammarException.Create('Invalid nested pattern');
PNest.FParent := Self;
InsertInto(PNest.Patterns);
PNest.FParent := nil;
end
else
if Src <> nil then begin
NewPtnList[NewPtnIdx] := Src;
inc(NewPtnIdx); inc(NewPtnIdx);
end; end;
end; end;
end; end;
begin begin
if UnFlatPatterns = nil then
UnFlatPatterns := Patterns;
SetLength(NewPtnList, 1); SetLength(NewPtnList, 1);
NewPtnIdx := 0; NewPtnIdx := 0;
InsertInto(Patterns); InsertInto(UnFlatPatterns);
SetLength(NewPtnList, NewPtnIdx);
Patterns := NewPtnList Patterns := NewPtnList
end; end;
procedure TTextMatePatternBaseNested.CopyFrom(AnOther: TTextMatePattern;
AnIndexOffset: Integer; ANewList: TTextMatePatternList);
var
TheOther: TTextMatePatternBaseNested absolute AnOther;
i: Integer;
Src: TTextMatePatternArray;
begin
inherited CopyFrom(AnOther, AnIndexOffset, ANewList);
FParent := GetCopyFor(TheOther.FParent, AnIndexOffset, ANewList);
Src := TTextMatePatternBaseNested(AnOther).UnFlatPatterns;
if Src = nil then
Src := TTextMatePatternBaseNested(AnOther).Patterns;
SetLength(Patterns, Length(Src));
for i := 0 to Length(Src) - 1 do
Patterns[i] := GetCopyFor(Src[i], AnIndexOffset, ANewList);
end;
procedure TTextMatePatternBaseNested.NextToken( procedure TTextMatePatternBaseNested.NextToken(
var AStates: TTextMatePatternState; const AText: String; var AStates: TTextMatePatternState; const AText: String;
ACurTokenPos: integer; out ANextTokenPos: integer; AnInitInfoOnly: Boolean); ACurTokenPos: integer; out ANextTokenPos: integer; AnInitInfoOnly: Boolean);
@ -1061,26 +1202,47 @@ begin
if AnIncludeNested then begin if AnIncludeNested then begin
l := Patterns; l := Patterns;
Patterns := nil; Patterns := nil;
for i := 0 to Length(Patterns) - 1 do for i := 0 to Length(l) - 1 do
Result := Result + Patterns[i].DebugDump(AnIndent + 2, AnIncludeNested, APrefix); Result := Result + l[i].DebugDump(AnIndent + 2, AnIncludeNested, APrefix);
Patterns := l; Patterns := l;
end; end;
end; end;
{ TTextMatePatternNested } { TTextMatePatternNestedList }
procedure TTextMatePatternNested.InitStates(const AGrammar: TTextMateGrammar; procedure TTextMatePatternNestedList.InitStates(const AGrammar: TTextMateGrammar;
var AStates: TTextMatePatternState; AParent: TTextMatePattern; var AStates: TTextMatePatternState; AParent: TTextMatePattern;
const AText: String; ADepth: Integer); const AText: String; ADepth: Integer);
begin begin
assert(False, 'TTextMatePatternNested.InitStates: False'); assert(False, 'TTextMatePatternNestedList.InitStates: False');
end; end;
procedure TTextMatePatternNested.FlattenNested; procedure TTextMatePatternNestedList.FlattenNested(AGrammar: TTextMateGrammar;
ARemoveMissingIncludes: boolean);
begin begin
// //
end; end;
{ TTextMatePatternInclude }
procedure TTextMatePatternInclude.CopyFrom(AnOther: TTextMatePattern;
AnIndexOffset: Integer; ANewList: TTextMatePatternList);
var
TheOther: TTextMatePatternInclude absolute AnOther;
begin
inherited CopyFrom(AnOther, AnIndexOffset, ANewList);
FSourceScope := TheOther.FSourceScope;
FSourceKey := TheOther.FSourceKey;
end;
function TTextMatePatternInclude.GetFirstMatchPos(const AText: String;
const ATextStartOffset: integer; AStateEntryP: PTextMatePatternStateEntry;
out APattern: TTextMatePattern; out AFoundStartPos: integer;
AMatchMustStartBefore: integer): Boolean;
begin
Result := False;
end;
{ TTextMatePatternCapture } { TTextMatePatternCapture }
procedure TTextMatePatternCapture.InitStates(const AGrammar: TTextMateGrammar; procedure TTextMatePatternCapture.InitStates(const AGrammar: TTextMateGrammar;
@ -1132,8 +1294,30 @@ begin
{$ENDIF} {$ENDIF}
end; end;
procedure TTextMatePatternCaptures.CopyFrom(AnOther: TTextMatePatternCaptures;
AnIndexOffset: Integer; ANewList: TTextMatePatternList);
var
i: Integer;
begin
SetLength(CaptureArray, Length(AnOther.CaptureArray));
for i := 0 to Length(AnOther.CaptureArray) - 1 do
CaptureArray[i] := TTextMatePatternCapture(TTextMatePattern.GetCopyFor(AnOther.CaptureArray[i], AnIndexOffset, ANewList));
end;
{ TTextMatePatternMatch } { TTextMatePatternMatch }
procedure TTextMatePatternMatch.CopyFrom(AnOther: TTextMatePattern;
AnIndexOffset: Integer; ANewList: TTextMatePatternList);
var
TheOther: TTextMatePatternMatch absolute AnOther;
begin
inherited CopyFrom(AnOther, AnIndexOffset, ANewList);
Captures.CopyFrom(TheOther.Captures, AnIndexOffset, ANewList);
Match := TheOther.Match;
DoInitRegex(FRegExMatch, Match, 'match');
end;
procedure TTextMatePatternMatch.InitStates(const AGrammar: TTextMateGrammar; procedure TTextMatePatternMatch.InitStates(const AGrammar: TTextMateGrammar;
var AStates: TTextMatePatternState; AParent: TTextMatePattern; var AStates: TTextMatePatternState; AParent: TTextMatePattern;
const AText: String; ADepth: Integer); const AText: String; ADepth: Integer);
@ -1247,6 +1431,24 @@ end;
{ TTextMatePatternBeginEnd } { TTextMatePatternBeginEnd }
procedure TTextMatePatternBeginEnd.CopyFrom(AnOther: TTextMatePattern;
AnIndexOffset: Integer; ANewList: TTextMatePatternList);
var
TheOther: TTextMatePatternBeginEnd absolute AnOther;
begin
inherited CopyFrom(AnOther, AnIndexOffset, ANewList);
ContentName := TheOther.ContentName;
ContentAttribInfo := TheOther.ContentAttribInfo;
EndPatternLast := TheOther.EndPatternLast;
Captures.CopyFrom(TheOther.Captures, AnIndexOffset, ANewList);
CapturesBegin.CopyFrom(TheOther.CapturesBegin, AnIndexOffset, ANewList);
CapturesEnd.CopyFrom(TheOther.CapturesEnd, AnIndexOffset, ANewList);
MatchBegin := TheOther.MatchBegin;
MatchEnd := TheOther.MatchEnd;
DoInitRegex(FRegExMatchBegin, MatchBegin, 'matchBegin');
DoInitRegex(FRegExMatchEnd, MatchEnd, 'matchEnd');
end;
procedure TTextMatePatternBeginEnd.InitStates(const AGrammar: TTextMateGrammar; procedure TTextMatePatternBeginEnd.InitStates(const AGrammar: TTextMateGrammar;
var AStates: TTextMatePatternState; AParent: TTextMatePattern; var AStates: TTextMatePatternState; AParent: TTextMatePattern;
const AText: String; ADepth: Integer); const AText: String; ADepth: Integer);
@ -1501,6 +1703,23 @@ end;
{ TTextMatePatternBeginWhile } { TTextMatePatternBeginWhile }
procedure TTextMatePatternBeginWhile.CopyFrom(AnOther: TTextMatePattern;
AnIndexOffset: Integer; ANewList: TTextMatePatternList);
var
TheOther: TTextMatePatternBeginWhile absolute AnOther;
begin
inherited CopyFrom(AnOther, AnIndexOffset, ANewList);
ContentName := TheOther.ContentName;
ContentAttribInfo := TheOther.ContentAttribInfo;
Captures.CopyFrom(TheOther.Captures, AnIndexOffset, ANewList);
CapturesBegin.CopyFrom(TheOther.CapturesBegin, AnIndexOffset, ANewList);
CapturesWhile.CopyFrom(TheOther.CapturesWhile, AnIndexOffset, ANewList);
MatchBegin := TheOther.MatchBegin;
MatchWhile := TheOther.MatchWhile;
DoInitRegex(FRegExMatchBegin, MatchBegin, 'matchBegin');
DoInitRegex(FRegExMatchWhile, MatchWhile, 'MatchWhile');
end;
procedure TTextMatePatternBeginWhile.InitStates( procedure TTextMatePatternBeginWhile.InitStates(
const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState; const AGrammar: TTextMateGrammar; var AStates: TTextMatePatternState;
AParent: TTextMatePattern; const AText: String; ADepth: Integer); AParent: TTextMatePattern; const AText: String; ADepth: Integer);
@ -1655,6 +1874,15 @@ end;
{ TTextMatePatternRoot } { TTextMatePatternRoot }
procedure TTextMatePatternRoot.CopyFrom(AnOther: TTextMatePattern;
AnIndexOffset: Integer; ANewList: TTextMatePatternList);
var
TheOther: TTextMatePatternRoot absolute AnOther;
begin
inherited CopyFrom(AnOther, AnIndexOffset, ANewList);
ScopeName := TheOther.ScopeName;
end;
procedure TTextMatePatternRoot.InitStates(const AGrammar: TTextMateGrammar; procedure TTextMatePatternRoot.InitStates(const AGrammar: TTextMateGrammar;
var AStates: TTextMatePatternState; AParent: TTextMatePattern; var AStates: TTextMatePatternState; AParent: TTextMatePattern;
const AText: String; ADepth: Integer); const AText: String; ADepth: Integer);
@ -1698,6 +1926,15 @@ begin
APattern := Self; APattern := Self;
end; end;
procedure TTextMatePatternForwarder.CopyFrom(AnOther: TTextMatePattern;
AnIndexOffset: Integer; ANewList: TTextMatePatternList);
var
TheOther: TTextMatePatternForwarder absolute AnOther;
begin
inherited CopyFrom(AnOther, AnIndexOffset, ANewList);
FForwardTo := TTextMatePatternForwarder(GetCopyFor(TheOther.FForwardTo, AnIndexOffset, ANewList));
end;
procedure TTextMatePatternForwarder.ClearDeepestRecurseData; procedure TTextMatePatternForwarder.ClearDeepestRecurseData;
begin begin
inherited ClearDeepestRecurseData; inherited ClearDeepestRecurseData;
@ -1738,10 +1975,19 @@ begin
FMainPatternList.Capacity := FMainPatternList.Capacity + FMainPatternList.Capacity := FMainPatternList.Capacity +
Min(Max(250, FMainPatternList.Capacity shr 2), 8000); Min(Max(250, FMainPatternList.Capacity shr 2), 8000);
Result := AClass.Create; Result := AClass.Create;
//Result.FMainIndex := FMainPatternList.Count;
Result.FMainIndex := FMainPatternList.Add(Result); Result.FMainIndex := FMainPatternList.Add(Result);
end; end;
procedure TTextMateGrammar.DoOtherGrammarFreed(Sender: TObject);
var
i: Integer;
begin
ClearGrammar;
i := FOtherGrammars.IndexOfData(TTextMateGrammar(Sender));
if i >= 0 then
FOtherGrammars.Delete(i);
end;
function TTextMateGrammar.GetJson(AGrammarDef: String): TJSONObject; function TTextMateGrammar.GetJson(AGrammarDef: String): TJSONObject;
var var
i: Integer; i: Integer;
@ -1804,43 +2050,84 @@ begin
Result := APatternJson.IndexOfName('include') >= 0; Result := APatternJson.IndexOfName('include') >= 0;
end; end;
function TTextMateGrammar.IncludeName(APatternJson: TJSONObject): string; function TTextMateGrammar.IncludeName(APatternJson: TJSONObject; out
AnOtherScopeName: string): string;
var var
j: TJSONData; j: TJSONData;
i: SizeInt;
begin begin
j := APatternJson['include']; j := APatternJson['include'];
if not (j is TJSONString) then if not (j is TJSONString) then
raise TTextMateGrammarException.Create('include is not string', 'include'); raise TTextMateGrammarException.Create('include is not string', 'include');
Result := TJSONString(APatternJson['include']).AsString; Result := TJSONString(APatternJson['include']).AsString;
if Result = '' then
i := pos('#', Result);
if i < 1 then i := Length(Result)+1;
AnOtherScopeName := copy(Result, 1, i-1);
system.Delete(Result, 1, i);
if (Result = '') and (AnOtherScopeName = '') then
raise TTextMateGrammarException.Create('invalid include without ref', 'include'); raise TTextMateGrammarException.Create('invalid include without ref', 'include');
if AnOtherScopeName = '$self' then
AnOtherScopeName := '';
if (AnOtherScopeName <> '') and (FOtherGrammars.IndexOf(AnOtherScopeName) < 0) then
FOtherGrammars.Add(AnOtherScopeName);
end; end;
function TTextMateGrammar.ResolveInclude(APatternJson: TJSONObject function TTextMateGrammar.ResolveInclude(APatternJson: TJSONObject
): TTextMatePattern; ): TTextMatePattern;
var var
n: String; n, OtherScopeName: String;
begin begin
Result := nil; Result := nil;
n := IncludeName(APatternJson); n := IncludeName(APatternJson, OtherScopeName);
if n = '$self' then begin if OtherScopeName <> '' then begin
Result := CreatePatternObject(TTextMatePatternInclude);
TTextMatePatternInclude(Result).FSourceScope := OtherScopeName;
TTextMatePatternInclude(Result).FSourceKey := n;
exit
end;
if n = '' then begin
Result := FRootPattern; Result := FRootPattern;
end end
else else
if n[1] = '#' then begin begin
Delete(n,1,1);
if FPatternRepo.IndexOf(n) >= 0 then
Result := FPatternRepo[n];
end
else
if StrLIComp(@n[1], PChar('$self#'), 6) = 0 then begin
Delete(n,1,6);
if FPatternRepo.IndexOf(n) >= 0 then if FPatternRepo.IndexOf(n) >= 0 then
Result := FPatternRepo[n]; Result := FPatternRepo[n];
end; end;
if Result = nil then if Result = nil then begin
Result := FRootPattern; debugln('unknown include ' + n);
//raise TTextMateGrammarException.Create('unknown include ' + jsKeyAsString(APatternJson, 'include'), 'include');
if FTheEmptyPattern = nil then
FTheEmptyPattern := TTextMatePatternNestedList.Create;
Result := FTheEmptyPattern;
if FMissingIncludes <> '' then FMissingIncludes := FMissingIncludes + ', ';
FMissingIncludes := FMissingIncludes + n;
end;
end;
procedure TTextMateGrammar.CopyPatterns(AnOtherGrammar: TTextMateGrammar;
AnIncludeName: String);
var
InsPos, i: Integer;
k: String;
o: TTextMatePattern;
begin
InsPos := FMainPatternList.Count;
for i := 0 to AnOtherGrammar.FMainPatternCount - 1 do
CreatePatternObject(TTextMatePatternClass(AnOtherGrammar.FMainPatternList[i].ClassType));
for i := 0 to AnOtherGrammar.FMainPatternCount - 1 do
FMainPatternList[InsPos + i].CopyFrom(AnOtherGrammar.FMainPatternList[i], InsPos, FMainPatternList);
FPatternRepo.Add(AnIncludeName+'#', AnOtherGrammar.RootPattern);
for i := 0 to AnOtherGrammar.FPatternRepo.Count - 1 do begin
k := AnOtherGrammar.FPatternRepo.Keys[i];
if pos('#', k) > 0 then
continue;
o := TTextMatePattern.GetCopyFor(AnOtherGrammar.FPatternRepo.Data[i], InsPos, FMainPatternList);
FPatternRepo.Add(AnIncludeName+'#'+k, o);
end;
end; end;
function TTextMateGrammar.CreatePattern(AParent: TTextMatePattern; function TTextMateGrammar.CreatePattern(AParent: TTextMatePattern;
@ -1863,7 +2150,7 @@ begin
end end
else else
if AllowPatternOnly and (APatternJson.IndexOfName('patterns') >= 0) then begin if AllowPatternOnly and (APatternJson.IndexOfName('patterns') >= 0) then begin
Result := CreatePatternObject(TTextMatePatternNested); Result := CreatePatternObject(TTextMatePatternNestedList);
end end
else else
raise TTextMateGrammarException.Create('invalid pattern'); raise TTextMateGrammarException.Create('invalid pattern');
@ -1954,7 +2241,7 @@ begin
ReadCaptures(APattern, ptrnM.Captures.CaptureArray, APatternJson, 'captures', Length(ptrnM.Match)); ReadCaptures(APattern, ptrnM.Captures.CaptureArray, APatternJson, 'captures', Length(ptrnM.Match));
end end
else else
if APattern is TTextMatePatternNested then begin if APattern is TTextMatePatternNestedList then begin
// no exception // no exception
end end
else else
@ -2035,15 +2322,23 @@ begin
FMainPatternList := TTextMatePatternList.Create(True); FMainPatternList := TTextMatePatternList.Create(True);
FPatternRepo := TTextMatePatternMap.Create(False); FPatternRepo := TTextMatePatternMap.Create(False);
FCurrentState.InitForDepth(0); FCurrentState.InitForDepth(0);
FOtherGrammars := TOtherGrammarMap.Create(False);
end; end;
destructor TTextMateGrammar.Destroy; destructor TTextMateGrammar.Destroy;
var
i: Integer;
begin begin
FLangName := ''; for i := 0 to FOtherGrammars.Count-1 do
if FOtherGrammars.Data[i] <> nil then
FOtherGrammars.Data[i].RemoveFreeNotification(@DoOtherGrammarFreed);
inherited Destroy;
ClearGrammar; ClearGrammar;
FMainPatternList.Free; FMainPatternList.Free;
FPatternRepo.Free; FPatternRepo.Free;
inherited Destroy; FTheEmptyPattern.Free;
FOtherGrammars.Free;
end; end;
procedure TTextMateGrammar.ParseGrammar(AGrammarDef: String); procedure TTextMateGrammar.ParseGrammar(AGrammarDef: String);
@ -2052,7 +2347,7 @@ type
var var
JSonDef, RepoJson, EntryJSon: TJSONObject; JSonDef, RepoJson, EntryJSon: TJSONObject;
i, j: Integer; i, j: Integer;
EntryName, InclName: String; EntryName, InclName, SourceName: String;
p: TTextMatePattern; p: TTextMatePattern;
InclList: TIndexNameMap; InclList: TIndexNameMap;
begin begin
@ -2072,7 +2367,7 @@ begin
FSampleTextFile := jsKeyAsString(JSonDef, 'sampleTextFile'); FSampleTextFile := jsKeyAsString(JSonDef, 'sampleTextFile');
FRootPattern.FName := jsKeyAsString(JSonDef, 'name'); FRootPattern.FName := jsKeyAsString(JSonDef, 'name');
FRootPattern.ScopeName := jsKeyAsString(JSonDef, 'scopedName'); FRootPattern.ScopeName := jsKeyAsString(JSonDef, 'scopeName');
// language file? // language file?
if JSonDef.IndexOfName('contributes') >= 0 then begin if JSonDef.IndexOfName('contributes') >= 0 then begin
@ -2105,8 +2400,8 @@ begin
end; end;
// include // include
InclName := IncludeName(EntryJSon); InclName := IncludeName(EntryJSon, SourceName);
if InclName[1] <> '#' then begin if SourceName <> '' then begin
try try
FPatternRepo.Add(EntryName, ResolveInclude(EntryJSon)); FPatternRepo.Add(EntryName, ResolveInclude(EntryJSon));
except except
@ -2117,12 +2412,13 @@ begin
end; end;
// # other entry from repo // # other entry from repo
Delete(InclName, 1, 1); if FPatternRepo.IndexOf(InclName) >=0 then begin
p := FPatternRepo[InclName]; p := FPatternRepo[InclName];
if p <> nil then begin if p <> nil then begin
FPatternRepo.Add(EntryName, p); FPatternRepo.Add(EntryName, p);
continue; continue;
end; end;
end;
InclList.Add(EntryName, InclName); InclList.Add(EntryName, InclName);
end; end;
@ -2132,6 +2428,7 @@ begin
for i := InclList.Count - 1 downto 0 do begin for i := InclList.Count - 1 downto 0 do begin
EntryName := InclList.Keys[i]; EntryName := InclList.Keys[i];
InclName := InclList.Data[i]; InclName := InclList.Data[i];
if FPatternRepo.IndexOf(InclName) >=0 then begin
p := FPatternRepo[InclName]; p := FPatternRepo[InclName];
if p <> nil then begin if p <> nil then begin
FPatternRepo.Add(EntryName, p); FPatternRepo.Add(EntryName, p);
@ -2139,6 +2436,7 @@ begin
continue; continue;
end; end;
end; end;
end;
if j = InclList.Count then if j = InclList.Count then
raise Exception.Create('circular includes'); raise Exception.Create('circular includes');
j := InclList.Count; j := InclList.Count;
@ -2179,7 +2477,7 @@ begin
end; end;
for i := 0 to FMainPatternList.Count - 1 do for i := 0 to FMainPatternList.Count - 1 do
FMainPatternList[i].FlattenNested; FMainPatternList[i].FlattenNested(Self, False);
FParserError := ''; FParserError := '';
except except
on E: TTextMateGrammarException do begin on E: TTextMateGrammarException do begin
@ -2189,21 +2487,58 @@ begin
FParserError := 'Error: ' + E.message; FParserError := 'Error: ' + E.message;
end; end;
end; end;
if FParserError <> '' then writeln('TTextMateGrammar.ParseGrammar #### ', FRootPattern.FName, '/',FRootPattern.ScopeName, ' : ', FParserError) if (FRootPattern <> nil) then begin
else writeln('++++ OK +++++ ', FRootPattern.FName, ' / ',FRootPattern.ScopeName, ' ++++++ '); FLangName := FRootPattern.FName;
if (FRootPattern <> nil) and (FRootPattern.FName <> '') then FLangName := FRootPattern.FName; FLanguageScopeName := FRootPattern.ScopeName;
FMainPatternCount := FMainPatternList.Count;
end;
if FParserError <> '' then if FParserError <> '' then
ClearGrammar; ClearGrammar;
JSonDef.Free; JSonDef.Free;
end; end;
procedure TTextMateGrammar.ResolveExternalIncludes;
var
o: TTextMateGrammar;
i: Integer;
begin
if (OnGetIncludedGrammar = nil) or (FOtherGrammars.Count = 0) then
exit;
try
for i := 0 to FOtherGrammars.Count - 1 do begin
o := FOnGetIncludedGrammar(Self, FOtherGrammars.Keys[i]);
if o = nil then begin
if FMissingIncludes <> '' then FMissingIncludes := FMissingIncludes + ', ';
FMissingIncludes := FMissingIncludes + FOtherGrammars.Keys[i];
continue;
end;
o.AddFreeNotification(@DoOtherGrammarFreed);
FOtherGrammars.Data[i] := o;
CopyPatterns(o, FOtherGrammars.Keys[i]);
end;
for i := 0 to FMainPatternList.Count - 1 do
FMainPatternList[i].FlattenNested(Self, True);
except
on E: TTextMateGrammarException do begin
FParserError := 'Error: ' + E.FullError;
end;
on E: Exception do begin
FParserError := 'Error: ' + E.message;
end;
end;
end;
procedure TTextMateGrammar.ClearGrammar; procedure TTextMateGrammar.ClearGrammar;
begin begin
FCurrentState.InitForDepth(0); FCurrentState.InitForDepth(0);
FRootPattern := nil; FRootPattern := nil;
FMainPatternList.Clear; FMainPatternList.Clear;
FMainPatternCount := 0;
FPatternRepo.Clear; FPatternRepo.Clear;
FMissingIncludes := '';
end; end;
function TTextMateGrammar.DebugDump(AnIndent: Integer; AnIncludeNested: Boolean function TTextMateGrammar.DebugDump(AnIndent: Integer; AnIncludeNested: Boolean

707
components/lazedit/xregexpr.pas
View File

File diff suppressed because it is too large Load Diff

10
components/lazutils/plist2json.pas
View File

@ -24,6 +24,7 @@ begin
i := 0; i := 0;
Result := CreateJSONObject([]); Result := CreateJSONObject([]);
try
while i < c do begin while i < c do begin
keyNd := AnNode.ChildNodes[i]; keyNd := AnNode.ChildNodes[i];
if LowerCase(keyNd.NodeName) <> 'key' then if LowerCase(keyNd.NodeName) <> 'key' then
@ -39,6 +40,10 @@ begin
TJSONObject(Result).Add(key, val) TJSONObject(Result).Add(key, val)
end; end;
except
Result.Free;
raise;
end;
end; end;
function XmlArray2Json(AnNode: TDOMNode): TJSONData; function XmlArray2Json(AnNode: TDOMNode): TJSONData;
@ -46,11 +51,16 @@ var
CN: TDOMNode; CN: TDOMNode;
begin begin
Result := CreateJSONArray([]); Result := CreateJSONArray([]);
try
CN := AnNode.FirstChild; CN := AnNode.FirstChild;
while CN <> nil do begin while CN <> nil do begin
TJSONArray(Result).Add(Xml2Json(CN)); TJSONArray(Result).Add(Xml2Json(CN));
CN := CN.NextSibling; CN := CN.NextSibling;
end; end;
except
Result.Free;
raise;
end;
end; end;
function Xml2Json(AnNode: TDOMNode): TJSONData; function Xml2Json(AnNode: TDOMNode): TJSONData;

25
ide/editoroptions.pp
View File

@ -69,7 +69,8 @@ uses
// BuildIntf // BuildIntf
IDEOptionsIntf, MacroIntf, IDEOptionsIntf, MacroIntf,
// IDEIntf // IDEIntf
IDECommands, SrcEditorIntf, IDEOptEditorIntf, IDEDialogs, EditorSyntaxHighlighterDef, IDECommands, SrcEditorIntf, IDEOptEditorIntf, IDEDialogs,
EditorSyntaxHighlighterDef, TextMateGrammar,
// IdeConfig // IdeConfig
LazConf, LazConf,
// IDE // IDE
@ -812,6 +813,8 @@ type
TEditOptLangList = class(TList, TIdeSyntaxHighlighterList) TEditOptLangList = class(TList, TIdeSyntaxHighlighterList)
private private
function DoGetTMLGrammar(Sender: TTextMateGrammar; AScopeName: string
): TTextMateGrammar;
function GetLazSyntaxHighlighterType(AnId: TIdeSyntaxHighlighterID): TLazSyntaxHighlighter; deprecated '(to be removed in 4.99) -- Only temporary for StrToLazSyntaxHighlighter'; function GetLazSyntaxHighlighterType(AnId: TIdeSyntaxHighlighterID): TLazSyntaxHighlighter; deprecated '(to be removed in 4.99) -- Only temporary for StrToLazSyntaxHighlighter';
function GetInfos(Index: Integer): TEditOptLanguageInfo; function GetInfos(Index: Integer): TEditOptLanguageInfo;
function GetSharedSynInstances(AnID: TIdeSyntaxHighlighterID): TSrcIDEHighlighter; function GetSharedSynInstances(AnID: TIdeSyntaxHighlighterID): TSrcIDEHighlighter;
@ -2827,6 +2830,20 @@ end;
{ TEditOptLangList } { TEditOptLangList }
function TEditOptLangList.DoGetTMLGrammar(Sender: TTextMateGrammar;
AScopeName: string): TTextMateGrammar;
var
i: Integer;
begin
for i := 1 to Count - 1 do begin
if (SharedInstances[i] is TSynTextMateSyn) and
(TSynTextMateSyn(SharedInstances[i]).TextMateGrammar.LanguageScopeName = AScopeName)
then
exit(TSynTextMateSyn(SharedInstances[i]).TextMateGrammar);
end;
Result := nil;
end;
function TEditOptLangList.GetLazSyntaxHighlighterType( function TEditOptLangList.GetLazSyntaxHighlighterType(
AnId: TIdeSyntaxHighlighterID): TLazSyntaxHighlighter; AnId: TIdeSyntaxHighlighterID): TLazSyntaxHighlighter;
begin begin
@ -3703,6 +3720,7 @@ begin
StrLoader.Free; StrLoader.Free;
end; end;
end; end;
tmlHighlighter.TextMateGrammar.OnGetIncludedGrammar := @DoGetTMLGrammar;
NewInfo := TEditOptLanguageTextMateInfo.Create; NewInfo := TEditOptLanguageTextMateInfo.Create;
TEditOptLanguageTextMateInfo(NewInfo).FileName := FileList[i]; TEditOptLanguageTextMateInfo(NewInfo).FileName := FileList[i];
@ -3742,6 +3760,11 @@ begin
FileList.Free; FileList.Free;
end; end;
for i := 1 to Count - 1 do begin
if SharedInstances[i] is TSynTextMateSyn then
TSynTextMateSyn(SharedInstances[i]).TextMateGrammar.ResolveExternalIncludes;
end;
end; end;
destructor TEditOptLangList.Destroy; destructor TEditOptLangList.Destroy;

1
ide/frames/editor_color_tml_options.lfm
View File

@ -53,6 +53,7 @@ object TEditorColorOptionsTMLFrame: TTEditorColorOptionsTMLFrame
Align = alClient Align = alClient
BorderSpacing.Around = 6 BorderSpacing.Around = 6
ReadOnly = True ReadOnly = True
ScrollBars = ssAutoVertical
TabOrder = 1 TabOrder = 1
end end
end end

18
ide/frames/editor_color_tml_options.pas
View File

@ -42,6 +42,23 @@ var
i: Integer; i: Integer;
tmlHighlighter: TSynTextMateSyn; tmlHighlighter: TSynTextMateSyn;
begin begin
Memo1.Clear;
for i := 0 to HighlighterList.Count - 1 do begin
if (HighlighterList.SharedInstances[i] is TSynTextMateSyn) and
(TSynTextMateSyn(HighlighterList.SharedInstances[i]).TextMateGrammar.MissingIncludes <> '')
then
Memo1.Lines.Add(Format('"%2:s" (%3:s) - '+dlgColorsTmlMissingInclude, [LineEnding+'',
TSynTextMateSyn(HighlighterList.SharedInstances[i]).TextMateGrammar.MissingIncludes,
TSynTextMateSyn(HighlighterList.SharedInstances[i]).TextMateGrammar.LanguageName,
TSynTextMateSyn(HighlighterList.SharedInstances[i]).TextMateGrammar.LanguageScopeName
]));
end;
if Memo1.Lines.Count > 1 then begin
Memo1.Lines.Add('----------');
Memo1.Lines.Add('');
end;
dir := AppendPathDelim(UserSchemeDirectory(False)) + 'tml'; dir := AppendPathDelim(UserSchemeDirectory(False)) + 'tml';
FileList := nil; FileList := nil;
if DirectoryExistsUTF8(dir) then if DirectoryExistsUTF8(dir) then
@ -52,7 +69,6 @@ begin
exit; exit;
end; end;
Memo1.Clear;
for i := 0 to FileList.Count - 1 do begin for i := 0 to FileList.Count - 1 do begin
tmlHighlighter := TSynTextMateSyn.Create(nil); tmlHighlighter := TSynTextMateSyn.Create(nil);
tmlHighlighter.LoadGrammar(FileList[i], ''); tmlHighlighter.LoadGrammar(FileList[i], '');

1
ide/lazarusidestrconsts.pas
View File

@ -1946,6 +1946,7 @@ resourcestring
'To activate newly added/changed files restart the IDE.%0:s' + 'To activate newly added/changed files restart the IDE.%0:s' +
'The "Reload" button will update the list below, checking if any errors were fixed.'; 'The "Reload" button will update the list below, checking if any errors were fixed.';
dlgColorsTmlNoFilesFound = 'No files found.'; dlgColorsTmlNoFilesFound = 'No files found.';
dlgColorsTmlMissingInclude = 'Did not find all includes: %1:s';
dlgColorsTmlFromFile = 'File:'; dlgColorsTmlFromFile = 'File:';
dlgColorsTmlNoSampleTxt = 'No sample text configured'; dlgColorsTmlNoSampleTxt = 'No sample text configured';
dlgColorsTmlBadSampleTxtFile = 'Sample text file not found: %1:s'; dlgColorsTmlBadSampleTxtFile = 'Sample text file not found: %1:s';