lazarus/components/synedit/synhighlighterperl.pas
2021-02-05 11:23:37 +00:00

2600 lines
74 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: SynHighlighterPerl.pas, released 2000-04-10.
The Original Code is based on the DcjSynPerl.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Michael Trier.
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$
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
Known Issues:
- Using q, qq, qw, qx, m, s, tr will not properly parse the contained
information.
- Not very optimized.
-------------------------------------------------------------------------------}
{
@abstract(Provides a Perl syntax highlighter for SynEdit)
@author(Michael Trier)
@created(1999, converted to SynEdit 2000-04-10 by Michael Hieke)
@lastmod(2000-06-23)
The SynHighlighterPerl unit provides SynEdit with a Perl syntax highlighter.
}
unit SynHighlighterPerl;
{$I synedit.inc}
interface
uses
SysUtils, Classes,
LCLIntf, LCLType,
Controls, Graphics,
SynEditTypes, SynEditHighlighter, SynEditStrConst;
type
TtkTokenKind = (tkComment, tkIdentifier, tkKey, tkNull, tkNumber, tkOperator,
tkPragma, tkSpace, tkString, tkSymbol, tkUnknown, tkVariable);
TProcTableProc = procedure of object;
TIdentFuncTableFunc = function: TtkTokenKind of object;
TSynPerlSyn = class(TSynCustomHighlighter)
private
fLine: PChar;
fProcTable: array[#0..#255] of TProcTableProc;
Run: LongInt;
fStringLen: Integer;
fToIdent: PChar;
fTokenPos: Integer;
FTokenID: TtkTokenKind;
fIdentFuncTable: array[0..2167] of TIdentFuncTableFunc;
fLineNumber: Integer;
fCommentAttri: TSynHighlighterAttributes;
fIdentifierAttri: TSynHighlighterAttributes;
fInvalidAttri: TSynHighlighterAttributes;
fKeyAttri: TSynHighlighterAttributes;
fNumberAttri: TSynHighlighterAttributes;
fOperatorAttri: TSynHighlighterAttributes;
fPragmaAttri: TSynHighlighterAttributes;
fSpaceAttri: TSynHighlighterAttributes;
fStringAttri: TSynHighlighterAttributes;
fSymbolAttri: TSynHighlighterAttributes;
fVariableAttri: TSynHighlighterAttributes;
function KeyHash(ToHash: PChar): Integer;
function KeyComp(const aKey: String): Boolean;
function Func109: TtkTokenKind;
function Func113: TtkTokenKind;
function Func196: TtkTokenKind;
function Func201: TtkTokenKind;
function Func204: TtkTokenKind;
function Func207: TtkTokenKind;
function Func209: TtkTokenKind;
function Func211: TtkTokenKind;
function Func214: TtkTokenKind;
function Func216: TtkTokenKind;
function Func219: TtkTokenKind;
function Func221: TtkTokenKind;
function Func224: TtkTokenKind;
function Func225: TtkTokenKind;
function Func226: TtkTokenKind;
function Func230: TtkTokenKind;
function Func232: TtkTokenKind;
function Func233: TtkTokenKind;
function Func248: TtkTokenKind;
function Func254: TtkTokenKind;
function Func255: TtkTokenKind;
function Func257: TtkTokenKind;
function Func262: TtkTokenKind;
function Func263: TtkTokenKind;
function Func269: TtkTokenKind;
function Func280: TtkTokenKind;
function Func282: TtkTokenKind;
function Func306: TtkTokenKind;
function Func307: TtkTokenKind;
function Func310: TtkTokenKind;
function Func314: TtkTokenKind;
function Func317: TtkTokenKind;
function Func318: TtkTokenKind;
function Func320: TtkTokenKind;
function Func322: TtkTokenKind;
function Func325: TtkTokenKind;
function Func326: TtkTokenKind;
function Func327: TtkTokenKind;
function Func330: TtkTokenKind;
function Func331: TtkTokenKind;
function Func333: TtkTokenKind;
function Func335: TtkTokenKind;
function Func337: TtkTokenKind;
function Func338: TtkTokenKind;
function Func340: TtkTokenKind;
function Func345: TtkTokenKind;
function Func346: TtkTokenKind;
function Func368: TtkTokenKind;
function Func401: TtkTokenKind;
function Func412: TtkTokenKind;
function Func413: TtkTokenKind;
function Func415: TtkTokenKind;
function Func419: TtkTokenKind;
function Func420: TtkTokenKind;
function Func421: TtkTokenKind;
function Func424: TtkTokenKind;
function Func425: TtkTokenKind;
function Func426: TtkTokenKind;
function Func428: TtkTokenKind;
function Func430: TtkTokenKind;
function Func431: TtkTokenKind;
function Func432: TtkTokenKind;
function Func433: TtkTokenKind;
function Func434: TtkTokenKind;
function Func436: TtkTokenKind;
function Func437: TtkTokenKind;
function Func438: TtkTokenKind;
function Func439: TtkTokenKind;
function Func440: TtkTokenKind;
function Func441: TtkTokenKind;
function Func442: TtkTokenKind;
function Func444: TtkTokenKind;
function Func445: TtkTokenKind;
function Func447: TtkTokenKind;
function Func448: TtkTokenKind;
function Func456: TtkTokenKind;
function Func458: TtkTokenKind;
function Func470: TtkTokenKind;
function Func477: TtkTokenKind;
function Func502: TtkTokenKind;
function Func522: TtkTokenKind;
function Func523: TtkTokenKind;
function Func525: TtkTokenKind;
function Func527: TtkTokenKind;
function Func530: TtkTokenKind;
function Func531: TtkTokenKind;
function Func534: TtkTokenKind;
function Func535: TtkTokenKind;
function Func536: TtkTokenKind;
function Func537: TtkTokenKind;
function Func539: TtkTokenKind;
function Func542: TtkTokenKind;
function Func543: TtkTokenKind;
function Func545: TtkTokenKind;
function Func546: TtkTokenKind;
function Func547: TtkTokenKind;
function Func548: TtkTokenKind;
function Func549: TtkTokenKind;
function Func552: TtkTokenKind;
function Func555: TtkTokenKind;
function Func556: TtkTokenKind;
function Func557: TtkTokenKind;
function Func562: TtkTokenKind;
function Func569: TtkTokenKind;
function Func570: TtkTokenKind;
function Func622: TtkTokenKind;
function Func624: TtkTokenKind;
function Func627: TtkTokenKind;
function Func630: TtkTokenKind;
function Func632: TtkTokenKind;
function Func637: TtkTokenKind;
function Func640: TtkTokenKind;
function Func642: TtkTokenKind;
function Func643: TtkTokenKind;
function Func645: TtkTokenKind;
function Func647: TtkTokenKind;
function Func648: TtkTokenKind;
function Func649: TtkTokenKind;
function Func650: TtkTokenKind;
function Func651: TtkTokenKind;
function Func652: TtkTokenKind;
function Func655: TtkTokenKind;
function Func656: TtkTokenKind;
function Func657: TtkTokenKind;
function Func658: TtkTokenKind;
function Func665: TtkTokenKind;
function Func666: TtkTokenKind;
function Func667: TtkTokenKind;
function Func672: TtkTokenKind;
function Func675: TtkTokenKind;
function Func677: TtkTokenKind;
function Func687: TtkTokenKind;
function Func688: TtkTokenKind;
function Func716: TtkTokenKind;
function Func719: TtkTokenKind;
function Func727: TtkTokenKind;
function Func728: TtkTokenKind;
function Func731: TtkTokenKind;
function Func734: TtkTokenKind;
function Func740: TtkTokenKind;
function Func741: TtkTokenKind;
function Func743: TtkTokenKind;
function Func746: TtkTokenKind;
function Func749: TtkTokenKind;
function Func750: TtkTokenKind;
function Func752: TtkTokenKind;
function Func753: TtkTokenKind;
function Func754: TtkTokenKind;
function Func759: TtkTokenKind;
function Func761: TtkTokenKind;
function Func762: TtkTokenKind;
function Func763: TtkTokenKind;
function Func764: TtkTokenKind;
function Func765: TtkTokenKind;
function Func768: TtkTokenKind;
function Func769: TtkTokenKind;
function Func773: TtkTokenKind;
function Func774: TtkTokenKind;
function Func775: TtkTokenKind;
function Func815: TtkTokenKind;
function Func821: TtkTokenKind;
function Func841: TtkTokenKind;
function Func842: TtkTokenKind;
function Func845: TtkTokenKind;
function Func853: TtkTokenKind;
function Func855: TtkTokenKind;
function Func857: TtkTokenKind;
function Func860: TtkTokenKind;
function Func864: TtkTokenKind;
function Func867: TtkTokenKind;
function Func868: TtkTokenKind;
function Func869: TtkTokenKind;
function Func870: TtkTokenKind;
function Func873: TtkTokenKind;
function Func874: TtkTokenKind;
function Func876: TtkTokenKind;
function Func877: TtkTokenKind;
function Func878: TtkTokenKind;
function Func881: TtkTokenKind;
function Func883: TtkTokenKind;
function Func890: TtkTokenKind;
function Func892: TtkTokenKind;
function Func906: TtkTokenKind;
function Func933: TtkTokenKind;
function Func954: TtkTokenKind;
function Func956: TtkTokenKind;
function Func965: TtkTokenKind;
function Func968: TtkTokenKind;
function Func974: TtkTokenKind;
function Func978: TtkTokenKind;
function Func981: TtkTokenKind;
function Func985: TtkTokenKind;
function Func986: TtkTokenKind;
function Func988: TtkTokenKind;
function Func1056: TtkTokenKind;
function Func1077: TtkTokenKind;
function Func1079: TtkTokenKind;
function Func1084: TtkTokenKind;
function Func1086: TtkTokenKind;
function Func1091: TtkTokenKind;
function Func1093: TtkTokenKind;
function Func1095: TtkTokenKind;
function Func1103: TtkTokenKind;
function Func1105: TtkTokenKind;
function Func1107: TtkTokenKind;
function Func1136: TtkTokenKind;
function Func1158: TtkTokenKind;
function Func1165: TtkTokenKind;
function Func1169: TtkTokenKind;
function Func1172: TtkTokenKind;
function Func1176: TtkTokenKind;
function Func1202: TtkTokenKind;
function Func1211: TtkTokenKind;
function Func1215: TtkTokenKind;
function Func1218: TtkTokenKind;
function Func1223: TtkTokenKind;
function Func1230: TtkTokenKind;
function Func1273: TtkTokenKind;
function Func1277: TtkTokenKind;
function Func1283: TtkTokenKind;
function Func1327: TtkTokenKind;
function Func1343: TtkTokenKind;
function Func1361: TtkTokenKind;
function Func1379: TtkTokenKind;
function Func1396: TtkTokenKind;
function Func1402: TtkTokenKind;
function Func1404: TtkTokenKind;
function Func1409: TtkTokenKind;
function Func1421: TtkTokenKind;
function Func1425: TtkTokenKind;
function Func1440: TtkTokenKind;
function Func1520: TtkTokenKind;
function Func1523: TtkTokenKind;
function Func1673: TtkTokenKind;
function Func1752: TtkTokenKind;
function Func1762: TtkTokenKind;
function Func1768: TtkTokenKind;
function Func2167: TtkTokenKind;
procedure AndSymbolProc;
procedure CRProc;
procedure ColonProc;
procedure CommentProc;
procedure EqualProc;
procedure GreaterProc;
procedure IdentProc;
procedure LFProc;
procedure LowerProc;
procedure MinusProc;
procedure NotSymbolProc;
procedure NullProc;
procedure NumberProc;
procedure OrSymbolProc;
procedure PlusProc;
procedure SlashProc;
procedure SpaceProc;
procedure StarProc;
procedure StringInterpProc;
procedure StringLiteralProc;
procedure SymbolProc;
procedure XOrSymbolProc;
procedure UnknownProc;
function AltFunc: TtkTokenKind;
procedure InitIdent;
function IdentKind(MayBe: PChar): TtkTokenKind;
procedure MakeMethodTables;
protected
function GetIdentChars: TSynIdentChars; override;
public
class function GetLanguageName: string; override;
public
constructor Create(AOwner: TComponent); override;
function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
override;
function GetEol: Boolean; override;
function GetTokenID: TtkTokenKind;
procedure SetLine(const NewValue: String;
LineNumber:Integer); override;
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;
procedure Next; override;
published
property CommentAttri: TSynHighlighterAttributes read fCommentAttri
write fCommentAttri;
property IdentifierAttri: TSynHighlighterAttributes read fIdentifierAttri
write fIdentifierAttri;
property InvalidAttri: TSynHighlighterAttributes read fInvalidAttri
write fInvalidAttri;
property KeyAttri: TSynHighlighterAttributes read fKeyAttri write fKeyAttri;
property NumberAttri: TSynHighlighterAttributes read fNumberAttri
write fNumberAttri;
property OperatorAttri: TSynHighlighterAttributes read fOperatorAttri
write fOperatorAttri;
property PragmaAttri: TSynHighlighterAttributes read fPragmaAttri
write fPragmaAttri;
property SpaceAttri: TSynHighlighterAttributes read fSpaceAttri
write fSpaceAttri;
property StringAttri: TSynHighlighterAttributes read fStringAttri
write fStringAttri;
property SymbolAttri: TSynHighlighterAttributes read fSymbolAttri
write fSymbolAttri;
property VariableAttri: TSynHighlighterAttributes read fVariableAttri
write fVariableAttri;
end;
implementation
var
Identifiers: array[#0..#255] of ByteBool;
// mHashTable: array[#0..#255] of Integer;
procedure MakeIdentTable;
var
I: Char;
begin
for I := #0 to #255 do
begin
Case I of
'_', '0'..'9', 'a'..'z', 'A'..'Z': Identifiers[I] := True;
else Identifiers[I] := False;
end;
{Case I in['%', '@', '$', '_', 'a'..'z', 'A'..'Z'] of
True:
begin
if (I > #64) and (I < #91) then mHashTable[I] := Ord(I) - 64 else
if (I > #96) then mHashTable[I] := Ord(I) - 95;
end;
else mHashTable[I] := 0;
end;}
end;
end;
procedure TSynPerlSyn.InitIdent;
var
I: Integer;
begin
for I := 0 to 2167 do
Case I of
109: fIdentFuncTable[I] := @Func109;
113: fIdentFuncTable[I] :=@func113;
196: fIdentFuncTable[I] :=@func196;
201: fIdentFuncTable[I] :=@func201;
204: fIdentFuncTable[I] :=@func204;
207: fIdentFuncTable[I] :=@func207;
209: fIdentFuncTable[I] :=@func209;
211: fIdentFuncTable[I] :=@func211;
214: fIdentFuncTable[I] :=@func214;
216: fIdentFuncTable[I] :=@func216;
219: fIdentFuncTable[I] :=@func219;
221: fIdentFuncTable[I] :=@func221;
224: fIdentFuncTable[I] :=@func224;
225: fIdentFuncTable[I] :=@func225;
226: fIdentFuncTable[I] :=@func226;
230: fIdentFuncTable[I] :=@func230;
232: fIdentFuncTable[I] :=@func232;
233: fIdentFuncTable[I] :=@func233;
248: fIdentFuncTable[I] :=@func248;
254: fIdentFuncTable[I] :=@func254;
255: fIdentFuncTable[I] :=@func255;
257: fIdentFuncTable[I] :=@func257;
262: fIdentFuncTable[I] :=@func262;
263: fIdentFuncTable[I] :=@func263;
269: fIdentFuncTable[I] :=@func269;
280: fIdentFuncTable[I] :=@func280;
282: fIdentFuncTable[I] :=@func282;
306: fIdentFuncTable[I] :=@func306;
307: fIdentFuncTable[I] :=@func307;
310: fIdentFuncTable[I] :=@func310;
314: fIdentFuncTable[I] :=@func314;
317: fIdentFuncTable[I] :=@func317;
318: fIdentFuncTable[I] :=@func318;
320: fIdentFuncTable[I] :=@func320;
322: fIdentFuncTable[I] :=@func322;
325: fIdentFuncTable[I] :=@func325;
326: fIdentFuncTable[I] :=@func326;
327: fIdentFuncTable[I] :=@func327;
330: fIdentFuncTable[I] :=@func330;
331: fIdentFuncTable[I] :=@func331;
333: fIdentFuncTable[I] :=@func333;
335: fIdentFuncTable[I] :=@func335;
337: fIdentFuncTable[I] :=@func337;
338: fIdentFuncTable[I] :=@func338;
340: fIdentFuncTable[I] :=@func340;
345: fIdentFuncTable[I] :=@func345;
346: fIdentFuncTable[I] :=@func346;
368: fIdentFuncTable[I] :=@func368;
401: fIdentFuncTable[I] :=@func401;
412: fIdentFuncTable[I] :=@func412;
413: fIdentFuncTable[I] :=@func413;
415: fIdentFuncTable[I] :=@func415;
419: fIdentFuncTable[I] :=@func419;
420: fIdentFuncTable[I] :=@func420;
421: fIdentFuncTable[I] :=@func421;
424: fIdentFuncTable[I] :=@func424;
425: fIdentFuncTable[I] :=@func425;
426: fIdentFuncTable[I] :=@func426;
428: fIdentFuncTable[I] :=@func428;
430: fIdentFuncTable[I] :=@func430;
431: fIdentFuncTable[I] :=@func431;
432: fIdentFuncTable[I] :=@func432;
433: fIdentFuncTable[I] :=@func433;
434: fIdentFuncTable[I] :=@func434;
436: fIdentFuncTable[I] :=@func436;
437: fIdentFuncTable[I] :=@func437;
438: fIdentFuncTable[I] :=@func438;
439: fIdentFuncTable[I] :=@func439;
440: fIdentFuncTable[I] :=@func440;
441: fIdentFuncTable[I] :=@func441;
442: fIdentFuncTable[I] :=@func442;
444: fIdentFuncTable[I] :=@func444;
445: fIdentFuncTable[I] :=@func445;
447: fIdentFuncTable[I] :=@func447;
448: fIdentFuncTable[I] :=@func448;
456: fIdentFuncTable[I] :=@func456;
458: fIdentFuncTable[I] :=@func458;
470: fIdentFuncTable[I] :=@func470;
477: fIdentFuncTable[I] :=@func477;
502: fIdentFuncTable[I] :=@func502;
522: fIdentFuncTable[I] :=@func522;
523: fIdentFuncTable[I] :=@func523;
525: fIdentFuncTable[I] :=@func525;
527: fIdentFuncTable[I] :=@func527;
530: fIdentFuncTable[I] :=@func530;
531: fIdentFuncTable[I] :=@func531;
534: fIdentFuncTable[I] :=@func534;
535: fIdentFuncTable[I] :=@func535;
536: fIdentFuncTable[I] :=@func536;
537: fIdentFuncTable[I] :=@func537;
539: fIdentFuncTable[I] :=@func539;
542: fIdentFuncTable[I] :=@func542;
543: fIdentFuncTable[I] :=@func543;
545: fIdentFuncTable[I] :=@func545;
546: fIdentFuncTable[I] :=@func546;
547: fIdentFuncTable[I] :=@func547;
548: fIdentFuncTable[I] :=@func548;
549: fIdentFuncTable[I] :=@func549;
552: fIdentFuncTable[I] :=@func552;
555: fIdentFuncTable[I] :=@func555;
556: fIdentFuncTable[I] :=@func556;
557: fIdentFuncTable[I] :=@func557;
562: fIdentFuncTable[I] :=@func562;
569: fIdentFuncTable[I] :=@func569;
570: fIdentFuncTable[I] :=@func570;
622: fIdentFuncTable[I] :=@func622;
624: fIdentFuncTable[I] :=@func624;
627: fIdentFuncTable[I] :=@func627;
630: fIdentFuncTable[I] :=@func630;
632: fIdentFuncTable[I] :=@func632;
637: fIdentFuncTable[I] :=@func637;
640: fIdentFuncTable[I] :=@func640;
642: fIdentFuncTable[I] :=@func642;
643: fIdentFuncTable[I] :=@func643;
645: fIdentFuncTable[I] :=@func645;
647: fIdentFuncTable[I] :=@func647;
648: fIdentFuncTable[I] :=@func648;
649: fIdentFuncTable[I] :=@func649;
650: fIdentFuncTable[I] :=@func650;
651: fIdentFuncTable[I] :=@func651;
652: fIdentFuncTable[I] :=@func652;
655: fIdentFuncTable[I] := @func655;
656: fIdentFuncTable[I] := @func656;
657: fIdentFuncTable[I] := @func657;
658: fIdentFuncTable[I] := @func658;
665: fIdentFuncTable[I] := @func665;
666: fIdentFuncTable[I] := @func666;
667: fIdentFuncTable[I] := @func667;
672: fIdentFuncTable[I] := @func672;
675: fIdentFuncTable[I] := @func675;
677: fIdentFuncTable[I] := @func677;
687: fIdentFuncTable[I] := @func687;
688: fIdentFuncTable[I] := @func688;
716: fIdentFuncTable[I] := @func716;
719: fIdentFuncTable[I] := @func719;
727: fIdentFuncTable[I] := @func727;
728: fIdentFuncTable[I] := @func728;
731: fIdentFuncTable[I] := @func731;
734: fIdentFuncTable[I] := @func734;
740: fIdentFuncTable[I] := @func740;
741: fIdentFuncTable[I] := @func741;
743: fIdentFuncTable[I] := @func743;
746: fIdentFuncTable[I] := @func746;
749: fIdentFuncTable[I] := @func749;
750: fIdentFuncTable[I] := @func750;
752: fIdentFuncTable[I] := @func752;
753: fIdentFuncTable[I] := @func753;
754: fIdentFuncTable[I] := @func754;
759: fIdentFuncTable[I] := @func759;
761: fIdentFuncTable[I] := @func761;
762: fIdentFuncTable[I] := @func762;
763: fIdentFuncTable[I] := @func763;
764: fIdentFuncTable[I] := @func764;
765: fIdentFuncTable[I] := @func765;
768: fIdentFuncTable[I] := @func768;
769: fIdentFuncTable[I] := @func769;
773: fIdentFuncTable[I] := @func773;
774: fIdentFuncTable[I] := @func774;
775: fIdentFuncTable[I] := @func775;
815: fIdentFuncTable[I] := @func815;
821: fIdentFuncTable[I] := @func821;
841: fIdentFuncTable[I] := @func841;
842: fIdentFuncTable[I] := @func842;
845: fIdentFuncTable[I] := @func845;
853: fIdentFuncTable[I] := @func853;
855: fIdentFuncTable[I] := @func855;
857: fIdentFuncTable[I] := @func857;
860: fIdentFuncTable[I] := @func860;
864: fIdentFuncTable[I] := @func864;
867: fIdentFuncTable[I] := @func867;
868: fIdentFuncTable[I] := @func868;
869: fIdentFuncTable[I] := @func869;
870: fIdentFuncTable[I] := @func870;
873: fIdentFuncTable[I] := @func873;
874: fIdentFuncTable[I] := @func874;
876: fIdentFuncTable[I] := @func876;
877: fIdentFuncTable[I] := @func877;
878: fIdentFuncTable[I] := @func878;
881: fIdentFuncTable[I] := @func881;
883: fIdentFuncTable[I] := @func883;
890: fIdentFuncTable[I] := @func890;
892: fIdentFuncTable[I] := @func892;
906: fIdentFuncTable[I] := @func906;
933: fIdentFuncTable[I] := @func933;
954: fIdentFuncTable[I] := @func954;
956: fIdentFuncTable[I] := @func956;
965: fIdentFuncTable[I] := @func965;
968: fIdentFuncTable[I] := @func968;
974: fIdentFuncTable[I] := @func974;
978: fIdentFuncTable[I] := @func978;
981: fIdentFuncTable[I] := @func981;
985: fIdentFuncTable[I] := @func985;
986: fIdentFuncTable[I] := @func986;
988: fIdentFuncTable[I] := @func988;
1056: fIdentFuncTable[I] := @func1056;
1077: fIdentFuncTable[I] := @func1077;
1079: fIdentFuncTable[I] := @func1079;
1084: fIdentFuncTable[I] := @func1084;
1086: fIdentFuncTable[I] := @func1086;
1091: fIdentFuncTable[I] := @func1091;
1093: fIdentFuncTable[I] := @func1093;
1095: fIdentFuncTable[I] := @func1095;
1103: fIdentFuncTable[I] := @func1103;
1105: fIdentFuncTable[I] := @func1105;
1107: fIdentFuncTable[I] := @func1107;
1136: fIdentFuncTable[I] := @func1136;
1158: fIdentFuncTable[I] := @func1158;
1165: fIdentFuncTable[I] := @func1165;
1169: fIdentFuncTable[I] := @func1169;
1172: fIdentFuncTable[I] := @func1172;
1176: fIdentFuncTable[I] := @func1176;
1202: fIdentFuncTable[I] := @func1202;
1211: fIdentFuncTable[I] := @func1211;
1215: fIdentFuncTable[I] := @func1215;
1218: fIdentFuncTable[I] := @func1218;
1223: fIdentFuncTable[I] := @func1223;
1230: fIdentFuncTable[I] := @func1230;
1273: fIdentFuncTable[I] := @func1273;
1277: fIdentFuncTable[I] := @func1277;
1283: fIdentFuncTable[I] := @func1283;
1327: fIdentFuncTable[I] := @func1327;
1343: fIdentFuncTable[I] := @func1343;
1361: fIdentFuncTable[I] := @func1361;
1379: fIdentFuncTable[I] := @func1379;
1396: fIdentFuncTable[I] := @func1396;
1402: fIdentFuncTable[I] := @func1402;
1404: fIdentFuncTable[I] := @func1404;
1409: fIdentFuncTable[I] := @func1409;
1421: fIdentFuncTable[I] := @func1421;
1425: fIdentFuncTable[I] := @func1425;
1440: fIdentFuncTable[I] := @func1440;
1520: fIdentFuncTable[I] := @func1520;
1523: fIdentFuncTable[I] := @func1523;
1673: fIdentFuncTable[I] := @func1673;
1752: fIdentFuncTable[I] := @func1752;
1762: fIdentFuncTable[I] := @func1762;
1768: fIdentFuncTable[I] := @func1768;
2167: fIdentFuncTable[I] := @func2167;
else fIdentFuncTable[I] := @AltFunc;
end;
end;
function TSynPerlSyn.KeyHash(ToHash: PChar): Integer;
begin
Result := 0;
while ToHash^ in ['%', '@', '$', '_', '0'..'9', 'a'..'z', 'A'..'Z'] do
begin
inc(Result, Integer(ToHash^));
inc(ToHash);
end;
fStringLen := ToHash - fToIdent;
end; { KeyHash }
function TSynPerlSyn.KeyComp(const aKey: String): Boolean;
var
I: Integer;
Temp: PChar;
begin
Temp := fToIdent;
if Length(aKey) = fStringLen then
begin
Result := True;
for i := 1 to fStringLen do begin
if Temp^ <> aKey[i] then
begin
Result := False;
break;
end;
inc(Temp);
end;
end else Result := False;
end; { KeyComp }
function TSynPerlSyn.Func109: TtkTokenKind;
begin
if KeyComp('m') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func113: TtkTokenKind;
begin
if KeyComp('q') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func196: TtkTokenKind;
begin
if KeyComp('$NR') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func201: TtkTokenKind;
begin
if KeyComp('$RS') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func204: TtkTokenKind;
begin
if KeyComp('ge') then Result := tkOperator else Result := tkIdentifier;
end;
function TSynPerlSyn.Func207: TtkTokenKind;
begin
if KeyComp('lc') then Result := tkKey else
if KeyComp('if') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func209: TtkTokenKind;
begin
if KeyComp('le') then Result := tkOperator else Result := tkIdentifier;
end;
function TSynPerlSyn.Func211: TtkTokenKind;
begin
if KeyComp('ne') then Result := tkOperator else
if KeyComp('do') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func214: TtkTokenKind;
begin
if KeyComp('eq') then Result := tkOperator else Result := tkIdentifier;
end;
function TSynPerlSyn.Func216: TtkTokenKind;
begin
if KeyComp('uc') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func219: TtkTokenKind;
begin
if KeyComp('gt') then Result := tkOperator else Result := tkIdentifier;
end;
function TSynPerlSyn.Func221: TtkTokenKind;
begin
if KeyComp('no') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func224: TtkTokenKind;
begin
if KeyComp('lt') then Result := tkOperator else Result := tkIdentifier;
end;
function TSynPerlSyn.Func225: TtkTokenKind;
begin
if KeyComp('or') then Result := tkOperator else Result := tkIdentifier;
end;
function TSynPerlSyn.Func226: TtkTokenKind;
begin
if KeyComp('qq') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func230: TtkTokenKind;
begin
if KeyComp('tr') then Result := tkKey else
if KeyComp('my') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func232: TtkTokenKind;
begin
if KeyComp('qw') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func233: TtkTokenKind;
begin
if KeyComp('qx') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func248: TtkTokenKind;
begin
if KeyComp('$GID') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func254: TtkTokenKind;
begin
if KeyComp('$ARG') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func255: TtkTokenKind;
begin
if KeyComp('%INC') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func257: TtkTokenKind;
begin
if KeyComp('$PID') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func262: TtkTokenKind;
begin
if KeyComp('$UID') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func263: TtkTokenKind;
begin
if KeyComp('$SIG') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func269: TtkTokenKind;
begin
if KeyComp('$ENV') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func280: TtkTokenKind;
begin
if KeyComp('$ORS') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func282: TtkTokenKind;
begin
if KeyComp('@INC') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func306: TtkTokenKind;
begin
if KeyComp('die') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func307: TtkTokenKind;
begin
if KeyComp('and') then Result := tkOperator else Result := tkIdentifier;
end;
function TSynPerlSyn.Func310: TtkTokenKind;
begin
if KeyComp('abs') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func314: TtkTokenKind;
begin
if KeyComp('eof') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func317: TtkTokenKind;
begin
if KeyComp('ref') then Result := tkKey else
if KeyComp('chr') then Result := tkKey else
if KeyComp('$EGID') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func318: TtkTokenKind;
begin
if KeyComp('vec') then Result := tkKey else
if KeyComp('map') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func320: TtkTokenKind;
begin
if KeyComp('cmp') then Result := tkOperator else Result := tkIdentifier;
end;
function TSynPerlSyn.Func322: TtkTokenKind;
begin
if KeyComp('tie') then Result := tkKey else
if KeyComp('log') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func325: TtkTokenKind;
begin
if KeyComp('hex') then Result := tkKey else
if KeyComp('ord') then Result := tkKey else
if KeyComp('cos') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func326: TtkTokenKind;
begin
if KeyComp('oct') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func327: TtkTokenKind;
begin
if KeyComp('for') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func330: TtkTokenKind;
begin
if KeyComp('sin') then Result := tkKey else
if KeyComp('sub') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func331: TtkTokenKind;
begin
if KeyComp('$EUID') then Result := tkVariable else
if KeyComp('int') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func333: TtkTokenKind;
begin
if KeyComp('use') then Result := tkKey else
if KeyComp('exp') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func335: TtkTokenKind;
begin
if KeyComp('pop') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func337: TtkTokenKind;
begin
if KeyComp('not') then Result := tkOperator else Result := tkIdentifier;
end;
function TSynPerlSyn.Func338: TtkTokenKind;
begin
if KeyComp('pos') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func340: TtkTokenKind;
begin
if KeyComp('$ARGV') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func345: TtkTokenKind;
begin
if KeyComp('xor') then Result := tkOperator else Result := tkIdentifier;
end;
function TSynPerlSyn.Func346: TtkTokenKind;
begin
if KeyComp('$OFMT') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func368: TtkTokenKind;
begin
if KeyComp('@ARGV') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func401: TtkTokenKind;
begin
if KeyComp('$MATCH') then Result := tkVariable else
if KeyComp('each') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func412: TtkTokenKind;
begin
if KeyComp('read') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func413: TtkTokenKind;
begin
if KeyComp('bind') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func415: TtkTokenKind;
begin
if KeyComp('pack') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func419: TtkTokenKind;
begin
if KeyComp('getc') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func420: TtkTokenKind;
begin
if KeyComp('glob') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func421: TtkTokenKind;
begin
if KeyComp('exec') then Result := tkKey else
if KeyComp('rand') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func424: TtkTokenKind;
begin
if KeyComp('seek') then Result := tkKey else
if KeyComp('eval') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func425: TtkTokenKind;
begin
if KeyComp('else') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func426: TtkTokenKind;
begin
if KeyComp('chop') then Result := tkKey else
if KeyComp('redo') then Result := tkKey else
if KeyComp('send') then Result := tkKey else
if KeyComp('$ERRNO') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func428: TtkTokenKind;
begin
if KeyComp('kill') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func430: TtkTokenKind;
begin
if KeyComp('grep') then Result := tkKey else
if KeyComp('pipe') then Result := tkKey else
if KeyComp('link') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func431: TtkTokenKind;
begin
if KeyComp('time') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func432: TtkTokenKind;
begin
if KeyComp('recv') then Result := tkKey else
if KeyComp('join') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func433: TtkTokenKind;
begin
if KeyComp('tell') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func434: TtkTokenKind;
begin
if KeyComp('open') then Result := tkKey else
if KeyComp('fork') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func436: TtkTokenKind;
begin
if KeyComp('last') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func437: TtkTokenKind;
begin
if KeyComp('wait') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func438: TtkTokenKind;
begin
if KeyComp('dump') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func439: TtkTokenKind;
begin
if KeyComp('less') then Result := tkPragma else Result := tkIdentifier;
end;
function TSynPerlSyn.Func440: TtkTokenKind;
begin
if KeyComp('warn') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func441: TtkTokenKind;
begin
if KeyComp('goto') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func442: TtkTokenKind;
begin
if KeyComp('exit') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func444: TtkTokenKind;
begin
if KeyComp('vars') then Result := tkPragma else
if KeyComp('keys') then Result := tkKey else
if KeyComp('stat') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func445: TtkTokenKind;
begin
if KeyComp('subs') then Result := tkPragma else Result := tkIdentifier;
end;
function TSynPerlSyn.Func447: TtkTokenKind;
begin
if KeyComp('next') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func448: TtkTokenKind;
begin
if KeyComp('push') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func456: TtkTokenKind;
begin
if KeyComp('sort') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func458: TtkTokenKind;
begin
if KeyComp('sqrt') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func470: TtkTokenKind;
begin
if KeyComp('atan2') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func477: TtkTokenKind;
begin
if KeyComp('$PERLDB') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func502: TtkTokenKind;
begin
if KeyComp('$SUBSEP') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func522: TtkTokenKind;
begin
if KeyComp('chdir') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func523: TtkTokenKind;
begin
if KeyComp('local') then Result := tkKey else
if KeyComp('chmod') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func525: TtkTokenKind;
begin
if KeyComp('alarm') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func527: TtkTokenKind;
begin
if KeyComp('flock') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func530: TtkTokenKind;
begin
if KeyComp('undef') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func531: TtkTokenKind;
begin
if KeyComp('elsif') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func534: TtkTokenKind;
begin
if KeyComp('close') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func535: TtkTokenKind;
begin
if KeyComp('mkdir') then Result := tkKey else
if KeyComp('fcntl') then Result := tkKey else
if KeyComp('chomp') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func536: TtkTokenKind;
begin
if KeyComp('index') then Result := tkKey else
if KeyComp('srand') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func537: TtkTokenKind;
begin
if KeyComp('sleep') then Result := tkKey else
if KeyComp('while') then Result := tkKey else
if KeyComp('bless') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func539: TtkTokenKind;
begin
if KeyComp('ioctl') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func542: TtkTokenKind;
begin
if KeyComp('shift') then Result := tkKey else
if KeyComp('rmdir') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func543: TtkTokenKind;
begin
if KeyComp('chown') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func545: TtkTokenKind;
begin
if KeyComp('umask') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func546: TtkTokenKind;
begin
if KeyComp('times') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func547: TtkTokenKind;
begin
if KeyComp('reset') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func548: TtkTokenKind;
begin
if KeyComp('semop') then Result := tkKey else
if KeyComp('utime') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func549: TtkTokenKind;
begin
if KeyComp('untie') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func552: TtkTokenKind;
begin
if KeyComp('lstat') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func555: TtkTokenKind;
begin
if KeyComp('write') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func556: TtkTokenKind;
begin
if KeyComp('split') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func557: TtkTokenKind;
begin
if KeyComp('print') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func562: TtkTokenKind;
begin
if KeyComp('crypt') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func569: TtkTokenKind;
begin
if KeyComp('study') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func570: TtkTokenKind;
begin
if KeyComp('$WARNING') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func622: TtkTokenKind;
begin
if KeyComp('$BASETIME') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func624: TtkTokenKind;
begin
if KeyComp('locale') then Result := tkPragma else
if KeyComp('accept') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func627: TtkTokenKind;
begin
if KeyComp('caller') then Result := tkKey else
if KeyComp('delete') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func630: TtkTokenKind;
begin
if KeyComp('scalar') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func632: TtkTokenKind;
begin
if KeyComp('rename') then Result := tkKey else
if KeyComp('$PREMATCH') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func637: TtkTokenKind;
begin
if KeyComp('fileno') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func640: TtkTokenKind;
begin
if KeyComp('splice') then Result := tkKey else
if KeyComp('select') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func642: TtkTokenKind;
begin
if KeyComp('length') then Result := tkKey else
if KeyComp('unpack') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func643: TtkTokenKind;
begin
if KeyComp('gmtime') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func645: TtkTokenKind;
begin
if KeyComp('semget') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func647: TtkTokenKind;
begin
if KeyComp('msgget') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func648: TtkTokenKind;
begin
if KeyComp('shmget') then Result := tkKey else
if KeyComp('semctl') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func649: TtkTokenKind;
begin
if KeyComp('socket') then Result := tkKey else
if KeyComp('format') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func650: TtkTokenKind;
begin
if KeyComp('rindex') then Result := tkKey else
if KeyComp('msgctl') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func651: TtkTokenKind;
begin
if KeyComp('shmctl') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func652: TtkTokenKind;
begin
if KeyComp('msgsnd') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func655: TtkTokenKind;
begin
if KeyComp('listen') then Result := tkKey else
if KeyComp('chroot') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func656: TtkTokenKind;
begin
if KeyComp('values') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func657: TtkTokenKind;
begin
if KeyComp('unlink') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func658: TtkTokenKind;
begin
if KeyComp('msgrcv') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func665: TtkTokenKind;
begin
if KeyComp('strict') then Result := tkPragma else Result := tkIdentifier;
end;
function TSynPerlSyn.Func666: TtkTokenKind;
begin
if KeyComp('unless') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func667: TtkTokenKind;
begin
if KeyComp('import') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func672: TtkTokenKind;
begin
if KeyComp('return') then Result := tkKey else
if KeyComp('exists') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func675: TtkTokenKind;
begin
if KeyComp('substr') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func677: TtkTokenKind;
begin
if KeyComp('system') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func687: TtkTokenKind;
begin
if KeyComp('$OS_ERROR') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func688: TtkTokenKind;
begin
if KeyComp('$DEBUGGING') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func716: TtkTokenKind;
begin
if KeyComp('package') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func719: TtkTokenKind;
begin
if KeyComp('defined') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func727: TtkTokenKind;
begin
if KeyComp('$POSTMATCH') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func728: TtkTokenKind;
begin
if KeyComp('foreach') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func731: TtkTokenKind;
begin
if KeyComp('readdir') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func734: TtkTokenKind;
begin
if KeyComp('binmode') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func740: TtkTokenKind;
begin
if KeyComp('shmread') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func741: TtkTokenKind;
begin
if KeyComp('dbmopen') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func743: TtkTokenKind;
begin
if KeyComp('seekdir') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func746: TtkTokenKind;
begin
if KeyComp('connect') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func749: TtkTokenKind;
begin
if KeyComp('getppid') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func750: TtkTokenKind;
begin
if KeyComp('integer') then Result := tkPragma else Result := tkIdentifier;
end;
function TSynPerlSyn.Func752: TtkTokenKind;
begin
if KeyComp('telldir') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func753: TtkTokenKind;
begin
if KeyComp('opendir') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func754: TtkTokenKind;
begin
if KeyComp('waitpid') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func759: TtkTokenKind;
begin
if KeyComp('lcfirst') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func761: TtkTokenKind;
begin
if KeyComp('getpgrp') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func762: TtkTokenKind;
begin
if KeyComp('sigtrap') then Result := tkPragma else Result := tkIdentifier;
end;
function TSynPerlSyn.Func763: TtkTokenKind;
begin
if KeyComp('sysread') then Result := tkKey else
if KeyComp('syscall') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func764: TtkTokenKind;
begin
if KeyComp('reverse') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func765: TtkTokenKind;
begin
if KeyComp('require') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func768: TtkTokenKind;
begin
if KeyComp('ucfirst') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func769: TtkTokenKind;
begin
if KeyComp('unshift') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func773: TtkTokenKind;
begin
if KeyComp('setpgrp') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func774: TtkTokenKind;
begin
if KeyComp('sprintf') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func775: TtkTokenKind;
begin
if KeyComp('symlink') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func815: TtkTokenKind;
begin
if KeyComp('$PROCESS_ID') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func821: TtkTokenKind;
begin
if KeyComp('$EVAL_ERROR') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func841: TtkTokenKind;
begin
if KeyComp('dbmclose') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func842: TtkTokenKind;
begin
if KeyComp('readlink') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func845: TtkTokenKind;
begin
if KeyComp('getgrgid') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func853: TtkTokenKind;
begin
if KeyComp('getgrnam') then Result := tkKey else
if KeyComp('closedir') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func855: TtkTokenKind;
begin
if KeyComp('endgrent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func857: TtkTokenKind;
begin
if KeyComp('getlogin') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func860: TtkTokenKind;
begin
if KeyComp('formline') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func864: TtkTokenKind;
begin
if KeyComp('getgrent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func867: TtkTokenKind;
begin
if KeyComp('getpwnam') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func868: TtkTokenKind;
begin
if KeyComp('$ACCUMULATOR') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func869: TtkTokenKind;
begin
if KeyComp('endpwent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func870: TtkTokenKind;
begin
if KeyComp('truncate') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func873: TtkTokenKind;
begin
if KeyComp('getpwuid') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func874: TtkTokenKind;
begin
if KeyComp('constant') then Result := tkPragma else Result := tkIdentifier;
end;
function TSynPerlSyn.Func876: TtkTokenKind;
begin
if KeyComp('setgrent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func877: TtkTokenKind;
begin
if KeyComp('$FORMAT_NAME') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func878: TtkTokenKind;
begin
if KeyComp('getpwent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func881: TtkTokenKind;
begin
if KeyComp('$CHILD_ERROR') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func883: TtkTokenKind;
begin
if KeyComp('shmwrite') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func890: TtkTokenKind;
begin
if KeyComp('setpwent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func892: TtkTokenKind;
begin
if KeyComp('shutdown') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func906: TtkTokenKind;
begin
if KeyComp('syswrite') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func933: TtkTokenKind;
begin
if KeyComp('$INPLACE_EDIT') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func954: TtkTokenKind;
begin
if KeyComp('localtime') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func956: TtkTokenKind;
begin
if KeyComp('$PROGRAM_NAME') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func965: TtkTokenKind;
begin
if KeyComp('endnetent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func968: TtkTokenKind;
begin
if KeyComp('rewinddir') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func974: TtkTokenKind;
begin
if KeyComp('getnetent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func978: TtkTokenKind;
begin
if KeyComp('$REAL_USER_ID') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func981: TtkTokenKind;
begin
if KeyComp('quotemeta') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func985: TtkTokenKind;
begin
if KeyComp('wantarray') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func986: TtkTokenKind;
begin
if KeyComp('setnetent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func988: TtkTokenKind;
begin
if KeyComp('$PERL_VERSION') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1056: TtkTokenKind;
begin
if KeyComp('$REAL_GROUP_ID') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1077: TtkTokenKind;
begin
if KeyComp('socketpair') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1079: TtkTokenKind;
begin
if KeyComp('$SYSTEM_FD_MAX') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1084: TtkTokenKind;
begin
if KeyComp('endhostent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1086: TtkTokenKind;
begin
if KeyComp('endservent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1091: TtkTokenKind;
begin
if KeyComp('getsockopt') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1093: TtkTokenKind;
begin
if KeyComp('gethostent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1095: TtkTokenKind;
begin
if KeyComp('getservent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1103: TtkTokenKind;
begin
if KeyComp('setsockopt') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1105: TtkTokenKind;
begin
if KeyComp('sethostent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1107: TtkTokenKind;
begin
if KeyComp('setservent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1136: TtkTokenKind;
begin
if KeyComp('$LIST_SEPARATOR') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1158: TtkTokenKind;
begin
if KeyComp('$EXECUTABLE_NAME') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1165: TtkTokenKind;
begin
if KeyComp('getpeername') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1169: TtkTokenKind;
begin
if KeyComp('getsockname') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1172: TtkTokenKind;
begin
if KeyComp('$FORMAT_FORMFEED') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1176: TtkTokenKind;
begin
if KeyComp('diagnostics') then Result := tkPragma else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1202: TtkTokenKind;
begin
if KeyComp('endprotoent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1211: TtkTokenKind;
begin
if KeyComp('getprotoent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1215: TtkTokenKind;
begin
if KeyComp('$FORMAT_TOP_NAME') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1218: TtkTokenKind;
begin
if KeyComp('getpriority') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1223: TtkTokenKind;
begin
if KeyComp('setprotoent') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1230: TtkTokenKind;
begin
if KeyComp('setpriority') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1273: TtkTokenKind;
begin
if KeyComp('$LAST_PAREN_MATCH') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1277: TtkTokenKind;
begin
if KeyComp('getnetbyaddr') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1283: TtkTokenKind;
begin
if KeyComp('getnetbyname') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1327: TtkTokenKind;
begin
if KeyComp('$OUTPUT_AUTOFLUSH') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1343: TtkTokenKind;
begin
if KeyComp('$EFFECTIVE_USER_ID') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1361: TtkTokenKind;
begin
if KeyComp('$FORMAT_LINES_LEFT') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1379: TtkTokenKind;
begin
if KeyComp('$INPUT_LINE_NUMBER') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1396: TtkTokenKind;
begin
if KeyComp('gethostbyaddr') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1402: TtkTokenKind;
begin
if KeyComp('gethostbyname') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1404: TtkTokenKind;
begin
if KeyComp('getservbyname') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1409: TtkTokenKind;
begin
if KeyComp('$MULTILINE_MATCHING') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1421: TtkTokenKind;
begin
if KeyComp('$EFFECTIVE_GROUP_ID') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1425: TtkTokenKind;
begin
if KeyComp('$FORMAT_PAGE_NUMBER') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1440: TtkTokenKind;
begin
if KeyComp('getservbyport') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1520: TtkTokenKind;
begin
if KeyComp('getprotobyname') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1523: TtkTokenKind;
begin
if KeyComp('$SUBSCRIPT_SEPARATOR') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1673: TtkTokenKind;
begin
if KeyComp('$FORMAT_LINES_PER_PAGE') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1752: TtkTokenKind;
begin
if KeyComp('getprotobynumber') then Result := tkKey else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1762: TtkTokenKind;
begin
if KeyComp('$INPUT_RECORD_SEPARATOR') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func1768: TtkTokenKind;
begin
if KeyComp('$OUTPUT_FIELD_SEPARATOR') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.Func2167: TtkTokenKind;
begin
if KeyComp('$FORMAT_LINE_BREAK_CHARACTERS') then Result := tkVariable else Result := tkIdentifier;
end;
function TSynPerlSyn.AltFunc: TtkTokenKind;
begin
Result := tkIdentifier;
end;
function TSynPerlSyn.IdentKind(MayBe: PChar): TtkTokenKind;
var
HashKey: Integer;
begin
fToIdent := MayBe;
HashKey := KeyHash(MayBe);
if HashKey < 2168 then
Result := fIdentFuncTable[HashKey]()
else
Result := tkIdentifier;
end;
procedure TSynPerlSyn.MakeMethodTables;
var
I: Char;
begin
for I := #0 to #255 do
case I of
'&': fProcTable[I] := @AndSymbolProc;
#13: fProcTable[I] := @CRProc;
':': fProcTable[I] := @ColonProc;
'#': fProcTable[I] := @CommentProc;
'=': fProcTable[I] := @EqualProc;
'>': fProcTable[I] := @GreaterProc;
'%', '@', '$', 'A'..'Z', 'a'..'z', '_':
fProcTable[I] := @IdentProc;
#10: fProcTable[I] := @LFProc;
'<': fProcTable[I] := @LowerProc;
'-': fProcTable[I] := @MinusProc;
'!': fProcTable[I] := @NotSymbolProc;
#0: fProcTable[I] := @NullProc;
'0'..'9', '.': fProcTable[I] := @NumberProc;
'|': fProcTable[I] := @OrSymbolProc;
'+': fProcTable[I] := @PlusProc;
'/': fProcTable[I] := @SlashProc;
#1..#9, #11, #12, #14..#32: fProcTable[I] := @SpaceProc;
'*': fProcTable[I] := @StarProc;
#34: fProcTable[I] := @StringInterpProc;
#39: fProcTable[I] := @StringLiteralProc;
'^': fProcTable[I] := @XOrSymbolProc;
'(', ')', '[', ']', '\', '{', '}', ',', ';', '?', '~':
fProcTable[I] := @SymbolProc;
else
fProcTable[I] := @UnknownProc;
end;
end;
constructor TSynPerlSyn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fCommentAttri := TSynHighlighterAttributes.Create(@SYNS_AttrComment, SYNS_XML_AttrComment);
fCommentAttri.Style:= [fsItalic];
AddAttribute(fCommentAttri);
fIdentifierAttri := TSynHighlighterAttributes.Create(@SYNS_AttrIdentifier, SYNS_XML_AttrIdentifier);
AddAttribute(fIdentifierAttri);
fInvalidAttri := TSynHighlighterAttributes.Create(@SYNS_AttrIllegalChar, SYNS_XML_AttrIllegalChar);
AddAttribute(fInvalidAttri);
fKeyAttri := TSynHighlighterAttributes.Create(@SYNS_AttrReservedWord, SYNS_XML_AttrReservedWord);
fKeyAttri.Style:= [fsBold];
AddAttribute(fKeyAttri);
fNumberAttri := TSynHighlighterAttributes.Create(@SYNS_AttrNumber, SYNS_XML_AttrNumber);
AddAttribute(fNumberAttri);
fOperatorAttri := TSynHighlighterAttributes.Create(@SYNS_AttrOperator, SYNS_XML_AttrOperator);
AddAttribute(fOperatorAttri);
fPragmaAttri := TSynHighlighterAttributes.Create(@SYNS_AttrPragma, SYNS_XML_AttrPragma);
fPragmaAttri.Style := [fsBold];
AddAttribute(fPragmaAttri);
fSpaceAttri := TSynHighlighterAttributes.Create(@SYNS_AttrSpace, SYNS_XML_AttrSpace);
fSpaceAttri.Foreground := clWindow;
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(@SYNS_AttrVariable, SYNS_XML_AttrVariable);
fVariableAttri.Style := [fsBold];
AddAttribute(fVariableAttri);
SetAttributesOnChange(@DefHighlightChange);
InitIdent;
MakeMethodTables;
fDefaultFilter := SYNS_FilterPerl;
end; { Create }
procedure TSynPerlSyn.SetLine(const NewValue: String;
LineNumber:Integer);
begin
inherited;
fLine := PChar(NewValue);
Run := 0;
fLineNumber := LineNumber;
Next;
end; { SetLine }
procedure TSynPerlSyn.AndSymbolProc;
begin
case FLine[Run + 1] of
'=': {bit and assign}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
'&':
begin
if FLine[Run + 2] = '=' then {logical and assign}
inc(Run, 3)
else {logical and}
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {bit and}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.CRProc;
begin
fTokenID := tkSpace;
Case FLine[Run + 1] of
#10: inc(Run, 2);
else inc(Run);
end;
end;
procedure TSynPerlSyn.ColonProc;
begin
Case FLine[Run + 1] of
':': {double colon}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {colon}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.CommentProc;
begin
fTokenID := tkComment;
repeat
case FLine[Run] of
#0, #10, #13: break;
end;
inc(Run);
until FLine[Run] = #0;
end;
procedure TSynPerlSyn.EqualProc;
begin
case FLine[Run + 1] of
'=': {logical equal}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
'>': {digraph}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
'~': {bind scalar to pattern}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {assign}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.GreaterProc;
begin
Case FLine[Run + 1] of
'=': {greater than or equal to}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
'>':
begin
if FLine[Run + 2] = '=' then {shift right assign}
inc(Run, 3)
else {shift right}
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {greater than}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.IdentProc;
begin
Case FLine[Run] of
'$':
begin
Case FLine[Run + 1] of
'!'..'+', '-'..'@', '['..']', '_', '`', '|', '~':
begin {predefined variables}
inc(Run, 2);
fTokenID := tkVariable;
exit;
end;
'^':
begin
Case FLine[Run + 2] of
'A', 'D', 'F', 'I', 'L', 'P', 'T', 'W', 'X':
begin {predefined variables}
inc(Run, 3);
fTokenID := tkVariable;
exit;
end;
#0, #10, #13: {predefined variables}
begin
inc(Run, 2);
fTokenID := tkVariable;
exit;
end;
end;
end;
end;
end;
'%':
begin
Case FLine[Run + 1] of
'=': {mod assign}
begin
inc(Run, 2);
fTokenID := tkSymbol;
exit;
end;
#0, #10, #13: {mod}
begin
inc(Run);
fTokenID := tkSymbol;
exit;
end;
end;
end;
'x':
begin
Case FLine[Run + 1] of
'=': {repetition assign}
begin
inc(Run, 2);
fTokenID := tkSymbol;
exit;
end;
#0, #10, #13: {repetition}
begin
inc(Run);
fTokenID := tkSymbol;
exit;
end;
end;
end;
end;
{regular identifier}
fTokenID := IdentKind((fLine + Run));
inc(Run, fStringLen);
while Identifiers[fLine[Run]] do inc(Run);
end;
procedure TSynPerlSyn.LFProc;
begin
fTokenID := tkSpace;
inc(Run);
end;
procedure TSynPerlSyn.LowerProc;
begin
case FLine[Run + 1] of
'=':
begin
if FLine[Run + 2] = '>' then {compare - less than, equal, greater}
inc(Run, 3)
else {less than or equal to}
inc(Run, 2);
fTokenID := tkSymbol;
end;
'<':
begin
if FLine[Run + 2] = '=' then {shift left assign}
inc(Run, 3)
else {shift left}
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {less than}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.MinusProc;
begin
case FLine[Run + 1] of
'=': {subtract assign}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
'-': {decrement}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
'>': {arrow}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {subtract}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.NotSymbolProc;
begin
case FLine[Run + 1] of
'~': {logical negated bind like =~}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
'=': {not equal}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {not}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.NullProc;
begin
fTokenID := tkNull;
end;
procedure TSynPerlSyn.NumberProc;
begin
if FLine[Run] = '.' then
begin
case FLine[Run + 1] of
'.':
begin
inc(Run, 2);
if FLine[Run] = '.' then {sed range}
inc(Run);
fTokenID := tkSymbol; {range}
exit;
end;
'=':
begin
inc(Run, 2);
fTokenID := tkSymbol; {concatenation assign}
exit;
end;
'a'..'z', 'A'..'Z', '_':
begin
fTokenID := tkSymbol; {concatenation}
inc(Run);
exit;
end;
end;
end;
fTokenID := tkNumber;
if (FLine[Run] = '0') and (FLine[Run+1] in ['x', 'X'])then
begin
inc(Run, 2);
while FLine[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do inc(Run);
exit;
end;
inc(Run);
while FLine[Run] in ['0'..'9'] do inc(Run);
if (FLine[Run]='.') and not(fLine[Run+1]='.') then begin
inc(Run);
while FLine[Run] in ['0'..'9'] do inc(Run);
end;
if (FLine[Run]='e') or (fLine[Run]='E') then begin
inc(Run);
if (FLine[Run]='+') or (fLine[Run]='-') then inc(Run);
while FLine[Run] in ['0'..'9'] do inc(Run);
end;
end;
procedure TSynPerlSyn.OrSymbolProc;
begin
case FLine[Run + 1] of
'=': {bit or assign}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
'|':
begin
if FLine[Run + 2] = '=' then {logical or assign}
inc(Run, 3)
else {logical or}
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {bit or}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.PlusProc;
begin
case FLine[Run + 1] of
'=': {add assign}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
'+': {increment}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {add}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.SlashProc;
begin
case FLine[Run + 1] of
'=': {division assign}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {division}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.SpaceProc;
begin
inc(Run);
fTokenID := tkSpace;
while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
end;
procedure TSynPerlSyn.StarProc;
begin
case FLine[Run + 1] of
'=': {multiply assign}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
'*':
begin
if FLine[Run + 2] = '=' then {exponentiation assign}
inc(Run, 3)
else {exponentiation}
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {multiply}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.StringInterpProc;
begin
fTokenID := tkString;
if (FLine[Run + 1] = #34) and (FLine[Run + 2] = #34) then inc(Run, 2);
repeat
case FLine[Run] of
#0, #10, #13: break;
#92:
{ backslash quote not the ending one }
if FLine[Run + 1] = #34 then inc(Run);
end;
inc(Run);
until FLine[Run] = #34;
if FLine[Run] <> #0 then inc(Run);
end;
procedure TSynPerlSyn.StringLiteralProc;
begin
fTokenID := tkString;
repeat
case FLine[Run] of
#0, #10, #13: break;
end;
inc(Run);
until FLine[Run] = #39;
if FLine[Run] <> #0 then inc(Run);
end;
procedure TSynPerlSyn.SymbolProc;
begin
inc(Run);
fTokenId := tkSymbol;
end;
procedure TSynPerlSyn.XOrSymbolProc;
begin
Case FLine[Run + 1] of
'=': {xor assign}
begin
inc(Run, 2);
fTokenID := tkSymbol;
end;
else {xor}
begin
inc(Run);
fTokenID := tkSymbol;
end;
end;
end;
procedure TSynPerlSyn.UnknownProc;
begin
{$IFDEF SYN_MBCSSUPPORT}
if FLine[Run] in LeadBytes then
Inc(Run,2)
else
{$ENDIF}
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 TSynPerlSyn.Next;
begin
fTokenPos := Run;
fProcTable[fLine[Run]]();
end;
function TSynPerlSyn.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_VARIABLE: Result := fVariableAttri;
else
Result := nil;
end;
end;
function TSynPerlSyn.GetEol: Boolean;
begin
Result := fTokenID = tkNull;
end;
function TSynPerlSyn.GetToken: string;
var
Len: LongInt;
begin
Result := '';
Len := Run - fTokenPos;
SetString(Result, (FLine + fTokenPos), Len);
end;
procedure TSynPerlSyn.GetTokenEx(out TokenStart: PChar;
out TokenLength: integer);
begin
TokenLength:=Run-fTokenPos;
TokenStart:=FLine + fTokenPos;
end;
function TSynPerlSyn.GetTokenID: TtkTokenKind;
begin
Result := fTokenId;
end;
function TSynPerlSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
case fTokenID of
tkComment: Result := fCommentAttri;
tkIdentifier: Result := fIdentifierAttri;
tkKey: Result := fKeyAttri;
tkNumber: Result := fNumberAttri;
tkOperator: Result := fOperatorAttri;
tkPragma: Result := fPragmaAttri;
tkSpace: Result := fSpaceAttri;
tkString: Result := fStringAttri;
tkSymbol: Result := fSymbolAttri;
tkUnknown: Result := fInvalidAttri;
tkVariable: Result := fVariableAttri;
else Result := nil;
end;
end;
function TSynPerlSyn.GetTokenKind: integer;
begin
Result := Ord(fTokenId);
end;
function TSynPerlSyn.GetTokenPos: Integer;
begin
Result := fTokenPos;
end;
function TSynPerlSyn.GetIdentChars: TSynIdentChars;
begin
Result := ['%', '@', '$', '_', '0'..'9', 'a'..'z', 'A'..'Z'] + TSynSpecialChars;
end;
class function TSynPerlSyn.GetLanguageName: string;
begin
Result := SYNS_LangPerl;
end;
initialization
MakeIdentTable;
RegisterPlaceableHighlighter(TSynPerlSyn);
end.