Why Gemfury?
Push, build, and install
RubyGems
npm packages
Python packages
Maven artifacts
PHP packages
Go Modules
Debian packages
RPM packages
NuGet packages
Repository URL to install this package:
|
Version:
1.6 ▾
|
{-------------------------------------------------------------------------------
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: SynHighlighterGeneral.pas, released 2000-04-07.
The Original Code is based on the mwGeneralSyn.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Martin Waldenburg.
Portions written by Martin Waldenburg are copyright 1999 Martin Waldenburg.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
Contributors.txt file.
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.
$Id: SynHighlighterGeneral.pas,v 1.3 2000/11/08 22:09:59 mghie Exp $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
Known Issues:
-------------------------------------------------------------------------------
@abstract(Provides a customizable highlighter for SynEdit)
@author(Martin Waldenburg, converted to SynEdit by Michael Hieke)
@created(1999)
@lastmod(2000-06-23)
The SynHighlighterGeneral unit provides a customizable highlighter for SynEdit.
Notes: March 21, 2006
-SynHighlighterAny.pas converted for use with Lazarus by Lars (L505)
}
unit SynHighlighterAny;
{$I SynEdit.inc}
interface
uses
SysUtils, Classes, LazUTF8, LazFileUtils, Controls, Graphics, Registry,
SynEditTypes, SynEditHighlighter;
type
TtkTokenKind = (tkComment, tkIdentifier, tkKey, tkNull, tkNumber,
tkPreprocessor, tkSpace, tkString, tkSymbol, tkUnknown, tkConstant, tkObject, tkEntity, tkDollarVariable, tkDot);
TCommentStyle = (csAnsiStyle, csPasStyle, csCStyle, csAsmStyle, csBasStyle, csVBStyle);
CommentStyles = set of TCommentStyle;
TRangeState = (rsANil, rsAnsi, rsPasStyle, rsCStyle, rsUnKnown);
TStringDelim = (sdSingleQuote, sdDoubleQuote);
TProcTableProc = procedure of object;
type
TIniList= class(TStringList)
private
function GetKeyIndex(asection,akey:string):integer;
function GetKeyValue(asection,akey:string):string;
public
function ReadString(asection,akey,adefault:string):string;
function ReadInteger(asection,akey:string; adefault:integer):integer;
function ReadBool(asection,akey:string; adefault:boolean):boolean;
procedure ReadSectionNames(asection:string;alist:TStrings);
end;
{ TSynAnySyn }
TSynAnySyn = class(TSynCustomHighlighter)
private
fUserData:TIniList;
fMarkupOn:boolean;
fRange: TRangeState;
fLine: PChar;
fProcTable: array[#0..#255] of TProcTableProc;
Run: LongInt;
fTokenPos: Integer;
fTokenID: TtkTokenKind;
fLineNumber : Integer;
fCommentAttri: TSynHighlighterAttributes;
fIdentifierAttri: TSynHighlighterAttributes;
fKeyAttri: TSynHighlighterAttributes;
fConstantAttri: TSynHighlighterAttributes;
fObjectAttri: TSynHighlighterAttributes;
fNumberAttri: TSynHighlighterAttributes;
fPreprocessorAttri: TSynHighlighterAttributes;
fSpaceAttri: TSynHighlighterAttributes;
fStringAttri: TSynHighlighterAttributes;
fSymbolAttri: TSynHighlighterAttributes;
fKeyWords: TStrings;
fConstants:TStrings;
fObjects:TStrings;
fComments: CommentStyles;
fStringDelimCh: char;
fIdentChars: TSynIdentChars;
fDetectPreprocessor: boolean;
FMarkup: boolean;
FEntity: boolean;
fEntityAttri: TSynHighlighterAttributes;
FDollarVariables: boolean;
fVariableAttri: TSynHighlighterAttributes;
FActiveDot: boolean;
FDotAttri: TSynHighlighterAttributes;
procedure ApostropheProc;
procedure AmpersandProc;
procedure AsciiCharProc;
procedure BraceOpenProc;
procedure BraceCloseProc;
procedure PointCommaProc;
procedure CRProc;
procedure DotProc;
procedure IdentProc;
procedure IntegerProc;
procedure DollarProc;
procedure LFProc;
procedure NullProc;
procedure NumberProc;
procedure RoundOpenProc;
procedure RoundCloseProc;
procedure SlashProc;
procedure SpaceProc;
procedure StringProc;
procedure UnknownProc;
procedure GreaterThan;
procedure SmallerThan;
procedure MakeMethodTables;
procedure AnsiProc;
procedure PasStyleProc;
procedure CStyleProc;
procedure SetKeyWords(const Value: TStrings);
procedure SetComments(Value: CommentStyles);
function GetStringDelim: TStringDelim;
procedure SetStringDelim(const Value: TStringDelim);
function GetIdentifierChars: string;
procedure SetIdentifierChars(const Value: string);
procedure SetDetectPreprocessor(Value: boolean);
procedure SetConstants(const Value: TStrings);
procedure SetObjects(const Value: TStrings);
function IsObject(const AObject: string): boolean;
procedure SetMarkup(const Value: boolean);
procedure SetEntity(const Value: boolean);
procedure SetDollarVariables(const Value: boolean);
procedure SetActiveDot(const Value: boolean);
procedure SetDotAttri(const Value: TSynHighlighterAttributes);
protected
function GetIdentChars: TSynIdentChars; 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 GetTokenID: TtkTokenKind;
function GetToken: String; override;
procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override;
function GetTokenAttribute: TSynHighlighterAttributes; override;
function GetTokenKind: integer; override;
function GetTokenPos: Integer; override;
function IsKeyword(const AKeyword: string): boolean; override; //mh 2000-11-08
function IsConstant(const AConstant: string): boolean;
procedure Next; override;
procedure ResetRange; override;
procedure SetRange(Value: Pointer); override;
procedure SetLine(const NewValue: String; LineNumber: Integer); override;
function SaveToRegistry(RootKey: HKEY; Key: string): boolean; override;
function LoadFromRegistry(RootKey: HKEY; Key: string): boolean; override;
procedure LoadHighLighter(aFile: string);
published
property CommentAttri: TSynHighlighterAttributes read fCommentAttri
write fCommentAttri;
property Comments: CommentStyles read fComments write SetComments;
property DetectPreprocessor: boolean read fDetectPreprocessor
write SetDetectPreprocessor;
property IdentifierAttri: TSynHighlighterAttributes read fIdentifierAttri
write fIdentifierAttri;
property IdentifierChars: string read GetIdentifierChars
write SetIdentifierChars;
property KeyAttri: TSynHighlighterAttributes read fKeyAttri write fKeyAttri;
property ConstantAttri: TSynHighlighterAttributes read fConstantAttri write fConstantAttri;
property ObjectAttri: TSynHighlighterAttributes read fObjectAttri write fObjectAttri;
property EntityAttri: TSynHighlighterAttributes read fEntityAttri write fEntityAttri;
property VariableAttri: TSynHighlighterAttributes read fVariableAttri write fVariableAttri;
property DotAttri: TSynHighlighterAttributes read FDotAttri write SetDotAttri;
property KeyWords: TStrings read fKeyWords write SetKeyWords;
property Constants: TStrings read fConstants write SetConstants;
property Objects: TStrings read fObjects write SetObjects;
property NumberAttri: TSynHighlighterAttributes read fNumberAttri
write fNumberAttri;
property PreprocessorAttri: TSynHighlighterAttributes
read fPreprocessorAttri write fPreprocessorAttri;
property SpaceAttri: TSynHighlighterAttributes read fSpaceAttri
write fSpaceAttri;
property StringAttri: TSynHighlighterAttributes read fStringAttri
write fStringAttri;
property SymbolAttri: TSynHighlighterAttributes read fSymbolAttri
write fSymbolAttri;
property StringDelim: TStringDelim read GetStringDelim write SetStringDelim
default sdSingleQuote;
property Markup:boolean read FMarkup write SetMarkup;
property Entity:boolean read FEntity write SetEntity;
property DollarVariables:boolean read FDollarVariables write SetDollarVariables;
property ActiveDot:boolean read FActiveDot write SetActiveDot;
end;
implementation
uses
SynEditStrConst;
var
Identifiers: array[#0..#255] of ByteBool;
procedure MakeIdentTable;
var
I: Char;
idents:string;
begin
idents:='_0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-?!';
for I := #0 to #255 do
begin
if pos(i,idents)>0 then identifiers[i]:=true
else identifiers[i]:=false;
// case I in ['_', '0'..'9', 'a'..'z', 'A'..'Z','-','?','!'] of true: Identifiers[I] := True;
// else Identifiers[I] := False;
// end;
end;
end;
function TSynAnySyn.IsKeyword(const AKeyword: string): boolean; //mh 2000-11-08
var
First, Last, I, Compare: Integer;
Token: String;
begin
First := 0;
Last := fKeywords.Count - 1;
Result := False;
Token := UpperCase(AKeyword);
while First <= Last do
begin
I := (First + Last) shr 1;
Compare := AnsiCompareStr(fKeywords[i], Token);
if Compare = 0 then
begin
Result := True;
break;
end else
if Compare < 0 then First := I + 1 else Last := I - 1;
end;
end; { IsKeyWord }
function TSynAnySyn.IsConstant(const AConstant: string): boolean; //mh 2000-11-08
var
First, Last, I, Compare: Integer;
Token: String;
begin
First := 0;
Last := fConstants.Count - 1;
Result := False;
Token := UpperCase(AConstant);
while First <= Last do
begin
I := (First + Last) shr 1;
Compare := AnsiCompareStr(fConstants[i], Token);
if Compare = 0 then
begin
Result := True;
break;
end else
if Compare < 0 then First := I + 1 else Last := I - 1;
end;
end; { IsConstant }
function TSynAnySyn.IsObject(const AObject: string): boolean; //mh 2000-11-08
var
First, Last, I, Compare: Integer;
Token: String;
begin
First := 0;
Last := fObjects.Count - 1;
Result := False;
Token := UpperCase(AObject);
while First <= Last do
begin
I := (First + Last) shr 1;
Compare := AnsiCompareStr(fObjects[i], Token);
if Compare = 0 then
begin
Result := True;
break;
end else
if Compare < 0 then First := I + 1 else Last := I - 1;
end;
end; { IsObject }
procedure TSynAnySyn.MakeMethodTables;
var
I: Char;
begin
for I := #0 to #255 do
case I of
#39: begin
if csVBStyle in comments then begin
fProcTable[I] := @ApostropheProc;
fStringDelimch:= #34;
end
else
fProcTable[I] := @UnknownProc;
end;
'<': begin
if markup then
fProcTable[i]:= @SmallerThan
else
fProcTable[I] := @UnknownProc;
end;
'>': begin
if markup then
fProcTable[i]:= @GreaterThan
else
fProcTable[I] := @UnknownProc;
end;
'&': begin
if Entity then
fProcTable[i]:= @AmpersandProc
else
fProcTable[I] := @UnknownProc;
end;
'#': fProcTable[I] := @AsciiCharProc;
'{': fProcTable[I] := @BraceOpenProc;
'}': fProcTable[I] := @BraceCloseProc;
';': fProcTable[I] := @PointCommaProc;
#13: fProcTable[I] := @CRProc;
'A'..'Z', 'a'..'z', '_': fProcTable[I] := @IdentProc;
'$': begin
if dollarvariables then
fProcTable[I] := @DollarProc
else
fProcTable[I] := @IntegerProc;
end;
'.': fProcTable[i] := @DotProc;
#10: fProcTable[I] := @LFProc;
#0: fProcTable[I] := @NullProc;
'0'..'9': fProcTable[I] := @NumberProc;
'(': fProcTable[I] := @RoundOpenProc;
')': fProcTable[I] := @RoundCloseProc;
'/': fProcTable[I] := @SlashProc;
#1..#9, #11, #12, #14..#32: fProcTable[I] := @SpaceProc;
else fProcTable[I] := @UnknownProc;
end;
fProcTable[fStringDelimCh] := @StringProc;
end;
constructor TSynAnySyn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fUserData:= TIniList.Create;
fKeyWords := TStringList.Create;
TStringList(fKeyWords).Sorted := True;
TStringList(fKeyWords).Duplicates := dupIgnore;
fConstants := TStringList.Create;
TStringList(fConstants).Sorted := True;
TStringList(fConstants).Duplicates := dupIgnore;
fObjects := TStringList.Create;
TStringList(fObjects).Sorted := True;
TStringList(fObjects).Duplicates := dupIgnore;
fCommentAttri := TSynHighlighterAttributes.Create(@SYNS_AttrComment, SYNS_XML_AttrComment);
fCommentAttri.Style := [fsItalic];
AddAttribute(fCommentAttri);
fIdentifierAttri := TSynHighlighterAttributes.Create(@SYNS_AttrIdentifier, SYNS_XML_AttrIdentifier);
AddAttribute(fIdentifierAttri);
fKeyAttri := TSynHighlighterAttributes.Create(@SYNS_AttrReservedWord, SYNS_XML_AttrReservedWord);
fKeyAttri.Style := [fsBold];
AddAttribute(fKeyAttri);
fConstantAttri := TSynHighlighterAttributes.Create('jan_constant');
fConstantAttri.Style := [fsBold];
fConstantAttri.Foreground:=clfuchsia;
AddAttribute(fConstantAttri);
fObjectAttri := TSynHighlighterAttributes.Create('jan_object');
fObjectAttri.Style := [fsBold];
fObjectAttri.Foreground:=clmaroon;
AddAttribute(fObjectAttri);
fEntityAttri := TSynHighlighterAttributes.Create('jan_entity');
fEntityAttri.Style := [fsBold];
fEntityAttri.Foreground:=cllime;
AddAttribute(fEntityAttri);
fDotAttri := TSynHighlighterAttributes.Create('jan_dot');
fDotAttri.Style := [fsBold];
fDotAttri.Foreground:=clgreen;
AddAttribute(fDotAttri);
fNumberAttri := TSynHighlighterAttributes.Create(@SYNS_AttrNumber, SYNS_XML_AttrNumber);
AddAttribute(fNumberAttri);
fSpaceAttri := TSynHighlighterAttributes.Create(@SYNS_AttrSpace, SYNS_XML_AttrSpace);
AddAttribute(fSpaceAttri);
fStringAttri := TSynHighlighterAttributes.Create(@SYNS_AttrString, SYNS_XML_AttrString);
AddAttribute(fStringAttri);
fSymbolAttri := TSynHighlighterAttributes.Create(@SYNS_AttrSymbol, SYNS_XML_AttrSymbol);
AddAttribute(fSymbolAttri);
fVariableAttri := TSynHighlighterAttributes.Create('jan_Variable');
fVariableAttri.Style := [fsBold];
fVariableAttri.Foreground:=clpurple;
AddAttribute(fVariableAttri);
fPreprocessorAttri := TSynHighlighterAttributes.Create(@SYNS_AttrPreprocessor, SYNS_XML_AttrPreprocessor);
AddAttribute(fPreprocessorAttri);
SetAttributesOnChange(@DefHighlightChange);
fStringDelimCh := '''';
fIdentChars := inherited GetIdentChars;
MakeMethodTables;
fRange := rsUnknown;
end; { Create }
destructor TSynAnySyn.Destroy;
begin
fUserData.free;
fKeyWords.Free;
FConstants.Free;
FObjects.Free;
inherited Destroy;
end; { Destroy }
procedure TSynAnySyn.SetLine(const NewValue: String; LineNumber:Integer);
begin
inherited;
fLine := PChar(NewValue);
Run := 0;
fLineNumber := LineNumber;
Next;
end; { SetLine }
procedure TSynAnySyn.AnsiProc;
begin
case fLine[Run] of
#0: NullProc;
#10: LFProc;
#13: CRProc;
else
fTokenID := tkComment;
repeat
if (fLine[Run] = '*') and (fLine[Run + 1] = ')') then begin
fRange := rsUnKnown;
Inc(Run, 2);
break;
end;
Inc(Run);
until fLine[Run] in [#0, #10, #13];
end;
end;
procedure TSynAnySyn.PasStyleProc;
begin
case fLine[Run] of
#0: NullProc;
#10: LFProc;
#13: CRProc;
else
fTokenID := tkComment;
repeat
if fLine[Run] = '}' then begin
fRange := rsUnKnown;
Inc(Run);
break;
end;
Inc(Run);
until fLine[Run] in [#0, #10, #13];
end;
end;
procedure TSynAnySyn.CStyleProc;
begin
case fLine[Run] of
#0: NullProc;
#10: LFProc;
#13: CRProc;
else
fTokenID := tkComment;
repeat
if (fLine[Run] = '*') and (fLine[Run + 1] = '/') then begin
fRange := rsUnKnown;
Inc(Run, 2);
break;
end;
Inc(Run);
until fLine[Run] in [#0, #10, #13];
end;
end;
procedure TSynAnySyn.AsciiCharProc;
begin
if fDetectPreprocessor then begin
fTokenID := tkPreprocessor;
repeat
inc(Run);
until fLine[Run] in [#0, #10, #13];
end else begin
fTokenID := tkString;
repeat
inc(Run);
until not (fLine[Run] in ['0'..'9']);
end;
end;
procedure TSynAnySyn.BraceOpenProc;
begin
if csPasStyle in fComments then
begin
fTokenID := tkComment;
fRange := rsPasStyle;
inc(Run);
while FLine[Run] <> #0 do
case FLine[Run] of
'}':
begin
fRange := rsUnKnown;
inc(Run);
break;
end;
#10: break;
#13: break;
else inc(Run);
end;
end else
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
procedure TSynAnySyn.BraceCloseProc;
begin
inc(Run);
FTokenID := tkSymbol;
end;
procedure TSynAnySyn.PointCommaProc;
begin
if (csASmStyle in fComments) or (csBasStyle in fComments) then
begin
fTokenID := tkComment;
fRange := rsUnknown;
inc(Run);
while FLine[Run] <> #0 do
begin
fTokenID := tkComment;
inc(Run);
end;
end else
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
procedure TSynAnySyn.CRProc;
begin
fTokenID := tkSpace;
Inc(Run);
if fLine[Run] = #10 then Inc(Run);
end;
procedure TSynAnySyn.IdentProc;
var
aToken:string;
begin
while Identifiers[fLine[Run]] do inc(Run);
aToken:=GetToken;
if IsKeyWord(aToken) then begin
if not Markup then
fTokenId:= tkKey
else begin
if fMarkupOn then
fTokenId := tkKey
else
fTokenId:=tkIdentifier;
end
end
else if IsConstant(aToken) then fTokenId:=tkConstant
else if IsObject(aToken) then fTokenId:=tkObject
else fTokenId := tkIdentifier;
end;
procedure TSynAnySyn.IntegerProc;
begin
inc(Run);
fTokenID := tkNumber;
while FLine[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do inc(Run);
end;
procedure TSynAnySyn.LFProc;
begin
fTokenID := tkSpace;
inc(Run);
end;
procedure TSynAnySyn.NullProc;
begin
fTokenID := tkNull;
end;
procedure TSynAnySyn.NumberProc;
begin
inc(Run);
fTokenID := tkNumber;
while FLine[Run] in ['0'..'9', '.', 'e', 'E', 'x'] do
begin
case FLine[Run] of
'x': begin // handle C style hex numbers
IntegerProc;
break;
end;
'.':
if FLine[Run + 1] = '.' then break;
end;
inc(Run);
end;
end;
procedure TSynAnySyn.RoundOpenProc;
begin
inc(Run);
if csAnsiStyle in fComments then
begin
case fLine[Run] of
'*':
begin
fTokenID := tkComment;
fRange := rsAnsi;
inc(Run);
while fLine[Run] <> #0 do
case fLine[Run] of
'*':
if fLine[Run + 1] = ')' then
begin
fRange := rsUnKnown;
inc(Run, 2);
break;
end else inc(Run);
#10: break;
#13: break;
else inc(Run);
end;
end;
'.':
begin
inc(Run);
fTokenID := tkSymbol;
end;
else
begin
FTokenID := tkSymbol;
end;
end;
end else fTokenId := tkSymbol;
end;
procedure TSynAnySyn.RoundCloseProc;
begin
inc(Run);
FTokenID := tkSymbol;
end;
procedure TSynAnySyn.SlashProc;
begin
case FLine[Run + 1] of
'/':
begin
inc(Run, 2);
fTokenID := tkComment;
while FLine[Run] <> #0 do
begin
case FLine[Run] of
#10, #13: break;
end;
inc(Run);
end;
end;
'*':
begin
if csCStyle in fComments then
begin
fTokenID := tkComment;
fRange := rsCStyle;
inc(Run);
while fLine[Run] <> #0 do
case fLine[Run] of
'*':
if fLine[Run + 1] = '/' then
begin
fRange := rsUnKnown;
inc(Run, 2);
break;
end else inc(Run);
#10: break;
#13: break;
else inc(Run);
end;
end
else
begin
inc(Run);
fTokenId := tkSymbol;
end;
end;
else
begin
inc(Run);
if markup and fmarkupon then
fTokenID:=tkKey
else
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynAnySyn.SpaceProc;
begin
inc(Run);
fTokenID := tkSpace;
while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
end;
procedure TSynAnySyn.StringProc;
begin
fTokenID := tkString;
if (fLine[Run + 1] = fStringDelimCh) and (fLine[Run + 2] = fStringDelimCh) then
Inc(Run, 2);
repeat
case FLine[Run] of
#0, #10, #13: break;
end;
inc(Run);
until FLine[Run] = fStringDelimCh;
if FLine[Run] <> #0 then inc(Run);
end;
procedure TSynAnySyn.UnknownProc;
begin
inc(Run);
while (fLine[Run] in [#128..#191]) OR // continued utf8 subcode
((fLine[Run]<>#0) and (fProcTable[fLine[Run]] = @UnknownProc)) do inc(Run);
fTokenID := tkUnKnown;
end;
procedure TSynAnySyn.Next;
begin
fTokenPos := Run;
case fRange of
rsAnsi: AnsiProc;
rsPasStyle: PasStyleProc;
rsCStyle: CStyleProc;
else
fProcTable[fLine[Run]];
end;
end;
function TSynAnySyn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
begin
case Index of
SYN_ATTR_COMMENT: Result := fCommentAttri;
SYN_ATTR_IDENTIFIER: Result := fIdentifierAttri;
SYN_ATTR_KEYWORD: Result := fKeyAttri;
SYN_ATTR_STRING: Result := fStringAttri;
SYN_ATTR_WHITESPACE: Result := fSpaceAttri;
SYN_ATTR_SYMBOL: Result := fSymbolAttri;
SYN_ATTR_NUMBER: Result := fNumberAttri;
SYN_ATTR_DIRECTIVE: Result := fPreprocessorAttri;
else
Result := nil;
end;
end;
function TSynAnySyn.GetEol: Boolean;
begin
Result := fTokenId = tkNull;
end;
function TSynAnySyn.GetRange: Pointer;
begin
Result := Pointer(PtrUInt(fRange));
end;
function TSynAnySyn.GetToken: String;
var
Len: LongInt;
begin
Len := Run - fTokenPos;
Result:='';
SetString(Result, (FLine + fTokenPos), Len);
end;
procedure TSynAnySyn.GetTokenEx(out TokenStart: PChar;
out TokenLength: integer);
begin
TokenLength:=Run-fTokenPos;
TokenStart:=FLine + fTokenPos;
end;
function TSynAnySyn.GetTokenID: TtkTokenKind;
begin
Result := fTokenId;
end;
function TSynAnySyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
case fTokenID of
tkComment: Result := fCommentAttri;
tkIdentifier: Result := fIdentifierAttri;
tkEntity: result:= fEntityAttri;
tkKey: Result := fKeyAttri;
tkConstant: Result := fConstantAttri;
tkObject: Result := fObjectAttri;
tkNumber: Result := fNumberAttri;
tkPreprocessor: Result := fPreprocessorAttri;
tkSpace: Result := fSpaceAttri;
tkString: Result := fStringAttri;
tkSymbol: Result := fSymbolAttri;
tkDollarVariable: Result := fVariableAttri;
tkDot: result:=fDotAttri;
tkUnknown: Result := fSymbolAttri;
else
Result := nil;
end;
end;
function TSynAnySyn.GetTokenKind: integer;
begin
Result := Ord(fTokenId);
end;
function TSynAnySyn.GetTokenPos: Integer;
begin
Result := fTokenPos;
end;
procedure TSynAnySyn.ReSetRange;
begin
fRange := rsUnknown;
end;
procedure TSynAnySyn.SetRange(Value: Pointer);
begin
fRange := TRangeState(PtrUInt(Value));
end;
procedure TSynAnySyn.SetKeyWords(const Value: TStrings);
var
i: Integer;
begin
if Value <> nil then
begin
Value.BeginUpdate;
for i := 0 to Value.Count - 1 do
Value[i] := UpperCase(Value[i]);
Value.EndUpdate;
end;
fKeyWords.Assign(Value);
DefHighLightChange(nil);
end;
procedure TSynAnySyn.SetComments(Value: CommentStyles);
begin
if fComments = Value then exit;
fComments := Value;
MakeMethodTables;
DefHighLightChange(nil);
end;
class function TSynAnySyn.GetLanguageName: string;
begin
Result := SYNS_LangGeneral;
end;
function TSynAnySyn.LoadFromRegistry(RootKey: HKEY; Key: string): boolean;
var
r: TRegistry;
begin
r:= TRegistry.Create;
try
r.RootKey := RootKey;
if r.OpenKeyReadOnly(Key) then begin
if r.ValueExists('KeyWords') then KeyWords.Text:= r.ReadString('KeyWords');
Result := inherited LoadFromRegistry(RootKey, Key);
end
else Result := false;
finally r.Free; end;
end;
function TSynAnySyn.SaveToRegistry(RootKey: HKEY; Key: string): boolean;
var
r: TRegistry;
begin
r:= TRegistry.Create;
try
r.RootKey := RootKey;
if r.OpenKey(Key,true) then begin
Result := true;
r.WriteString('KeyWords', KeyWords.Text);
Result := inherited SaveToRegistry(RootKey, Key);
end
else Result := false;
finally r.Free; end;
end;
function TSynAnySyn.GetStringDelim: TStringDelim;
begin
if fStringDelimCh = '''' then
Result := sdSingleQuote
else
Result := sdDoubleQuote;
end;
procedure TSynAnySyn.SetStringDelim(const Value: TStringDelim);
var
newCh: char;
begin
case Value of
sdSingleQuote: newCh := '''';
else newCh := '"';
end; //case
if newCh <> fStringDelimCh then begin
fStringDelimCh := newCh;
MakeMethodTables;
end;
end;
function TSynAnySyn.GetIdentifierChars: string;
var
ch: char;
s: shortstring;
begin
s := '';
for ch := #0 to #255 do
if ch in fIdentChars then s := s + ch;
Result := s;
end;
procedure TSynAnySyn.SetIdentifierChars(const Value: string);
var
i: integer;
begin
fIdentChars := [];
for i := 1 to Length(Value) do begin
fIdentChars := fIdentChars + [Value[i]];
end; //for
end;
function TSynAnySyn.GetIdentChars: TSynIdentChars;
begin
Result := fIdentChars;
end;
procedure TSynAnySyn.SetDetectPreprocessor(Value: boolean);
begin
if Value <> fDetectPreprocessor then begin
fDetectPreprocessor := Value;
DefHighlightChange(Self);
end;
end;
procedure TSynAnySyn.ApostropheProc;
begin
fTokenID := tkComment;
repeat
inc(Run);
until fLine[Run] in [#0, #10, #13];
end;
procedure TSynAnySyn.SetConstants(const Value: TStrings);
var
i: Integer;
begin
if Value <> nil then
begin
Value.BeginUpdate;
for i := 0 to Value.Count - 1 do
Value[i] := UpperCase(Value[i]);
Value.EndUpdate;
end;
fConstants.Assign(Value);
DefHighLightChange(nil);
end;
procedure TSynAnySyn.SetObjects(const Value: TStrings);
var
i: Integer;
begin
if Value <> nil then
begin
Value.BeginUpdate;
for i := 0 to Value.Count - 1 do
Value[i] := UpperCase(Value[i]);
Value.EndUpdate;
end;
fObjects.Assign(Value);
DefHighLightChange(nil);
end;
procedure TSynAnySyn.SetMarkup(const Value: boolean);
begin
if value<>FMarkup then begin
FMarkup := Value;
DefHighLightChange(nil);
end;
end;
procedure TSynAnySyn.GreaterThan;
begin
inc(Run);
if markup then begin
fMarkupOn:=false;
fTokenId:=tkKey;
end
else
fTokenID := tkUnKnown;
end;
procedure TSynAnySyn.SmallerThan;
begin
inc(Run);
if markup then begin
fMarkupOn:=true;
fTokenId:=tkKey;
end
else
fTokenID := tkUnKnown;
end;
procedure TSynAnySyn.LoadHighLighter(aFile: string);
var
hini:TIniList;
s:string;
b:boolean;
HL:TSynAnySyn;
i:integer;
genlist:TStringlist;
function StyleToStr(aStyle:TFontStyles):string;
begin
Result:='';
if (fsbold in aStyle) then
result:=result+'bold,';
if (fsitalic in aStyle) then
result:=result+'italic,';
if (fsunderline in aStyle) then
result:=result+'underline';
end;
procedure ReadAttribute(attr:TSynHighlighterAttributes;attrname:string);
begin
s:='';
if (fsbold in attr.Style) then
s:='bold,';
if (fsitalic in attr.Style) then
s:=s+'italic,';
if (fsunderline in attr.Style) then
s:=s+'underline';
s:=hini.ReadString(AttrName,'Style',s);
if (s='normal') or (s='') then
attr.style:=[]
else begin
if pos('bold',s)>0 then attr.style:=attr.style+[fsbold] else attr.style:=attr.style-[fsbold];
if pos('italic',s)>0 then attr.style:=attr.style+[fsitalic] else attr.style:=attr.style-[fsitalic];
if pos('underline',s)>0 then attr.style:=attr.style+[fsunderline] else attr.style:=attr.style-[fsunderline];
end;
s:=colortostring(Attr.Background);
s:=hini.ReadString(AttrName,'Background',s);
Attr.Background:=stringtocolor(s);
s:=colortostring(Attr.Foreground);
s:=hini.ReadString(AttrName,'Foreground',s);
Attr.Foreground:=stringtocolor(s);
end;
begin
if FileExistsUTF8(aFile) then
begin
HL:=self;
fUserData.LoadFromFile(UTF8ToSys(aFile));
hini:=fUserData;
// attributes
ReadAttribute(HL.Commentattri,'Comment');
ReadAttribute(HL.Identifierattri,'Identifier');
ReadAttribute(HL.Keyattri,'Key');
ReadAttribute(HL.Constantattri,'Constant');
ReadAttribute(HL.Objectattri,'Object');
ReadAttribute(HL.Numberattri,'Number');
ReadAttribute(HL.Spaceattri,'Space');
ReadAttribute(HL.Stringattri,'String');
ReadAttribute(HL.Symbolattri,'Symbol');
ReadAttribute(HL.Entityattri,'Entity');
ReadAttribute(HL.Variableattri,'Variables');
ReadAttribute(HL.DotAttri,'Dot');
// comment style
HL.Comments:=[];
if hini.ReadBool('CommentStyle','ansi',false) then
HL.comments:=HL.Comments+[csAnsiStyle];
if hini.ReadBool('CommentStyle','pas',false) then
HL.comments:=HL.Comments+[csPasStyle];
if hini.ReadBool('CommentStyle','c',false) then
HL.comments:=HL.Comments+[csCStyle];
if hini.ReadBool('CommentStyle','asm',false) then
HL.comments:=HL.Comments+[csAsmStyle];
if hini.ReadBool('CommentStyle','bas',false) then
HL.comments:=HL.Comments+[csBasStyle];
if hini.ReadBool('CommentStyle','vb',false) then
HL.comments:=HL.Comments+[csVBStyle];
// markup switch for html, xml, xsl etc.
HL.markup:= hini.ReadBool('Switches','markup',false);
// entity switch for html, xml, xsl etc.
HL.entity:= hini.ReadBool('Switches','entity',false);
// $variable switch for languages like perl and php
HL.dollarvariables:= hini.ReadBool('Switches','dollarvariables',false);
// .dot switch for object methods and properties
HL.ActiveDot:= hini.ReadBool('Switches','activedot',false);
// string delimiter
b:=hini.ReadBool('String Delimiter','Double Quotes',false);
if b then
HL.StringDelim:=sdDoubleQuote
else
HL.StringDelim:=sdSingleQuote;
genlist:=TStringList.create;
// read keywords
hini.ReadSectionNames('Keywords',genlist);
if genlist.count>0 then
for i:=0 to genlist.count-1 do
genlist[i]:=uppercase(genlist[i]);
HL.KeyWords.assign(genlist);
hini.ReadSectionNames('Constants',genlist);
if genlist.count>0 then
for i:=0 to genlist.count-1 do
genlist[i]:=uppercase(genlist[i]);
HL.Constants.assign(genlist);
hini.ReadSectionNames('Objects',genlist);
if genlist.count>0 then
for i:=0 to genlist.count-1 do
genlist[i]:=uppercase(genlist[i]);
HL.Objects.assign(genlist);
genlist.free;
makemethodtables;
end;
end;
{ TIniList }
function TIniList.GetKeyIndex(asection, akey: string): integer;
var
i,c:integer;
begin
result:=-1;
i:=self.IndexOf('['+asection+']');
if i=-1 then exit;
c:=self.Count;
inc(i);
while (i<c) and (pos('=',strings[i])<>0) do begin
if comparetext(names[i],akey)=0 then begin
result:=i;
exit;
end;
inc(i);
end;
end;
function TIniList.GetKeyValue(asection, akey: string): string;
var
i,p:integer;
begin
result:='';
i:=getkeyindex(asection,akey);
if i=-1 then exit;
p:=pos('=',strings[i]);
result:=copy(strings[i],p+1,maxint);
end;
function TIniList.ReadBool(asection, akey: string;
adefault: boolean): boolean;
var
keyvalue:string;
begin
result:=adefault;
keyvalue:=GetKeyValue(asection,akey);
result:=comparetext('true',keyvalue)=0;
end;
function TIniList.ReadInteger(asection, akey: string;
adefault: integer): integer;
var
keyvalue:string;
begin
result:=adefault;
keyvalue:=GetKeyValue(asection,akey);
try
result:=strtoint(keyvalue);
except
end;
end;
procedure TIniList.ReadSectionNames(asection: string; alist: TStrings);
var
i,c,p:integer;
s:string;
begin
alist.Clear;
i:=self.IndexOf('['+asection+']');
if i=-1 then exit;
inc(i);
c:=count;
while (i<c) and (pos('[',strings[i])=0) and (strings[i]<>'') do begin
s:=strings[i];
p:=pos('=',s);
if p=0 then
alist.Append(s)
else
alist.append(copy(s,1,p-1));
inc(i);
end;
end;
function TIniList.ReadString(asection, akey, adefault: string): string;
var
keyvalue:string;
begin
result:=adefault;
keyvalue:=GetKeyValue(asection,akey);
if keyvalue<>'' then result:=keyvalue;
end;
procedure TSynAnySyn.SetEntity(const Value: boolean);
begin
if value<>FEntity then begin
FEntity := Value;
DefHighLightChange(nil);
end;
end;
procedure TSynAnySyn.AmpersandProc;
function testentity:boolean;
var i:integer;
begin
result:=false;
i:=run;
inc(i);
while FLine[i] <> #0 do
case FLine[i] of
';':
begin
fRange := rsUnKnown;
inc(i);
result:=true;
break;
end;
#10: break;
' ': break;
#13: break;
else inc(i);
end;
if result then run:=i;
end;
begin
if Entity then
begin
if testentity then
fTokenID := tkEntity
else begin
inc(Run);
fTokenID := tkSymbol;
end;
end else
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
procedure TSynAnySyn.SetDollarVariables(const Value: boolean);
begin
if Value<>FDollarVariables then begin
FDollarVariables := Value;
MakeMethodTables;
DefHighLightChange(nil);
end;
end;
procedure TSynAnySyn.DollarProc;
begin
inc(Run);
fTokenID := tkDollarVariable;
while FLine[Run] in ['0'..'9', 'A'..'Z', 'a'..'z','_'] do inc(Run);
end;
procedure TSynAnySyn.DotProc;
function testdot:boolean;
var i:integer;
begin
result:=false;
i:=run;
inc(i);
while (FLine[i] in ['a'..'z','A'..'Z']) do
inc(i);
if i>(run+1) then result:=true;
if result then run:=i;
end;
begin
if not FActiveDot then
begin
inc(Run);
fTokenID := tkSymbol;
end
else if testDot then
fTokenID := tkDot
else begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
procedure TSynAnySyn.SetActiveDot(const Value: boolean);
begin
FActiveDot := Value;
end;
procedure TSynAnySyn.SetDotAttri(const Value: TSynHighlighterAttributes);
begin
FDotAttri := Value;
end;
initialization
MakeIdentTable;
end.