mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-05 05:48:12 +02:00
2797 lines
77 KiB
ObjectPascal
2797 lines
77 KiB
ObjectPascal
{-------------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: SynUniHighlighter.pas, released 2003-01
|
|
All Rights Reserved.
|
|
|
|
Alternatively, the contents of this file may be used under the terms of the
|
|
GNU General Public License Version 2 or later (the "GPL"), in which case
|
|
the provisions of the GPL are applicable instead of those above.
|
|
If you wish to allow use of your version of this file only under the terms
|
|
of the GPL and not to allow others to use your version of this file
|
|
under the MPL, indicate your decision by deleting the provisions above and
|
|
replace them with the notice and other provisions required by the GPL.
|
|
If you do not delete the provisions above, a recipient may use your version
|
|
of this file under either the MPL or the GPL.}
|
|
|
|
{
|
|
@abstract(Provides a universal highlighter for SynEdit)
|
|
@authors(Fantasist [walking_in_the_sky@yahoo.com],Vit [nevzorov@yahoo.com])
|
|
@created(2003)
|
|
@lastmod(2003-01-29)
|
|
}
|
|
|
|
(******************************************************************************
|
|
Authors: Fantasist (Kirill Burtsev walking_in_the_sky@yahoo.com)
|
|
Vit (Vitaly Nevzorov nevzorov@yahoo.com);
|
|
Official Site: www.delphist.com
|
|
With all questions, please visit www.delphist.com/forum
|
|
|
|
Contributors:
|
|
|
|
Tom Lisjac <vlx@users.sourceforge.net> http://theseus.sf.net
|
|
Initially adapted for use with Lazarus and FPC - 2003-06-12
|
|
Changes can be found by searching for: ////TL
|
|
|
|
|
|
******************************************************************************)
|
|
|
|
unit SynUniHighlighter;
|
|
|
|
{$I SynEdit.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils,
|
|
Graphics,
|
|
GraphType, FileUtil,
|
|
SynEditTypes, SynEditHighlighter;
|
|
|
|
Const
|
|
_Root='Root';
|
|
_NewRange='New';
|
|
|
|
type
|
|
TVersionType=(vtInternalTest, vtBeta, vtRelease);
|
|
|
|
TAuthorInfo=record
|
|
Name:string;
|
|
Email:string;
|
|
Web:string;
|
|
Copyright:string;
|
|
Company:string;
|
|
Remark:string;
|
|
end;
|
|
|
|
TVerInfo=record
|
|
Version:Integer;
|
|
Revision:Integer;
|
|
VersionType:TVersionType;
|
|
ReleaseDate:TDateTime;
|
|
end;
|
|
|
|
THighInfo=record
|
|
Name:string;
|
|
FileTypeName:string;
|
|
Layout:string;
|
|
end;
|
|
|
|
TInfo=record
|
|
Author:TAuthorInfo;
|
|
Version:TVerInfo;
|
|
General:THighInfo;
|
|
History:TStringList;
|
|
Sample:TStringlist;
|
|
End;
|
|
|
|
TSynRange=class;
|
|
|
|
TSymbBrakeType=(btUnspecified,btAny,btTerm);
|
|
|
|
TSynSymbol=class
|
|
private
|
|
Attr:TSynHighlighterAttributes;
|
|
fOpenRule:TSynRange;
|
|
FBrakeType:TSymbBrakeType;
|
|
public
|
|
Symbol:string;
|
|
property BrakeType:TSymbBrakeType read FBrakeType write FBrakeType;
|
|
property Attributes:TSynHighlighterAttributes read Attr write Attr;
|
|
constructor Create(s:string;attribs:TSynHighlighterAttributes); virtual;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TSynSymbolGroup=class
|
|
Attribs:TSynHighlighterAttributes;
|
|
KeywordsList:TStringList;
|
|
GroupName:string;
|
|
Name:string;
|
|
constructor Create(s:string; attr:TSynHighlighterAttributes);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TSymbRangeSet=record
|
|
RangeValue:Integer;
|
|
IncludeSymbols:boolean;
|
|
end;
|
|
|
|
PSymbRangeSet=^TSymbRangeSet;
|
|
|
|
|
|
SymbolsSet=set of char;
|
|
|
|
TSymbolList=class;
|
|
|
|
TSymbolNode=class
|
|
c:char;
|
|
BrakeType:TSymbBrakeType;
|
|
NextSymbs:TSymbolList;
|
|
tkSynSymbol:TSynSymbol;
|
|
constructor Create(AC:char; SynSymbol:TSynSymbol; ABrakeType:TSymbBrakeType); overload; virtual;
|
|
constructor Create(AC:char); overload;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TSymbolList=class
|
|
SymbList:TList;
|
|
function FindSymbol(c:char):TSymbolNode;
|
|
procedure AddSymbol(symb:TSymbolNode);
|
|
procedure SetSymbolNode(Index:Integer;Value:TSymbolNode);
|
|
function GetSymbolNode(Index:integer):TSymbolNode;
|
|
function GetCount:integer;
|
|
property Nodes[index:integer]:TSymbolNode read GetSymbolNode write SetSymbolNode;
|
|
property Count:Integer read GetCount;
|
|
constructor Create(); virtual;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TSynUniSyn = class;
|
|
|
|
TAbstractSymbol=class
|
|
function GetToken(parser:TSynUniSyn; var tkSynSymbol:TSynSymbol):boolean; virtual; abstract;
|
|
end;
|
|
|
|
TSymbols=class(TAbstractSymbol)
|
|
HeadNode:TSymbolNode;
|
|
function GetToken(parser:TSynUniSyn; var tkSynSymbol:TSynSymbol):boolean; override;
|
|
procedure AddSymbol(s:string; tkSynSymbol:TSynSymbol; ABrakeType: TSymbBrakeType);
|
|
function FindSymbol(s:string):TSymbolNode;
|
|
constructor Create(c:char; tkSynSymbol:TSynSymbol;ABrakeType:TSymbBrakeType); reintroduce; virtual;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TDefaultSymbols=class(TAbstractSymbol)
|
|
tkSynSymbol:TSynSymbol;
|
|
constructor Create(SynSymb:TSynSymbol); reintroduce; virtual;
|
|
destructor Destroy; override;
|
|
////TL Duplicate identifier TkSynSymbol... changed to TkSynSymbol1
|
|
function GetToken(parser:TSynUniSyn; var tkSynSymbol1:TSynSymbol):boolean; override;
|
|
end;
|
|
|
|
TDefaultTermSymbols=class(TAbstractSymbol)
|
|
tkSynSymbol:TSynSymbol;
|
|
constructor Create(SynSymb:TSynSymbol); virtual;
|
|
////TL Duplicate identifier TkSynSymbol... changed to TkSynSymbol1
|
|
function GetToken(parser:TSynUniSyn; var tkSynSymbol1:TSynSymbol):boolean; override;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
TNumberSymbols=class(TAbstractSymbol)
|
|
tkSynSymbol:TSynSymbol;
|
|
constructor Create(SynSymbol:TSynSymbol); virtual;
|
|
////TL Duplicate identifier TkSynSymbol... changed to TkSynSymbol1
|
|
function GetToken(parser:TSynUniSyn; var tkSynSymbol1:TSynSymbol):boolean; override;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TClosingSymbolSet=record
|
|
Symbol:TSynSymbol;
|
|
AllowPredClose:boolean;
|
|
end;
|
|
PClosingSymbolSet=^TClosingSymbolSet;
|
|
|
|
TSynRange=class
|
|
private
|
|
fCloseSymbol:TSynSymbol;
|
|
fOpenSymbol: TSynSymbol;
|
|
fCloseOnTerm:boolean;
|
|
fCloseOnEol:boolean;
|
|
FCaseSensitive:boolean;
|
|
fOwner:TSynRange;
|
|
// fClosingSymbols:array of TClosingSymbolSet;
|
|
fClosingSymbol:TClosingSymbolSet;
|
|
|
|
fSynSymbols:TList;
|
|
fSynRanges:TList;
|
|
fSymbolGroups:TList;
|
|
|
|
fDefaultSynSymbol:TSynSymbol;
|
|
fNumberSymbol:TNumberSymbols;
|
|
fDefaultSymbols:TDefaultSymbols;
|
|
fDefaultTermSymbol:TDefaultTermSymbols;
|
|
|
|
fDefaultAttri: TSynHighlighterAttributes;
|
|
fNumberAttri: TSynHighlighterAttributes;
|
|
fAttribs:TList;
|
|
|
|
fTermSymbols:SymbolsSet;
|
|
SymbolList: array[char] of TAbstractSymbol;
|
|
|
|
CaseFunct:function (c:char):char;
|
|
StringCaseFunct:function (const s:string):string;
|
|
fPrepared:boolean;
|
|
FName: string;
|
|
private
|
|
function GetSynSymbol(Index:Integer):TSynSymbol;
|
|
function GetSynRange(Index:Integer):TSynRange;
|
|
function GetSynSymbolGroup(Index:Integer):TSynSymbolGroup;
|
|
function GetRangeCount:Integer;
|
|
function GetSymbolCount:Integer;
|
|
function GetSymbolGroupCount:Integer;
|
|
|
|
function GetCaseSensitive: boolean;
|
|
procedure SetCaseSensitive(const Value: boolean);
|
|
public
|
|
////TL Get rid of default, optional parameters... we'll be explicit in the calls
|
|
////TL constructor Create(OpenSymbs:string='';CloseSymbs:string=''); virtual;
|
|
constructor Create(OpenSymbs:string; CloseSymbs:string); virtual;
|
|
destructor Destroy; override;
|
|
|
|
procedure AddSymbolGroup(SymbolGroup:TSynSymbolGroup);
|
|
procedure AddSymbol(NewSymb:TSynSymbol);
|
|
procedure AddRange(NewSymb:TSynRange);
|
|
function GetSymbol(s:string):TSynSymbol;
|
|
function FindSymbol(s:string):TSynSymbol;
|
|
function FindSymbolOwner(Symbol:TSynSymbol):TSynSymbolGroup;
|
|
|
|
procedure DeleteRange(index:integer); overload;
|
|
procedure DeleteRange(SynRange:TSynRange); overload;
|
|
procedure DeleteSymbolGroup(index:integer); overload;
|
|
procedure DeleteSymbolGroup(SymbolGroup:TSynSymbolGroup); overload;
|
|
////TL FPC errored with duplicate id... changed to Name1 in the following 2 functions
|
|
function AddNewAttribs(Name1:String):TSynHighlighterAttributes;
|
|
function AttribsByName(Name1:string):TSynHighlighterAttributes;
|
|
function AddAttribs(Attri:TSynHighlighterAttributes):integer;
|
|
procedure DeleteAttribs(Idx:integer); overload;
|
|
////TL FPC errored with duplicate id... changed to Name1
|
|
procedure DeleteAttribs(Name1:string); overload;
|
|
|
|
procedure Prepare(Owner:TSynRange);
|
|
procedure Reset;
|
|
procedure Clear;
|
|
|
|
Procedure LoadFromStream(aSrc: TStream);
|
|
public
|
|
property TermSymbols:SymbolsSet read fTermSymbols write fTermSymbols;
|
|
property OpenSymbol:TSynSymbol read fOpenSymbol;
|
|
property CloseSymbol:TSynSymbol read fCloseSymbol;
|
|
property CloseOnTerm:boolean read fCloseOnTerm write fCloseOnTerm;
|
|
property CloseOnEol:boolean read fCloseOnEol write fCloseOnEol;
|
|
|
|
property Ranges[Index:integer]:TSynRange read GetSynRange;
|
|
property RangeCount:integer read GetRangeCount;
|
|
property Symbols[Index:integer]:TSynSymbol read GetSynSymbol;
|
|
property SymbolCount:integer read GetSymbolCount;
|
|
property SymbolGroups[Index:integer]:TSynSymbolGroup read GetSynSymbolGroup;
|
|
property SymbolGroupCount:Integer read GetSymbolGroupCount;
|
|
|
|
property NumberAttri: TSynHighlighterAttributes read fNumberAttri;
|
|
property DefaultAttri: TSynHighlighterAttributes read fDefaultAttri;
|
|
|
|
property CaseSensitive:boolean read GetCaseSensitive write SetCaseSensitive;
|
|
property Prepared:boolean read fPrepared;
|
|
property Parent:TSynRange read fOwner;
|
|
property Name:string read FName write FName;
|
|
end;
|
|
|
|
|
|
TSynUniSyn = class(TSynCustomHighlighter)
|
|
private
|
|
procedure ReadSyntax(Reader: TReader);
|
|
procedure WriteSyntax(Writer: TWriter);
|
|
protected
|
|
fMainRules:TSynRange;
|
|
|
|
fEol:boolean;
|
|
fPrEol:boolean;
|
|
fTrueLine: PChar;
|
|
fLine: PChar;
|
|
fLineNumber: Integer;
|
|
Run: LongInt;
|
|
fStringLen: Integer;
|
|
fTokenPos: Integer;
|
|
|
|
fCurrToken:TSynSymbol;
|
|
|
|
fCurrentRule:TSynRange;
|
|
fSymbols:TSymbols;
|
|
SymbolList: array[char] of TAbstractSymbol;
|
|
|
|
fPrepared:boolean;
|
|
procedure SpaceProc;
|
|
procedure NullProc;
|
|
function GetIdentChars: TSynIdentChars; override;
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetSampleSource: string; override;
|
|
procedure SetSampleSource(Value: string); override;
|
|
public
|
|
class function GetLanguageName: string; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
|
|
override;
|
|
function GetEOL: Boolean; override;
|
|
function GetRange: Pointer; override;
|
|
function GetToken: string; override;
|
|
////TL Added the following 3 lines... and the implementation procedure
|
|
procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override; ////TL: Added 2003-06-11
|
|
|
|
function GetTokenAttribute: TSynHighlighterAttributes; override;
|
|
function GetTokenID: Integer;
|
|
function GetTokenKind: integer; override;
|
|
function GetTokenPos: Integer; override;
|
|
function IsKeyword(const AKeyword: string): boolean; override; // DJLP 2000-08-09
|
|
procedure Next; override;
|
|
procedure ResetRange; override;
|
|
procedure SetLine(const NewValue: String; LineNumber:Integer); override; ////TL: Replaced line below 2003-06-12
|
|
////TL replaced by line above procedure SetLine(NewValue: string; LineNumber: Integer); ////TL override;
|
|
procedure SetRange(Value: Pointer); override;
|
|
procedure Reset;
|
|
procedure Clear;
|
|
procedure Prepare;
|
|
Procedure CreateStandardRules;
|
|
Procedure LoadFromStream(aSrc: TStream);
|
|
Procedure SaveToStream(aDst: TStream);
|
|
Procedure LoadFromFile(FileName:string);
|
|
Procedure SaveToFile(FileName:string);
|
|
public
|
|
Info:TInfo;
|
|
property MainRules:TSynRange read fMainRules;
|
|
end;
|
|
|
|
TNodeType=(ntRange, ntRootRange, ntKeyWords, ntNone);
|
|
|
|
Function String2Set(s:string):SymbolsSet;
|
|
Function Set2String(s:SymbolsSet):string;
|
|
procedure BuildXMLIndexes(xmlInfoTags: TStringList);
|
|
|
|
const
|
|
DefaultTermSymbols: SymbolsSet = ['*','/','+','-','=','\','|','&','(',')',
|
|
'[',']','{','}','`','~','!','@',',','$','%','^','?',':',';','''','"','.',
|
|
'>','<','#'];
|
|
|
|
Procedure Register;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SynEditStrConst;
|
|
|
|
procedure BuildXMLIndexes(xmlInfoTags: TStringList);
|
|
begin
|
|
xmlInfoTags.Add('AnyTerm');
|
|
xmlInfoTags.Add('Attri');
|
|
xmlInfoTags.Add('Author');
|
|
xmlInfoTags.Add('Back');
|
|
xmlInfoTags.Add('CaseSensitive');
|
|
xmlInfoTags.Add('CloseOnEol');
|
|
xmlInfoTags.Add('CloseOnTerm');
|
|
xmlInfoTags.Add('CloseSymbol');
|
|
xmlInfoTags.Add('Company');
|
|
xmlInfoTags.Add('Copyright');
|
|
xmlInfoTags.Add('Date');
|
|
xmlInfoTags.Add('Def');
|
|
xmlInfoTags.Add('DelimiterChars');
|
|
xmlInfoTags.Add('Email');
|
|
xmlInfoTags.Add('FileTypeName');
|
|
xmlInfoTags.Add('Fore');
|
|
xmlInfoTags.Add('General');
|
|
xmlInfoTags.Add('H');
|
|
xmlInfoTags.Add('History');
|
|
xmlInfoTags.Add('Info');
|
|
xmlInfoTags.Add('KW');
|
|
xmlInfoTags.Add('Layout');
|
|
xmlInfoTags.Add('Name');
|
|
xmlInfoTags.Add('Num');
|
|
xmlInfoTags.Add('OpenSymbol');
|
|
xmlInfoTags.Add('Range');
|
|
xmlInfoTags.Add('Remark');
|
|
xmlInfoTags.Add('Revision');
|
|
xmlInfoTags.Add('S');
|
|
xmlInfoTags.Add('Sample');
|
|
xmlInfoTags.Add('Style');
|
|
xmlInfoTags.Add('Type');
|
|
xmlInfoTags.Add('UniHighlighter');
|
|
xmlInfoTags.Add('Version');
|
|
xmlInfoTags.Add('W');
|
|
xmlInfoTags.Add('Web');
|
|
end;
|
|
|
|
const
|
|
////TL: Duplicate members: #32=' '... FPC is right... why did Delphi allow it?
|
|
//////////////AbsoluteTermSymbols:SymbolsSet=[' ',#13,#0,#10,#32];
|
|
AbsoluteTermSymbols:SymbolsSet=[' ',#13,#0,#10];
|
|
|
|
tkNoRange=1;
|
|
tkNoRangeChange=0;
|
|
// srNoRangeChange:TSymbRangeSet=(RangeValue:tkNoRangeChange;IncludeSymbols:true;);
|
|
|
|
xitAnyTerm=0;
|
|
xitAttri=1;
|
|
xitAuthor=2;
|
|
xitBack=3;
|
|
xitCaseSensitive=4;
|
|
xitCloseOnEol=5;
|
|
xitCloseOnTerm=6;
|
|
xitCloseSymbol=7;
|
|
xitCompany=8;
|
|
xitCopyright=9;
|
|
xitDate=10;
|
|
xitDef=11;
|
|
xitDelimiterChars=12;
|
|
xitEmail=13;
|
|
xitFileTypeName=14;
|
|
xitFore=15;
|
|
xitGeneral=16;
|
|
xitH=17;
|
|
xitHistory=18;
|
|
xitInfo=19;
|
|
xitKW=20;
|
|
xitLayout=21;
|
|
xitName=22;
|
|
xitNum=23;
|
|
xitOpenSymbol=24;
|
|
xitRange=25;
|
|
xitRemark=26;
|
|
xitRevision=27;
|
|
xitS=28;
|
|
xitSample=29;
|
|
xitStyle=30;
|
|
xitType=31;
|
|
xitUniHighlighter=32;
|
|
xitVersion=33;
|
|
xitW=34;
|
|
xitWeb=35;
|
|
|
|
Function String2Set(s:string):SymbolsSet;
|
|
var i:integer;
|
|
begin
|
|
result:=[];
|
|
for i:=1 to length(s) do Result:=Result+[s[i]];
|
|
end;
|
|
|
|
Function Set2String(s:SymbolsSet):string;
|
|
var b:byte;
|
|
begin
|
|
Result:='';
|
|
for b:=1 to 255 do
|
|
if (chr(b) in s) and (not (chr(b) in AbsoluteTermSymbols)) then
|
|
Result:=Result+chr(b);
|
|
end;
|
|
|
|
Function String2Fs(Style: string):TFontStyles;
|
|
begin
|
|
Result := [];
|
|
if Pos('B', Style) > 0 then
|
|
Include( Result, fsBold );
|
|
if Pos('I', Style) > 0 then
|
|
Include( Result, fsItalic );
|
|
if Pos('U', Style) > 0 then
|
|
Include( Result, fsUnderline );
|
|
if Pos('S', Style) > 0 then
|
|
Include( Result, fsStrikeOut );
|
|
end;
|
|
|
|
Function Fs2String(Style:TFontStyles):string;
|
|
begin
|
|
Result:='';
|
|
if fsBold in Style then Result:=Result+'B';
|
|
if fsItalic in Style then Result:=Result+'I';
|
|
if fsUnderline in Style then Result:=Result+'U';
|
|
if fsStrikeOut in Style then Result:=Result+'S';
|
|
end;
|
|
|
|
procedure FreeList(var List:TList);
|
|
var
|
|
i:integer;
|
|
begin
|
|
if List=nil then exit;
|
|
|
|
for i:=0 to List.Count-1 do
|
|
TObject(List[i]).Free;
|
|
List.Free;
|
|
List:=nil;
|
|
end;
|
|
|
|
procedure ClearList(List:TList);
|
|
var
|
|
i:integer;
|
|
begin
|
|
if List=nil then exit;
|
|
|
|
for i:=0 to List.Count-1 do
|
|
TObject(List[i]).Free;
|
|
List.Clear;
|
|
end;
|
|
|
|
function CaseNone(c:char):char;
|
|
begin
|
|
Result:=c;
|
|
end;
|
|
|
|
function StringCaseNone(const s:string):string;
|
|
begin
|
|
Result:=s;
|
|
end;
|
|
|
|
(*
|
|
function CloseRangeComp(CloseRange:PSymbRangeSet;RangeCount:Integer; Range:Integer; var IncludeSymbol:boolean):boolean;
|
|
var
|
|
i:integer;
|
|
begin
|
|
for i:=1 to RangeCount do
|
|
begin
|
|
if CloseRange^.RangeValue=Range then
|
|
begin
|
|
Result:=True;
|
|
IncludeSymbol:=CloseRange^.IncludeSymbols;
|
|
exit;
|
|
end;
|
|
inc(CloseRange);
|
|
end;
|
|
Result:=False;
|
|
end;
|
|
*)
|
|
|
|
{ TSynSymbolGroup }
|
|
|
|
constructor TSynSymbolGroup.Create(s: string; attr: TSynHighlighterAttributes);
|
|
begin
|
|
Attribs:=attr;
|
|
KeywordsList:=TStringList.Create;
|
|
KeywordsList.Text:=s;
|
|
end;
|
|
|
|
destructor TSynSymbolGroup.Destroy;
|
|
begin
|
|
KeywordsList.Free;
|
|
inherited;
|
|
end;
|
|
|
|
|
|
{ TSynSymbol }
|
|
|
|
constructor TSynSymbol.Create(s: string;
|
|
attribs: TSynHighlighterAttributes);
|
|
begin
|
|
attr:=attribs;
|
|
Symbol:=s;
|
|
fOpenRule:=nil;
|
|
BrakeType:=btUnspecified;
|
|
// fClosing:=false;
|
|
end;
|
|
|
|
destructor TSynSymbol.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
{ TSynRange }
|
|
|
|
procedure TSynRange.AddRange(NewSymb: TSynRange);
|
|
begin
|
|
fSynRanges.Add(NewSymb);
|
|
end;
|
|
|
|
procedure TSynRange.AddSymbol(NewSymb: TSynSymbol);
|
|
var
|
|
SynSym:TSynSymbol;
|
|
begin
|
|
SynSym:=FindSymbol(NewSymb.Symbol);
|
|
if SynSym<>nil then
|
|
begin
|
|
fSynSymbols.Remove(SynSym);
|
|
SynSym.Free;
|
|
end;
|
|
fSynSymbols.Add(NewSymb);
|
|
end;
|
|
|
|
procedure TSynRange.AddSymbolGroup(SymbolGroup: TSynSymbolGroup);
|
|
begin
|
|
fSymbolGroups.Add(SymbolGroup);
|
|
end;
|
|
|
|
constructor TSynRange.Create(OpenSymbs:string;CloseSymbs:string);
|
|
begin
|
|
fOpenSymbol:=TSynSymbol.Create(OpenSymbs,nil);
|
|
fCloseSymbol:=TSynSymbol.Create(CloseSymbs,nil);
|
|
|
|
fDefaultAttri :=TSynHighlighterAttributes.Create(SYNS_AttrDefaultPackage);
|
|
fNumberAttri := TSynHighlighterAttributes.Create(SYNS_AttrNumber);
|
|
|
|
FillChar(SymbolList,sizeof(SymbolList),0);
|
|
////TL Added @ prefix
|
|
CaseFunct:=@UpCase;
|
|
StringCaseFunct:=@UpperCase;
|
|
|
|
fPrepared:=false;
|
|
fCloseOnTerm:=false;
|
|
fCloseOnEol:=false;
|
|
|
|
fAttribs:=TList.Create;
|
|
fSymbolGroups:=TList.Create;
|
|
fSynSymbols:=TList.Create;
|
|
fSynRanges:=TList.Create;
|
|
fTermSymbols:=DefaultTermSymbols;
|
|
end;
|
|
|
|
destructor TSynRange.Destroy;
|
|
begin
|
|
// Reset;
|
|
fOpenSymbol.Free;
|
|
fCloseSymbol.Free;
|
|
FreeList(fSymbolGroups);
|
|
FreeList(fSynSymbols);
|
|
FreeList(fSynRanges);
|
|
FreeList(fAttribs);
|
|
inherited;
|
|
end;
|
|
|
|
function TSynRange.FindSymbol(s: string): TSynSymbol;
|
|
var
|
|
i:integer;
|
|
begin
|
|
Result:=nil;
|
|
for i:=0 to fSynSymbols.Count-1 do
|
|
if TSynSymbol(fSynSymbols.Items[i]).Symbol=s then
|
|
begin
|
|
Result:=TSynSymbol(fSynSymbols.Items[i]);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
function TSynRange.FindSymbolOwner(Symbol: TSynSymbol): TSynSymbolGroup;
|
|
var
|
|
i,j:integer;
|
|
begin
|
|
Result:=nil;
|
|
for i:=0 to fSymbolGroups.Count-1 do
|
|
if TSynSymbolGroup(fSymbolGroups[i]).KeywordsList.Find(Symbol.Symbol,j) then
|
|
begin
|
|
Result:=TSynSymbolGroup(fSymbolGroups[i]);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
function TSynRange.GetRangeCount: Integer;
|
|
begin
|
|
Result:=fSynRanges.Count;
|
|
end;
|
|
|
|
function TSynRange.GetSymbol(s: string): TSynSymbol;
|
|
begin
|
|
Result:=FindSymbol(s);
|
|
end;
|
|
|
|
function TSynRange.GetSymbolCount: Integer;
|
|
begin
|
|
Result:=fSynSymbols.Count;
|
|
end;
|
|
|
|
function TSynRange.GetSymbolGroupCount: Integer;
|
|
begin
|
|
Result:=fSymbolGroups.Count;
|
|
end;
|
|
|
|
function TSynRange.GetSynRange(Index: Integer): TSynRange;
|
|
begin
|
|
Result:=TSynRange(fSynRanges[Index]);
|
|
end;
|
|
|
|
function TSynRange.GetSynSymbol(Index: Integer): TSynSymbol;
|
|
begin
|
|
Result:=TSynSymbol(fSynSymbols[Index]);
|
|
end;
|
|
|
|
function TSynRange.GetSynSymbolGroup(Index: Integer): TSynSymbolGroup;
|
|
begin
|
|
Result:=TSynSymbolGroup(fSymbolGroups[Index]);
|
|
end;
|
|
|
|
procedure TSynRange.Prepare(Owner:TSynRange);
|
|
var
|
|
i,j:integer;
|
|
SynSymbol:TSynSymbol;
|
|
s:string;
|
|
FirstChar:char;
|
|
BrakeType:TSymbBrakeType;
|
|
|
|
procedure SortSymbolList(List:TList);
|
|
var
|
|
i:integer;
|
|
fin:boolean;
|
|
begin
|
|
fin:=False;
|
|
while not fin do
|
|
begin
|
|
fin:=True;
|
|
for i:=0 to List.Count-2 do
|
|
if TSynSymbol(List[i]).Symbol>TSynSymbol(List[i+1]).Symbol then
|
|
begin
|
|
List.Exchange(i,i+1);
|
|
fin:=False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function SafeInsertSymbol(Symb:TSynSymbol; Rules:TSynRange; Attribs:TSynHighlighterAttributes):TSynSymbol;
|
|
begin
|
|
Result:=Rules.FindSymbol(Symb.Symbol);
|
|
if Result=nil then
|
|
begin
|
|
Result:=TSynSymbol.Create(Symb.Symbol,Symb.Attr);
|
|
Result.BrakeType:=Symb.BrakeType;
|
|
Rules.AddSymbol(Result);
|
|
end;
|
|
if Result.Attr=nil then
|
|
Result.Attr:=Attribs;
|
|
end;
|
|
|
|
begin
|
|
Reset;
|
|
fOwner:=Owner;
|
|
|
|
fDefaultSynSymbol:=TSynSymbol.Create('',fDefaultAttri);
|
|
fDefaultTermSymbol:=TDefaultTermSymbols.Create(TSynSymbol.Create('',fDefaultAttri));
|
|
fDefaultSymbols:=TDefaultSymbols.Create(TSynSymbol.Create('',fDefaultAttri));
|
|
fNumberSymbol:=TNumberSymbols.Create(TSynSymbol.Create('',fNumberAttri));
|
|
fTermSymbols:=fTermSymbols+AbsoluteTermSymbols;
|
|
|
|
//Add all keywords in Symbol list.
|
|
for i:=0 to fSymbolGroups.Count-1 do
|
|
for j:=0 to TSynSymbolGroup(fSymbolGroups[i]).KeywordsList.Count-1 do
|
|
AddSymbol(TSynSymbol.Create(TSynSymbolGroup(fSymbolGroups[i]).KeywordsList[j],TSynSymbolGroup(fSymbolGroups[i]).Attribs));
|
|
|
|
//Assign range opening and closing symbols and Prepare range rules.
|
|
for i:=0 to fSynRanges.Count-1 do
|
|
begin
|
|
//Assign range opening symbol
|
|
SynSymbol:=SafeInsertSymbol(TSynRange(fSynRanges[i]).fOpenSymbol,self,TSynRange(fSynRanges[i]).fDefaultAttri);
|
|
SynSymbol.fOpenRule:=TSynRange(fSynRanges[i]);
|
|
|
|
//Assing range closing symbols
|
|
SynSymbol:=SafeInsertSymbol(TSynRange(fSynRanges[i]).fCloseSymbol,TSynRange(fSynRanges[i]),TSynRange(fSynRanges[i]).fDefaultAttri);
|
|
TSynRange(fSynRanges[i]).fClosingSymbol.Symbol:=SynSymbol;
|
|
|
|
TSynRange(fSynRanges[i]).Prepare(Self);
|
|
end;
|
|
|
|
//Build tokens table
|
|
|
|
SortSymbolList(fSynSymbols);
|
|
for i:=0 to fSynSymbols.Count-1 do
|
|
begin
|
|
SynSymbol:=TSynSymbol(fSynSymbols[i]);
|
|
if Length(SynSymbol.Symbol)<1 then
|
|
continue;
|
|
s:=SynSymbol.Symbol;
|
|
FirstChar:=s[1];
|
|
if SynSymbol.BrakeType<>btUnspecified then
|
|
BrakeType:=SynSymbol.BrakeType
|
|
else
|
|
if s[Length(s)] in fTermSymbols then
|
|
BrakeType:=btAny
|
|
else
|
|
BrakeType:=btTerm;
|
|
if SymbolList[CaseFunct(FirstChar)]=nil then
|
|
begin
|
|
if Length(s)=1 then
|
|
SymbolList[CaseFunct(FirstChar)]:=TSymbols.Create(FirstChar,SynSymbol,BrakeType)
|
|
else
|
|
begin
|
|
SymbolList[CaseFunct(FirstChar)]:=TSymbols.Create(FirstChar,fDefaultSynSymbol,BrakeType);
|
|
TSymbols(SymbolList[CaseFunct(FirstChar)]).AddSymbol(StringCaseFunct(copy(s,2,Length(s)-1)),SynSymbol,BrakeType);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if Length(s)=1 then
|
|
else
|
|
TSymbols(SymbolList[CaseFunct(FirstChar)]).AddSymbol(StringCaseFunct(copy(s,2,Length(s)-1)),SynSymbol,BrakeType);
|
|
end;
|
|
end;
|
|
|
|
//Fill remaining table
|
|
for i:=0 to 255 do
|
|
if SymbolList[char(i)]=nil then
|
|
begin
|
|
if char(i) in fTermSymbols then
|
|
SymbolList[char(i)]:=fDefaultTermSymbol
|
|
else
|
|
if char(i) in ['0'..'9'] then
|
|
SymbolList[char(i)]:=fNumberSymbol
|
|
else
|
|
SymbolList[char(i)]:=fDefaultSymbols;
|
|
end;
|
|
|
|
fPrepared:=true;
|
|
end;
|
|
|
|
function TSynRange.GetCaseSensitive: boolean;
|
|
begin
|
|
Result:=FCaseSensitive;//@CaseFunct=@UpCase;
|
|
end;
|
|
|
|
procedure TSynRange.SetCaseSensitive(const Value: boolean);
|
|
begin
|
|
FCaseSensitive:=Value;
|
|
if Value then
|
|
begin
|
|
CaseFunct:=@CaseNone;
|
|
StringCaseFunct:=@StringCaseNone;
|
|
end
|
|
else
|
|
begin
|
|
////TL Added @ prefix
|
|
CaseFunct:=@UpCase;
|
|
StringCaseFunct:=@UpperCase;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TSynRange.AddAttribs(Attri: TSynHighlighterAttributes): integer;
|
|
begin
|
|
Result:=fAttribs.Add(Attri);
|
|
end;
|
|
|
|
function TSynRange.AddNewAttribs(Name1: String): TSynHighlighterAttributes;
|
|
begin
|
|
Result:=TSynHighlighterAttributes.Create(Name1);
|
|
fAttribs.Add(Result);
|
|
end;
|
|
|
|
function TSynRange.AttribsByName(Name1: string): TSynHighlighterAttributes;
|
|
var
|
|
i:integer;
|
|
begin
|
|
Result:=nil;
|
|
for i:=0 to fAttribs.Count-1 do
|
|
if TSynHighlighterAttributes(fAttribs[i]).Name=Name1 then
|
|
begin
|
|
Result:=TSynHighlighterAttributes(fAttribs[i]);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TSynRange.DeleteAttribs(Idx: integer);
|
|
begin
|
|
TSynHighlighterAttributes(fAttribs[Idx]).Free;
|
|
fAttribs.Delete(Idx);
|
|
end;
|
|
|
|
procedure TSynRange.DeleteAttribs(Name1:string);
|
|
var
|
|
p:TSynHighlighterAttributes;
|
|
begin
|
|
p:=AttribsByName(Name1);
|
|
p.Free;
|
|
fAttribs.Remove(p);
|
|
end;
|
|
|
|
procedure TSynRange.Reset;
|
|
var
|
|
i:integer;
|
|
begin
|
|
if not fPrepared then
|
|
exit;
|
|
fDefaultSynSymbol.Free;
|
|
fDefaultTermSymbol.Free;
|
|
fDefaultSymbols.Free;
|
|
fNumberSymbol.Free;
|
|
|
|
for i:=0 to 255 do
|
|
SymbolList[char(i)]:=nil;
|
|
|
|
for i:=0 to fSynRanges.Count-1 do
|
|
TSynRange( fSynRanges[i] ).Reset;
|
|
|
|
|
|
ClearList(fSynSymbols);
|
|
|
|
fPrepared:=False;
|
|
end;
|
|
|
|
procedure TSynRange.Clear;
|
|
var
|
|
i:integer;
|
|
begin
|
|
Reset;
|
|
for i:=0 to fSynRanges.Count-1 do
|
|
TSynRange(fSynRanges[i]).Clear;
|
|
|
|
ClearList(fSynRanges);
|
|
ClearList(fSynSymbols);
|
|
ClearList(fSymbolGroups);
|
|
ClearList(fAttribs);
|
|
end;
|
|
|
|
procedure TSynRange.LoadFromStream(aSrc: TStream);
|
|
var
|
|
buf,sav:PChar;
|
|
BufSize:Integer;
|
|
CurTagIndex:Integer;
|
|
LineNumber:integer;
|
|
Param:string;
|
|
xmlInfoTags: TStringList;
|
|
|
|
////TL Guess FPC doesn't support optional parameters. Never used this in Delphi or Kylix.
|
|
////TL I'm going to remove them and explicitly state the parms in each call.
|
|
////TL function GetNextTag(var Idx:Integer; var TagParam:string; IgnoreUnknown:boolean=false):boolean;
|
|
function GetNextTag(var Idx:Integer; var TagParam:string; IgnoreUnknown:boolean):boolean;
|
|
var
|
|
s:string;
|
|
sPos:PChar;
|
|
begin
|
|
Idx:=-1;
|
|
Result:=True;
|
|
TagParam:='';
|
|
while buf^<>'<' do
|
|
begin
|
|
if buf^=#0 then exit;
|
|
if buf^=#13 then Inc(LineNumber);
|
|
Inc(buf);
|
|
end;
|
|
Inc(buf);
|
|
while (buf^=' ') or (buf^=#32) do
|
|
if (buf^=#0) or (buf^=#13) then
|
|
raise Exception.Create('Unexpected end of line. Line '+IntToStr(LineNumber))
|
|
else Inc(buf);
|
|
|
|
if buf^='/' then
|
|
begin
|
|
Result:=False;
|
|
inc(buf);
|
|
end;
|
|
sPos:=buf;
|
|
while (buf^<>#32) and (buf^<>'>') do
|
|
if (buf^=#0) or (buf^=#13) then
|
|
raise Exception.Create('Unexpected end of line. Line '+IntToStr(LineNumber))
|
|
else Inc(buf);
|
|
SetLength(s,Cardinal(buf)-Cardinal(sPos));
|
|
move(sPos^,pointer(s)^,Cardinal(buf)-Cardinal(sPos));
|
|
|
|
if (not xmlInfoTags.Find(s,Idx)) then
|
|
if (not IgnoreUnknown) then
|
|
raise Exception.Create('Tag "'+s+'" is unknown (line '+IntToStr(LineNumber) +')')
|
|
else
|
|
begin
|
|
Idx:=-1; Result:=True;
|
|
exit;
|
|
end;
|
|
|
|
while buf^<>'>' do
|
|
begin
|
|
if (buf^=#0) or (buf^=#13) then
|
|
raise Exception.Create('Unexpected end of line. Line '+IntToStr(LineNumber));
|
|
if buf^='"' then
|
|
begin
|
|
inc(buf);
|
|
sPos:=buf;
|
|
while (buf^<>'"') do
|
|
if buf^=#0 then begin Result:=False; exit; end
|
|
else Inc(buf);
|
|
SetLength(TagParam,Cardinal(buf)-Cardinal(sPos));
|
|
move(sPos^,pointer(TagParam)^,Cardinal(buf)-Cardinal(sPos));
|
|
end;
|
|
Inc(buf);
|
|
end;
|
|
Inc(buf);
|
|
end;
|
|
|
|
function GetReplacement:string;
|
|
var
|
|
sPos:PChar;
|
|
begin
|
|
Result:='';
|
|
sPos:=buf;
|
|
inc(buf);
|
|
if buf^='l' then begin
|
|
Inc(buf);
|
|
if buf^='t' then begin
|
|
Inc(buf);
|
|
if buf^=';' then
|
|
Result:='<';
|
|
end;
|
|
end
|
|
else
|
|
if buf^='g' then begin
|
|
Inc(buf);
|
|
if buf^='t' then begin
|
|
Inc(buf);
|
|
if buf^=';' then
|
|
Result:='>';
|
|
end;
|
|
end
|
|
else
|
|
if buf^='q' then begin
|
|
Inc(buf);
|
|
if buf^='t' then begin
|
|
Inc(buf);
|
|
if buf^=';' then
|
|
Result:='"';
|
|
end;
|
|
end
|
|
else
|
|
if buf^='a' then begin
|
|
Inc(buf);
|
|
if buf^='m' then begin
|
|
Inc(buf);
|
|
if buf^='p' then begin
|
|
Inc(buf);
|
|
if buf^=';' then
|
|
Result:='&';
|
|
end;
|
|
end;
|
|
end;
|
|
if Result='' then
|
|
begin
|
|
Dec(buf);
|
|
SetLength(Result,Cardinal(buf)-Cardinal(sPos));
|
|
Move(sPos^,pointer(Result)^,Cardinal(buf)-Cardinal(sPos));
|
|
end
|
|
else
|
|
Inc(buf);
|
|
end;
|
|
|
|
function GetData(TagIndex:integer):string;
|
|
var
|
|
s:string;
|
|
sPos:PChar;
|
|
idx:Integer;
|
|
begin
|
|
Result:='';
|
|
sPos:=buf;
|
|
while buf^<>'<' do
|
|
begin
|
|
if buf^='&' then
|
|
begin
|
|
SetLength(s,Cardinal(buf)-Cardinal(sPos));
|
|
move(sPos^,pointer(s)^,Cardinal(buf)-Cardinal(sPos));
|
|
Result:=Result+s+GetReplacement;
|
|
sPos:=buf;
|
|
end
|
|
else
|
|
if (buf^=#0) or (buf^=#13) then
|
|
raise Exception.Create('Unexpected end of line. Line '+IntToStr(LineNumber))
|
|
else Inc(buf);
|
|
end;
|
|
SetLength(s,Cardinal(buf)-Cardinal(sPos));
|
|
Move(sPos^,pointer(s)^,Cardinal(buf)-Cardinal(sPos));
|
|
Result:=Result+s;
|
|
////TL added the third parameter
|
|
if (GetNextTag(idx,s,false)) or (idx<>CurTagIndex) then
|
|
raise Exception.Create('Close tag: /'+xmlInfoTags[idx]+' is not found. Line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadInfo;
|
|
|
|
procedure ReadGeneral;
|
|
begin
|
|
////TL added the third parameter
|
|
while GetNextTag(CurTagIndex,Param, false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitName: GetData(xitName);
|
|
xitFileTypeName: GetData(xitFileTypeName);
|
|
xitLayout: GetData(xitLayout);
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitGeneral then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[curTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadVersion;
|
|
function GetType(s:string):TVersionType;
|
|
begin
|
|
if s='Beta' then Result:=vtBeta else
|
|
if s='Release' then Result:=vtRelease else
|
|
Result:=vtInternalTest;
|
|
end;
|
|
begin
|
|
////TL added the third parameter
|
|
while GetNextTag(CurTagIndex,Param, false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitVersion: GetData(xitVersion);
|
|
xitRevision: GetData(xitRevision);
|
|
xitDate: GetData(xitDate);
|
|
xitType: GetData(xitType);
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitVersion then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadAuthor;
|
|
begin
|
|
////TL added the third parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitName: GetData(xitName);
|
|
xitEmail: GetData(xitEmail);
|
|
xitWeb: GetData(xitWeb);
|
|
xitCopyright: GetData(xitCopyright);
|
|
xitCompany: GetData(xitCompany);
|
|
xitRemark: GetData(xitRemark);
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitAuthor then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadHistroy;
|
|
begin
|
|
////TL added the third parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitH: GetData(xitH);
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitHistory then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadSample;
|
|
begin
|
|
////TL added the third parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitS: GetData(xitS);
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitSample then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
begin
|
|
////TL added the third parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitGeneral: ReadGeneral;
|
|
xitVersion: ReadVersion;
|
|
xitAuthor: ReadAuthor;
|
|
xitHistory: ReadHistroy;
|
|
xitSample: ReadSample;
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitInfo then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadKW(SymbGr:TSynSymbolGroup);
|
|
|
|
procedure ReadAttri;
|
|
begin
|
|
////TL added the third parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitBack: SymbGr.Attribs.Background:=strtointdef(GetData(xitBack),0);
|
|
xitFore: SymbGr.Attribs.Foreground:=strtointdef(GetData(xitFore),0);
|
|
xitStyle:SymbGr.Attribs.Style:=String2Fs(GetData(xitStyle));
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitAttri then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
begin
|
|
////TL added the third parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitAttri: ReadAttri;
|
|
xitW: SymbGr.KeywordsList.Add(GetData(xitW));
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitKW then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
|
|
procedure ReadRange(CurRange:TSynRange);
|
|
var
|
|
NewRange:TSynRange;
|
|
NewSymbolGroup:TSynSymbolGroup;
|
|
|
|
procedure ReadDef;
|
|
begin
|
|
////TL added the third parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitBack: CurRange.DefaultAttri.Background:=strtointdef(GetData(xitBack),0);
|
|
xitFore: CurRange.DefaultAttri.Foreground:=strtointdef(GetData(xitFore),0);
|
|
xitStyle: CurRange.DefaultAttri.Style:=String2Fs( GetData(xitStyle) );
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitDef then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadNum;
|
|
begin
|
|
////TL added the third parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitBack: CurRange.NumberAttri.Background:=strtointdef(GetData(xitBack),0);
|
|
xitFore: CurRange.NumberAttri.Foreground:=strtointdef(GetData(xitFore),0);
|
|
xitStyle: CurRange.DefaultAttri.Style:=String2Fs(GetData(xitStyle));
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitNum then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
begin
|
|
////TL added the third parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitDef: ReadDef;
|
|
xitOpenSymbol: CurRange.OpenSymbol.Symbol:=GetData(xitOpenSymbol);
|
|
xitCloseSymbol: CurRange.CloseSymbol.Symbol:=GetData(xitCloseSymbol);
|
|
xitCloseOnTerm: CurRange.CloseOnTerm:=CompareText(GetData(xitCloseOnTerm),'true')=0;
|
|
xitCloseOnEol: CurRange.CloseOnEol:=CompareText(GetData(xitCloseOnEol),'true')=0;
|
|
xitAnyTerm: if CompareText(GetData(xitAnyTerm),'true')=0 then
|
|
CurRange.OpenSymbol.BrakeType:=btAny
|
|
else
|
|
CurRange.OpenSymbol.BrakeType:=btTerm;
|
|
xitDelimiterChars: CurRange.TermSymbols:=String2Set(GetData(xitDelimiterChars));
|
|
xitNum: ReadNum;
|
|
xitCaseSensitive: CurRange.CaseSensitive:=CompareText(GetData(xitCaseSensitive),'true')=0;
|
|
xitKW: begin
|
|
NewSymbolGroup:=TSynSymbolGroup.Create('',CurRange.AddNewAttribs('unknown'));
|
|
NewSymbolGroup.Name:=Param;
|
|
CurRange.AddSymbolGroup(NewSymbolGroup);
|
|
ReadKW(NewSymbolGroup);
|
|
end;
|
|
xitRange:
|
|
begin
|
|
////TL added two empty string parameters to explicitly match the
|
|
////TL modified declaration.
|
|
NewRange:=TSynRange.Create('','');
|
|
NewRange.Name:=Param;
|
|
CurRange.AddRange(NewRange);
|
|
ReadRange(NewRange);
|
|
end;
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitRange then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
begin
|
|
Clear;
|
|
|
|
try
|
|
BufSize:= aSrc.Size;
|
|
GetMem(buf,BufSize);
|
|
aSrc.ReadBuffer(buf^,BufSize);
|
|
except
|
|
FreeMem(buf);
|
|
raise;
|
|
end;
|
|
sav:=buf;
|
|
LineNumber:=0;
|
|
|
|
xmlInfoTags := nil;
|
|
try
|
|
xmlInfoTags := TStringList.Create;
|
|
BuildXMLIndexes( xmlInfoTags );
|
|
////TL added the third parameter
|
|
if (not GetNextTag(CurTagIndex,Param,false)) or
|
|
(CurTagIndex<>xitUniHighlighter) then
|
|
raise exception.Create('Highlighter header tag ("<UniHighlighter>") is not found.');
|
|
|
|
while GetNextTag(CurTagIndex,Param,True) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitInfo: ReadInfo;
|
|
xitRange: ReadRange(self);
|
|
xitCopyRight: GetData(xitCopyRight);
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitUniHighlighter then
|
|
raise Exception.Create('Closing tag: /'+xmlInfoTags[xitUniHighlighter]+' was not found. Line '+IntToStr(LineNumber));
|
|
finally
|
|
FreeMem(sav);
|
|
xmlInfoTags.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TSymbolList }
|
|
|
|
procedure TSymbolList.AddSymbol(symb: TSymbolNode);
|
|
begin
|
|
SymbList.Add(symb);
|
|
end;
|
|
|
|
constructor TSymbolList.Create;
|
|
begin
|
|
SymbList:=TList.Create;
|
|
end;
|
|
|
|
destructor TSymbolList.Destroy;
|
|
begin
|
|
FreeList(SymbList);
|
|
inherited;
|
|
end;
|
|
|
|
function TSymbolList.FindSymbol(c: char): TSymbolNode;
|
|
var
|
|
i:integer;
|
|
begin
|
|
Result:=nil;
|
|
for i:=0 to SymbList.Count-1 do
|
|
if TSymbolNode(SymbList[i]).c=c then
|
|
begin
|
|
Result:=TSymbolNode(SymbList[i]);
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
function TSymbolList.GetCount: integer;
|
|
begin
|
|
Result:=SymbList.Count
|
|
end;
|
|
|
|
function TSymbolList.GetSymbolNode(Index: integer): TSymbolNode;
|
|
begin
|
|
Result:=TSymbolNode(SymbList[index]);
|
|
end;
|
|
|
|
procedure TSymbolList.SetSymbolNode(Index: Integer; Value: TSymbolNode);
|
|
begin
|
|
if Index<SymbList.Count then
|
|
TSymbolNode(SymbList[index]).Free;
|
|
SymbList[index]:=Value;
|
|
end;
|
|
|
|
{ TSymbols }
|
|
|
|
procedure TSymbols.AddSymbol(s:string; tkSynSymbol:TSynSymbol; ABrakeType: TSymbBrakeType);
|
|
var
|
|
i:integer;
|
|
l:integer;
|
|
Node:TSymbolNode;
|
|
SList:TSymbolList;
|
|
begin
|
|
SList:=HeadNode.NextSymbs;
|
|
Node:=nil;
|
|
l:=Length(s);
|
|
for i:=1 to l do
|
|
begin
|
|
Node:=SList.FindSymbol(s[i]);
|
|
if Node=nil then
|
|
begin
|
|
Node:=TSymbolNode.Create(s[i]);
|
|
SList.AddSymbol(Node);
|
|
end;
|
|
SList:=Node.NextSymbs;
|
|
end;
|
|
Node.BrakeType:=ABrakeType;
|
|
Node.tkSynSymbol:=tkSynSymbol;
|
|
end;
|
|
|
|
constructor TSymbols.Create(c: char; tkSynSymbol: TSynSymbol;
|
|
ABrakeType: TSymbBrakeType);
|
|
begin
|
|
HeadNode:=TSymbolNode.Create(c,tkSynSymbol,ABrakeType);
|
|
end;
|
|
|
|
destructor TSymbols.Destroy;
|
|
begin
|
|
HeadNode.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TSymbols.FindSymbol(s:string): TSymbolNode;
|
|
var
|
|
i:integer;
|
|
l:integer;
|
|
Node,prvNode:TSymbolNode;
|
|
begin
|
|
Node:=HeadNode;
|
|
l:=Length(s);
|
|
for i:=1 to l do
|
|
begin
|
|
prvNode:=Node.NextSymbs.FindSymbol(s[i]);
|
|
if prvNode=nil then
|
|
break;
|
|
Node:=prvNode;
|
|
end;
|
|
Result:=Node;
|
|
end;
|
|
|
|
function TSymbols.GetToken(parser: TSynUniSyn; var tkSynSymbol:TSynSymbol):boolean;
|
|
var
|
|
Node,nxtNode:TSymbolNode;
|
|
begin
|
|
Result:=false;
|
|
Node:=HeadNode;
|
|
nxtNode:=nil;
|
|
|
|
while (Node.NextSymbs.Count>0) and (parser.fLine[parser.Run]<>#0) do
|
|
begin
|
|
inc(parser.Run);
|
|
nxtNode:=Node.NextSymbs.FindSymbol(parser.fLine[parser.Run]);
|
|
if nxtNode=nil then
|
|
break;
|
|
Node:=nxtNode;
|
|
end;
|
|
|
|
if Node.tkSynSymbol=nil then
|
|
exit;
|
|
|
|
if (nxtNode=nil) and (Node.NextSymbs.Count>0) then
|
|
dec(parser.Run);
|
|
|
|
if parser.fLine[parser.Run]<>#0 then
|
|
inc(parser.Run);
|
|
|
|
if Node.BrakeType=btAny then
|
|
begin
|
|
Result:=True;
|
|
tkSynSymbol:=Node.tkSynSymbol;
|
|
exit;
|
|
end;
|
|
|
|
if parser.fLine[parser.Run] in parser.fCurrentRule.fTermSymbols then
|
|
begin
|
|
Result:=True;
|
|
tkSynSymbol:=Node.tkSynSymbol;
|
|
end;
|
|
|
|
end;
|
|
|
|
{ TSymbolNode }
|
|
|
|
constructor TSymbolNode.Create(AC: char; SynSymbol:TSynSymbol;
|
|
ABrakeType: TSymbBrakeType);
|
|
begin
|
|
c:=AC;
|
|
NextSymbs:=TSymbolList.Create;
|
|
BrakeType:=ABrakeType;
|
|
tkSynSymbol:=SynSymbol;
|
|
end;
|
|
|
|
constructor TSymbolNode.Create(AC: char);
|
|
begin
|
|
c:=AC;
|
|
NextSymbs:=TSymbolList.Create;
|
|
tkSynSymbol:=nil;
|
|
end;
|
|
|
|
destructor TSymbolNode.Destroy;
|
|
begin
|
|
NextSymbs.Free;
|
|
inherited;
|
|
end;
|
|
|
|
{ TDefaultSymbols }
|
|
|
|
constructor TDefaultSymbols.Create(SynSymb:TSynSymbol);
|
|
begin
|
|
tkSynSymbol:=SynSymb;
|
|
end;
|
|
|
|
destructor TDefaultSymbols.Destroy;
|
|
begin
|
|
tkSynSymbol.Free;
|
|
inherited;
|
|
end;
|
|
|
|
|
|
function TDefaultSymbols.GetToken(parser:TSynUniSyn; var tkSynSymbol1:TSynSymbol): boolean;
|
|
begin
|
|
inc(parser.Run);
|
|
Result:=False;
|
|
end;
|
|
|
|
{ TNumberSymbols }
|
|
|
|
constructor TNumberSymbols.Create(SynSymbol: TSynSymbol);
|
|
begin
|
|
tkSynSymbol:=SynSymbol;
|
|
end;
|
|
|
|
destructor TNumberSymbols.Destroy;
|
|
begin
|
|
tkSynSymbol.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TNumberSymbols.GetToken(parser:TSynUniSyn; var tkSynSymbol1:TSynSymbol): boolean;
|
|
begin
|
|
repeat
|
|
Inc(Parser.Run);
|
|
until not (parser.fLine[parser.Run] in ['0'..'9']);
|
|
if parser.fLine[parser.Run] in parser.fCurrentRule.fTermSymbols then
|
|
begin
|
|
Result:=True;
|
|
tkSynSymbol1:=self.tkSynSymbol;
|
|
end
|
|
else
|
|
Result:=false;
|
|
end;
|
|
|
|
{ TDefaultTermSymbols }
|
|
|
|
constructor TDefaultTermSymbols.Create(SynSymb:TSynSymbol);
|
|
begin
|
|
tkSynSymbol:=SynSymb;
|
|
end;
|
|
|
|
destructor TDefaultTermSymbols.Destroy;
|
|
begin
|
|
tkSynSymbol.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TDefaultTermSymbols.GetToken(parser: TSynUniSyn;var tkSynSymbol1:TSynSymbol): boolean;
|
|
begin
|
|
if parser.fLine[parser.Run]<>#0 then
|
|
Inc(parser.Run);
|
|
tkSynSymbol1:=self.tkSynSymbol;
|
|
Result:=True;
|
|
end;
|
|
|
|
{ TSynUniSyn }
|
|
|
|
constructor TSynUniSyn.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
Info.History:=TStringList.Create;
|
|
Info.Sample:=TStringList.Create;
|
|
fPrepared:=false;
|
|
////TL added two empty string parameters to match the
|
|
////TL modified declaration.
|
|
fMainRules:=TSynRange.Create('','');
|
|
fMainRules.Name:=_Root;
|
|
fEol:=false;
|
|
fPrEol:=false;
|
|
fCurrentRule:=fMainRules;
|
|
end;
|
|
|
|
destructor TSynUniSyn.Destroy;
|
|
begin
|
|
fMainRules.Free;
|
|
Info.History.Free;
|
|
Info.Sample.Free;
|
|
inherited;
|
|
end;
|
|
|
|
////TL Replaced to reflect declaration: procedure TSynUniSyn.SetLine(NewValue: string; LineNumber: Integer);
|
|
procedure TSynUniSyn.SetLine(const NewValue: String; LineNumber:Integer);
|
|
var
|
|
l,i:integer;
|
|
begin
|
|
if not fCurrentRule.fPrepared then
|
|
Prepare;
|
|
fTrueLine := PChar(NewValue);
|
|
l:=Length(NewValue);
|
|
GetMem(fLine,l+1);
|
|
for i:=0 to l do
|
|
fLine[i]:=fCurrentRule.CaseFunct(fTrueLine[i]);
|
|
Run := 0;
|
|
fTokenPos:=0;
|
|
fLineNumber := LineNumber;
|
|
fEol:=false;
|
|
fPrEol:=false;
|
|
Next;
|
|
end;
|
|
|
|
procedure TSynUniSyn.SpaceProc;
|
|
begin
|
|
repeat
|
|
Inc(Run);
|
|
until (fLine[Run] > #32) or (fLine[Run] in [#0, #10, #13]);
|
|
end;
|
|
|
|
{begin} // DJLP 2000-08-09
|
|
function TSynUniSyn.IsKeyword(const AKeyword: string): boolean;
|
|
begin
|
|
Result := fSymbols.FindSymbol(AKeyword) <> nil;
|
|
end;
|
|
{end} // DJLP 2000-08-09
|
|
|
|
procedure TSynUniSyn.Next;
|
|
begin
|
|
if fPrEol then
|
|
begin
|
|
if (fCurrentRule.fCloseOnEol) or (fCurrentRule.fCloseOnTerm) then
|
|
fCurrentRule:=fCurrentRule.fOwner;
|
|
fEol:=True;
|
|
exit;
|
|
end;
|
|
|
|
fTokenPos := Run;
|
|
if (fCurrentRule.fCloseOnTerm) and (fLine[Run] in fCurrentRule.fTermSymbols) then
|
|
fCurrentRule:=fCurrentRule.fOwner;
|
|
|
|
if not fCurrentRule.SymbolList[fLine[Run]].GetToken(self,fCurrToken) then
|
|
begin
|
|
fCurrToken:=fCurrentRule.fDefaultSynSymbol;
|
|
while not (fLine[Run] in fCurrentRule.fTermSymbols) do
|
|
inc(Run);
|
|
end
|
|
else
|
|
if fCurrentRule.fClosingSymbol.Symbol=fCurrToken then
|
|
fCurrentRule:=fCurrentRule.fOwner
|
|
else
|
|
if fCurrToken.fOpenRule<>nil then
|
|
fCurrentRule:=fCurrToken.fOpenRule;
|
|
|
|
if fLine[Run]=#0 then
|
|
fPrEol:=True;
|
|
end;
|
|
|
|
function TSynUniSyn.GetDefaultAttribute(Index: integer):
|
|
TSynHighlighterAttributes;
|
|
begin
|
|
case Index of
|
|
SYN_ATTR_COMMENT: Result := fCurrentRule.fDefaultAttri;
|
|
SYN_ATTR_IDENTIFIER: Result := fCurrentRule.fDefaultAttri;
|
|
SYN_ATTR_KEYWORD: Result := fCurrentRule.fDefaultAttri;
|
|
SYN_ATTR_STRING: Result := fCurrentRule.fDefaultAttri;
|
|
SYN_ATTR_WHITESPACE: Result := fCurrentRule.fDefaultAttri;
|
|
else Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TSynUniSyn.GetEOL: Boolean;
|
|
begin
|
|
Result := fEol;
|
|
end;
|
|
|
|
function TSynUniSyn.GetRange: Pointer;
|
|
begin
|
|
Result := fCurrentRule;
|
|
end;
|
|
|
|
function TSynUniSyn.GetToken: string;
|
|
var
|
|
Len: LongInt;
|
|
begin
|
|
Len := Run - fTokenPos;
|
|
Setstring(Result, (FTrueLine + fTokenPos), Len);
|
|
end;
|
|
|
|
////TL 2003-06-12: Added the following to satisfy abstract method override
|
|
procedure TSynUniSyn.GetTokenEx(out TokenStart: PChar;
|
|
out TokenLength: integer);
|
|
begin
|
|
TokenLength:=Run-fTokenPos;
|
|
TokenStart:=FLine + fTokenPos;
|
|
end;
|
|
|
|
function TSynUniSyn.GetTokenID: Integer;
|
|
begin
|
|
Result :=1;// CODE_REVIEW fCurrToken.ID;
|
|
end;
|
|
|
|
function TSynUniSyn.GetTokenAttribute: TSynHighlighterAttributes;
|
|
begin
|
|
Result:=fCurrToken.Attr;
|
|
end;
|
|
|
|
function TSynUniSyn.GetTokenKind: integer;
|
|
begin
|
|
Result :=1;// CODE_REVIEW fCurrToken.ID;
|
|
end;
|
|
|
|
function TSynUniSyn.GetTokenPos: Integer;
|
|
begin
|
|
Result := fTokenPos;
|
|
end;
|
|
|
|
procedure TSynUniSyn.ResetRange;
|
|
begin
|
|
fCurrentRule := fMainRules;
|
|
end;
|
|
|
|
procedure TSynUniSyn.SetRange(Value: Pointer);
|
|
begin
|
|
fCurrentRule:=TSynRange(Value);
|
|
end;
|
|
|
|
class function TSynUniSyn.GetLanguageName: string;
|
|
begin
|
|
Result := 'UniLenguage';
|
|
end;
|
|
|
|
procedure TSynUniSyn.Clear;
|
|
begin
|
|
MainRules.Clear;
|
|
end;
|
|
|
|
procedure TSynUniSyn.CreateStandardRules;
|
|
var r:TSynRange;
|
|
kw:TSynSymbolGroup;
|
|
|
|
begin
|
|
self.MainRules.Clear;
|
|
self.MainRules.DefaultAttri.Foreground:=clBlack;
|
|
self.MainRules.DefaultAttri.Background:=clWhite;
|
|
self.MainRules.NumberAttri.Foreground:=clMaroon;
|
|
self.MainRules.NumberAttri.Background:=clWhite;
|
|
self.MainRules.CaseSensitive:=false;
|
|
|
|
r:=TSynRange.Create('''','''');
|
|
r.Name:='Strings ''..''';
|
|
r.DefaultAttri.Foreground:=clRed;
|
|
r.DefaultAttri.Background:=clWhite;
|
|
r.NumberAttri.Foreground:=clRed;
|
|
r.NumberAttri.Background:=clWhite;
|
|
r.CaseSensitive:=false;
|
|
r.OpenSymbol.BrakeType:=btAny;
|
|
self.MainRules.AddRange(r);
|
|
|
|
r:=TSynRange.Create('"','"');
|
|
r.Name:='Strings ".."';
|
|
r.DefaultAttri.Foreground:=clRed;
|
|
r.DefaultAttri.Background:=clWhite;
|
|
r.NumberAttri.Foreground:=clRed;
|
|
r.NumberAttri.Background:=clWhite;
|
|
r.CaseSensitive:=false;
|
|
r.OpenSymbol.BrakeType:=btAny;
|
|
self.MainRules.AddRange(r);
|
|
|
|
r:=TSynRange.Create('{','}');
|
|
r.Name:='Remarks {..}';
|
|
r.DefaultAttri.Foreground:=clNavy;
|
|
r.DefaultAttri.Background:=clWhite;
|
|
r.NumberAttri.Foreground:=clNavy;
|
|
r.NumberAttri.Background:=clWhite;
|
|
r.CaseSensitive:=false;
|
|
r.OpenSymbol.BrakeType:=btAny;
|
|
self.MainRules.AddRange(r);
|
|
|
|
r:=TSynRange.Create('(*','*)');
|
|
r.Name:='Remarks (*..*)';
|
|
r.DefaultAttri.Foreground:=clNavy;
|
|
r.DefaultAttri.Background:=clWhite;
|
|
r.NumberAttri.Foreground:=clNavy;
|
|
r.NumberAttri.Background:=clWhite;
|
|
r.CaseSensitive:=false;
|
|
r.OpenSymbol.BrakeType:=btAny;
|
|
self.MainRules.AddRange(r);
|
|
|
|
r:=TSynRange.Create('/*','*/');
|
|
r.Name:='Remarks /*..*/';
|
|
r.DefaultAttri.Foreground:=clNavy;
|
|
r.DefaultAttri.Background:=clWhite;
|
|
r.NumberAttri.Foreground:=clNavy;
|
|
r.NumberAttri.Background:=clWhite;
|
|
r.CaseSensitive:=false;
|
|
r.OpenSymbol.BrakeType:=btAny;
|
|
self.MainRules.AddRange(r);
|
|
|
|
kw:=TSynSymbolGroup.Create('',TSynHighlighterAttributes.Create('unknown'));
|
|
kw.Name:='Key words';
|
|
kw.Attribs.Foreground:=clGreen;
|
|
kw.Attribs.Background:=clWhite;
|
|
self.MainRules.AddSymbolGroup(kw);
|
|
end;
|
|
|
|
procedure TSynUniSyn.Prepare;
|
|
begin
|
|
fMainRules.Prepare(fMainRules);
|
|
end;
|
|
|
|
|
|
procedure TSynUniSyn.NullProc;
|
|
begin
|
|
// fEol:=True;
|
|
end;
|
|
|
|
procedure TSynUniSyn.Reset;
|
|
begin
|
|
fMainRules.Reset;
|
|
end;
|
|
|
|
procedure TSynUniSyn.SaveToStream(aDst: TStream);
|
|
|
|
procedure WriteString(const aStr: string);
|
|
begin
|
|
aDst.Write( aStr[1], Length(aStr) );
|
|
aDst.Write( #10#13, 1 );
|
|
end;
|
|
|
|
Function Indent(i:integer):string;
|
|
begin
|
|
SetLength( Result, i );
|
|
FillChar( Result[1], i, #32 );
|
|
end;
|
|
|
|
Function GetValidValue(Value:string):string;
|
|
begin
|
|
Value:=StringReplace(Value,'&','&',[rfReplaceAll, rfIgnoreCase]);
|
|
Value:=StringReplace(Value,'<','<',[rfReplaceAll, rfIgnoreCase]);
|
|
Value:=StringReplace(Value,'"','&qt;',[rfReplaceAll, rfIgnoreCase]);
|
|
Result:=StringReplace(Value,'>','>',[rfReplaceAll, rfIgnoreCase]);
|
|
end;
|
|
|
|
Procedure InsertTag(Ind:integer; Name:string; Value:string);
|
|
begin
|
|
WriteString( Format('%s<%s>%s</%s>',[Indent(Ind),Name,GetValidValue(Value),Name]) );
|
|
end;
|
|
|
|
////TL Removed the default, optional parameters...
|
|
////TL and will explicitly state them in calls.
|
|
////TL Procedure OpenTag(Ind:integer; Name:string;Param:string='';ParamValue:string='');
|
|
Procedure OpenTag(Ind:integer; Name:string;Param:string;ParamValue:string);
|
|
begin
|
|
if Param='' then
|
|
WriteString(Format('%s<%s>',[Indent(Ind),Name]))
|
|
else
|
|
WriteString(Format('%s<%s %s="%s">',[Indent(Ind),Name, Param, GetValidValue(ParamValue)]));
|
|
end;
|
|
|
|
Procedure SaveColor(MainTag:string; Ind, Fore, Back:integer; Style:TFontStyles);
|
|
begin
|
|
////TL Add missing null parameters
|
|
OpenTag(Ind, MainTag,'','');
|
|
InsertTag(Ind+1, 'Back', Inttostr(Back));
|
|
InsertTag(Ind+1, 'Fore', Inttostr(Fore));
|
|
InsertTag(Ind+1, 'Style', Fs2String(Style));
|
|
////TL Add missing null parameters
|
|
OpenTag(Ind, '/'+MainTag,'','');
|
|
end;
|
|
|
|
Procedure SaveKWGroup(Ind:integer;G:TSynSymbolGroup);
|
|
var i:integer;
|
|
begin
|
|
OpenTag(Ind, 'KW', 'Name', G.Name);
|
|
SaveColor('Attri',Ind+1, G.Attribs.Foreground, G.Attribs.Background, G.Attribs.Style);
|
|
For i:=0 to G.KeywordsList.Count-1 do InsertTag(Ind+1, 'W', G.KeywordsList[i]);
|
|
////TL Add missing null parameters
|
|
OpenTag(Ind, '/KW','','');
|
|
end;
|
|
|
|
Procedure SaveRange(Ind:integer;R:TSynRange);
|
|
var i:integer;
|
|
Procedure InsertTagBool(Ind:integer; Name:string; Value:Boolean);
|
|
begin
|
|
if Value then
|
|
WriteString(Format('%s<%s>True</%s>',[Indent(Ind),Name,Name]))
|
|
else
|
|
WriteString(Format('%s<%s>False</%s>',[Indent(Ind),Name,Name]))
|
|
end;
|
|
|
|
Procedure SaveRangeColor(Ind:integer;R:TSynRange);
|
|
begin
|
|
SaveColor('Def', Ind, R.DefaultAttri.Foreground, R.DefaultAttri.Background, R.DefaultAttri.Style);
|
|
SaveColor('Num', Ind, R.NumberAttri.Foreground, R.NumberAttri.Background, R.NumberAttri.Style);
|
|
end;
|
|
|
|
begin
|
|
OpenTag(Ind, 'Range', 'Name',R.Name);
|
|
SaveRangeColor(Ind, R);
|
|
InsertTag(Ind, 'OpenSymbol', R.OpenSymbol.Symbol);
|
|
InsertTag(Ind, 'CloseSymbol', R.CloseSymbol.Symbol);
|
|
|
|
InsertTag(Ind, 'DelimiterChars', Set2String(R.TermSymbols));
|
|
if R.OpenSymbol.BrakeType=btAny then
|
|
InsertTag(Ind, 'AnyTerm', 'True')
|
|
else
|
|
InsertTag(Ind, 'AnyTerm', 'False');
|
|
InsertTagBool(Ind, 'CloseOnTerm', R.CloseOnTerm);
|
|
InsertTagBool(Ind, 'CloseOnEol', R.CloseOnEol);
|
|
InsertTagBool(Ind, 'CaseSensitive', R.CaseSensitive);
|
|
For i:=0 to R.SymbolGroupCount-1 do SaveKWGroup(Ind, R.SymbolGroups[i]);
|
|
For i:=0 to R.RangeCount-1 do SaveRange(Ind+1, R.Ranges[i]);
|
|
////TL Add missing null parameters
|
|
OpenTag(Ind, '/Range','','');
|
|
end;
|
|
|
|
Procedure SaveInfo;
|
|
var i:integer;
|
|
begin
|
|
////TL Add missing null parameters to all the OpenTag calls
|
|
OpenTag(1, 'Info','','');
|
|
|
|
OpenTag(2, 'General','','');
|
|
InsertTag(3, 'Name', info.General.Name);
|
|
InsertTag(3, 'FileTypeName', info.General.FileTypeName);
|
|
InsertTag(3, 'Layout', info.General.Layout);
|
|
OpenTag(2, '/General','','');
|
|
|
|
OpenTag(2, 'Author','','');
|
|
InsertTag(3, 'Name', info.Author.Name);
|
|
InsertTag(3, 'Email', info.Author.Email);
|
|
InsertTag(3, 'Web', info.Author.Web);
|
|
InsertTag(3, 'Copyright', info.Author.Copyright);
|
|
InsertTag(3, 'Company', info.Author.Company);
|
|
InsertTag(3, 'Remark', info.Author.Remark);
|
|
OpenTag(2, '/Author','','');
|
|
|
|
OpenTag(2, 'Version','','');
|
|
InsertTag(3, 'Version', inttostr(Info.Version.Version));
|
|
InsertTag(3, 'Revision', inttostr(Info.Version.Revision));
|
|
InsertTag(3, 'Date', floattostr(Info.Version.ReleaseDate));
|
|
case Info.Version.VersionType of
|
|
vtInternalTest: InsertTag(3, 'Type', 'Internal Test');
|
|
vtBeta: InsertTag(3, 'Type', 'Beta');
|
|
vtRelease: InsertTag(3, 'Type', 'Release');
|
|
end;
|
|
OpenTag(2, '/Version','','');
|
|
|
|
OpenTag(2, 'History','','');
|
|
for i:=0 to Info.history.count-1 do InsertTag(3, 'H', Info.history[i]);
|
|
OpenTag(2, '/History','','');
|
|
|
|
OpenTag(2, 'Sample','','');
|
|
for i:=0 to Info.Sample.count-1 do InsertTag(3, 'S', Info.Sample[i]);
|
|
OpenTag(2, '/Sample','','');
|
|
|
|
OpenTag(1, '/Info','','');
|
|
end;
|
|
|
|
begin
|
|
OpenTag(0, 'UniHighlighter','','');
|
|
OpenTag(1, 'ImportantInfo','','');
|
|
WriteString(Indent(2)+'******* Please read carefully *************************');
|
|
WriteString(Indent(2)+'* Please, make any changes in this file very carefuly!*');
|
|
WriteString(Indent(2)+'* It is much more convinient to use native designer! *');
|
|
WriteString(Indent(2)+'*******************************************************');
|
|
OpenTag(1, '/ImportantInfo','','');
|
|
SaveInfo;
|
|
SaveRange(1, self.MainRules);
|
|
InsertTag(1, 'CopyRight','Rule file for UniHighlighter Delphi component (Copyright(C) Fantasist(walking_in_the_sky@yahoo.com), Vit(nevzorov@yahoo.com), 2002)');
|
|
OpenTag(0, '/UniHighlighter','','');
|
|
end;
|
|
|
|
|
|
procedure TSynUniSyn.LoadFromStream(aSrc: TStream);
|
|
{ type
|
|
TParserState=(psTagWaiting,psTagReading,psDataReading);
|
|
|
|
type TParsingSection=(psNone, psInitialized, psMainRange, psRange);
|
|
Range(Name="") OpenSymbol CloseSymbol KW(name="")
|
|
|
|
|
|
<Info>
|
|
<General>
|
|
<Name>Oemsetup Script</Name>
|
|
<FileTypeName>INF</FileTypeName>
|
|
<Layout>Standard</Layout>
|
|
</General>
|
|
<Author>
|
|
<Name>Vitaly Nevzorov</Name>
|
|
<Email>nevzorov@yahoo.com</Email>
|
|
<Web>www.delphist.com</Web>
|
|
<Copyright>Copyright (c) Vitaly Nevzorov, 2002</Copyright>
|
|
<Company>N/A</Company>
|
|
<Remark>Created based on UltraEdit:oemsetup.txt</Remark>
|
|
</Author>
|
|
<Version>
|
|
<Version>1</Version>
|
|
<Revision>0</Revision>
|
|
<Date>37612.555991169</Date>
|
|
<Type>Beta</Type>
|
|
</Version>
|
|
<History>
|
|
</History>
|
|
<Sample>
|
|
<S></S>
|
|
</Sample>
|
|
</Info>
|
|
|
|
var f:textfile;
|
|
s, rest:string;
|
|
R:TSynRange;
|
|
c:TComponent;
|
|
ParsingSection:TParsingSection;
|
|
|
|
Function isEqual(const s1,s2:string):boolean;
|
|
begin
|
|
result:=trim(lowercase(s1))=trim(lowercase(s2));
|
|
end;
|
|
|
|
Function isPresent(str, substr:string):boolean;
|
|
begin
|
|
str:=trim(lowercase(str));
|
|
substr:=trim(lowercase(substr));
|
|
str:=copy(str,1,length(substr));
|
|
Result:=str=substr;
|
|
end;
|
|
|
|
Procedure LookForInitialization(s:string);
|
|
begin
|
|
if isPresent(s,'<UniHighlighter>') then
|
|
begin
|
|
Clear;
|
|
ParsingSection:=psInitialized;
|
|
end;
|
|
end;
|
|
|
|
Function GetValue(Str:string):string;
|
|
var temp:string;
|
|
begin
|
|
temp:=copy(str,pos('>',str)+1,length(str));
|
|
result:=copy(temp,1,pos('<',temp)-1);
|
|
result:=StringReplace(result,'&qt;','"',[rfReplaceAll, rfIgnoreCase]);
|
|
result:=StringReplace(result,'<','<',[rfReplaceAll, rfIgnoreCase]);
|
|
result:=StringReplace(result,'>','>',[rfReplaceAll, rfIgnoreCase]);
|
|
result:=StringReplace(result,'&','&',[rfReplaceAll, rfIgnoreCase]);
|
|
end;
|
|
|
|
Function GetName(Str:string):string;
|
|
var temp:string;
|
|
begin
|
|
temp:=copy(str,pos('"',str)+1,length(str));
|
|
result:=copy(temp,1,pos('"',temp)-1);
|
|
result:=StringReplace(result,'&qt;','"',[rfReplaceAll, rfIgnoreCase]);
|
|
result:=StringReplace(result,'<','<',[rfReplaceAll, rfIgnoreCase]);
|
|
result:=StringReplace(result,'>','>',[rfReplaceAll, rfIgnoreCase]);
|
|
result:=StringReplace(result,'&','&',[rfReplaceAll, rfIgnoreCase]);
|
|
end;
|
|
|
|
Procedure LoadRange(R:TSynRange);
|
|
var rr:TSynRange;
|
|
kw:TSynSymbolGroup;
|
|
label 1;
|
|
begin
|
|
R.TermSymbols:=AbsoluteTermSymbols+DefaultTermSymbols;
|
|
R.OpenSymbol.BrakeType:=btAny;
|
|
repeat
|
|
1: readln(f,s);
|
|
if eof(f) then exit;
|
|
if isPresent(s,'<Range Name="') then
|
|
begin
|
|
rr:=TSynRange.create;
|
|
rr.Name:=GetName(s);
|
|
r.AddRange(rr);
|
|
LoadRange(rr);
|
|
goto 1;
|
|
end;
|
|
|
|
if isPresent(s,'<Def>') then
|
|
repeat
|
|
readln(f,s);
|
|
if eof(f) then exit;
|
|
if isPresent(s,'<Back>') then R.DefaultAttri.Background:=strtointdef(GetValue(s),$FFFFFF);
|
|
if isPresent(s,'<Fore>') then R.DefaultAttri.Foreground:=strtointdef(GetValue(s),0);
|
|
if isPresent(s,'<Style>') then ;
|
|
until isPresent(s,'</Def>');
|
|
|
|
if isPresent(s,'<Num>') then
|
|
repeat
|
|
readln(f,s);
|
|
if eof(f) then exit;
|
|
if isPresent(s,'<Back>') then R.NumberAttri.Background:=strtointdef(GetValue(s),$FFFFFF);
|
|
if isPresent(s,'<Fore>') then R.NumberAttri.Foreground:=strtointdef(GetValue(s),0);
|
|
if isPresent(s,'<Style>') then ;
|
|
until isPresent(s,'</Num>');
|
|
|
|
if isPresent(s,'<DelimiterChars>') then R.TermSymbols:=String2Set(GetValue(s));
|
|
|
|
if isPresent(s,'<OpenSymbol>') then R.OpenSymbol.Symbol:=GetValue(s);
|
|
if isPresent(s,'<CloseSymbol>') then R.CloseSymbol.Symbol:=GetValue(s);
|
|
if isPresent(s,'<CloseOnTerm>') then R.CloseOnTerm:=Lowercase(GetValue(s))='true';
|
|
if isPresent(s,'<CloseOnEol>') then R.CloseOnEol:=Lowercase(GetValue(s))='true';
|
|
if isPresent(s,'<CaseSensitive>') then R.CaseSensitive:=Lowercase(GetValue(s))='true';
|
|
if (isPresent(s,'<AnyTerm>')) and (R.Name<>_Root) then
|
|
begin
|
|
if Lowercase(GetValue(s))='true' then
|
|
R.OpenSymbol.BrakeType:=btAny
|
|
else
|
|
R.OpenSymbol.BrakeType:=btTerm;
|
|
end;
|
|
|
|
if isPresent(s,'<KW Name="') then
|
|
begin
|
|
kw:=TSynSymbolGroup.Create('',TSynHighlighterAttributes.Create('unknown'));
|
|
kw.Name:=GetName(s);
|
|
R.AddSymbolGroup(kw);
|
|
repeat
|
|
readln(f,s);
|
|
if eof(f) then exit;
|
|
if isPresent(s,'<Attri>') then
|
|
repeat
|
|
readln(f,s);
|
|
if eof(f) then exit;
|
|
if isPresent(s,'<Back>') then Kw.Attribs.Background:=strtointdef(GetValue(s),$FFFFFF);
|
|
if isPresent(s,'<Fore>') then Kw.Attribs.Foreground:=strtointdef(GetValue(s),0);
|
|
if isPresent(s,'<Style>') then ;
|
|
until isPresent(s,'</Attri>');
|
|
if isPresent(s,'<W>') then KW.KeywordsList.add(GetValue(s));
|
|
until isPresent(s,'</KW>');
|
|
end;
|
|
Until isPresent(s,'</Range>');
|
|
end;
|
|
|
|
Procedure LoadInfo;
|
|
var i:integer;
|
|
begin
|
|
info.history.Clear;
|
|
info.Sample.Clear;
|
|
if isPresent(s,'<Info>') then
|
|
repeat
|
|
readln(f,s);
|
|
if eof(f) then exit;
|
|
|
|
if isPresent(s,'<General>') then
|
|
repeat
|
|
readln(f,s);
|
|
if eof(f) then exit;
|
|
if isPresent(s,'<Name>') then info.General.Name:=GetValue(s);
|
|
if isPresent(s,'<FileTypeName>') then info.General.FileTypeName:=GetValue(s);
|
|
if isPresent(s,'<Layout>') then info.General.Layout:=GetValue(s);
|
|
until isPresent(s,'</General>');
|
|
|
|
if isPresent(s,'<Author>') then
|
|
repeat
|
|
readln(f,s);
|
|
if eof(f) then exit;
|
|
if isPresent(s,'<Name>') then info.Author.Name:=GetValue(s);
|
|
if isPresent(s,'<Email>') then info.Author.Email:=GetValue(s);
|
|
if isPresent(s,'<Web>') then info.Author.Web:=GetValue(s);
|
|
if isPresent(s,'<Copyright>') then info.Author.Copyright:=GetValue(s);
|
|
if isPresent(s,'<Company>') then info.Author.Company:=GetValue(s);
|
|
if isPresent(s,'<Remark>') then info.Author.Remark:=GetValue(s);
|
|
until isPresent(s,'</Author>');
|
|
|
|
if isPresent(s,'<Version>') then
|
|
repeat
|
|
readln(f,s);
|
|
if eof(f) then exit;
|
|
if isPresent(s,'<Version>') then info.Version.Version:=strtointdef(GetValue(s),0);
|
|
if isPresent(s,'<Revision>') then info.Version.Revision:=strtointdef(GetValue(s),0);
|
|
if isPresent(s,'<Date>') then info.Version.ReleaseDate:=strtointdef(GetValue(s),0);
|
|
if isPresent(s,'<Type>') then
|
|
begin
|
|
if GetValue(s)='Beta' then info.Version.VersionType:=vtBeta else
|
|
if GetValue(s)='Release' then info.Version.VersionType:=vtRelease else
|
|
info.Version.VersionType:=vtInternalTest;
|
|
end;
|
|
until isPresent(s,'</Version>');
|
|
|
|
if isPresent(s,'<History>') then
|
|
repeat
|
|
readln(f,s);
|
|
if eof(f) then exit;
|
|
if isPresent(s,'<H>') then info.history.add(GetValue(s));
|
|
until isPresent(s,'</History>');
|
|
|
|
if isPresent(s,'<Sample>') then
|
|
repeat
|
|
readln(f,s);
|
|
if eof(f) then exit;
|
|
if isPresent(s,'<S>') then info.Sample.add(GetValue(s));
|
|
until isPresent(s,'</Sample>');
|
|
until isPresent(s,'</Info>');
|
|
end;
|
|
|
|
|
|
Procedure LookForMainRange(s:string);
|
|
begin
|
|
if isPresent(s,'<Info>') then LoadInfo;
|
|
if isPresent(s,'<Range Name="Root">') then
|
|
begin
|
|
ParsingSection:=psMainRange;
|
|
R:=self.MainRules;
|
|
R.Name:=_Root;
|
|
LoadRange(R);
|
|
end;
|
|
end;
|
|
|
|
}
|
|
var
|
|
buf,sav:PChar;
|
|
BufSize:Integer;
|
|
CurTagIndex:Integer;
|
|
LineNumber:integer;
|
|
Param:string;
|
|
xmlInfoTags:TStringList;
|
|
|
|
|
|
function GetReplacement:string;
|
|
var
|
|
sPos:PChar;
|
|
begin
|
|
Result:='';
|
|
sPos:=buf;
|
|
inc(buf);
|
|
if buf^='l' then begin
|
|
Inc(buf);
|
|
if buf^='t' then begin
|
|
Inc(buf);
|
|
if buf^=';' then
|
|
Result:='<';
|
|
end;
|
|
end
|
|
else
|
|
if buf^='g' then begin
|
|
Inc(buf);
|
|
if buf^='t' then begin
|
|
Inc(buf);
|
|
if buf^=';' then
|
|
Result:='>';
|
|
end;
|
|
end
|
|
else
|
|
if buf^='q' then begin
|
|
Inc(buf);
|
|
if buf^='t' then begin
|
|
Inc(buf);
|
|
if buf^=';' then
|
|
Result:='"';
|
|
end;
|
|
end
|
|
else
|
|
if buf^='a' then begin
|
|
Inc(buf);
|
|
if buf^='m' then begin
|
|
Inc(buf);
|
|
if buf^='p' then begin
|
|
Inc(buf);
|
|
if buf^=';' then
|
|
Result:='&';
|
|
end;
|
|
end;
|
|
end;
|
|
if Result='' then
|
|
begin
|
|
Dec(buf);
|
|
SetLength(Result,Cardinal(buf)-Cardinal(sPos));
|
|
Move(sPos^,pointer(Result)^,Cardinal(buf)-Cardinal(sPos));
|
|
end
|
|
else
|
|
Inc(buf);
|
|
end;
|
|
////TL Removed optional default parameter assignment... fixed in the calls
|
|
////TL function GetNextTag(var Idx:Integer; var TagParam:string; IgnoreUnknown:boolean=false):boolean;
|
|
function GetNextTag(var Idx:Integer; var TagParam:string; IgnoreUnknown:boolean):boolean;
|
|
var
|
|
s,stmp:string;
|
|
sPos:PChar;
|
|
begin
|
|
Idx:=-1;
|
|
Result:=True;
|
|
TagParam:='';
|
|
while buf^<>'<' do
|
|
begin
|
|
if buf^=#0 then exit;
|
|
if buf^=#13 then Inc(LineNumber);
|
|
Inc(buf);
|
|
end;
|
|
Inc(buf);
|
|
while (buf^=#32) do
|
|
if (buf^=#0) or (buf^=#13) then
|
|
raise Exception.Create('Unexpected end of line. Line '+IntToStr(LineNumber))
|
|
else Inc(buf);
|
|
|
|
if buf^='/' then
|
|
begin
|
|
Result:=False;
|
|
inc(buf);
|
|
end;
|
|
sPos:=buf;
|
|
while (buf^<>#32) and (buf^<>'>') do
|
|
if (buf^=#0) or (buf^=#13) then
|
|
raise Exception.Create('Unexpected end of line. Line '+IntToStr(LineNumber))
|
|
else Inc(buf);
|
|
SetLength(s,Cardinal(buf)-Cardinal(sPos));
|
|
move(sPos^,pointer(s)^,Cardinal(buf)-Cardinal(sPos));
|
|
|
|
if (not xmlInfoTags.Find(s,Idx)) then
|
|
if (not IgnoreUnknown) then
|
|
raise Exception.Create('Tag "'+s+'" is unknown (line '+IntToStr(LineNumber) +')')
|
|
else
|
|
begin
|
|
Idx:=-1; Result:=True;
|
|
exit;
|
|
end;
|
|
|
|
while buf^<>'>' do
|
|
begin
|
|
if (buf^=#0) or (buf^=#13) then
|
|
raise Exception.Create('Unexpected end of line. Line '+IntToStr(LineNumber));
|
|
if buf^='"' then
|
|
begin
|
|
inc(buf);
|
|
sPos:=buf;
|
|
stmp:='';
|
|
while (buf^<>'"') do
|
|
if buf^=#0 then begin Result:=False; exit; end
|
|
else if buf^='&' then
|
|
begin
|
|
SetLength(s,Cardinal(buf)-Cardinal(sPos));
|
|
move(sPos^,pointer(s)^,Cardinal(buf)-Cardinal(sPos));
|
|
stmp:=stmp+s+GetReplacement;
|
|
sPos:=buf;
|
|
end
|
|
else Inc(buf);
|
|
SetLength(s,Cardinal(buf)-Cardinal(sPos));
|
|
move(sPos^,pointer(s)^,Cardinal(buf)-Cardinal(sPos));
|
|
TagParam:=stmp+s;
|
|
end;
|
|
Inc(buf);
|
|
end;
|
|
Inc(buf);
|
|
end;
|
|
|
|
|
|
function GetData(TagIndex:integer):string;
|
|
var
|
|
s:string;
|
|
sPos:PChar;
|
|
idx:Integer;
|
|
begin
|
|
Result:='';
|
|
sPos:=buf;
|
|
while buf^<>'<' do
|
|
begin
|
|
if buf^='&' then
|
|
begin
|
|
SetLength(s,Cardinal(buf)-Cardinal(sPos));
|
|
move(sPos^,pointer(s)^,Cardinal(buf)-Cardinal(sPos));
|
|
Result:=Result+s+GetReplacement;
|
|
sPos:=buf;
|
|
end
|
|
else
|
|
if (buf^=#0) or (buf^=#13) then
|
|
raise Exception.Create('Unexpected end of line. Line '+IntToStr(LineNumber))
|
|
else Inc(buf);
|
|
end;
|
|
SetLength(s,Cardinal(buf)-Cardinal(sPos));
|
|
Move(sPos^,pointer(s)^,Cardinal(buf)-Cardinal(sPos));
|
|
Result:=Result+s;
|
|
////TL Added 3rd parameter
|
|
if (GetNextTag(idx,s,false)) or (idx<>CurTagIndex) then
|
|
raise Exception.Create('Close tag: /'+xmlInfoTags[idx]+' is not found. Line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadInfo;
|
|
|
|
procedure ReadGeneral;
|
|
begin
|
|
////TL Added 3rd parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitName: info.General.Name:=GetData(xitName);
|
|
xitFileTypeName: info.General.FileTypeName:=GetData(xitFileTypeName);
|
|
xitLayout: info.General.Layout:=GetData(xitLayout);
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitGeneral then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[curTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadVersion;
|
|
function GetType(s:string):TVersionType;
|
|
begin
|
|
if s='Beta' then Result:=vtBeta else
|
|
if s='Release' then Result:=vtRelease else
|
|
Result:=vtInternalTest;
|
|
end;
|
|
begin
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitVersion: info.Version.Version:=strtointdef(GetData(xitVersion),0);
|
|
xitRevision: info.Version.Revision:=strtointdef(GetData(xitRevision),0);
|
|
xitDate: info.Version.ReleaseDate:=strtointdef(GetData(xitDate),0);
|
|
xitType: info.Version.VersionType:=GetType(GetData(xitType));
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitVersion then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadAuthor;
|
|
begin
|
|
////TL Added 3rd parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitName: info.Author.Name:=GetData(xitName);
|
|
xitEmail: info.Author.Email:=GetData(xitEmail);
|
|
xitWeb: info.Author.Web:=GetData(xitWeb);
|
|
xitCopyright: info.Author.Copyright:=GetData(xitCopyright);
|
|
xitCompany: info.Author.Company:=GetData(xitCompany);
|
|
xitRemark: info.Author.Remark:=GetData(xitRemark);
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitAuthor then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadHistroy;
|
|
begin
|
|
////TL Added 3rd parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitH: info.history.add(GetData(xitH));
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitHistory then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadSample;
|
|
begin
|
|
info.Sample.Clear;
|
|
////TL Added 3rd parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitS: info.Sample.Add(GetData(xitS));
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitSample then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
begin
|
|
////TL Added 3rd parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitGeneral: ReadGeneral;
|
|
xitVersion: ReadVersion;
|
|
xitAuthor: ReadAuthor;
|
|
xitHistory: ReadHistroy;
|
|
xitSample: ReadSample;
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitInfo then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadKW(SymbGr:TSynSymbolGroup);
|
|
|
|
procedure ReadAttri;
|
|
begin
|
|
////TL Added 3rd parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitBack: SymbGr.Attribs.Background:=strtointdef(GetData(xitBack),0);
|
|
xitFore: SymbGr.Attribs.Foreground:=strtointdef(GetData(xitFore),0);
|
|
xitStyle: SymbGr.Attribs.Style:=String2Fs(GetData(xitStyle));
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitAttri then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
begin
|
|
////TL Added 3rd parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitAttri: ReadAttri;
|
|
xitW: SymbGr.KeywordsList.Add(GetData(xitW));
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitKW then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadRange(CurRange:TSynRange);
|
|
var
|
|
NewRange:TSynRange;
|
|
NewSymbolGroup:TSynSymbolGroup;
|
|
|
|
procedure ReadDef;
|
|
begin
|
|
////TL Added 3rd parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitBack: CurRange.DefaultAttri.Background:=strtointdef(GetData(xitBack),0);
|
|
xitFore: CurRange.DefaultAttri.Foreground:=strtointdef(GetData(xitFore),0);
|
|
xitStyle: CurRange.DefaultAttri.Style := String2Fs(GetData(xitStyle));
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitDef then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
procedure ReadNum;
|
|
begin
|
|
////TL Added 3rd parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitBack: CurRange.NumberAttri.Background:=strtointdef(GetData(xitBack),0);
|
|
xitFore: CurRange.NumberAttri.Foreground:=strtointdef(GetData(xitFore),0);
|
|
xitStyle: CurRange.DefaultAttri.Style:=String2Fs(GetData(xitStyle));
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitNum then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
begin
|
|
////TL Added 3rd parameter
|
|
while GetNextTag(CurTagIndex,Param,false) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitDef: ReadDef;
|
|
xitOpenSymbol: CurRange.OpenSymbol.Symbol:=GetData(xitOpenSymbol);
|
|
xitCloseSymbol: CurRange.CloseSymbol.Symbol:=GetData(xitCloseSymbol);
|
|
xitCloseOnTerm: CurRange.CloseOnTerm:=CompareText(GetData(xitCloseOnTerm),'true')=0;
|
|
xitCloseOnEol: CurRange.CloseOnEol:=CompareText(GetData(xitCloseOnEol),'true')=0;
|
|
xitAnyTerm: if CompareText(GetData(xitAnyTerm),'true')=0 then
|
|
CurRange.OpenSymbol.BrakeType:=btAny
|
|
else
|
|
CurRange.OpenSymbol.BrakeType:=btTerm;
|
|
xitDelimiterChars: CurRange.TermSymbols:=String2Set(GetData(xitDelimiterChars));
|
|
xitNum: ReadNum;
|
|
xitCaseSensitive: CurRange.CaseSensitive:=CompareText(GetData(xitCaseSensitive),'true')=0;
|
|
xitKW: begin
|
|
NewSymbolGroup:=TSynSymbolGroup.Create('',CurRange.AddNewAttribs('unknown'));
|
|
NewSymbolGroup.Name:=Param;
|
|
CurRange.AddSymbolGroup(NewSymbolGroup);
|
|
ReadKW(NewSymbolGroup);
|
|
end;
|
|
xitRange:
|
|
begin
|
|
////TL added two default null string parameters
|
|
NewRange:=TSynRange.Create('','');
|
|
NewRange.Name:=Param;
|
|
CurRange.AddRange(NewRange);
|
|
ReadRange(NewRange);
|
|
end;
|
|
else
|
|
raise Exception.Create('Unexpected tag: '+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitRange then
|
|
raise Exception.Create('Unexpected tag: /'+xmlInfoTags[CurTagIndex]+' line '+IntToStr(LineNumber));
|
|
end;
|
|
|
|
begin
|
|
Clear;
|
|
|
|
try
|
|
BufSize:= aSrc.Size;
|
|
GetMem(buf,BufSize);
|
|
aSrc.ReadBuffer(buf^,BufSize);
|
|
except
|
|
FreeMem(buf);
|
|
raise;
|
|
end;
|
|
sav:=buf;
|
|
LineNumber:=0;
|
|
|
|
xmlInfoTags := nil;
|
|
try
|
|
xmlInfoTags := TStringList.Create;
|
|
xmlInfoTags.Sorted := true;
|
|
BuildXMLIndexes( xmlInfoTags );
|
|
////TL Added 3rd parameter
|
|
if (not GetNextTag(CurTagIndex,Param,false)) or (CurTagIndex<>xitUniHighlighter) then
|
|
raise exception.Create('Highlighter header tag ("<UniHighlighter>") was not found.');
|
|
|
|
while GetNextTag(CurTagIndex,Param,True) do
|
|
begin
|
|
case CurTagIndex of
|
|
xitInfo: ReadInfo;
|
|
xitRange:
|
|
begin
|
|
self.MainRules.Name:=Param;
|
|
ReadRange(self.MainRules);
|
|
end;
|
|
xitCopyRight: GetData(xitCopyRight);
|
|
end;
|
|
end;
|
|
if CurTagIndex<>xitUniHighlighter then
|
|
raise Exception.Create('Closing tag: /'+xmlInfoTags[xitUniHighlighter]+' was not found. Line '+IntToStr(LineNumber));
|
|
finally
|
|
FreeMem(sav);
|
|
xmlInfoTags.Free;
|
|
end;
|
|
|
|
{ ParsingSection:=psNone;
|
|
While not eof(f) do
|
|
begin
|
|
readln(f,s);
|
|
Case ParsingSection of
|
|
psNone: LookForInitialization(s);
|
|
psInitialized: LookForMainRange(s);
|
|
End;
|
|
End;
|
|
closefile(f);
|
|
if R=nil then raise exception.Create('Highlighter is not valid. Check structure!');
|
|
end;}
|
|
|
|
DefHighlightChange( Self );
|
|
end;
|
|
|
|
procedure TSynRange.DeleteRange(SynRange: TSynRange);
|
|
begin
|
|
fSynRanges.Remove(SynRange);
|
|
SynRange.Free;
|
|
end;
|
|
|
|
procedure TSynRange.DeleteRange(index: integer);
|
|
begin
|
|
TSynRange(fSynRanges[index]).Free;
|
|
fSynRanges.Delete(index);
|
|
end;
|
|
|
|
procedure TSynRange.DeleteSymbolGroup(SymbolGroup: TSynSymbolGroup);
|
|
begin
|
|
fSymbolGroups.Remove(SymbolGroup);
|
|
SymbolGroup.Free;
|
|
end;
|
|
|
|
procedure TSynRange.DeleteSymbolGroup(index: integer);
|
|
begin
|
|
TSynSymbolGroup(fSymbolGroups[index]).Free;
|
|
fSymbolGroups.Delete(index);
|
|
end;
|
|
|
|
procedure TSynUniSyn.LoadFromFile(FileName: string);
|
|
var
|
|
F: TFileStream;
|
|
begin
|
|
if FileName = '' then
|
|
raise exception.Create('FileName is empty');
|
|
F:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
LoadFromStream( F );
|
|
finally
|
|
F.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSynUniSyn.SaveToFile(FileName: string);
|
|
var
|
|
F: TFileStream;
|
|
begin
|
|
if FileName = '' then
|
|
raise exception.Create('FileName is empty');
|
|
F:=TFileStream.Create(FileName,fmOpenWrite or fmShareDenyNone);
|
|
try
|
|
SaveToStream( F );
|
|
finally
|
|
F.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSynUniSyn.DefineProperties(Filer: TFiler);
|
|
var
|
|
iHasData: boolean;
|
|
begin
|
|
inherited;
|
|
if Filer.Ancestor <> nil then
|
|
begin
|
|
iHasData := True;
|
|
end
|
|
else
|
|
iHasData := MainRules.RangeCount > 0;
|
|
////TL Added 2 @ prefixes
|
|
Filer.DefineProperty( 'Syntax', @ReadSyntax, @WriteSyntax, iHasData );
|
|
end;
|
|
|
|
procedure TSynUniSyn.ReadSyntax(Reader: TReader);
|
|
var
|
|
iBuffer: TStringStream;
|
|
begin
|
|
iBuffer := nil;
|
|
try
|
|
iBuffer := TStringStream.Create( Reader.ReadString );
|
|
iBuffer.Position := 0;
|
|
LoadFromStream( iBuffer );
|
|
finally
|
|
iBuffer.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSynUniSyn.WriteSyntax(Writer: TWriter);
|
|
var
|
|
iBuffer: TStringStream;
|
|
begin
|
|
iBuffer := TStringStream.Create( '' );
|
|
try
|
|
SaveToStream( iBuffer );
|
|
iBuffer.Position := 0;
|
|
Writer.WriteString( iBuffer.DataString );
|
|
finally
|
|
iBuffer.Free;
|
|
end;
|
|
end;
|
|
|
|
function TSynUniSyn.GetIdentChars: TSynIdentChars;
|
|
begin
|
|
Result := [#32..#255] - fCurrentRule.TermSymbols;
|
|
end;
|
|
|
|
function TSynUniSyn.GetSampleSource: string;
|
|
begin
|
|
Result := Info.Sample.Text;
|
|
end;
|
|
|
|
procedure TSynUniSyn.SetSampleSource(Value: string);
|
|
begin
|
|
Info.Sample.Text := Value;
|
|
end;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('SynEdit', [TSynUniSyn]);
|
|
end;
|
|
|
|
initialization
|
|
RegisterPlaceableHighlighter(TSynUniSyn);
|
|
|
|
end.
|
|
|
|
|