paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-16 00:00:49 +01:00
Code Issues Packages Projects Releases Wiki Activity

Support for Highlighter based on TextMate grammar

Browse Source
This commit is contained in:
Martin 2023-07-29 18:53:30 +02:00
parent c92ad74886
commit 40fd2fc1fe
43 changed files with 213586 additions and 439 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/buildintf/ideoptionsintf.pas
View File

@ -175,6 +175,7 @@ const
EdtOptionsGeneralMisc = 120;
EdtOptionsDisplay = 200;
EdtOptionsColors = 500;
EdtOptionsTMLColors = 501;
EdtOptionsMarkup = 502;
EdtOptionsUserDefined = 504;
EdtOptionsKeys = 300;

47
components/ideintf/editorsyntaxhighlighterdef.pas
View File

@ -1,6 +1,7 @@
unit EditorSyntaxHighlighterDef;
{$mode objfpc}{$H+}
{$Interfaces CORBA}
interface
@ -14,7 +15,35 @@ type
lshDiff, lshBat, lshIni, lshPo, lshPike
);
TIdeSyntaxHighlighterID = type integer;
{ TIdeSyntaxHighlighterList }
TIdeSyntaxHighlighterList = interface ['{266257FF-38B5-4071-AC90-97F6738B6F8F}']
function GetLazSyntaxHighlighterType(AnId: TIdeSyntaxHighlighterID): TLazSyntaxHighlighter; deprecated '(to be removed in 4.99) -- Only temporary for StrToLazSyntaxHighlighter';
function GetCount: integer;
function GetCaptions(AnID: TIdeSyntaxHighlighterID): String;
function GetNames(AnID: TIdeSyntaxHighlighterID): String;
function GetSharedInstances(AnID: TIdeSyntaxHighlighterID): TObject;
function GetSynHlClasses(AnID: TIdeSyntaxHighlighterID): TClass;
function GetIdForLazSyntaxHighlighter(AnHighlighterType: TLazSyntaxHighlighter): TIdeSyntaxHighlighterID;
function GetIdForFileExtension(Ext: String): TIdeSyntaxHighlighterID;
function GetIdForFileExtension(Ext: String; ADelphiMode: boolean): TIdeSyntaxHighlighterID;
function GetIdForName(AName: String): TIdeSyntaxHighlighterID;
property Count: integer read GetCount;
property Captions [AnID: TIdeSyntaxHighlighterID]: String read GetCaptions;
property Names [AnID: TIdeSyntaxHighlighterID]: String read GetNames;
property SynHlClasses [AnID: TIdeSyntaxHighlighterID]: TClass read GetSynHlClasses; // class of TSynCustomHighlighter
property SharedInstances[AnID: TIdeSyntaxHighlighterID]: TObject read GetSharedInstances; // TSynCustomHighlighter
end;
const
IdeHighlighterNoneID = TIdeSyntaxHighlighterID(0);
IdeHighlighterStartId = TIdeSyntaxHighlighterID(1); // first regulor Highlighter in IdeSyntaxHighlighters (lowest index)
LazSyntaxHighlighterNames: array[TLazSyntaxHighlighter] of String =
( 'None',
'Text',
@ -37,28 +66,24 @@ const
'Ini',
'PO',
'Pike'
);
) deprecated 'Use IdeSyntaxHighlighters (to be removed in 4.99)';
function GetSyntaxHighlighterCaption(h: TLazSyntaxHighlighter): string;
function StrToLazSyntaxHighlighter(const s: String): TLazSyntaxHighlighter;
function GetSyntaxHighlighterCaption(h: TLazSyntaxHighlighter): string; deprecated 'Use IdeSyntaxHighlighters (to be removed in 4.99)';
function StrToLazSyntaxHighlighter(const s: String): TLazSyntaxHighlighter; deprecated 'Use IdeSyntaxHighlighters (to be removed in 4.99)';
var
IdeSyntaxHighlighters: TIdeSyntaxHighlighterList;
implementation
function GetSyntaxHighlighterCaption(h: TLazSyntaxHighlighter): string;
begin
if h=lshFreePascal then
Result:='Free Pascal'
else
Result:=LazSyntaxHighlighterNames[h];
Result:=IdeSyntaxHighlighters.Captions[IdeSyntaxHighlighters.GetIdForLazSyntaxHighlighter(h)];
end;
function StrToLazSyntaxHighlighter(const s: String): TLazSyntaxHighlighter;
begin
for Result := Low(TLazSyntaxHighlighter) to High(TLazSyntaxHighlighter) do
if (CompareText(s, LazSyntaxHighlighterNames[Result]) = 0) then
exit;
Result := lshFreePascal;
Result := IdeSyntaxHighlighters.GetLazSyntaxHighlighterType(IdeSyntaxHighlighters.GetIdForName(s)){%H-};
end;
end.

2
components/ideintf/ideopteditorintf.pas
View File

@ -55,7 +55,9 @@ type
// read-only access to options needed by external packages.
// feel free to extend when needed
function CreateSynHighlighter(LazSynHilighter: TLazSyntaxHighlighter): TObject; virtual; abstract; // returns sub-class of TSynCustomHighlighter
deprecated 'Use IdeSyntaxHighlighters (to be removed in 4.99)';
function ExtensionToLazSyntaxHighlighter(Ext: String): TLazSyntaxHighlighter; virtual; abstract;
deprecated 'Use IdeSyntaxHighlighters.GetIdForLazSyntaxHighlighter (to be removed in 4.99)';
property TabPosition: TTabPosition read GetTabPosition;
end;

3290
components/lazedit/Makefile Normal file
View File

File diff suppressed because it is too large Load Diff

5
components/lazedit/Makefile.compiled Normal file
View File

@ -0,0 +1,5 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Makefile Value="2"/>
<Params Value="-Fu.;../../packager/units/$(CPU_TARGET)-$(OS_TARGET);../lazutils/lib/$(CPU_TARGET)-$(OS_TARGET) -MObjFPC -Scghi -O1 -g -gl -l -vewnhibq lazedit.pas"/>
</CONFIG>

64
components/lazedit/Makefile.fpc Normal file
View File

@ -0,0 +1,64 @@
# File generated automatically by Lazarus Package Manager
#
# Makefile.fpc for LazEdit 0.0
#
# This file was generated on 11/09/2023
[package]
name=lazedit
version=0.0
[compiler]
unittargetdir=lib/$(CPU_TARGET)-$(OS_TARGET)
unitdir=. ../../packager/units/$(CPU_TARGET)-$(OS_TARGET) ../lazutils/lib/$(CPU_TARGET)-$(OS_TARGET)
options=-MObjFPC -Scghi -O1 -g -gl -l -vewnhibq $(DBG_OPTIONS)
[target]
units=lazedit.pas
[clean]
files=$(wildcard $(COMPILER_UNITTARGETDIR)/*$(OEXT)) \
$(wildcard $(COMPILER_UNITTARGETDIR)/*$(PPUEXT)) \
$(wildcard $(COMPILER_UNITTARGETDIR)/*$(RSTEXT)) \
$(wildcard $(COMPILER_UNITTARGETDIR)/*.lfm) \
$(wildcard $(COMPILER_UNITTARGETDIR)/*.res) \
$(wildcard $(COMPILER_UNITTARGETDIR)/*.compiled) \
$(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))
[prerules]
# LCL Platform
ifndef LCL_PLATFORM
ifeq ($(OS_TARGET),win32)
LCL_PLATFORM=win32
else
ifeq ($(OS_TARGET),win64)
LCL_PLATFORM=win32
else
ifeq ($(OS_TARGET),darwin)
LCL_PLATFORM=cocoa
else
LCL_PLATFORM=gtk2
endif
endif
endif
endif
export LCL_PLATFORM
DBG_OPTIONS=
ifeq ($(OS_TARGET),darwin)
DBG_OPTIONS=-gw
endif
[rules]
.PHONY: cleartarget compiled all
cleartarget:
-$(DEL) $(COMPILER_UNITTARGETDIR)/lazedit$(PPUEXT)
compiled:
$(CPPROG) -f Makefile.compiled $(COMPILER_UNITTARGETDIR)/lazedit.compiled
all: cleartarget $(COMPILER_UNITTARGETDIR) lazedit$(PPUEXT) compiled
distclean: clean
${DELTREE} lib/*

68
components/lazedit/fpmake.pp Normal file
View File

@ -0,0 +1,68 @@
{
File generated automatically by Lazarus Package Manager
fpmake.pp for LazEdit 0.0
This file was generated on 11/09/2023
}
{$ifndef ALLPACKAGES}
{$mode objfpc}{$H+}
program fpmake;
uses fpmkunit;
{$endif ALLPACKAGES}
procedure add_LazEdit(const ADirectory: string);
var
P : TPackage;
T : TTarget;
D : TDependency;
begin
with Installer do
begin
P:=AddPackage('lazedit');
P.Version:='<none>';
P.Directory:=ADirectory;
P.Author:='See each unit';
P.License:='modified LGPL-2'#13#10'Additional licenses may be granted in each individual file. See the headers in each file.';
P.Description:='Tools/Units to be used by SynEdit (or other editors)';
D := P.Dependencies.Add('lazutils');
D := P.Dependencies.Add('fcl');
P.Options.Add('-MObjFPC');
P.Options.Add('-Scghi');
P.Options.Add('-O1');
P.Options.Add('-g');
P.Options.Add('-gl');
P.Options.Add('-l');
P.Options.Add('-vewnhibq');
P.UnitPath.Add('.');
T:=P.Targets.AddUnit('lazedit.pas');
t.Dependencies.AddUnit('textmategrammar');
t.Dependencies.AddUnit('xHyperLinksDecorator');
t.Dependencies.AddUnit('xregexpr');
t.Dependencies.AddUnit('xregexpr_unicodedata');
T:=P.Targets.AddUnit('textmategrammar.pas');
T:=P.Targets.AddUnit('xHyperLinksDecorator.pas');
T:=P.Targets.AddUnit('xregexpr.pas');
T:=P.Targets.AddUnit('xregexpr_unicodedata.pas');
// copy the compiled file, so the IDE knows how the package was compiled
P.Sources.AddSrc('lazedit.compiled');
P.InstallFiles.Add('lazedit.compiled',AllOSes,'$(unitinstalldir)');
end;
end;
{$ifndef ALLPACKAGES}
begin
add_LazEdit('');
Installer.Run;
end.
{$endif ALLPACKAGES}

59
components/lazedit/lazedit.lpk Normal file
View File

@ -0,0 +1,59 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="5">
<PathDelim Value="\"/>
<Name Value="LazEdit"/>
<Author Value="See each unit"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<ConfigFile>
<WriteConfigFilePath Value=""/>
</ConfigFile>
<CustomOptions Value="$(IDEBuildOptions)"/>
</Other>
</CompilerOptions>
<Description Value="Tools/Units to be used by SynEdit (or other editors)"/>
<License Value="modified LGPL-2
Additional licenses may be granted in each individual file. See the headers in each file.
"/>
<Version Major="1"/>
<Files>
<Item>
<Filename Value="textmategrammar.pas"/>
<UnitName Value="TextMateGrammar"/>
</Item>
<Item>
<Filename Value="xHyperLinksDecorator.pas"/>
<UnitName Value="xHyperLinksDecorator"/>
</Item>
<Item>
<Filename Value="xregexpr.pas"/>
<UnitName Value="xregexpr"/>
</Item>
<Item>
<Filename Value="xregexpr_unicodedata.pas"/>
<UnitName Value="xregexpr_unicodedata"/>
</Item>
</Files>
<RequiredPkgs>
<Item>
<PackageName Value="LazUtils"/>
</Item>
<Item>
<PackageName Value="FCL"/>
</Item>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
</Package>
</CONFIG>

15
components/lazedit/lazedit.pas Normal file
View File

@ -0,0 +1,15 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit LazEdit;
{$warn 5023 off : no warning about unused units}
interface
uses
TextMateGrammar, xHyperLinksDecorator, xregexpr, xregexpr_unicodedata;
implementation
end.

450
components/lazedit/regexpr_compilers.inc Normal file
View File

@ -0,0 +1,450 @@
{$IFDEF VER90}
{$DEFINE D2}
{$ENDIF} // D2
{$IFDEF VER93}
{$DEFINE D2}
{$ENDIF} // CPPB 1
{$IFDEF VER100}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D3
{$IFDEF VER110}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // CPPB 3
{$IFDEF VER120}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D4
{$IFDEF VER130}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D5
{$IFDEF VER140}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D6
{$IFDEF VER150}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D7
{$IFDEF VER160}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D8
{$IFDEF VER170}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D2005
{$IFDEF VER180}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D2006
{$IFDEF VER185}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D2007
{$IFDEF VER200}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D2009
{$IFDEF VER210}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D2010
{$IFDEF VER220}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D XE
{$IFDEF VER230}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D XE2
{$IFDEF VER240}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D XE3
{$IFDEF VER250}
{$DEFINE D_XE4}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D XE4
{$IFDEF VER260}
{$DEFINE D_XE5}
{$DEFINE D_XE4}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D XE5
{$IFDEF VER270}
{$DEFINE D_XE6}
{$DEFINE D_XE5}
{$DEFINE D_XE4}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D XE6
{$IFDEF VER280}
{$DEFINE D_XE7}
{$DEFINE D_XE6}
{$DEFINE D_XE5}
{$DEFINE D_XE4}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D XE7
{$IFDEF VER290}
{$DEFINE D_XE8}
{$DEFINE D_XE7}
{$DEFINE D_XE6}
{$DEFINE D_XE5}
{$DEFINE D_XE4}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D XE8
{$IFDEF VER300}
{$DEFINE D_100}
{$DEFINE D_XE8}
{$DEFINE D_XE7}
{$DEFINE D_XE6}
{$DEFINE D_XE5}
{$DEFINE D_XE4}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D 10
{$IFDEF VER310}
{$DEFINE D_101}
{$DEFINE D_100}
{$DEFINE D_XE8}
{$DEFINE D_XE7}
{$DEFINE D_XE6}
{$DEFINE D_XE5}
{$DEFINE D_XE4}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D 10.1
{$IFDEF VER320}
{$DEFINE D_102}
{$DEFINE D_101}
{$DEFINE D_100}
{$DEFINE D_XE8}
{$DEFINE D_XE7}
{$DEFINE D_XE6}
{$DEFINE D_XE5}
{$DEFINE D_XE4}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D 10.2
{$IFDEF VER330}
{$DEFINE D_103}
{$DEFINE D_102}
{$DEFINE D_101}
{$DEFINE D_100}
{$DEFINE D_XE8}
{$DEFINE D_XE7}
{$DEFINE D_XE6}
{$DEFINE D_XE5}
{$DEFINE D_XE4}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D 10.3
{$IFDEF VER340}
{$DEFINE D_104}
{$DEFINE D_103}
{$DEFINE D_102}
{$DEFINE D_101}
{$DEFINE D_100}
{$DEFINE D_XE8}
{$DEFINE D_XE7}
{$DEFINE D_XE6}
{$DEFINE D_XE5}
{$DEFINE D_XE4}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D 10.4
{$IFDEF VER350}
{$DEFINE D_110}
{$DEFINE D_104}
{$DEFINE D_103}
{$DEFINE D_102}
{$DEFINE D_101}
{$DEFINE D_100}
{$DEFINE D_XE8}
{$DEFINE D_XE7}
{$DEFINE D_XE6}
{$DEFINE D_XE5}
{$DEFINE D_XE4}
{$DEFINE D_XE3}
{$DEFINE D_XE2}
{$DEFINE D_XE}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE D8}
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D5}
{$DEFINE D4}
{$DEFINE D3}
{$DEFINE D2}
{$ENDIF} // D 11.0
{$IFDEF D6}
{$WARN SYMBOL_PLATFORM OFF} // Suppress .Net warnings
{$ENDIF}
{$IFDEF D7}
{$WARN UNSAFE_CAST OFF} // Suppress .Net warnings
{$WARN UNSAFE_TYPE OFF} // Suppress .Net warnings
{$WARN UNSAFE_CODE OFF} // Suppress .Net warnings
{$ENDIF}

580
components/lazedit/test/lazedittest.lpi Normal file
View File

@ -0,0 +1,580 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="lazedittest"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="O0" Default="True"/>
<Item Name="O0riota">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O0 NO-gt1">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O0riota1 NO-gt">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O0 -gt">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O0 -gtt">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O0 -gttt">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O0 -gtttt &lt;nil>">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O1">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O1riota">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O2">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O2riota">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O3">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O3riota">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O4">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<Item Name="O4riota">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-gt
-dWithSynBiDi"/>
</Other>
</CompilerOptions>
</Item>
<SharedMatrixOptions Count="15">
<Item1 ID="682559408105" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/>
<Item2 ID="394047217475" Targets="SynEdit" Modes="O0riota,O1riota,O2riota,O3riota,O4riota" Value="-CR"/>
<Item3 ID="476451423372" Targets="#project,SynEdit,LCL,LazUtils" Modes="O0,O0riota,O0riota1 NO-gt,O0 -gt,O0 -gtt,O0 -gttt,O0 -gtttt &lt;nil>,O0 NO-gt1" Value="-O-"/>
<Item4 ID="353669118028" Targets="#project,SynEdit,LCL,LazUtils" Modes="O1,O1riota" Value="-O-1"/>
<Item5 ID="705666282637" Targets="#project,SynEdit,LCL,LazUtils" Modes="O2,O2riota" Value="-O-2"/>
<Item6 ID="139516671950" Targets="#project,SynEdit,LCL,LazUtils" Modes="O3,O3riota" Value="-O-3"/>
<Item7 ID="951152446553" Targets="#project,SynEdit,LCL,LazUtils" Modes="O4,O4riota" Value="-O-4"/>
<Item8 ID="290834599239" Targets="#project,SynEdit,LCL,LazUtils" Modes="O0riota,O1riota,O2riota,O3riota,O4riota,O0 -gtttt &lt;nil>,O0 -gttt,O0 -gtt,O0 -gt,O0riota1 NO-gt" Value="-Criot"/>
<Item9 ID="862413201644" Targets="#project,SynEdit,LCL,LazUtils" Value="-CR"/>
<Item10 ID="552061010909" Targets="#project,SynEdit,LCL,LazUtils" Modes="O0riota,O1riota,O2riota,O3riota,O4riota,O0riota1 NO-gt,O0 -gt,O0 -gtt,O0 -gttt,O0 -gtttt &lt;nil>" Value="-Sa"/>
<Item11 ID="362454399046" Targets="#project,SynEdit,LCL,LazUtils" Modes="O0 -gt" Value="-gt- -gt"/>
<Item12 ID="710122956011" Targets="#project,SynEdit,LCL,LazUtils" Modes="O0 -gtt" Value="-gt- -gtt"/>
<Item13 ID="041078026067" Targets="#project,SynEdit,LCL,LazUtils" Modes="O0 -gttt" Value="-gt- -gttt"/>
<Item14 ID="961200635277" Targets="#project,SynEdit,LCL,LazUtils" Modes="O0 -gtttt &lt;nil>" Value="-gt- -gtttt"/>
<Item15 ID="901082361902" Targets="#project,SynEdit,LCL,LazUtils" Modes="O0riota1 NO-gt,O0 NO-gt1,O4,O3,O2,O1" Value="-gt-"/>
</SharedMatrixOptions>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="fpcunittestrunner"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
<Item>
<PackageName Value="FCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="lazedittest.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="LazEditTest"/>
</Unit>
<Unit>
<Filename Value="testtextmategrammar.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TestTextMateGrammar"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="lazedittest"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
</Linking>
<Other>
<ConfigFile>
<WriteConfigFilePath Value=""/>
</ConfigFile>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
<Item>
<Name Value="TTextMateGrammarException"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

15
components/lazedit/test/lazedittest.lpr Normal file
View File

@ -0,0 +1,15 @@
program LazEditTest;
{$mode objfpc}{$H+}
uses
Interfaces, Forms, GuiTestRunner, TestTextMateGrammar;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TGuiTestRunner, TestRunner);
Application.Run;
end.

946
components/lazedit/test/testtextmategrammar.pas Normal file
View File

@ -0,0 +1,946 @@
unit TestTextMateGrammar;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry,
TextMateGrammar, LazLoggerBase;
type
TCaptIdx = (c0, c1, c2, c3, c4, c5, c6);
TCaptSet = set of TCaptIdx;
{ TTestTextMateGrammar }
TTestTextMateGrammar = class(TTestCase)
private
procedure DoCheckAttributeInfo(Sender: TTextMatePattern;
const AnAttribInfo: TSynAttributeInfo; out AnUseId, AnUseObject: Boolean);
procedure DoPopulateAttributeInfo(Sender: TTextMateGrammar;
APattern: TTextMatePattern; AContextName: String;
var AnAttribInfo: TSynAttributeInfo);
function GetTestA1Foo: String;
function GetTestA1(WithContentName: Boolean; ASubPatterns: array of String): String;
function GetTestA1(WithContentName: Boolean; BCaptures, ECaptures, ACaptures: TCaptSet;
B3Pattern, B5Pattern, E3Pattern, E5Pattern, ASubPatterns: array of String): String;
function GetTestB1Bar(ASubPatterns: array of String): String;
function GetTestB1Nest(ASubPatterns: array of String): String;
function GetTestB1(WithContentName, WithCaptures: Boolean; ASubPatterns: array of String): String;
function GetTestC1(ASubPatterns: array of String): String;
function GetTestM1(ASubPatterns: array of String): String;
function GetTestW1(ASubPatterns: array of String): String;
function GetTestNest(ASubPatterns: array of String): String;
function Join(const APatterns: array of String): String;
function Include(const AName: String): String;
function BuildPatterns(const APatterns: array of String; AMore: String = ''; LeadComma: boolean = True): String;
procedure SetGrammar(AText: String);
procedure SetGrammar(const ARootPatterns, ARepository: array of String);
function RunGrammar(ATestName, ATextLine: String; out LastPatternIndex: Integer; AStartPatternIndex: integer = -1): String;
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; AStartPatternName: String): Integer;
protected
FGrammar: TTextMateGrammar;
FGrammarText: String;
FNames: TStringList;
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestFlatNested;
procedure TestBeginEnd;
procedure TestBeginEndInCapture;
procedure TestWhile;
procedure TestForwarder;
procedure TestRecurse;
procedure TestVarious;
end;
implementation
procedure TTestTextMateGrammar.DoCheckAttributeInfo(Sender: TTextMatePattern;
const AnAttribInfo: TSynAttributeInfo; out AnUseId, AnUseObject: Boolean);
begin
AnUseId := True;
AnUseObject := True;
end;
procedure TTestTextMateGrammar.DoPopulateAttributeInfo(
Sender: TTextMateGrammar; APattern: TTextMatePattern; AContextName: String;
var AnAttribInfo: TSynAttributeInfo);
begin
if AContextName = 'Default-text' then AContextName := '-';
AnAttribInfo.TokId := FNames.IndexOf(AContextName);
if AnAttribInfo.TokId < 0 then
AnAttribInfo.TokId := FNames.Add(AContextName);
AnAttribInfo.TokObject := nil;
end;
function TTestTextMateGrammar.GetTestA1Foo: String;
begin
Result := '{ "name": "a1.foo",' +
' "match": "foo"' +
'}';
end;
function TTestTextMateGrammar.GetTestA1(WithContentName: Boolean;
ASubPatterns: array of String): String;
begin
Result := '{ "name": "a1",';
if WithContentName then Result := Result +
' "contentName": "a1.c",';
Result := Result +
' "begin": "<a1.*?>",' +
' "end": "</a1.*?>"' +
BuildPatterns(ASubPatterns) +
'}';
end;
function TTestTextMateGrammar.GetTestA1(WithContentName: Boolean; BCaptures,
ECaptures, ACaptures: TCaptSet; B3Pattern, B5Pattern, E3Pattern, E5Pattern,
ASubPatterns: array of String): String;
begin
Result := '{ "name": "a1",';
if WithContentName then Result := Result +
' "contentName": "a1.c",';
Result := Result +
' "begin": "(<)(a1)([^->]+?)?-?(M*)(.*?)?(>)",' +
' "end": "(<)(/a1)([^->]+?)?-?(M*)(.*?)?(>)",' +
' "beginCaptures": {';
if c0 in BCaptures then Result := Result +' "0": { "name": "a1.b0" },';
if c1 in BCaptures then Result := Result +' "1": { "name": "a1.b1" },';
if c2 in BCaptures then Result := Result +' "2": { "name": "a1.b2" },';
if c3 in BCaptures then begin
Result := Result +' "3": { "name": "a1.b3",' +
BuildPatterns(B3Pattern,
' { "name": "a1.b3.x", "match": "x*" },' +
' { "name": "a1.b3.y", "match": "y.*" },' +
' { "name": "a1.b3.z", "match": ".*z" }',
False
) +
' },';
end;
if c4 in ECaptures then Result := Result +' "4": { "name": "a1.b4" },';
if c5 in BCaptures then begin
Result := Result +' "5": { ' +
BuildPatterns(B5Pattern,
' { "name": "a1.b5.x", "match": "x*" },' +
' { "name": "a1.b5.y", "match": "y.*" },' +
' { "name": "a1.b5.z", "match": ".*z" }',
False
) +
' },';
end;
if c6 in BCaptures then Result := Result +' "6": { "name": "a1.b6" },';
Result := Result + '"99": { "name": "DUMMY"}' +
' },' +
' "endCaptures": {';
if c0 in ECaptures then Result := Result +' "0": { "name": "a1.e0" },';
if c1 in ECaptures then Result := Result +' "1": { "name": "a1.e1" },';
if c2 in ECaptures then Result := Result +' "2": { "name": "a1.e2" },';
if c3 in ECaptures then begin
Result := Result +' "3": { "name": "a1.e3",' +
BuildPatterns(E3Pattern,
' { "name": "a1.e3.x", "match": "x*" },' +
' { "name": "a1.e3.y", "match": "y.*" },' +
' { "name": "a1.e3.z", "match": ".*z" }',
False
) +
' },';
end;
if c4 in ECaptures then Result := Result +' "4": { "name": "a1.e4" },';
if c5 in ECaptures then begin
Result := Result +' "5": { ' +
BuildPatterns(E5Pattern,
' { "name": "a1.e5.x", "match": "x*" },' +
' { "name": "a1.e5.y", "match": "y.*" },' +
' { "name": "a1.e5.z", "match": ".*z" }',
False
) +
' },';
end;
if c6 in ECaptures then Result := Result +' "6": { "name": "a1.e6" },';
Result := Result + '"99": { "name": "DUMMY"}' +
' },' +
' "captures": {';
if c0 in ACaptures then Result := Result +' "0": { "name": "a1.a0" },';
if c1 in ACaptures then Result := Result +' "1": { "name": "a1.a1" },';
if c2 in ACaptures then Result := Result +' "2": { "name": "a1.a2" },';
if c3 in ACaptures then Result := Result +' "3": { "name": "a1.a3" },';
if c4 in ACaptures then Result := Result +' "4": { "name": "a1.a4" },';
if c5 in ACaptures then Result := Result +' "5": { "name": "a1.a5" },';
if c6 in ACaptures then Result := Result +' "6": { "name": "a1.a6" },';
Result := Result + '"99": { "name": "DUMMY"}' +
' }';
Result := Result +
BuildPatterns(ASubPatterns) +
'}';
end;
function TTestTextMateGrammar.GetTestB1Bar(ASubPatterns: array of String
): String;
begin
Result := '{ "name": "b1.bar",' +
' "match": "bar.*?end"' +
BuildPatterns(ASubPatterns) +
'}';
end;
function TTestTextMateGrammar.GetTestB1Nest(ASubPatterns: array of String
): String;
begin
Result := '{ "name": "b1.nest",' +
' "begin": "nest",' +
' "end": "back" ' +
BuildPatterns(ASubPatterns) +
'}';
end;
function TTestTextMateGrammar.GetTestB1(WithContentName, WithCaptures: Boolean;
ASubPatterns: array of String): String;
begin
Result := '{ "name": "b1",';
if WithContentName then Result := Result +
' "contentName": "b1.c",';
if WithCaptures then begin
Result := Result +
' "begin": "(\\[)(b1)(\\])",' +
' "end": "(\\[)(/b1)(\\])",' +
' "captures": {' +
' "1": { "name": "b1.a1" },' +
' "3": { "name": "b1.a3" }' +
' }';
end
else Result := Result +
' "begin": "\\[b1.*?\\]",' +
' "end": "\\[/b1.*?\\]"';
Result := Result +
BuildPatterns(ASubPatterns) +
'}' ;
end;
function TTestTextMateGrammar.GetTestC1(ASubPatterns: array of String): String;
begin
Result := '{ "name": "c1",' +
' "begin": "<c1>",' +
' "end": "</c1>" ' +
BuildPatterns(ASubPatterns) +
'}';
end;
function TTestTextMateGrammar.GetTestM1(ASubPatterns: array of String): String;
begin
Result := '{ "name": "m1",' +
' "match": "==>([^!]*).*$",' +
' "captures": {' +
' "1": { "name": "m1c" ' +
BuildPatterns(ASubPatterns) +
' },' +
' }' +
'}';
end;
function TTestTextMateGrammar.GetTestW1(ASubPatterns: array of String): String;
begin
Result := '{ "name": "w1",' +
' "begin": "W",' +
' "while": "w" ' +
BuildPatterns(ASubPatterns) +
'}';
end;
function TTestTextMateGrammar.GetTestNest(ASubPatterns: array of String
): String;
begin
Result := '{ ' +
BuildPatterns(ASubPatterns, '', False) +
'}';
end;
function TTestTextMateGrammar.Join(const APatterns: array of String): String;
var
i: Integer;
begin
Result := '';
for i := 0 to Length(APatterns)-1 do begin
if APatterns[i] = '' then
Continue;
if Result <> '' then Result := Result + ',';
Result := Result + APatterns[i];
end;
end;
function TTestTextMateGrammar.Include(const AName: String): String;
begin
Result := '{ "include": "#'+AName+'" }';
end;
function TTestTextMateGrammar.BuildPatterns(const APatterns: array of String;
AMore: String; LeadComma: boolean): String;
begin
Result := Join([AMore, Join(APatterns)]);
if Result <> '' then
Result := ' "patterns": [' + Result + ' ]';
if (Result <> '') and LeadComma then
Result := ',' + Result;
end;
procedure TTestTextMateGrammar.SetGrammar(AText: String);
begin
FGrammar.ClearGrammar;
FGrammarText := AText;
FGrammar.ParseGrammar(AText);
if FGrammar.ParserError = '' then
debugln(FGrammar.DebugDump());
end;
procedure TTestTextMateGrammar.SetGrammar(const ARootPatterns,
ARepository: array of String);
var
RepoPtn: String;
i: Integer;
begin
RepoPtn := '';
for i := 0 to Length(ARepository) div 2 -1 do begin
if RepoPtn <> '' then RepoPtn := RepoPtn + ',';
RepoPtn := RepoPtn + '"' + ARepository[i*2] + '": ' + ARepository[i*2+1];
end;
SetGrammar(
'{ "name": "root",'+
' "scopeName": "source" '+
BuildPatterns(ARootPatterns) +
' , "repository": {' +
RepoPtn +
' }' +
'}'
);
end;
function TTestTextMateGrammar.RunGrammar(ATestName, ATextLine: String; out
LastPatternIndex: Integer; AStartPatternIndex: integer): String;
var
LastPattern: TTextMatePattern;
begin
Result := '';
DebugLn(['TTestTextMateGrammar.RunGrammar START: ',ATextLine]);
FGrammar.SetLine(ATextLine, AStartPatternIndex);
FGrammar.First;
Result := Result + IntToStr(FGrammar.CurrentTokenPos) + ':' + FNames[FGrammar.CurrentTokenKind];
while not FGrammar.IsAtEol do begin
FGrammar.Next;
if not FGrammar.IsAtEol then
Result := Result + ',' + IntToStr(FGrammar.CurrentTokenPos) + ':' + FNames[FGrammar.CurrentTokenKind];
end;
LastPatternIndex := FGrammar.CurrentPatternIndex;
LastPattern := FGrammar.MainPatternList[LastPatternIndex];
while LastPattern is TTextMatePatternForwarder do
LastPattern := TTextMatePatternForwarder(LastPattern).ForwardTo;
Result := Result + '/' + TTextMatePatternBaseNested(LastPattern).Name;
Result := Result + '/' + IntToStr(FGrammar.CurrentState.StateIdx);
end;
procedure TTestTextMateGrammar.RunNextToEol(ATestName, ATextLine: String; out
LastPatternIndex: Integer; AStartPatternIndex: integer);
begin
DebugLn(['TTestTextMateGrammar.RunNextToEol START: ',ATextLine]);
FGrammar.SetLine(ATextLine, AStartPatternIndex);
FGrammar.NextToEol;
AssertTrue(ATestName+': at eol', FGrammar.IsAtEol);
LastPatternIndex := FGrammar.CurrentPatternIndex;
end;
function TTestTextMateGrammar.TestLine(ATestName, ATextLine, Expect: String;
AStartPatternIndex: integer): Integer;
var
t: String;
p, LastIdx, d: Integer;
begin
t := RunGrammar(ATestName, ATextLine, p, AStartPatternIndex);
DebugLn(['--- Line: ''', ATextLine, ' // ',ATestName]);
DebugLn(['Expect: ''', Expect, '''']);
DebugLn([' GOT: ''', t, '''']);
AssertEquals(ATestName+' Result', Expect, t);
t := RunGrammar(ATestName, ATextLine, Result, AStartPatternIndex);
AssertEquals(ATestName+' Result', Expect, t); // run twice // no interaction between runs
AssertEquals(ATestName+' LastId', PtrUInt(p), PtrUInt(Result));
d := FGrammar.CurrentState.StateIdx;
RunNextToEol(ATestName, ATextLine, LastIdx, AStartPatternIndex);
AssertEquals(ATestName+' NextToEol LastId', PtrUInt(p), PtrUInt(LastIdx));
AssertEquals(ATestName+' NextToEol StateIdx', d, FGrammar.CurrentState.StateIdx);
t := RunGrammar(ATestName, ATextLine, Result, AStartPatternIndex);
AssertEquals(ATestName+' Result', Expect, t); // run twice // no interaction between runs
AssertEquals(ATestName+' LastId', PtrUInt(p), PtrUInt(Result));
end;
function TTestTextMateGrammar.TestLine(ATestName, ATextLine, Expect: String;
AStartPatternName: String): Integer;
var
AStartPattern: TTextMatePattern;
i: Integer;
begin
AStartPattern := nil;
for i := 0 to FGrammar.MainPatternList.Count - 1 do
if (FGrammar.MainPatternList[i] is TTextMatePatternBaseNested) and
(TTextMatePatternBaseNested(FGrammar.MainPatternList[i]).Name = AStartPatternName)
then begin
AStartPattern := FGrammar.MainPatternList[i];
break;
end;
AssertTrue(ATestName+': Found AStartPattern', AStartPattern <> nil);
Result := TestLine(ATestName, ATextLine, Expect, AStartPattern.Index);
end;
procedure TTestTextMateGrammar.SetUp;
begin
inherited SetUp;
FGrammar := TTextMateGrammar.Create;
FGrammar.OnPopulateAttributeInfo := @DoPopulateAttributeInfo;
FGrammar.OnCheckAttributeInfo := @DoCheckAttributeInfo;
FNames := TStringList.Create;
end;
procedure TTestTextMateGrammar.TearDown;
begin
inherited TearDown;
FGrammar.Free;
FNames.Free;
end;
procedure TTestTextMateGrammar.TestFlatNested;
begin
SetGrammar([GetTestA1(False, [ GetTestNest( [GetTestC1([]) ] ),
GetTestNest( [GetTestC1([]), GetTestB1(False, False, []) ] ),
Include('X1')
])
],
[ 'X1', GetTestNest( [GetTestC1([]), GetTestB1(False, False, []) ] )
]);
AssertEquals('no error', FGrammar.ParserError, '');
SetGrammar([Include('X1')
],
[ 'X1', GetTestNest( [GetTestC1([]), Include('X1')] )
]);
AssertFalse('got error', FGrammar.ParserError = '');
SetGrammar([Include('X1')
],
[ 'X1', GetTestNest( [Include('X1')] )
]);
AssertFalse('got error', FGrammar.ParserError = '');
SetGrammar([Include('X1')
],
[ 'X1', GetTestNest( [Include('Y1')] ),
'Y1', GetTestNest( [Include('X1')] )
]);
AssertFalse('got error', FGrammar.ParserError = '');
SetGrammar([Include('X1')
],
[ 'X1', GetTestNest( [GetTestC1([]), Include('Y1')] ),
'Y1', GetTestNest( [GetTestC1([]), Include('X1')] )
]);
AssertFalse('got error', FGrammar.ParserError = '');
end;
procedure TTestTextMateGrammar.TestBeginEnd;
procedure TestNoCtxName;
begin
TestLine('simple', 'a<a1>b</a1>c', '1:-,2:a1,12:-/root/0');
TestLine('Repeat', 'a<a1>b</a1>c<a1>d</a1>e', '1:-,2:a1,12:-,13:a1,23:-/root/0'); // repeat
TestLine('No Gap', 'a<a1>b</a1><a1>d</a1>e', '1:-,2:a1,12:a1,22:-/root/0'); // repeat, no gap
TestLine('At EOL/BOL', '<a1>b</a1>', '1:a1/root/0'); // line start/end
TestLine('immediate End', 'a<a1></a1>c', '1:-,2:a1,11:-/root/0'); // empty
TestLine('M-L ', 'a<a1>b', '1:-,2:a1/a1/1'); // multilnie
TestLine('M-L ', 'b', '1:a1/a1/1', 'a1');
TestLine('M-L ', 'b</a1>c', '1:a1,7:-/root/0', 'a1');
TestLine('M-L ', 'a<a1>', '1:-,2:a1/a1/1'); // multilnie bounds
TestLine('M-L ', 'b', '1:a1/a1/1', 'a1');
TestLine('M-L ', '</a1>c', '1:a1,6:-/root/0', 'a1');
TestLine('no foo in match', 'a<a1 foo>b</a1 foo>c', '1:-,2:a1,20:-/root/0');
TestLine('pattern', 'a<a1> foo </a1>c', '1:-,2:a1,7:a1.foo,10:a1,16:-/root/0'); // pattern
TestLine('pattern no-space', 'a<a1>foo</a1>c', '1:-,2:a1,6:a1.foo,9:a1,14:-/root/0'); // pattern no space
TestLine('pattern twice', 'a<a1> foo foo </a1>c', '1:-,2:a1,7:a1.foo,10:a1,11:a1.foo,14:a1,20:-/root/0'); // pattern / twice
TestLine('pattern twice-s', 'a<a1>foo foo</a1>c', '1:-,2:a1,6:a1.foo,9:a1,10:a1.foo,13:a1,18:-/root/0'); // pattern no space / twice
TestLine('pattern twice-sg', 'a<a1>foofoo</a1>c', '1:-,2:a1,6:a1.foo,9:a1.foo,12:a1,17:-/root/0'); // pattern no space / twice / no gap
TestLine('M-L pattern', 'a<a1>foo', '1:-,2:a1,6:a1.foo/a1/1'); // multilnie pattern
TestLine('M-L pattern', 'foo', '1:a1.foo/a1/1', 'a1');
TestLine('M-L pattern', ' foofoo', '1:a1,2:a1.foo,5:a1.foo/a1/1', 'a1');
TestLine('M-L pattern', 'foo</a1>foo', '1:a1.foo,4:a1,9:-/root/0', 'a1');
TestLine('B', '<a1> [b1] [/b1] </a1>', '1:a1,6:b1,16:a1/root/0'); // pattern B
TestLine('B', '<a1> [b1]foo[/b1] </a1>', '1:a1,6:b1,18:a1/root/0'); // pattern B / no foo
TestLine('B', '<a1> [b1]bar end[/b1] </a1>', '1:a1,6:b1,10:b1.bar,17:b1,22:a1/root/0'); // pattern B / bar end
TestLine('B', '<a1> [b1]bar[/b1]end[/b1] </a1>', '1:a1,6:b1,10:b1.bar,21:b1,26:a1/root/0'); // pattern B / bar end overlap
TestLine('B', '<a1> [b1] </a1> [/b1] </a1>', '1:a1,6:b1,22:a1/root/0'); // pattern B overlap
TestLine('B', '<a1>[b1]</a1>[/b1]</a1>', '1:a1,5:b1,19:a1/root/0'); // pattern B overlap no space
TestLine('', '<a1>', '1:a1/a1/1'); // multiline
TestLine('', '[b1]', '1:b1/b1/2', 'a1');
TestLine('', 'foo', '1:b1/b1/2', 'b1');
TestLine('', 'nest<a1>[/b1]</a1>back', '1:b1.nest,5:a1,19:b1.nest/b1/2', 'b1');
TestLine('', 'B[/b1]bar end', '1:b1,7:a1/a1/1', 'b1');
TestLine('', 'foo</a1>foo', '1:a1.foo,4:a1,9:-/root/0', 'a1'); // pattern B / no foo // A foo
TestLine('', 'a<a1 A-A> foo </a1 A-A>c', '1:-,2:a1,11:a1.foo,14:a1,24:-/root/0');
TestLine('', 'a<a1 Axnn-A> foo </a1 xnn-A>c', '1:-,2:a1,14:a1.foo,17:a1,29:-/root/0');
TestLine('', 'a<a1 nnyA-A> foo </a1 A-nny>c', '1:-,2:a1,14:a1.foo,17:a1,29:-/root/0');
TestLine('', 'a<a1 Az-A> foo </a1 A-zA>c', '1:-,2:a1,12:a1.foo,15:a1,26:-/root/0');
TestLine('', 'a<a1 A-xnnA> foo </a1 A-Axnn>c', '1:-,2:a1,14:a1.foo,17:a1,30:-/root/0');
TestLine('', 'a<a1 A-Anny> foo </a1 A-nnyA>c', '1:-,2:a1,14:a1.foo,17:a1,30:-/root/0');
TestLine('', 'a<a1 A-z> foo </a1 A-z>c', '1:-,2:a1,11:a1.foo,14:a1,24:-/root/0');
TestLine('', 'a<a1-y> foo </a1-A>c', '1:-,2:a1,9:a1.foo,12:a1,20:-/root/0');
TestLine('', 'a<a1-> foo </a1->c', '1:-,2:a1,8:a1.foo,11:a1,18:-/root/0');
end;
begin
SetGrammar(
[ GetTestA1(False,
[ GetTestA1Foo,
GetTestB1(False, False,
[ GetTestB1Bar([]),
GetTestB1Nest([ GetTestA1(False, []) ])
])
])
],
[]
);
TestNoCtxName;
SetGrammar(
[ Include('RepoA1')
],
[ 'RepoA1', GetTestA1(False,
[ GetTestA1Foo,
GetTestB1(False, False,
[ GetTestB1Bar([]),
GetTestB1Nest([ GetTestA1(False, []) ])
])
])
]
);
TestNoCtxName;
SetGrammar(
[ Include('RepoA1')
],
[ 'RepoA1', GetTestA1(False,
[ GetTestA1Foo,
Include('RepoB1')
]),
'RepoB1', GetTestB1(False, False,
[ GetTestB1Bar([]),
GetTestB1Nest([ Include('RepoA1Sub') ])
]),
'RepoA1Sub', GetTestA1(False, [])
]
);
TestNoCtxName;
// With Content name
SetGrammar(
[ GetTestA1(True,
[ GetTestA1Foo,
GetTestB1(False, False,
[ GetTestB1Bar([]),
GetTestB1Nest([ GetTestA1(False, []) ])
])
])
],
[]
);
TestLine('simple', 'a<a1>b</a1>c', '1:-,2:a1,6:a1.c,7:a1,12:-/root/0');
TestLine('Repeat', 'a<a1>b</a1>c<a1>d</a1>e', '1:-,2:a1,6:a1.c,7:a1,12:-,13:a1,17:a1.c,18:a1,23:-/root/0'); // repeat
TestLine('immediate End', 'a<a1></a1>c', '1:-,2:a1,11:-/root/0'); // empty
TestLine('M-L ', 'a<a1>b', '1:-,2:a1,6:a1.c/a1/1'); // multilnie
TestLine('M-L ', 'b', '1:a1.c/a1/1', 'a1');
TestLine('M-L ', 'b</a1>c', '1:a1.c,2:a1,7:-/root/0', 'a1');
TestLine('M-L ', 'a<a1>', '1:-,2:a1/a1/1'); // multilnie bounds
TestLine('M-L ', 'b', '1:a1.c/a1/1', 'a1');
TestLine('M-L ', '</a1>c', '1:a1,6:-/root/0', 'a1');
TestLine('no foo in match', 'a<a1 foo>b</a1 foo>c', '1:-,2:a1,10:a1.c,11:a1,20:-/root/0');
TestLine('pattern', 'a<a1> foo </a1>c', '1:-,2:a1,6:a1.c,7:a1.foo,10:a1.c,11:a1,16:-/root/0'); // pattern
TestLine('pattern no-space', 'a<a1>foo</a1>c', '1:-,2:a1,6:a1.foo,9:a1,14:-/root/0'); // pattern no space
TestLine('pattern twice', 'a<a1> foo foo </a1>c', '1:-,2:a1,6:a1.c,7:a1.foo,10:a1.c,11:a1.foo,14:a1.c,15:a1,20:-/root/0'); // pattern / twice
TestLine('pattern twice-s', 'a<a1>foo foo</a1>c', '1:-,2:a1,6:a1.foo,9:a1.c,10:a1.foo,13:a1,18:-/root/0'); // pattern no space / twice
TestLine('pattern twice-sg', 'a<a1>foofoo</a1>c', '1:-,2:a1,6:a1.foo,9:a1.foo,12:a1,17:-/root/0'); // pattern no space / twice / no gap
TestLine('M-L pattern', 'a<a1>foo', '1:-,2:a1,6:a1.foo/a1/1'); // multilnie pattern
TestLine('M-L pattern', 'foo', '1:a1.foo/a1/1', 'a1');
TestLine('M-L pattern', ' foofoo', '1:a1.c,2:a1.foo,5:a1.foo/a1/1', 'a1');
TestLine('M-L pattern', 'foo</a1>foo', '1:a1.foo,4:a1,9:-/root/0', 'a1');
// capture at end
SetGrammar(
[ GetTestA1(False, [], [c6], [],
[], [], [], [],
[])
],
[]
);
TestLine('capt at end', '<a1>b</a1>', '1:a1,10:a1.e6/root/0');
// capture at end
SetGrammar(
[ GetTestA1(False, [c6], [c6], [],
[], [], [], [],
[])
],
[]
);
TestLine('capt at end', '<a1>', '1:a1,4:a1.b6/a1/1');
// capture at end
SetGrammar(
[ GetTestA1(False, [], [c5,c6], [],
[], [], [], [GetTestB1(False, False, [])],
[])
],
[]
);
TestLine('capt at end', '<a1>b</a1-M[b1]>', '1:a1,12:b1,16:a1.e6/root/0');
end;
procedure TTestTextMateGrammar.TestBeginEndInCapture;
begin
SetGrammar(
[ GetTestM1([ GetTestA1(False, [ GetTestA1Foo ] ) ])
],
[]
);
TestLine('M1', 'a==><a1>b</a1>c', '1:-,2:m1,5:a1,15:m1c/root/0');
TestLine('M1', 'a==><a1>b!c', '1:-,2:m1,5:a1,10:m1/root/0'); // "a1" did return to m1
TestLine('M1', 'a==><a1>b', '1:-,2:m1,5:a1/root/0'); // "a1" and "m1" did return
end;
procedure TTestTextMateGrammar.TestWhile;
var
p: Integer;
begin
SetGrammar(
[ GetTestW1([])
],
[]
);
p := TestLine('M1', 'a', '1:-/root/0');
p := TestLine('M1', 'w', '1:-/root/0', p);
p := TestLine('M1', '_W', '1:-,2:w1/w1/1', p);
p := TestLine('M1', 'w', '1:w1/w1/1', p);
p := TestLine('M1', '_w', '1:w1/w1/1', p);
p := TestLine('M1', 'a', '1:-/root/0', p);
p := TestLine('M1', 'w', '1:-/root/0', p);
end;
procedure TTestTextMateGrammar.TestForwarder;
var
p: Integer;
begin
SetGrammar(
[ Include('RepoA1'), Include('RepoB1'), Include('RepoC1')
],
[ 'RepoA1', GetTestA1(False, [ GetTestA1Foo ] ),
'RepoB1', GetTestB1(False, False,
[ GetTestB1Bar([]),
Include('RepoB1Nest')
]),
'RepoC1', GetTestC1(
[ Include('RepoB1'),
Include('RepoB1Nest'),
GetTestB1Nest([ Include('RepoA1Dup') ])
]),
'RepoA1Dup', GetTestA1(True, [ Include('RepoA1'), Include('RepoB1') ] ),
'RepoB1Nest', GetTestB1Nest([ Include('RepoA1') ])
]
);
TestLine('A1', 'a<a1>b</a1>c', '1:-,2:a1,12:-/root/0');
p := TestLine('A1 M-L ', 'a<a1>b', '1:-,2:a1/a1/1');
p := TestLine('A1 M-L ', 'bfoob', '1:a1,2:a1.foo,5:a1/a1/1', p);
p := TestLine('A1 M-L ', 'b</a1>c', '1:a1,7:-/root/0', p);
TestLine('B1 A1', 'a[b1]foo nest foo<a1>nest foo back</a1>bar back bar <a1> end[/b1]nest foo back',
'1:-,2:b1,10:b1.nest,18:a1,27:a1.foo,30:a1,40:b1.nest,48:b1,49:b1.bar,61:b1,66:-/root/0');
p := TestLine('M-L B1 A1', 'a', '1:-/root/0');
p := TestLine('M-L B1 A1', '[b1]', '1:b1/b1/1', p);
p := TestLine('M-L B1 A1', 'foo', '1:b1/b1/1', p);
p := TestLine('M-L B1 A1', 'nest', '1:b1.nest/b1.nest/2', p);
p := TestLine('M-L B1 A1', 'foo', '1:b1.nest/b1.nest/2', p);
p := TestLine('M-L B1 A1', '<a1>', '1:a1/a1/3', p);
p := TestLine('M-L B1 A1', 'nest foo', '1:a1,6:a1.foo/a1/3', p);
p := TestLine('M-L B1 A1', 'back', '1:a1/a1/3', p);
p := TestLine('M-L B1 A1', '</a1>', '1:a1/b1.nest/2', p);
p := TestLine('M-L B1 A1', 'x<a1>', '1:b1.nest,2:a1/a1/3', p);
p := TestLine('M-L B1 A1', 'x</a1>x', '1:a1,7:b1.nest/b1.nest/2', p);
p := TestLine('M-L B1 A1', 'bar', '1:b1.nest/b1.nest/2', p);
p := TestLine('M-L B1 A1', 'back', '1:b1.nest/b1/1', p);
p := TestLine('M-L B1 A1', 'bar <a1> end', '1:b1.bar/b1/1', p);
p := TestLine('M-L B1 A1', '[/b1]bar foo end', '1:b1,6:-/root/0', p);
// Get to B1Nest via all the diff paths:
// B1 -> B1Nest -> A1
// C1 -> B1Nest -> A1
// C1 -> B1 -> B1Nest -> A1
p := TestLine('M-L B1 A1', '[b1]', '1:b1/b1/1');
p := TestLine('M-L B1 A1', 'nest', '1:b1.nest/b1.nest/2', p);
p := TestLine('M-L B1 A1', '<a1>', '1:a1/a1/3', p);
p := TestLine('M-L B1 A1', '</a1>', '1:a1/b1.nest/2', p);
p := TestLine('M-L B1 A1', 'back', '1:b1.nest/b1/1', p);
p := TestLine('M-L B1 A1', '[/b1]', '1:b1/root/0', p);
p := TestLine('M-L B1 A1', '<c1>', '1:c1/c1/1');
p := TestLine('M-L B1 A1', 'nest', '1:b1.nest/b1.nest/2', p);
p := TestLine('M-L B1 A1', '<a1>', '1:a1/a1/3', p);
p := TestLine('M-L B1 A1', '</a1>', '1:a1/b1.nest/2', p);
p := TestLine('M-L B1 A1', 'back', '1:b1.nest/c1/1', p);
p := TestLine('M-L B1 A1', '</c1>', '1:c1/root/0', p);
p := TestLine('M-L B1 A1', '<c1>', '1:c1/c1/1');
p := TestLine('M-L B1 A1', '[b1]', '1:b1/b1/2', p);
p := TestLine('M-L B1 A1', 'nest', '1:b1.nest/b1.nest/3', p);
p := TestLine('M-L B1 A1', '<a1>', '1:a1/a1/4', p);
p := TestLine('M-L B1 A1', '</a1>', '1:a1/b1.nest/3', p);
p := TestLine('M-L B1 A1', 'back', '1:b1.nest/b1/2', p);
p := TestLine('M-L B1 A1', '[/b1]', '1:b1/c1/1', p);
p := TestLine('M-L B1 A1', '</c1>', '1:c1/root/0', p);
end;
procedure TTestTextMateGrammar.TestRecurse;
var
p, p1, p2, p3, p4, p5, p6, p7, p8, p9, pa, pb, pc, pd, pe, pf, pg: Integer;
begin
SetGrammar(
[ Include('RepoA1')
],
[ 'RepoA1', GetTestA1(True, [ Include('RepoB1') ] ),
'RepoB1', GetTestB1(True, False, [ Include('RepoC1') ]),
'RepoC1', GetTestC1([ Include('RepoA1') ])
]
);
p1 := TestLine('A1 M-L ', 'a<a1>b', '1:-,2:a1,6:a1.c/a1/1');
p2 := TestLine('A1 M-L ', 'a[b1]b', '1:a1.c,2:b1,6:b1.c/b1/2', p1);
p3 := TestLine('A1 M-L ', 'a<c1>b', '1:b1.c,2:c1/c1/3', p2);
p4 := TestLine('A1 M-L ', 'a<a1>b', '1:c1,2:a1,6:a1.c/a1/4', p3);
p5 := TestLine('A1 M-L ', 'a<a1>b', '1:a1.c/a1/4', p4);
AssertEquals(p4,p5);
p6 := TestLine('A1 M-L ', 'a<c1>b', '1:a1.c/a1/4', p5);
AssertEquals(p4,p6);
p7 := TestLine('A1 M-L ', 'a[b1]b', '1:a1.c,2:b1,6:b1.c/b1/5', p6);
p8 := TestLine('A1 M-L ', 'a<c1>b', '1:b1.c,2:c1/c1/6', p7);
p9 := TestLine('A1 M-L ', 'a<a1>b', '1:c1,2:a1,6:a1.c/a1/7', p8);
pa := TestLine('A1 M-L ', 'a</a1>b', '1:a1.c,2:a1,7:c1/c1/6', p9);
pb := TestLine('A1 M-L ', 'a</c1>b', '1:c1,7:b1.c/b1/5', pa);
pc := TestLine('A1 M-L ', 'a[/b1]b', '1:b1.c,2:b1,7:a1.c/a1/4', pb);
pd := TestLine('A1 M-L ', 'a</a1>b', '1:a1.c,2:a1,7:c1/c1/3', pc);
pe := TestLine('A1 M-L ', 'a</c1>b', '1:c1,7:b1.c/b1/2', pd);
pf := TestLine('A1 M-L ', 'a[/b1]b', '1:b1.c,2:b1,7:a1.c/a1/1', pe);
pg := TestLine('A1 M-L ', 'a</a1>b', '1:a1.c,2:a1,7:-/root/0', pf);
AssertEquals(p1,pf);
AssertEquals(p2,pe);
AssertEquals(p3,pd);
AssertEquals(p4,pc);
AssertEquals(p7,pb);
AssertEquals(p8,pa);
p := TestLine('A1 M-L ', 'a<a1>b', '1:-,2:a1,6:a1.c/a1/1');
AssertEquals(p1,p);
p := TestLine('A1 M-L ', 'a[b1]b', '1:a1.c,2:b1,6:b1.c/b1/2', p);
AssertEquals(p2,p);
p := TestLine('A1 M-L ', 'a<c1>b', '1:b1.c,2:c1/c1/3', p);
AssertEquals(p3,p);
p := TestLine('A1 M-L ', 'a<a1>b', '1:c1,2:a1,6:a1.c/a1/4', p);
AssertEquals(p4,p);
p := TestLine('A1 M-L ', 'a<a1>b', '1:a1.c/a1/4', p);
AssertEquals(p5,p);
p := TestLine('A1 M-L ', 'a<c1>b', '1:a1.c/a1/4', p);
AssertEquals(p6,p);
p := TestLine('A1 M-L ', 'a[b1]b', '1:a1.c,2:b1,6:b1.c/b1/5', p);
AssertEquals(p7,p);
p := TestLine('A1 M-L ', 'a<c1>b', '1:b1.c,2:c1/c1/6', p);
AssertEquals(p8,p);
p := TestLine('A1 M-L ', 'a<a1>b', '1:c1,2:a1,6:a1.c/a1/7', p);
AssertEquals(p9,p);
p := TestLine('A1 M-L ', 'a</a1>b', '1:a1.c,2:a1,7:c1/c1/6', p);
AssertEquals(pa,p);
p := TestLine('A1 M-L ', 'a</c1>b', '1:c1,7:b1.c/b1/5', p);
AssertEquals(pb,p);
p := TestLine('A1 M-L ', 'a[/b1]b', '1:b1.c,2:b1,7:a1.c/a1/4', p);
AssertEquals(pc,p);
p := TestLine('A1 M-L ', 'a</a1>b', '1:a1.c,2:a1,7:c1/c1/3', p);
AssertEquals(pd,p);
p := TestLine('A1 M-L ', 'a</c1>b', '1:c1,7:b1.c/b1/2', p);
AssertEquals(pe,p);
p := TestLine('A1 M-L ', 'a[/b1]b', '1:b1.c,2:b1,7:a1.c/a1/1', p);
AssertEquals(pf,p);
p := TestLine('A1 M-L ', 'a</a1>b', '1:a1.c,2:a1,7:-/root/0', p);
AssertEquals(pg,p);
SetGrammar(
[ Include('RepoA1')
],
[ 'RepoA1', GetTestA1(True, [ Include('RepoB1') ] ),
'RepoB1', GetTestB1(False, False, [ Include('RepoC1'), Include('RepoB1Nest') ]),
'RepoC1', GetTestC1([ Include('RepoA1') ]),
'RepoB1Nest', GetTestB1Nest([ Include('RepoA1') ])
]
);
SetGrammar(
[ Include('RepoA1')
],
[ 'RepoA1', GetTestA1(True, [ Include('RepoB1') ] ),
'RepoB1', GetTestB1(False, False, [ Include('RepoC1'), Include('RepoB1Nest') ]),
'RepoC1', GetTestC1([ Include('RepoA1') ]),
'RepoB1Nest', GetTestB1Nest([ Include('RepoB1') ])
]
);
SetGrammar(
[ Include('RepoA1')
],
[ 'RepoA1', GetTestA1(True, [ Include('RepoA1') ] )
]
);
TestLine('A1', 'a<a1>c<a1>b</a1>c</a1>c', '1:-,2:a1,6:a1.c,7:a1,11:a1.c,12:a1,17:a1.c,18:a1,23:-/root/0');
p := TestLine('A1 M-L ', 'a<a1>b', '1:-,2:a1,6:a1.c/a1/1');
p := TestLine('A1 M-L ', 'a<a1>b', '1:a1.c,2:a1,6:a1.c/a1/2', p);
p := TestLine('A1 M-L ', 'a</a1>b', '1:a1.c,2:a1,7:a1.c/a1/1', p);
SetGrammar(
[ Include('RepoA1'), Include('RepoB1')
],
[ 'RepoA1', GetTestA1(True, [ Include('RepoB1') ] ),
'RepoB1', GetTestB1(False, False, [ Include('RepoA1') ])
]
);
SetGrammar(
[ Include('RepoA1'), Include('RepoB1'), Include('RepoC1')
],
[ 'RepoA1', GetTestA1(False, [ GetTestA1Foo,
Include('RepoB1')
] ),
'RepoB1', GetTestB1(False, False,
[ GetTestB1Bar([]),
Include('RepoB1Nest'),
Include('RepoC1')
]),
'RepoC1', GetTestC1(
[ Include('RepoB1'),
Include('RepoB1Nest'),
GetTestB1Nest([ Include('RepoA1Dup') ])
]),
'RepoA1Dup', GetTestA1(True, [ Include('RepoA1'), Include('RepoB1') ] ),
'RepoB1Nest', GetTestB1Nest([ Include('RepoA1') ])
]
);
end;
procedure TTestTextMateGrammar.TestVarious;
var
p: Integer;
begin
SetGrammar(
[ '{ "name": "t1", "begin": "(^[ \\t]+)?(?=//)", "end": "(?!\\G)" ' +
BuildPatterns(['{ "name": "t2", "begin": "//", "end": "$" }']) +
'}'
],
[]
);
p := TestLine('t1', ' // abc', '1:t1,3:t2/t1/1');
p := TestLine('t1', '', '1:t1/t1/1', p);
FGrammar.SetLine(' // abc', -1);
FGrammar.NextToEol;
FGrammar.SetLine('', FGrammar.CurrentPatternIndex);
FGrammar.NextToEol;
SetGrammar(
[ '{ "name": "t1", "begin": "(^[ \\t]+)?(?=//)", "end": "(?!\\G)", "beginCaptures": { "1": { "name": "t1.c" } } ' +
BuildPatterns(['{ "name": "t2", "begin": "//", "end": "$" }']) +
'}'
],
[]
);
p := TestLine('t1', ' // abc', '1:t1.c,3:t2/t1/1');
p := TestLine('t1', '', '1:t1/t1/1', p);
FGrammar.SetLine(' // abc', -1);
FGrammar.NextToEol;
FGrammar.SetLine('', FGrammar.CurrentPatternIndex);
FGrammar.NextToEol;
end;
initialization
RegisterTest(TTestTextMateGrammar);
end.

2294
components/lazedit/textmategrammar.pas Normal file
View File

File diff suppressed because it is too large Load Diff

167
components/lazedit/xHyperLinksDecorator.pas Normal file
View File

@ -0,0 +1,167 @@
{$B-}
unit xHyperLinksDecorator;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
{
Functions to 'decorate' hyper-links
(search for URLs and e-mails and replace
them with appropriate HTML-links).
Uses TRegExpr library.
(c) 2002 Andrey V. Sorokin, Saint Petersburg, Russia
https://sorokin.engineer/
andrey@sorokin.engineer
v. 0.101 2002.08.30
-=- (-) Missed closing tag </a>
Note:
This functions have to be optimized - they construct result strings
with step by step concatenation that can take a lot of resources while
processing big input texts with many hyper links.
}
interface
uses
regexpr;
type
TDecorateURLsFlags = (
// describes, which parts of hyper-link must be included
// into VISIBLE part of the link:
durlProto, // Protocol (like 'ftp://' or 'http://')
durlAddr, // TCP address or domain name (like 'sorokin.engineer')
durlPort, // Port number if specified (like ':8080')
durlPath, // Path to document (like 'index.html')
durlBMark, // Book mark (like '#mark')
durlParam // URL params (like '?ID=2&User=13')
);
TDecorateURLsFlagSet = set of TDecorateURLsFlags;
function DecorateURLs (
// can find hyper links like 'http://...' or 'ftp://..'
// as well as links without protocol, but start with 'www.'
const AText : string;
// Input text to find hyper-links
AFlags : TDecorateURLsFlagSet = [durlAddr, durlPath]
// Which part of hyper-links found must be included into visible
// part of URL, for example if [durlAddr] then hyper link
// 'https://sorokin.engineer/en/index.html' will be decorated as
// '<a href="https://sorokin.engineer/en/index.html">https://sorokin.engineer</a>'
) : string;
// Returns input text with decorated hyper links
function DecorateEMails (
// Replaces all syntax correct e-mails
// with '<a href="mailto:ADDR">ADDR</a>'
// For example, replaces 'anso@mail.ru'
// with '<a href="mailto:anso@mail.ru">anso@mail.ru</a>'.
const AText : string
// Input text to find e-mails
) : string;
// Returns input text with decorated e-mails
implementation
uses
SysUtils; // we are using AnsiCompareText
function DecorateURLs (const AText : string;
AFlags : TDecorateURLsFlagSet = [durlAddr, durlPath]
) : string;
const
URLTemplate =
'(?i)'
+ '('
+ '(FTP|HTTP)://' // Protocol
+ '|www\.)' // trick to catch links without
// protocol - by detecting of starting 'www.'
+ '([\w\d\-]+(\.[\w\d\-]+)+)' // TCP addr or domain name
+ '(:\d\d?\d?\d?\d?)?' // port number
+ '(((/[%+\w\d\-\\\.]*)+)*)' // unix path
+ '(\?[^\s=&]+=[^\s=&]+(&[^\s=&]+=[^\s=&]+)*)?'
// request (GET) params
+ '(#[\w\d\-%+]+)?'; // bookmark
var
PrevPos : integer;
s, Proto, Addr, HRef : string;
begin
Result := '';
PrevPos := 1;
with TRegExpr.Create do try
Expression := URLTemplate;
if Exec (AText) then
REPEAT
s := '';
if AnsiCompareText (Match [1], 'www.') = 0 then begin
Proto := 'http://';
Addr := Match [1] + Match [3];
HRef := Proto + Match [0];
end
else begin
Proto := Match [1];
Addr := Match [3];
HRef := Match [0];
end;
if durlProto in AFlags
then s := s + Proto;
if durlAddr in AFlags
then s := s + Addr;
if durlPort in AFlags
then s := s + Match [5];
if durlPath in AFlags
then s := s + Match [6];
if durlParam in AFlags
then s := s + Match [9];
if durlBMark in AFlags
then s := s + Match [11];
Result := Result + System.Copy (AText, PrevPos,
MatchPos [0] - PrevPos) + '<a href="' + HRef + '">' + s + '</a>'; //###0.101
PrevPos := MatchPos [0] + MatchLen [0];
UNTIL not ExecNext;
Result := Result + System.Copy (AText, PrevPos, MaxInt); // Tail
finally Free;
end;
end; { of function DecorateURLs
--------------------------------------------------------------}
function DecorateEMails (const AText : string) : string;
const
MailTemplate =
'[_a-zA-Z\d\-\.]+@[_a-zA-Z\d\-]+(\.[_a-zA-Z\d\-]+)+';
var
PrevPos : integer;
begin
Result := '';
PrevPos := 1;
with TRegExpr.Create do try
Expression := MailTemplate;
if Exec (AText) then
REPEAT
Result := Result + System.Copy (AText, PrevPos,
MatchPos [0] - PrevPos) + '<a href="mailto:' + Match [0] + '">' + Match [0] + '</a>';
PrevPos := MatchPos [0] + MatchLen [0];
UNTIL not ExecNext;
Result := Result + System.Copy (AText, PrevPos, MaxInt); // Tail
finally Free;
end;
end; { of function DecorateEMails
--------------------------------------------------------------}
end.

7607
components/lazedit/xregexpr.pas Normal file
View File

File diff suppressed because it is too large Load Diff

196632
components/lazedit/xregexpr_unicodedata.pas Normal file
View File

File diff suppressed because it is too large Load Diff

4
components/lazutils/lazutils.lpk
View File

@ -334,6 +334,10 @@
<Filename Value="commoncodepages.inc"/>
<Type Value="Include"/>
</Item>
<Item>
<Filename Value="plist2json.pas"/>
<UnitName Value="plist2json"/>
</Item>
</Files>
<LazDoc Paths="../../docs/xml/lazutils"/>
<i18n>

3
components/lazutils/lazutils.pas
View File

@ -19,7 +19,8 @@ uses
LazPasReadUtil, LazStringUtils, LazSysUtils, LazTracer, LazUnicode,
LazUTF16, LazUTF8, LazUtilities, LazUtilsStrConsts, LazVersion,
LConvEncoding, LCSVUtils, LookupStringList, Maps, Masks, ObjectLists,
StringHashList, TextStrings, Translations, UTF8Process, LazarusPackageIntf;
StringHashList, TextStrings, Translations, UTF8Process, PList2JSon,
LazarusPackageIntf;
implementation

148
components/lazutils/plist2json.pas Normal file
View File

@ -0,0 +1,148 @@
unit PList2JSon;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Laz2_DOM, fpjson;
function PListXml2Json(AnXml: TXMLDocument): TJSONData;
implementation
function Xml2Json(AnNode: TDOMNode): TJSONData; forward;
function XmlDict2Json(AnNode: TDOMNode): TJSONData;
var
c, i: integer;
key: DOMString;
val: TJSONData;
keyNd: TDOMNode;
begin
c := AnNode.GetChildCount;
i := 0;
Result := CreateJSONObject([]);
while i < c do begin
keyNd := AnNode.ChildNodes[i];
if LowerCase(keyNd.NodeName) <> 'key' then
raise Exception.Create('Expected <key>, but got ' + keyNd.NodeName);
key := Trim(keyNd.TextContent);
inc(i);
if i = c then
raise Exception.Create('Expected value for key '+key);
val := Xml2Json(AnNode.ChildNodes[i]);
inc(i);
TJSONObject(Result).Add(key, val)
end;
end;
function XmlArray2Json(AnNode: TDOMNode): TJSONData;
var
CN: TDOMNode;
begin
Result := CreateJSONArray([]);
CN := AnNode.FirstChild;
while CN <> nil do begin
TJSONArray(Result).Add(Xml2Json(CN));
CN := CN.NextSibling;
end;
end;
function Xml2Json(AnNode: TDOMNode): TJSONData;
var
n: DOMString;
i64: int64;
f: Double;
b: Boolean;
d: TDateTime;
begin
n := LowerCase(AnNode.NodeName);
if (n = 'dict') or (n = 'dictionary') then begin
Result := XmlDict2Json(AnNode);
end
else
if n = 'array' then begin
Result := XmlArray2Json(AnNode);
end
else
if n = 'string' then begin
Result := CreateJSON(AnNode.TextContent);
end
else
if n = 'number' then begin
if TryStrToInt64(trim(AnNode.TextContent), i64) then begin
if (i64 >= low(integer)) and (i64 <= high(integer)) then
Result := CreateJSON(integer(i64))
else
Result := CreateJSON(i64);
end
else begin
if TryStrToFloat(trim(AnNode.TextContent), f) then
Result := CreateJSON(f)
else
raise Exception.Create('Unknown number '+AnNode.TextContent);
end;
end
else
if n = 'boolean' then begin
if TryStrToBool(trim(AnNode.TextContent), b) then
Result := CreateJSON(b)
else
raise Exception.Create('Unknown bool '+AnNode.TextContent);
end
else
if n = 'date' then begin
if TryStrToDate(trim(AnNode.TextContent), d) then
Result := CreateJSON(d)
else
raise Exception.Create('Unknown date'+AnNode.TextContent);
end
else
if n = 'data' then begin
raise Exception.Create('DATA not supported');
end
else
raise Exception.Create('Unknown key '+n);
end;
function PListXml2Json(AnXml: TXMLDocument): TJSONData;
var
CN: TDOMNode;
begin
Result := nil;
if AnXml = nil then
raise Exception.Create('Missing XML');
CN := AnXml.FirstChild;
if CN = nil then
raise Exception.Create('Missing XML content');
if CN is TDOMDocumentType then
CN := CN.NextSibling;
if LowerCase(CN.NodeName) <> 'plist' then
raise Exception.Create('Expected <plist> ');
if CN.NextSibling <> nil then
raise Exception.Create('Trailing extra data');
if CN.GetChildCount <> 1 then
raise Exception.Create('Expected <dict> or <array> ');
CN := CN.ChildNodes[0];
if (LowerCase(CN.NodeName) = 'dict') or (LowerCase(CN.NodeName) = 'dictionary') then
Result := XmlDict2Json(CN)
else
if LowerCase(CN.NodeName) = 'CN' then
Result := XmlArray2Json(AnXml)
else
raise Exception.Create('Expected <dict> or <array> ');
end;
end.

2
components/synedit/allsynedit.pas
View File

@ -33,7 +33,7 @@ uses
SynEditTextSystemCharWidth, SynEditMarkupIfDef, SynPluginMultiCaret,
synhighlighterpike, SynEditMarkupFoldColoring, SynEditViewedLineMap,
SynEditWrappedView, SynBeautifierPascal, LazSynIMMBase, SynPopupMenu,
SynEditTextDynTabExpander, LazarusPackageIntf;
SynEditTextDynTabExpander, SynTextMateSyn, LazarusPackageIntf;
implementation

7
components/synedit/synedit.lpk
View File

@ -415,6 +415,10 @@ If you wish to allow use of your version of these files only under the terms of
<Filename Value="synedit.inc"/>
<Type Value="Include"/>
</Item>
<Item>
<Filename Value="syntextmatesyn.pas"/>
<UnitName Value="SynTextMateSyn"/>
</Item>
</Files>
<LazDoc Paths="docs\xml"/>
<i18n>
@ -422,6 +426,9 @@ If you wish to allow use of your version of these files only under the terms of
<OutDir Value="languages"/>
</i18n>
<RequiredPkgs>
<Item>
<PackageName Value="LazEdit"/>
</Item>
<Item>
<PackageName Value="fcl-registry"/>
<DependencyType Value="FPMake"/>

9
components/synedit/synedithighlighter.pp
View File

@ -352,6 +352,7 @@ type
fDefaultFilter: string;
fUpdateChange: boolean; //mh 2001-09-13
FIsInNextToEOL: Boolean;
function GetInstanceLanguageName: string; virtual;
procedure AddAttribute(AAttrib: TSynHighlighterAttributes);
procedure FreeHighlighterAttributes; //mh 2001-09-13
function GetAttribCount: integer; virtual;
@ -383,6 +384,7 @@ type
property IsScanning: Boolean read FIsScanning;
property KnownRanges[Index: Integer]: TSynHighlighterRangeList read GetKnownRanges;
property KnownLines: TSynEditLinesList read FKnownLines;
property CurrentLineText: string read FLineText;
public
procedure DefHighlightChange(Sender: TObject);
property AttributeChangeNeedScan: Boolean read FAttributeChangeNeedScan;
@ -447,7 +449,7 @@ type
procedure UnhookAttrChangeEvent(ANotifyEvent: TNotifyEvent);
property IdentChars: TSynIdentChars read GetIdentChars;
property WordBreakChars: TSynIdentChars read fWordBreakChars write SetWordBreakChars;
property LanguageName: string read GetLanguageName;
property LanguageName: string read GetInstanceLanguageName;
public
property AttrCount: integer read GetAttribCount;
property Attribute[idx: integer]: TSynHighlighterAttributes read GetAttribute;
@ -1838,6 +1840,11 @@ begin
Result := TSynHighlighterRangeList(KnownLines[Index].Ranges[GetRangeIdentifier]);
end;
function TSynCustomHighlighter.GetInstanceLanguageName: string;
begin
Result := GetLanguageName;
end;
function TSynCustomHighlighter.GetDrawDivider(Index: integer): TSynDividerDrawConfigSetting;
begin
result := SynEmptyDividerDrawConfigSetting;

314
components/synedit/syntextmatesyn.pas Normal file
View File

@ -0,0 +1,314 @@
unit SynTextMateSyn;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fgl, Math,
jsonparser, jsonscanner, fpjson,
// LazUtils
LazFileUtils,
Laz2_XMLRead, PList2JSon, Laz2_DOM,
// LazEdit
TextMateGrammar,
// SynEdit
SynEditHighlighter, SynEditHighlighterFoldBase, SynEditTypes;
type
TNameAttributesMap = specialize TFPGMapObject<string, TSynHighlighterAttributes>;
TGrammarLoadEvent = procedure(AGrammarFile, AGrammarPath: String; out AGrammarDef: String);
{ TSynTextMateSyn }
TSynTextMateSyn = class(TSynCustomFoldHighlighter)
private
FGrammarPath: String;
FOnLoadGrammarFile: TGrammarLoadEvent;
FTextMateGrammar: TTextMateGrammar;
private
FAttriMap: TNameAttributesMap;
function LoadFile(AGrammarFile: String): String;
procedure SetGrammarPath(AValue: String);
function GetOrCreateAttribIdxForName(AName: String): integer;
procedure DoPopulateAttributeInfo(Sender: TTextMateGrammar; APattern: TTextMatePattern;
AContextName: String; var AnAttribInfo: TSynAttributeInfo);
procedure DoCheckAttributeInfo(Sender: TTextMatePattern;
const AnAttribInfo: TSynAttributeInfo; out AnUseId, AnUseObject: Boolean);
private
FCurrentRange: Integer;
FCurrentTokenPos, FCurrentTokenLen: Integer;
FCurrentTokenKind: integer;
FCurrentAttrib: TSynHighlighterAttributes;
function GetParserError: String;
protected
function GetInstanceLanguageName: string; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure LoadGrammar(AGrammarDef: String);
procedure LoadGrammar(AGrammarFile, AGrammarPath: String);
procedure SetLine(const NewValue: String; LineNumber: Integer); override;
procedure Next; override;
function GetEol: Boolean; override;
function GetToken: String; override;
procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override;
function GetTokenPos: Integer; override;
function GetTokenKind: integer; override;
function GetTokenAttribute: TSynHighlighterAttributes; override;
//
function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override;
procedure SetRange(Value: Pointer); override;
procedure ResetRange; override;
function GetRange: Pointer; override;
function FoldBlockOpeningCount(ALineIndex: TLineIdx; const AFilter: TSynFoldBlockFilter): integer; override; overload;
function FoldBlockClosingCount(ALineIndex: TLineIdx; const AFilter: TSynFoldBlockFilter): integer; override; overload;
function FoldBlockEndLevel(ALineIndex: TLineIdx; const AFilter: TSynFoldBlockFilter): integer; override; overload;
function FoldBlockMinLevel(ALineIndex: TLineIdx; const AFilter: TSynFoldBlockFilter): integer; override; overload;
function FoldBlockNestedTypes(ALineIndex: TLineIdx; ANestIndex: Integer;
out AType: Pointer; const AFilter: TSynFoldBlockFilter): boolean; override; overload;
property OnLoadGrammarFile: TGrammarLoadEvent read FOnLoadGrammarFile write FOnLoadGrammarFile;
property GrammarPath: String read FGrammarPath write SetGrammarPath;
property ParserError: String read GetParserError;
property TextMateGrammar: TTextMateGrammar read FTextMateGrammar;
end;
implementation
{ TSynTextMateSyn }
function TSynTextMateSyn.LoadFile(AGrammarFile: String): String;
var
s: TStringStream;
begin
if Assigned(FOnLoadGrammarFile) then begin
OnLoadGrammarFile(AGrammarFile, FGrammarPath, Result);
end
else begin
s := TStringStream.Create('');
try
s.LoadFromFile(FGrammarPath + AGrammarFile);
Result := s.DataString;
finally
s.Free;
end;
end;
end;
procedure TSynTextMateSyn.SetGrammarPath(AValue: String);
begin
if FGrammarPath = AValue then Exit;
if AValue <> '' then
AppendPathDelim(AValue);
FGrammarPath := AValue;
end;
function TSynTextMateSyn.GetOrCreateAttribIdxForName(AName: String): integer;
var
attr: TSynHighlighterAttributes;
begin
if AName = '' then
exit(-1);
Result := FAttriMap.IndexOf(AName);
if Result >= 0 then
exit;
attr := TSynHighlighterAttributes.Create(AName, AName);
AddAttribute(attr);
Result := FAttriMap.Add(AName, attr);
end;
function TSynTextMateSyn.GetInstanceLanguageName: string;
begin
Result := FTextMateGrammar.LanguageName;
end;
procedure TSynTextMateSyn.DoPopulateAttributeInfo(
Sender: TTextMateGrammar; APattern: TTextMatePattern;
AContextName: String; var AnAttribInfo: TSynAttributeInfo);
begin
AnAttribInfo.TokId := GetOrCreateAttribIdxForName(AContextName);
if AnAttribInfo.TokId < 0 then
AnAttribInfo.TokObject := nil
else
AnAttribInfo.TokObject := FAttriMap.Data[AnAttribInfo.TokId];
end;
procedure TSynTextMateSyn.DoCheckAttributeInfo(Sender: TTextMatePattern;
const AnAttribInfo: TSynAttributeInfo; out AnUseId, AnUseObject: Boolean);
begin
AnUseId := AnAttribInfo.TokId >= 0;
AnUseObject := (AnAttribInfo.TokObject <> nil) and
(TSynHighlighterAttributes(AnAttribInfo.TokObject).IsEnabled);
end;
function TSynTextMateSyn.GetParserError: String;
begin
Result := FTextMateGrammar.ParserError;
end;
constructor TSynTextMateSyn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAttriMap := TNameAttributesMap.Create(False);
FTextMateGrammar := TTextMateGrammar.Create;
FTextMateGrammar.OnPopulateAttributeInfo := @DoPopulateAttributeInfo;
FTextMateGrammar.OnCheckAttributeInfo := @DoCheckAttributeInfo;
end;
destructor TSynTextMateSyn.Destroy;
begin
FTextMateGrammar.ClearGrammar;
FTextMateGrammar.Free;
FreeHighlighterAttributes;
FAttriMap.Clear;
FAttriMap.Free;
inherited Destroy;
end;
procedure TSynTextMateSyn.LoadGrammar(AGrammarDef: String);
begin
FTextMateGrammar.ParseGrammar(AGrammarDef);
end;
procedure TSynTextMateSyn.LoadGrammar(AGrammarFile, AGrammarPath: String);
begin
GrammarPath := AGrammarPath;
FTextMateGrammar.ParseGrammar(LoadFile(AGrammarFile));
if FTextMateGrammar.LanguageName = '' then
FTextMateGrammar.LanguageName := AGrammarFile;
end;
procedure TSynTextMateSyn.SetLine(const NewValue: String;
LineNumber: Integer);
begin
inherited SetLine(NewValue, LineNumber);
if FCurrentRange = -2 then
FCurrentRange := FTextMateGrammar.CurrentPatternIndex;
// TODO setline - keep range?
FTextMateGrammar.SetLine(CurrentLineText, FCurrentRange);
FCurrentRange := -2;
if IsScanning then begin
FTextMateGrammar.NextToEol;
end
else begin
FTextMateGrammar.First;
FCurrentTokenKind := FTextMateGrammar.CurrentTokenKind;
FCurrentAttrib := TSynHighlighterAttributes(FTextMateGrammar.CurrentAttrib);
FCurrentTokenPos := FTextMateGrammar.CurrentTokenPos;
FCurrentTokenLen := FTextMateGrammar.CurrentTokenLen;
end;
//FCurrentRange := FTextMateGrammar.CurrentPatternIndex;
end;
procedure TSynTextMateSyn.Next;
begin
FTextMateGrammar.Next;
FCurrentTokenKind := FTextMateGrammar.CurrentTokenKind;
FCurrentAttrib := TSynHighlighterAttributes(FTextMateGrammar.CurrentAttrib);
FCurrentTokenPos := FTextMateGrammar.CurrentTokenPos;
FCurrentTokenLen := FTextMateGrammar.CurrentTokenLen;
//FCurrentRange := FTextMateGrammar.CurrentPatternIndex;
end;
function TSynTextMateSyn.GetEol: Boolean;
begin
Result := FTextMateGrammar.IsAtEol;
end;
function TSynTextMateSyn.GetToken: String;
begin
Result := Copy(CurrentLineText, FCurrentTokenPos, FCurrentTokenLen);
end;
procedure TSynTextMateSyn.GetTokenEx(out TokenStart: PChar; out
TokenLength: integer);
begin
TokenStart := @CurrentLineText[FCurrentTokenPos];
TokenLength := FCurrentTokenLen;
end;
function TSynTextMateSyn.GetTokenPos: Integer;
begin
Result := FCurrentTokenPos - 1;
end;
function TSynTextMateSyn.GetTokenKind: integer;
begin
Result := FCurrentTokenKind;
end;
function TSynTextMateSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
Result := FCurrentAttrib;
end;
function TSynTextMateSyn.GetDefaultAttribute(Index: integer
): TSynHighlighterAttributes;
begin
Result := FAttriMap.Data[FTextMateGrammar.RootPattern.AttribInfo.TokId];
end;
procedure TSynTextMateSyn.SetRange(Value: Pointer);
begin
FCurrentRange := PtrUInt(Value);
end;
procedure TSynTextMateSyn.ResetRange;
begin
FCurrentRange := -1;
end;
function TSynTextMateSyn.GetRange: Pointer;
begin
FCurrentRange := FTextMateGrammar.CurrentPatternIndex;
Result := Pointer(PtrUInt(FCurrentRange));
end;
function TSynTextMateSyn.FoldBlockOpeningCount(ALineIndex: TLineIdx;
const AFilter: TSynFoldBlockFilter): integer;
begin
Result := 0;
end;
function TSynTextMateSyn.FoldBlockClosingCount(ALineIndex: TLineIdx;
const AFilter: TSynFoldBlockFilter): integer;
begin
Result := 0;
end;
function TSynTextMateSyn.FoldBlockEndLevel(ALineIndex: TLineIdx;
const AFilter: TSynFoldBlockFilter): integer;
begin
Result := 0;
end;
function TSynTextMateSyn.FoldBlockMinLevel(ALineIndex: TLineIdx;
const AFilter: TSynFoldBlockFilter): integer;
begin
Result := 0;
end;
function TSynTextMateSyn.FoldBlockNestedTypes(ALineIndex: TLineIdx;
ANestIndex: Integer; out AType: Pointer; const AFilter: TSynFoldBlockFilter
): boolean;
begin
Result := False;
end;
end.

4
converter/convertdelphi.pas
View File

@ -43,7 +43,7 @@ uses
AvgLvlTree,
// IDEIntf
ComponentReg, IDEDialogs, LazIDEIntf, PackageIntf, ProjectIntf,
IDEExternToolIntf, IDEOptEditorIntf,
IDEExternToolIntf, IDEOptEditorIntf, EditorSyntaxHighlighterDef,
// IdeConfig
IDEProcs,
// IDE
@ -1579,7 +1579,7 @@ begin
MainUnitInfo:=TUnitInfo.Create(fMainUnitConverter.fPascalBuffer);
Assert(Assigned(IDEEditorOptions), 'TConvertDelphiProject.CreateMainSourceFile: IDEEditorOptions is Nil.');
MainUnitInfo.DefaultSyntaxHighlighter:=
IDEEditorOptions.ExtensionToLazSyntaxHighlighter(fMainUnitConverter.LazFileExt);
IdeSyntaxHighlighters.GetIdForFileExtension(fMainUnitConverter.LazFileExt);
MainUnitInfo.IsPartOfProject:=true;
LazProject.AddFile(MainUnitInfo,false);
LazProject.MainFileID:=0;

2
ide/codetemplatesdlg.pas
View File

@ -859,7 +859,7 @@ begin
FilenameEdit.Filter:=dlgFilterDciFile + '|*.dci|' + dlgFilterAll + '|' + GetAllFilesMask;
// init synedit
ColorScheme:=EditorOpts.ReadColorScheme(ASynPasSyn.GetLanguageName);
ColorScheme:=EditorOpts.ReadColorScheme(ASynPasSyn.LanguageName);
EditorOpts.ReadHighlighterSettings(ASynPasSyn,ColorScheme);
if EditorOpts.UseSyntaxHighlight then
TemplateSynEdit.Highlighter:=ASynPasSyn

858
ide/editoroptions.pp
View File

File diff suppressed because it is too large Load Diff

7
ide/frames/editor_codefolding_options.pas
View File

@ -222,7 +222,7 @@ begin
Result := FHighlighters[SynType];
if (Result <> nil) or not(CreateIfNotExists) then exit;
SynClass := LazSyntaxHighlighterClasses[SynType];
SynClass := LazSyntaxHighlighterClasses{%H-}[SynType];
Result := SynClass.Create(nil);
FHighlighters[SynType] := Result;
Result.BeginUpdate;
@ -274,10 +274,11 @@ begin
with LanguageComboBox.Items do begin
BeginUpdate;
for i := 0 to EditorOpts.HighlighterList.Count - 1 do begin
for i := IdeHighlighterStartId to EditorOpts.HighlighterList.Count - 1 do begin
if HighlighterList[i].TheType = lshDelphi then continue; // configured via FreePascal
rf := EditorOptionsFoldDefaults[HighlighterList[i].TheType];
if (rf.Count > 0) then
Add(HighlighterList[i].SynClass.GetLanguageName);
Add(HighlighterList[i].SynInstance.LanguageName);
end;
EndUpdate;
end;

5
ide/frames/editor_color_options.lfm
View File

@ -177,7 +177,6 @@ object EditorColorOptionsFrame: TEditorColorOptionsFrame
ShowButtons = False
ShowLines = False
ShowRoot = False
ShowSeparators = False
SortType = stData
TabOrder = 0
OnAdvancedCustomDrawItem = ColorElementTreeAdvancedCustomDrawItem
@ -260,7 +259,6 @@ object EditorColorOptionsFrame: TEditorColorOptionsFrame
ShowButtons = False
ShowLines = False
ShowRoot = False
ShowSeparators = False
SortType = stData
TabOrder = 0
OnAdvancedCustomDrawItem = ColorElementTreeAdvancedCustomDrawItem
@ -343,7 +341,6 @@ object EditorColorOptionsFrame: TEditorColorOptionsFrame
ShowButtons = False
ShowLines = False
ShowRoot = False
ShowSeparators = False
SortType = stData
TabOrder = 0
OnAdvancedCustomDrawItem = ColorElementTreeAdvancedCustomDrawItem
@ -426,7 +423,6 @@ object EditorColorOptionsFrame: TEditorColorOptionsFrame
ShowButtons = False
ShowLines = False
ShowRoot = False
ShowSeparators = False
SortType = stData
TabOrder = 0
OnAdvancedCustomDrawItem = ColorElementTreeAdvancedCustomDrawItem
@ -577,7 +573,6 @@ object EditorColorOptionsFrame: TEditorColorOptionsFrame
ScrollBars = ssAutoBoth
ShowButtons = False
ShowRoot = False
ShowSeparators = False
TabOrder = 0
OnAdvancedCustomDrawItem = ColorElementTreeAdvancedCustomDrawItem
OnChange = ColorElementTreeChange

36
ide/frames/editor_color_options.pas
View File

@ -38,6 +38,7 @@ uses
SynColorAttribEditor,
// IdeIntf
IDEOptionsIntf, IDEOptEditorIntf, IDEImagesIntf, IDEUtils,
EditorSyntaxHighlighterDef,
// IdeConfig
IDEProcs, LazConf,
// IDE
@ -165,7 +166,7 @@ type
function GetColorSchemeForLang(const LanguageName: String): String;
procedure SetColorSchemeForLang(const LanguageName, ColorScheme: String);
procedure SetCurrentScheme(SynClass: TCustomSynClass; const ColorScheme: String);
procedure SetCurrentScheme(SynInstance: TSrcIDEHighlighter; const ColorScheme: String);
procedure ApplyCurrentScheme;
procedure UpdateCurrentScheme;
@ -1221,7 +1222,7 @@ begin
then
DefaultColorScheme := DefaultSchemeGrp.DefaultColors
else
DefaultColorScheme := DefaultSchemeGrp.ColorScheme[FCurrentColorScheme.Language];
DefaultColorScheme := DefaultSchemeGrp.ColorSchemeBySynHl[FCurrentColorScheme.SharedHighlighter];
if OnlySelected then begin
DefAttri := DefaultColorScheme.Attribute[FCurHighlightElement.StoredName];
@ -1274,8 +1275,8 @@ begin
FColorSchemes.Values[LanguageName] := ColorScheme;
end;
procedure TEditorColorOptionsFrame.SetCurrentScheme(SynClass: TCustomSynClass;
const ColorScheme: String);
procedure TEditorColorOptionsFrame.SetCurrentScheme(
SynInstance: TSrcIDEHighlighter; const ColorScheme: String);
var
SchemeGrp: TColorScheme;
NewColorScheme: TColorSchemeLanguage;
@ -1288,13 +1289,14 @@ begin
if FIsEditingDefaults then
NewColorScheme := SchemeGrp.DefaultColors
else
NewColorScheme := SchemeGrp.ColorSchemeBySynClass[SynClass];
NewColorScheme := SchemeGrp.ColorSchemeBySynHl[SynInstance];
if (NewColorScheme = FCurrentColorScheme) then
exit;
FCurrentColorScheme := NewColorScheme;
if not FIsEditingDefaults then begin
FCurrentHighlighter := FCurrentColorScheme.Highlighter;
FCurrentHighlighter.Free;
FCurrentHighlighter := EditorOpts.HighlighterList.GetNewSynInstance(FCurrentColorScheme.IdeHighlighterID);
SynColorAttrEditor1.CurrentColorScheme := FCurrentColorScheme;
FillPriorEditor;
end;
@ -1389,7 +1391,7 @@ begin
if not FIsEditingDefaults then
begin
FIsEditingDefaults := True;
SetCurrentScheme(TCustomSynClass(FCurrentHighlighter.ClassType), ColorSchemeButton.Caption);
SetCurrentScheme(FCurrentHighlighter, ColorSchemeButton.Caption);
end;
LanguageButton.Caption := (Sender as TMenuItem).Caption;
end
@ -1403,9 +1405,9 @@ begin
if NewVal >= 0 then
begin
CurLanguageID := NewVal;
SetCurrentScheme(EditorOpts.HighlighterList[CurLanguageID].SynClass,
SetCurrentScheme(EditorOpts.HighlighterList[CurLanguageID].SynInstance,
GetColorSchemeForLang(EditorOpts.HighlighterList
[CurLanguageID].SynClass.GetLanguageName));
[CurLanguageID].SynInstance.LanguageName));
SetColorSchemeItem(GetColorSchemeForLang(FCurrentHighlighter.LanguageName));
SetComboBoxText(FileExtensionsComboBox,
GetCurFileExtensions(FCurrentHighlighter.LanguageName),cstFilename);
@ -1425,7 +1427,7 @@ begin
// change the colorscheme
if not FIsEditingDefaults then
SetColorSchemeForLang(FCurrentHighlighter.LanguageName, Scheme);
SetCurrentScheme(TCustomSynClass(FCurrentHighlighter.ClassType), Scheme);
SetCurrentScheme(FCurrentHighlighter, Scheme);
end;
ColorSchemeButton.Caption := Scheme;
end;
@ -1468,6 +1470,7 @@ begin
FreeAndNil(FTempColorSchemeSettings);
FFileExtensions.Free;
FColorSchemes.Free;
FCurrentHighlighter.Free;
inherited Destroy;
end;
@ -1568,9 +1571,10 @@ begin
Item.AutoCheck := True;
Item.GroupIndex := 1;
LanguageMenu.Items.Add(Item);
for i := 0 to EditorOpts.HighlighterList.Count - 1 do
for i := IdeHighlighterStartId to EditorOpts.HighlighterList.Count - 1 do
begin
Item := NewItem(HighlighterList[i].SynClass.GetLanguageName, 0, False, True, @LanguageMenuItemClick, 0, '');
if HighlighterList[i].TheType = lshDelphi then continue; // configured via FreePascal
Item := NewItem(HighlighterList[i].SynInstance.LanguageName, 0, False, True, @LanguageMenuItemClick, 0, '');
Item.RadioItem := True;
Item.AutoCheck := True;
Item.GroupIndex := 1;
@ -1582,8 +1586,8 @@ begin
SetComboBoxText(FileExtensionsComboBox,
HighlighterList[CurLanguageID].FileExtensions,cstFilename);
SetCurrentScheme(TPreviewPasSyn, GetColorSchemeForLang(TPreviewPasSyn.GetLanguageName));
CurLanguageID := HighlighterList.FindByClass(TCustomSynClass(FCurrentHighlighter.ClassType));
CurLanguageID := HighlighterList.FindByName(TPreviewPasSyn.GetLanguageName);
SetCurrentScheme(HighlighterList[CurLanguageID].SynInstance, GetColorSchemeForLang(TPreviewPasSyn.GetLanguageName));
SetLanguageItem(FCurrentHighlighter.LanguageName);
SetColorSchemeItem(GetColorSchemeForLang(FCurrentHighlighter.LanguageName));
@ -1597,6 +1601,10 @@ procedure TEditorColorOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
var
i, j: Integer;
begin
with GeneralPage do
for i := Low(PreviewEdits) to High(PreviewEdits) do
PreviewEdits[i].Highlighter := nil;
with AOptions as TEditorOptions do
begin
UseSyntaxHighlight := UseSyntaxHighlightCheckBox.Down;

58
ide/frames/editor_color_tml_options.lfm Normal file
View File

@ -0,0 +1,58 @@
object TEditorColorOptionsTMLFrame: TTEditorColorOptionsTMLFrame
Left = 0
Height = 479
Top = 0
Width = 645
ClientHeight = 479
ClientWidth = 645
TabOrder = 0
DesignLeft = 277
DesignTop = 41
object Panel1: TPanel
Left = 0
Height = 37
Top = 0
Width = 645
Align = alTop
AutoSize = True
BevelOuter = bvNone
ClientHeight = 37
ClientWidth = 645
TabOrder = 0
object Label1: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideRight.Control = btnReload
Left = 6
Height = 15
Top = 12
Width = 552
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
Caption = 'info'
WordWrap = True
end
object btnReload: TButton
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 564
Height = 25
Top = 6
Width = 75
Anchors = [akTop, akRight]
BorderSpacing.Around = 6
Caption = 'btnReload'
TabOrder = 0
OnClick = btnReloadClick
end
end
object Memo1: TMemo
Left = 6
Height = 430
Top = 43
Width = 633
Align = alClient
BorderSpacing.Around = 6
ReadOnly = True
TabOrder = 1
end
end

117
ide/frames/editor_color_tml_options.pas Normal file
View File

@ -0,0 +1,117 @@
unit editor_color_tml_options;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls, LazarusIDEStrConsts,
EditorOptions, IDEOptEditorIntf, IDEOptionsIntf, LazFileUtils, FileUtil,
SynTextMateSyn;
type
{ TTEditorColorOptionsTMLFrame }
TTEditorColorOptionsTMLFrame = class(TAbstractIDEOptionsEditor)
btnReload: TButton;
Label1: TLabel;
Memo1: TMemo;
Panel1: TPanel;
procedure btnReloadClick(Sender: TObject);
private
public
class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
function GetTitle: String; override;
procedure Setup(ADialog: TAbstractOptionsEditorDialog); override;
procedure ReadSettings(AOptions: TAbstractIDEOptions); override;
procedure WriteSettings(AOptions: TAbstractIDEOptions); override;
end;
implementation
{$R *.lfm}
{ TTEditorColorOptionsTMLFrame }
procedure TTEditorColorOptionsTMLFrame.btnReloadClick(Sender: TObject);
var
dir: String;
FileList: TStringList;
i: Integer;
tmlHighlighter: TSynTextMateSyn;
begin
dir := AppendPathDelim(UserSchemeDirectory(False)) + 'tml';
FileList := nil;
if DirectoryExistsUTF8(dir) then
FileList := FindAllFiles(dir, '*.json', False);
if (FileList = nil) or (FileList.Count = 0) then begin
Memo1.Text := dlgColorsTmlNoFilesFound;
exit;
end;
Memo1.Clear;
for i := 0 to FileList.Count - 1 do begin
tmlHighlighter := TSynTextMateSyn.Create(nil);
tmlHighlighter.LoadGrammar(FileList[i], '');
Memo1.Lines.Add(tmlHighlighter.LanguageName);
Memo1.Lines.Add('- '+dlgColorsTmlFromFile+' '+FileList[i]);
if (tmlHighlighter.ParserError <> '') then begin
Memo1.Lines.Add('- '+dlgColorsTmlError+' '+tmlHighlighter.ParserError);
end
else begin
if (tmlHighlighter.TextMateGrammar.SampleText = '') then begin
if (tmlHighlighter.TextMateGrammar.SampleTextFile = '') then
Memo1.Lines.Add('- '+dlgColorsTmlNoSampleTxt)
else
if not FileExistsUTF8(TrimAndExpandFilename(tmlHighlighter.TextMateGrammar.SampleTextFile, dir)) then
Memo1.Lines.Add('- '+Format(dlgColorsTmlBadSampleTxtFile, [LineEnding+'', tmlHighlighter.TextMateGrammar.SampleTextFile]));
end;
Memo1.Lines.Add('- '+dlgColorsTmlOk);
end;
Memo1.Lines.Add('');
tmlHighlighter.Free;
end;
FileList.Free;
end;
class function TTEditorColorOptionsTMLFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
begin
Result := TEditorOptions;
end;
function TTEditorColorOptionsTMLFrame.GetTitle: String;
begin
Result := dlgColorsTml;
end;
procedure TTEditorColorOptionsTMLFrame.Setup(
ADialog: TAbstractOptionsEditorDialog);
begin
btnReload.Caption := dlgColorsTmlRefresh;
Label1.Caption := Format(dlgColorsTmlInfo, [LineEnding+'', AppendPathDelim(UserSchemeDirectory(False)) + 'tml']);
end;
procedure TTEditorColorOptionsTMLFrame.ReadSettings(
AOptions: TAbstractIDEOptions);
begin
btnReloadClick(nil);
end;
procedure TTEditorColorOptionsTMLFrame.WriteSettings(
AOptions: TAbstractIDEOptions);
begin
end;
initialization
RegisterIDEOptionsEditor(GroupEditor, TTEditorColorOptionsTMLFrame, EdtOptionsTMLColors, EdtOptionsColors);
end.

10
ide/frames/editor_dividerdraw_options.lfm
View File

@ -1,5 +1,7 @@
inherited EditorDividerDrawOptionsFrame: TEditorDividerDrawOptionsFrame
object EditorDividerDrawOptionsFrame: TEditorDividerDrawOptionsFrame
Left = 0
Height = 334
Top = 0
Width = 521
Anchors = [akTop]
ClientHeight = 334
@ -8,7 +10,7 @@ inherited EditorDividerDrawOptionsFrame: TEditorDividerDrawOptionsFrame
Visible = False
DesignLeft = 207
DesignTop = 207
object LanguageLabel: TLabel[0]
object LanguageLabel: TLabel
AnchorSideLeft.Control = LanguageComboBox
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = LanguageComboBox
@ -22,7 +24,7 @@ inherited EditorDividerDrawOptionsFrame: TEditorDividerDrawOptionsFrame
Caption = 'LanguageLabel'
ParentColor = False
end
object DividerConfPanel: TPanel[1]
object DividerConfPanel: TPanel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = LanguageComboBox
AnchorSideTop.Side = asrBottom
@ -232,7 +234,7 @@ inherited EditorDividerDrawOptionsFrame: TEditorDividerDrawOptionsFrame
TopIndex = -1
end
end
object LanguageComboBox: TComboBox[2]
object LanguageComboBox: TComboBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 0

7
ide/frames/editor_dividerdraw_options.pas
View File

@ -242,7 +242,7 @@ begin
Result := FHighlighters[SynType];
if (Result <> nil) or not(CreateIfNotExists) then exit;
SynClass := LazSyntaxHighlighterClasses[SynType];
SynClass := LazSyntaxHighlighterClasses{%H-}[SynType];
Result := SynClass.Create(nil);
FHighlighters[SynType] := Result;
EditorOpts.ReadHighlighterDivDrawSettings(Result);
@ -288,10 +288,11 @@ begin
begin
with LanguageComboBox.Items do begin
BeginUpdate;
for i := 0 to EditorOpts.HighlighterList.Count - 1 do begin
for i := IdeHighlighterStartId to EditorOpts.HighlighterList.Count - 1 do begin
if HighlighterList[i].TheType = lshDelphi then continue; // configured via FreePascal
rd := EditorOptionsDividerDefaults[HighlighterList[i].TheType];
if (rd.Count > 0) then
Add(HighlighterList[i].SynClass.GetLanguageName);
Add(HighlighterList[i].SynInstance.LanguageName);
end;
EndUpdate;
end;

7
ide/frames/editor_markup_options.pas
View File

@ -415,7 +415,7 @@ begin
Scheme := col.UnsavedColorSchemeSettings.ColorSchemeGroup[SynColorSchemeName];
LangScheme := nil;
if Scheme <> nil then
LangScheme := Scheme.ColorSchemeBySynClass[FCurHighlighter.ClassType];
LangScheme := Scheme.ColorSchemeBySynHl[FCurHighlighter];
if (LangScheme <> nil) then
@ -487,10 +487,11 @@ begin
with LanguageComboBox.Items do begin
BeginUpdate;
for i := 0 to EditorOpts.HighlighterList.Count - 1 do begin
for i := IdeHighlighterStartId to EditorOpts.HighlighterList.Count - 1 do begin
if HighlighterList[i].TheType = lshDelphi then continue; // configured via FreePascal
rf := EditorOptionsFoldDefaults[EditorOpts.HighlighterList[i].TheType];
if (rf.Count > 0) and (rf.HasMarkup) then
Add(EditorOpts.HighlighterList[i].SynClass.GetLanguageName);
Add(EditorOpts.HighlighterList[i].SynInstance.LanguageName);
end;
EndUpdate;
end;

6
ide/lazarus.lpi
View File

@ -1479,6 +1479,12 @@
<IsPartOfProject Value="True"/>
<UnitName Value="ProjectDebugLink"/>
</Unit>
<Unit>
<Filename Value="frames/editor_color_tml_options.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="TEditorColorOptionsTMLFrame"/>
<ResourceBaseClass Value="Frame"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>

12
ide/lazarusidestrconsts.pas
View File

@ -1933,6 +1933,18 @@ resourcestring
dlgUseSchemeLocal = 'selected language';
dlgColor = 'Color';
dlgColors = 'Colors';
dlgColorsTml = 'TML-Setup';
dlgColorsTmlRefresh = 'Reload';
dlgColorsTmlInfo = 'Below is a list of Highlighter (Textmate) found in the folder %1:s.%0:s' +
'This list may includes files with errors and files not yet active in the IDE.%0:s' +
'To activate newly added/changed files (re-)start the IDE.%0:s' +
'The "Reload" button will update the list below, checking if any errors were fixed.';
dlgColorsTmlNoFilesFound = 'No file found';
dlgColorsTmlFromFile = 'File:';
dlgColorsTmlNoSampleTxt = 'No sample text configured';
dlgColorsTmlBadSampleTxtFile = 'Sample text file not found: %1:s';
dlgColorsTmlOk = 'Ok';
dlgColorsTmlError = 'Error:';
lisHeaderColors = 'Header colors';
lisMsgColors = 'Message colors';
lisSetAllColors = 'Set all colors:';

7
ide/main.pp
View File

@ -120,7 +120,8 @@ uses
MsgWnd_Options, Files_Options, Desktop_Options, window_options, IdeStartup_Options,
Backup_Options, naming_options, fpdoc_options, idecoolbar_options, editortoolbar_options,
editor_display_options, editor_keymapping_options, editor_mouseaction_options,
editor_mouseaction_options_advanced, editor_color_options, editor_markup_options,
editor_mouseaction_options_advanced, editor_color_options, editor_color_tml_options,
editor_markup_options,
editor_markup_userdefined, editor_codetools_options, editor_codefolding_options,
editor_general_misc_options, editor_dividerdraw_options,
editor_multiwindow_options, editor_indent_options,
@ -6010,7 +6011,7 @@ begin
end;
DlgResult:=ShowUnitInfoDlg(ShortUnitName,
GetSyntaxHighlighterCaption(ActiveUnitInfo.DefaultSyntaxHighlighter),
IdeSyntaxHighlighters.Captions[ActiveUnitInfo.DefaultSyntaxHighlighter],
ActiveUnitInfo.IsPartOfProject,
SizeInBytes,UnitSizeWithIncludeFiles,UnitSizeParsed,
LineCount,UnitLineCountWithIncludes,UnitLineCountParsed,
@ -11511,7 +11512,7 @@ begin
end;
if AnUpdates * [sepuNewShared, sepuChangedHighlighter] <> [] then begin
p.SyntaxHighlighter := SrcEdit.SyntaxHighlighterType;
p.SyntaxHighlighter := SrcEdit.SyntaxHighlighterId;
end;
p.PageIndex := SrcEdit.PageIndex;

16
ide/mainbase.pas
View File

@ -1753,24 +1753,26 @@ end;
procedure TMainIDEBase.UpdateHighlighters(Immediately: boolean);
var
ASrcEdit: TSourceEditor;
h: TLazSyntaxHighlighter;
i: Integer;
AnEditorInfo: TUnitEditorInfo;
h: TSrcIDEHighlighter;
begin
if Immediately then begin
Exclude(FIdleIdeActions, iiaUpdateHighlighters);
for h := Low(TLazSyntaxHighlighter) to High(TLazSyntaxHighlighter) do
if Highlighters[h]<>nil then begin
Highlighters[h].BeginUpdate;
EditorOpts.GetHighlighterSettings(Highlighters[h]);
Highlighters[h].EndUpdate;
for i := IdeHighlighterStartId to EditorOpts.HighlighterList.Count - 1 do begin
h := EditorOpts.HighlighterList.SharedSynInstances[i];
if h<>nil then begin
h.BeginUpdate;
EditorOpts.GetHighlighterSettings(h);
h.EndUpdate;
end;
end;
if Project1<>nil then begin
for i := 0 to SourceEditorManager.SourceEditorCount - 1 do begin
ASrcEdit := SourceEditorManager.SourceEditors[i];
AnEditorInfo:=Project1.EditorInfoWithEditorComponent(ASrcEdit);
if AnEditorInfo <> nil then
ASrcEdit.SyntaxHighlighterType := AnEditorInfo.SyntaxHighlighter;
ASrcEdit.SyntaxHighlighterId := AnEditorInfo.SyntaxHighlighter;
end;
end;
end

59
ide/project.pp
View File

@ -201,13 +201,13 @@ type
FFoldState: String;
// Todo: FCustomHighlighter is only ever set to false, and not stored in XML
FCustomHighlighter: boolean; // do not change highlighter on file extension change
FSyntaxHighlighter: TLazSyntaxHighlighter;
FSyntaxHighlighter: TIdeSyntaxHighlighterID;
procedure SetCursorPos(const AValue: TPoint);
procedure SetFoldState(AValue: String);
procedure SetIsLocked(const AValue: Boolean);
procedure SetPageIndex(const AValue: Integer);
procedure SetIsVisibleTab(const AValue: Boolean);
procedure SetSyntaxHighlighter(AValue: TLazSyntaxHighlighter);
procedure SetSyntaxHighlighter(AValue: TIdeSyntaxHighlighterID);
procedure SetTopLine(const AValue: Integer);
procedure SetWindowIndex(const AValue: Integer);
protected
@ -229,7 +229,7 @@ type
property FoldState: String read FFoldState write SetFoldState;
property IsLocked: Boolean read FIsLocked write SetIsLocked;
property CustomHighlighter: Boolean read FCustomHighlighter write FCustomHighlighter; // SetCustomHighlighter
property SyntaxHighlighter: TLazSyntaxHighlighter read FSyntaxHighlighter write SetSyntaxHighlighter; // SetSyntaxHighlighter
property SyntaxHighlighter: TIdeSyntaxHighlighterID read FSyntaxHighlighter write SetSyntaxHighlighter; // SetSyntaxHighlighter
end;
{ TUnitEditorInfoList }
@ -270,7 +270,7 @@ type
private
FComponentTypesToClasses: TStringToPointerTree;
FComponentVarsToClasses: TStringToPointerTree;
FDefaultSyntaxHighlighter: TLazSyntaxHighlighter;
FDefaultSyntaxHighlighter: TIdeSyntaxHighlighterID;
FEditorInfoList: TUnitEditorInfoList;
fAutoRevertLockCount: integer;// =0 means, codetools can auto update from disk
fBookmarks: TFileBookmarks;
@ -337,7 +337,7 @@ type
procedure SetAutoReferenceSourceDir(const AValue: boolean);
procedure SetBuildFileIfActive(const AValue: boolean);
procedure SetCustomDefaultHighlighter(AValue: boolean);
procedure SetDefaultSyntaxHighlighter(const AValue: TLazSyntaxHighlighter);
procedure SetDefaultSyntaxHighlighter(const AValue: TIdeSyntaxHighlighterID);
procedure SetDisableI18NForLFM(const AValue: boolean);
procedure SetFileReadOnly(const AValue: Boolean);
procedure SetComponent(const AValue: TComponent);
@ -363,7 +363,7 @@ type
procedure SetInternalFilename(const NewFilename: string);
procedure SetUnitName(const AValue: string); override;
procedure UpdateHasCustomHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter);
procedure UpdateHasCustomHighlighter(aDefaultHighlighter: TIdeSyntaxHighlighterID);
procedure UpdatePageIndex;
public
constructor Create(ACodeBuffer: TCodeBuffer);
@ -434,7 +434,7 @@ type
function GetClosedOrNewEditorInfo: TUnitEditorInfo;
procedure SetLastUsedEditor(AEditor:TSourceEditorInterface);
// Highlighter
procedure UpdateDefaultHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter);
procedure UpdateDefaultHighlighter(aDefaultHighlighter: TIdeSyntaxHighlighterID);
public
{ Properties }
property UnitResourceFileformat: TUnitResourcefileFormatClass read GetUnitResourceFileformat;
@ -496,7 +496,7 @@ type
property RunFileIfActive: boolean read GetRunFileIfActive write SetRunFileIfActive;
property Source: TCodeBuffer read fSource write SetSource;
property SourceLFM: TCodeBuffer read FSourceLFM write SetSourceLFM;
property DefaultSyntaxHighlighter: TLazSyntaxHighlighter
property DefaultSyntaxHighlighter: TIdeSyntaxHighlighterID
read FDefaultSyntaxHighlighter write SetDefaultSyntaxHighlighter;
property UserReadOnly: Boolean read GetUserReadOnly write SetUserReadOnly;
property AutoReferenceSourceDir: boolean read GetAutoReferenceSourceDir
@ -1189,7 +1189,7 @@ const
var
Project1: TProject absolute LazProject1;// the main project
function FilenameToLazSyntaxHighlighter(Filename: String): TLazSyntaxHighlighter;
function FilenameToLazSyntaxHighlighter(Filename: String): TIdeSyntaxHighlighterID;
function AddCompileReasonsDiff(const PropertyName: string;
const Old, New: TCompileReasons; Tool: TCompilerDiffTool = nil): boolean;
function dbgs(aType: TUnitCompDependencyType): string; overload;
@ -1204,18 +1204,12 @@ const
ProjOptionsPath = 'ProjectOptions/';
function FilenameToLazSyntaxHighlighter(Filename: String): TLazSyntaxHighlighter;
function FilenameToLazSyntaxHighlighter(Filename: String): TIdeSyntaxHighlighterID;
var
CompilerMode: TCompilerMode;
begin
Result:=IDEEditorOptions.ExtensionToLazSyntaxHighlighter(ExtractFileExt(Filename));
if Result in [lshFreePascal,lshDelphi] then begin
CompilerMode:=CodeToolBoss.GetCompilerModeForDirectory(ExtractFilePath(Filename));
if CompilerMode in [cmDELPHI,cmTP] then
Result:=lshDelphi
else
Result:=lshFreePascal;
end;
CompilerMode:=CodeToolBoss.GetCompilerModeForDirectory(ExtractFilePath(Filename));
Result := IdeSyntaxHighlighters.GetIdForFileExtension(ExtractFileExt(Filename), CompilerMode in [cmDELPHI,cmTP]);
end;
function AddCompileReasonsDiff(const PropertyName: string;
@ -1330,7 +1324,7 @@ begin
FUnitInfo.SessionModified := True;
end;
procedure TUnitEditorInfo.SetSyntaxHighlighter(AValue: TLazSyntaxHighlighter);
procedure TUnitEditorInfo.SetSyntaxHighlighter(AValue: TIdeSyntaxHighlighterID);
begin
if FSyntaxHighlighter = AValue then Exit;
FSyntaxHighlighter := AValue;
@ -1393,9 +1387,9 @@ begin
XMLConfig.GetValue(Path+'CursorPos/Y',1));
FFoldState := XMLConfig.GetValue(Path+'FoldState/Value', '');
FIsLocked := XMLConfig.GetValue(Path+'IsLocked/Value', False);
FSyntaxHighlighter := StrToLazSyntaxHighlighter(
FSyntaxHighlighter := IdeSyntaxHighlighters.GetIdForName(
XMLConfig.GetValue(Path+'SyntaxHighlighter/Value',
LazSyntaxHighlighterNames[UnitInfo.DefaultSyntaxHighlighter]));
IdeSyntaxHighlighters.Names[UnitInfo.DefaultSyntaxHighlighter]));
end;
procedure TUnitEditorInfo.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
@ -1413,8 +1407,8 @@ begin
else
XMLConfig.DeletePath(Path+'FoldState');
XMLConfig.SetDeleteValue(Path+'SyntaxHighlighter/Value',
LazSyntaxHighlighterNames[fSyntaxHighlighter],
LazSyntaxHighlighterNames[UnitInfo.DefaultSyntaxHighlighter]);
IdeSyntaxHighlighters.Names[fSyntaxHighlighter],
IdeSyntaxHighlighters.Names[UnitInfo.DefaultSyntaxHighlighter]);
end;
{ TUnitEditorInfoList }
@ -1765,7 +1759,7 @@ begin
fComponentName := '';
fComponentResourceName := '';
FComponentState := wsNormal;
FDefaultSyntaxHighlighter := lshText;
FDefaultSyntaxHighlighter := IdeHighlighterNoneID;
DisableI18NForLFM:=false;
CustomDefaultHighlighter := False;
FEditorInfoList.ClearEachInfo;
@ -1898,8 +1892,8 @@ begin
// save custom session data
SaveStringToStringTree(XMLConfig,CustomSessionData,Path+'CustomSessionData/');
XMLConfig.SetDeleteValue(Path+'DefaultSyntaxHighlighter/Value',
LazSyntaxHighlighterNames[FDefaultSyntaxHighlighter],
LazSyntaxHighlighterNames[lshFreePascal]);
IdeSyntaxHighlighters.Names[FDefaultSyntaxHighlighter],
IdeSyntaxHighlighters.Names[IdeSyntaxHighlighters.GetIdForLazSyntaxHighlighter(lshFreePascal)]);
end;
end;
@ -1950,9 +1944,9 @@ begin
end;
// session data
FDefaultSyntaxHighlighter := StrToLazSyntaxHighlighter(
FDefaultSyntaxHighlighter := IdeSyntaxHighlighters.GetIdForName(
XMLConfig.GetValue(Path+'DefaultSyntaxHighlighter/Value',
LazSyntaxHighlighterNames[lshFreePascal]));
IdeSyntaxHighlighters.Names[IdeSyntaxHighlighters.GetIdForLazSyntaxHighlighter(lshFreePascal)]));
FEditorInfoList.Clear;
FEditorInfoList.NewEditorInfo;
FEditorInfoList[0].LoadFromXMLConfig(XMLConfig, Path);
@ -2040,7 +2034,8 @@ begin
UpdateSourceDirectoryReference;
end;
procedure TUnitInfo.UpdateHasCustomHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter);
procedure TUnitInfo.UpdateHasCustomHighlighter(
aDefaultHighlighter: TIdeSyntaxHighlighterID);
var
i: Integer;
begin
@ -2087,7 +2082,8 @@ begin
end;
end;
procedure TUnitInfo.UpdateDefaultHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter);
procedure TUnitInfo.UpdateDefaultHighlighter(
aDefaultHighlighter: TIdeSyntaxHighlighterID);
var
i: Integer;
begin
@ -2666,7 +2662,8 @@ begin
Exclude(FFlags, uifCustomDefaultHighlighter);
end;
procedure TUnitInfo.SetDefaultSyntaxHighlighter(const AValue: TLazSyntaxHighlighter);
procedure TUnitInfo.SetDefaultSyntaxHighlighter(
const AValue: TIdeSyntaxHighlighterID);
var
i: Integer;
begin

68
ide/sourceeditor.pp
View File

@ -262,7 +262,7 @@ type
FPopUpMenu: TPopupMenu;
FMouseActionPopUpMenu: TPopupMenu;
FSyntaxHighlighterType: TLazSyntaxHighlighter;
FSyntaxHighlighterId: TIdeSyntaxHighlighterID;
FErrorLine: integer;
FErrorColumn: integer;
FLineInfoNotification: TIDELineInfoNotification;
@ -354,7 +354,7 @@ type
function RefreshEditorSettings: Boolean;
function GetModified: Boolean; override;
procedure SetModified(const NewValue: Boolean); override;
procedure SetSyntaxHighlighterType(AHighlighterType: TLazSyntaxHighlighter);
procedure SetSyntaxHighlighterId(AHighlighterId: TIdeSyntaxHighlighterID);
procedure SetErrorLine(NewLine: integer);
procedure SetExecutionLine(NewLine: integer);
procedure StartIdentCompletionBox(JumpToError, CanAutoComplete: boolean);
@ -562,8 +562,8 @@ type
property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
property Source: TStrings read GetSource write SetSource;
property SourceNotebook: TSourceNotebook read FSourceNoteBook;
property SyntaxHighlighterType: TLazSyntaxHighlighter
read fSyntaxHighlighterType write SetSyntaxHighlighterType;
property SyntaxHighlighterId: TIdeSyntaxHighlighterID
read fSyntaxHighlighterId write SetSyntaxHighlighterId;
property SyncroLockCount: Integer read FSyncroLockCount;
function SharedEditorCount: Integer;
property SharedEditors[Index: Integer]: TSourceEditor read GetSharedEditors;
@ -1493,7 +1493,6 @@ function CompareSrcEditIntfWithFilename(SrcEdit1, SrcEdit2: Pointer): integer;
function CompareFilenameWithSrcEditIntf(FilenameStr, SrcEdit: Pointer): integer;
var
Highlighters: array[TLazSyntaxHighlighter] of TSynCustomHighlighter;
EnglishGPLNotice: string;
EnglishLGPLNotice: string;
EnglishModifiedLGPLNotice: string;
@ -3583,7 +3582,7 @@ Begin
else
FSourceNoteBook:=nil;
FSyntaxHighlighterType:=lshNone;
FSyntaxHighlighterId:=IdeHighlighterNoneID;
FErrorLine:=-1;
FErrorColumn:=-1;
FSyncroLockCount := 0;
@ -4639,7 +4638,7 @@ begin
end;
// ToDo: replace step by step to keep bookmarks and breakpoints
IsPascal := True;
i:=EditorOpts.HighlighterList.FindByHighlighter(FEditor.Highlighter);
i:=EditorOpts.HighlighterList.FindByName(FEditor.Highlighter.LanguageName);
if i>=0 then
IsPascal := EditorOpts.HighlighterList[i].DefaultCommentType <> comtCPP;
// will show modal dialog - must not be in Editor.BeginUpdate block, or painting will not work
@ -4725,7 +4724,7 @@ begin
comtNone: exit;
comtDefault:
begin
i:=EditorOpts.HighlighterList.FindByHighlighter(FEditor.Highlighter);
i:=EditorOpts.HighlighterList.FindByName(FEditor.Highlighter.LanguageName);
if i>=0 then
CommentType:=EditorOpts.HighlighterList[i].DefaultCommentType;
end;
@ -4980,19 +4979,18 @@ begin
end;
end;
procedure TSourceEditor.SetSyntaxHighlighterType(AHighlighterType: TLazSyntaxHighlighter);
procedure TSourceEditor.SetSyntaxHighlighterId(
AHighlighterId: TIdeSyntaxHighlighterID);
var
HlIsPas, OldHlIsPas: Boolean;
begin
if (AHighlighterType=fSyntaxHighlighterType)
if (AHighlighterId=fSyntaxHighlighterId)
and ((FEditor.Highlighter<>nil) = EditorOpts.UseSyntaxHighlight) then exit;
OldHlIsPas := FEditor.Highlighter is TSynPasSyn;
HlIsPas := False;
if EditorOpts.UseSyntaxHighlight then begin
if Highlighters[AHighlighterType]=nil then
Highlighters[AHighlighterType]:=EditorOpts.CreateSyn(AHighlighterType);
FEditor.Highlighter:=Highlighters[AHighlighterType];
FEditor.Highlighter:=EditorOpts.HighlighterList.SharedSynInstances[AHighlighterId];
HlIsPas := FEditor.Highlighter is TSynPasSyn;
end
else
@ -5006,7 +5004,7 @@ begin
EditorOpts.GetSynEditSettings(FEditor, nil);
end;
FSyntaxHighlighterType:=AHighlighterType;
FSyntaxHighlighterId:=AHighlighterId;
SourceNotebook.UpdateActiveEditColors(FEditor);
end;
@ -5061,7 +5059,7 @@ var
SimilarEditor: TSynEdit;
Begin
Result:=true;
SetSyntaxHighlighterType(fSyntaxHighlighterType);
SetSyntaxHighlighterId(fSyntaxHighlighterId);
// try to copy settings from an editor to the left
SimilarEditor:=nil;
@ -5122,7 +5120,7 @@ begin
end;
if EditorOpts.AutoBlockCompletion
and (SyntaxHighlighterType in [lshFreePascal,lshDelphi]) then
and (FEditor.Highlighter is TSynPasSyn) then
Result:=AutoBlockCompleteChar(Char,AddChar,Category,p,Line);
end;
@ -5140,7 +5138,7 @@ var
begin
Result:=false;
if (not EditorOpts.AutoBlockCompletion)
or (not (SyntaxHighlighterType in [lshFreePascal,lshDelphi])) then
or (not (FEditor.Highlighter is TSynPasSyn)) then
exit;
FEditor.GetWordBoundsAtRowCol(aTextPos, x1, x2);
// use the token left of the caret
@ -5187,7 +5185,7 @@ var
begin
Result:=false;
if (not EditorOpts.AutoBlockCompletion)
or (not (SyntaxHighlighterType in [lshFreePascal,lshDelphi])) then
or (not (FEditor.Highlighter is TSynPasSyn)) then
exit;
p:=GetCursorTextXY;
FEditor.GetWordBoundsAtRowCol(p, x1, x2);
@ -5661,7 +5659,7 @@ var
SemMode: TSemSelectionMode;
SemAction: TSemCopyPasteAction;
begin
if (SyntaxHighlighterType in [lshFreePascal, lshDelphi]) then
if (FEditor.Highlighter is TSynPasSyn) then
AText:=UnicodeSpacesToASCII(AText);
if Assigned(Manager) then begin
@ -5681,7 +5679,7 @@ begin
if AMode<>smNormal then exit;
if SyncroLockCount > 0 then exit;
if not CodeToolsOpts.IndentOnPaste then exit;
if not (SyntaxHighlighterType in [lshFreePascal, lshDelphi]) then
if not (FEditor.Highlighter is TSynPasSyn) then
exit;
{$IFDEF VerboseIndenter}
@ -7082,17 +7080,14 @@ var
IDEMenuItem: TIDEMenuItem;
i: LongInt;
SrcEdit: TSourceEditor;
h: TLazSyntaxHighlighter;
begin
SrcEdit:=GetActiveSE;
if SrcEdit=nil then exit;
if Sender is TIDEMenuItem then begin
IDEMenuItem:=TIDEMenuItem(Sender);
i:=IDEMenuItem.SectionIndex;
if (i>=ord(Low(TLazSyntaxHighlighter)))
and (i<=ord(High(TLazSyntaxHighlighter))) then begin
h:=TLazSyntaxHighlighter(i);
SrcEdit.SyntaxHighlighterType:=h;
if (i>=0) and (i<EditorOpts.HighlighterList.Count) then begin
SrcEdit.SyntaxHighlighterId:=i;
SrcEdit.UpdateProjectFile([sepuChangedHighlighter]);
end;
end;
@ -7519,17 +7514,15 @@ end;
procedure TSourceNotebook.UpdateHighlightMenuItems(SrcEdit: TSourceEditor);
var
h: TLazSyntaxHighlighter;
i: Integer;
CurName: String;
CurCaption: String;
IDEMenuItem: TIDEMenuItem;
begin
SrcEditSubMenuHighlighter.ChildrenAsSubMenu:=true;
i:=0;
for h:=Low(TLazSyntaxHighlighter) to High(TLazSyntaxHighlighter) do begin
for i := 0 to EditorOpts.HighlighterList.Count - 1 do begin
CurName:='Highlighter'+IntToStr(i);
CurCaption:=GetSyntaxHighlighterCaption(h);
CurCaption:= EditorOpts.HighlighterList.Captions[i];
if SrcEditSubMenuHighlighter.Count=i then begin
// add new item
IDEMenuItem:=RegisterIDEMenuCommand(SrcEditSubMenuHighlighter,
@ -7541,8 +7534,7 @@ begin
end;
if IDEMenuItem is TIDEMenuCommand then
TIDEMenuCommand(IDEMenuItem).Checked:=(SrcEdit<>nil)
and (SrcEdit.SyntaxHighlighterType=h);
inc(i);
and (SrcEdit.FSyntaxHighlighterId=i);
end;
end;
@ -8403,7 +8395,7 @@ begin
Include(NewEdit.FProjectFileUpdatesNeeded, sepuNewShared);
NewEdit.PageName := SrcEdit.PageName;
NewEdit.SyntaxHighlighterType := SrcEdit.SyntaxHighlighterType;
NewEdit.SyntaxHighlighterId := SrcEdit.SyntaxHighlighterId;
NewEdit.EditorComponent.TopLine := SrcEdit.EditorComponent.TopLine;
NewEdit.EditorComponent.CaretXY := SrcEdit.EditorComponent.CaretXY;
@ -9559,7 +9551,7 @@ begin
if Result then exit;
end;
if (SrcEdit.SyncroLockCount > 0) then exit;
if not (SrcEdit.SyntaxHighlighterType in [lshFreePascal, lshDelphi]) then
if not (SrcEdit.FEditor.Highlighter is TSynPasSyn) then
exit;
if Reason<>ecLineBreak then exit;
if not CodeToolsOpts.IndentOnLineBreak then exit;
@ -9770,8 +9762,6 @@ end;
//-----------------------------------------------------------------------------
procedure InternalInit;
var
h: TLazSyntaxHighlighter;
begin
// fetch the resourcestrings before they are translated
EnglishGPLNotice:=lisGPLNotice;
@ -9779,8 +9769,6 @@ begin
EnglishModifiedLGPLNotice:=lisModifiedLGPLNotice;
EnglishMITNotice:=lisMITNotice;
for h:=Low(TLazSyntaxHighlighter) to High(TLazSyntaxHighlighter) do
Highlighters[h]:=nil;
IDESearchInText:=@SearchInText;
PasBeautifier := TSynBeautifierPascal.Create(nil);
@ -9793,11 +9781,7 @@ begin
end;
procedure InternalFinal;
var
h: TLazSyntaxHighlighter;
begin
for h:=Low(TLazSyntaxHighlighter) to High(TLazSyntaxHighlighter) do
FreeThenNil(Highlighters[h]);
FreeThenNil(aWordCompletion);
FreeAndNil(PasBeautifier);
end;
@ -10198,7 +10182,7 @@ begin
end;
end;
if not (SrcEdit.SyntaxHighlighterType in [lshFreePascal, lshDelphi]) then
if not (SrcEdit.FEditor.Highlighter is TSynPasSyn) then
UseWordCompletion:=true;
Result:=true;
end;

16
ide/sourcefilemanager.pas
View File

@ -579,7 +579,7 @@ begin
// get syntax highlighter type
if (uifInternalFile in AnUnitInfo.Flags) then
AnUnitInfo.UpdateDefaultHighlighter(lshFreePascal)
AnUnitInfo.UpdateDefaultHighlighter(IdeSyntaxHighlighters.GetIdForLazSyntaxHighlighter(lshFreePascal))
else
AnUnitInfo.UpdateDefaultHighlighter(FilenameToLazSyntaxHighlighter(AFilename));
@ -631,7 +631,7 @@ begin
// restore source editor settings
DebugBossMgr.DoRestoreDebuggerMarks(AnUnitInfo);
NewSrcEdit.SyntaxHighlighterType := AnEditorInfo.SyntaxHighlighter;
NewSrcEdit.SyntaxHighlighterId := AnEditorInfo.SyntaxHighlighter;
NewSrcEdit.EditorComponent.AfterLoadFromFile;
try
NewSrcEdit.EditorComponent.FoldState := FoldState;
@ -883,7 +883,7 @@ begin
if MacroListViewer.MacroByFullName(FFileName) <> nil then
NewBuf.Source := MacroListViewer.MacroByFullName(FFileName).GetAsSource;
FNewUnitInfo:=TUnitInfo.Create(NewBuf);
FNewUnitInfo.DefaultSyntaxHighlighter := lshFreePascal;
FNewUnitInfo.DefaultSyntaxHighlighter := IdeSyntaxHighlighters.GetIdForLazSyntaxHighlighter(lshFreePascal);
Project1.AddFile(FNewUnitInfo,false);
end
else begin
@ -2250,7 +2250,7 @@ begin
NewUnitInfo.Source, True, AShareEditor);
MainIDEBar.itmFileClose.Enabled:=True;
MainIDEBar.itmFileCloseAll.Enabled:=True;
NewSrcEdit.SyntaxHighlighterType:=NewUnitInfo.EditorInfo[0].SyntaxHighlighter;
NewSrcEdit.SyntaxHighlighterId:=NewUnitInfo.EditorInfo[0].SyntaxHighlighter;
NewUnitInfo.GetClosedOrNewEditorInfo.EditorComponent := NewSrcEdit;
NewSrcEdit.EditorComponent.CaretXY := Point(1,1);
@ -4706,11 +4706,11 @@ begin
// try to keep the old filename and extension
SaveAsFileExt:=ExtractFileExt(AFileName);
if (SaveAsFileExt='') and (SrcEdit<>nil) then begin
if (SrcEdit.SyntaxHighlighterType in [lshFreePascal, lshDelphi]) then
if (IdeSyntaxHighlighters.GetLazSyntaxHighlighterType(SrcEdit.SyntaxHighlighterId) {%H-}in [lshFreePascal, lshDelphi]) then
SaveAsFileExt:=PascalExtension[EnvironmentOptions.PascalFileExtension]
else
SaveAsFileExt:=EditorOpts.HighlighterList.GetDefaultFilextension(
SrcEdit.SyntaxHighlighterType);
SrcEdit.SyntaxHighlighterId);
end;
if FilenameIsPascalSource(AFilename) then begin
if AnUnitInfo<>nil then
@ -5437,7 +5437,7 @@ var
OldFilePath, OldLRSFilePath: String;
OldSourceCode, OldUnitPath: String;
AmbiguousFilename, OutDir, S: string;
NewHighlighter: TLazSyntaxHighlighter;
NewHighlighter: TIdeSyntaxHighlighterID;
AmbiguousFiles: TStringList;
i: Integer;
DirRelation: TSPFileMaskRelation;
@ -5626,7 +5626,7 @@ begin
if (AnUnitInfo.EditorInfo[i].EditorComponent <> nil) and
(not AnUnitInfo.EditorInfo[i].CustomHighlighter)
then
TSourceEditor(AnUnitInfo.EditorInfo[i].EditorComponent).SyntaxHighlighterType :=
TSourceEditor(AnUnitInfo.EditorInfo[i].EditorComponent).SyntaxHighlighterId :=
AnUnitInfo.EditorInfo[i].SyntaxHighlighter;
// save file

1
packager/globallinks/lazedit-1.lpl Normal file
View File

@ -0,0 +1 @@
$(LazarusDir)/components/lazedit/lazedit.lpk