{$IFNDEF QUJASSHIGHLIGTHER}
unit uJassHighligther;
{$ENDIF}

{$I SynEdit.inc}

interface

uses
{$IFDEF SYN_CLX}
  QGraphics,
  QSynEditTypes,
  QSynEditHighlighter,
{$ELSE}
  Graphics,
  SynEditTypes,
  SynEditHighlighter,
{$ENDIF}
  SysUtils,
  Classes;

type
  TtkTokenKind = (
    tkComment,
    tkIdentifier,
    tkInteger,
    tkKey,
    tkNull,
    tkSpace,
    tkString,
    tkUnknown);

  TRangeState = (rsUnKnown, rsProcComment, rsString, rsInteger, rsCstyleComment);

  TProcTableProc = procedure of object;

  PIdentFuncTableFunc = ^TIdentFuncTableFunc;
  TIdentFuncTableFunc = function (Index: Integer): TtkTokenKind of object;

type
  TJassHighligther = class(TSynCustomHighlighter)
  private
    fRange: TRangeState;
    fTokenID: TtkTokenKind;
    fIdentFuncTable: array[0..40] of TIdentFuncTableFunc;
    fCommentAttri: TSynHighlighterAttributes;
    fIdentifierAttri: TSynHighlighterAttributes;
    fIntegerAttri: TSynHighlighterAttributes;
    fKeyAttri: TSynHighlighterAttributes;
    fSpaceAttri: TSynHighlighterAttributes;
    fStringAttri: TSynHighlighterAttributes;
    function HashKey(Str: PWideChar): Cardinal;
    function FuncArray(Index: Integer): TtkTokenKind;
    function FuncCall(Index: Integer): TtkTokenKind;
    function FuncConstant(Index: Integer): TtkTokenKind;
    function FuncElse(Index: Integer): TtkTokenKind;
    function FuncElseif(Index: Integer): TtkTokenKind;
    function FuncEndfunction(Index: Integer): TtkTokenKind;
    function FuncEndglobals(Index: Integer): TtkTokenKind;
    function FuncEndif(Index: Integer): TtkTokenKind;
    function FuncEndloop(Index: Integer): TtkTokenKind;
    function FuncExitwhen(Index: Integer): TtkTokenKind;
    function FuncExtends(Index: Integer): TtkTokenKind;
    function FuncFalse(Index: Integer): TtkTokenKind;
    function FuncFunction(Index: Integer): TtkTokenKind;
    function FuncGlobals(Index: Integer): TtkTokenKind;
    function FuncIf(Index: Integer): TtkTokenKind;
    function FuncLocal(Index: Integer): TtkTokenKind;
    function FuncLoop(Index: Integer): TtkTokenKind;
    function FuncNative(Index: Integer): TtkTokenKind;
    function FuncNot(Index: Integer): TtkTokenKind;
    function FuncNothing(Index: Integer): TtkTokenKind;
    function FuncNull(Index: Integer): TtkTokenKind;
    function FuncReturn(Index: Integer): TtkTokenKind;
    function FuncReturns(Index: Integer): TtkTokenKind;
    function FuncSet(Index: Integer): TtkTokenKind;
    function FuncTakes(Index: Integer): TtkTokenKind;
    function FuncThen(Index: Integer): TtkTokenKind;
    function FuncTrue(Index: Integer): TtkTokenKind;
    function FuncType(Index: Integer): TtkTokenKind;
    procedure IdentProc;
    procedure UnknownProc;
    function AltFunc(Index: Integer): TtkTokenKind;
    procedure InitIdent;
    function IdentKind(MayBe: PWideChar): TtkTokenKind;
    procedure NullProc;
    procedure SpaceProc;
    procedure CRProc;
    procedure LFProc;
    procedure ProcCommentOpenProc;
    procedure ProcCommentProc;
    procedure StringOpenProc;
    procedure StringProc;
    procedure IntegerOpenProc;
    procedure IntegerProc;
	procedure NumberProc;
  protected
    function GetSampleSource: WideString; override;
    function IsFilterStored: Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    class function GetFriendlyLanguageName: WideString; override;
    class function GetLanguageName: string; override;
    function GetRange: Pointer; override;
    procedure ResetRange; override;
    procedure SetRange(Value: Pointer); override;
    function GetDefaultAttribute(Index: Integer): TSynHighlighterAttributes; override;
    function GetEol: Boolean; override;
    function GetKeyWords(TokenKind: Integer): WideString; override;
    function GetTokenID: TtkTokenKind;
    function GetTokenAttribute: TSynHighlighterAttributes; override;
    function GetTokenKind: Integer; override;
    function IsIdentChar(AChar: WideChar): Boolean; override;
    procedure Next; override;
  published
    property CommentAttri: TSynHighlighterAttributes read fCommentAttri write fCommentAttri;
    property IdentifierAttri: TSynHighlighterAttributes read fIdentifierAttri write fIdentifierAttri;
    property IntegerAttri: TSynHighlighterAttributes read fIntegerAttri write fIntegerAttri;
    property KeyAttri: TSynHighlighterAttributes read fKeyAttri write fKeyAttri;
    property SpaceAttri: TSynHighlighterAttributes read fSpaceAttri write fSpaceAttri;
    property StringAttri: TSynHighlighterAttributes read fStringAttri write fStringAttri;
  end;

implementation

uses
{$IFDEF SYN_CLX}
  QSynEditStrConst;
{$ELSE}
  SynEditStrConst;
{$ENDIF}

resourcestring
  SYNS_Filterjass2 = 'All files (*.*)|*.*';
  SYNS_Langjass2 = 'jass2';
  SYNS_FriendlyLangjass2 = 'jass2';
  SYNS_AttrInteger = 'Integer';
  SYNS_FriendlyAttrInteger = 'Integer';

const
  // as this language is case-insensitive keywords *must* be in lowercase
  KeyWords: array[0..27] of WideString = (
    'array', 'call', 'constant', 'else', 'elseif', 'endfunction', 'endglobals', 
    'endif', 'endloop', 'exitwhen', 'extends', 'false', 'function', 'globals', 
    'if', 'local', 'loop', 'native', 'not', 'nothing', 'null', 'return', 
    'returns', 'set', 'takes', 'then', 'true', 'type' 
  );

  KeyIndices: array[0..40] of Integer = (
    -1, -1, 18, -1, 19, 0, 27, 22, 15, 3, 9, -1, 5, 6, 20, 7, -1, -1, -1, -1, 
    13, 12, -1, -1, 14, 17, 1, 8, -1, 25, 21, 2, 24, -1, 16, -1, 26, 23, 4, 10, 
    11 
  );

procedure TJassHighligther.InitIdent;
var
  i: Integer;
begin
  for i := Low(fIdentFuncTable) to High(fIdentFuncTable) do
    if KeyIndices[i] = -1 then
      fIdentFuncTable[i] := AltFunc;

  fIdentFuncTable[5] := FuncArray;
  fIdentFuncTable[26] := FuncCall;
  fIdentFuncTable[31] := FuncConstant;
  fIdentFuncTable[9] := FuncElse;
  fIdentFuncTable[38] := FuncElseif;
  fIdentFuncTable[12] := FuncEndfunction;
  fIdentFuncTable[13] := FuncEndglobals;
  fIdentFuncTable[15] := FuncEndif;
  fIdentFuncTable[27] := FuncEndloop;
  fIdentFuncTable[10] := FuncExitwhen;
  fIdentFuncTable[39] := FuncExtends;
  fIdentFuncTable[40] := FuncFalse;
  fIdentFuncTable[21] := FuncFunction;
  fIdentFuncTable[20] := FuncGlobals;
  fIdentFuncTable[24] := FuncIf;
  fIdentFuncTable[8] := FuncLocal;
  fIdentFuncTable[34] := FuncLoop;
  fIdentFuncTable[25] := FuncNative;
  fIdentFuncTable[2] := FuncNot;
  fIdentFuncTable[4] := FuncNothing;
  fIdentFuncTable[14] := FuncNull;
  fIdentFuncTable[30] := FuncReturn;
  fIdentFuncTable[7] := FuncReturns;
  fIdentFuncTable[37] := FuncSet;
  fIdentFuncTable[32] := FuncTakes;
  fIdentFuncTable[29] := FuncThen;
  fIdentFuncTable[36] := FuncTrue;
  fIdentFuncTable[6] := FuncType;
end;

{$Q-}
function TJassHighligther.HashKey(Str: PWideChar): Cardinal;
begin
  Result := 0;
  while IsIdentChar(Str^) do
  begin
    Result := Result * 310 + Ord(Str^) * 227;
    inc(Str);
  end;
  Result := Result mod 41;
  fStringLen := Str - fToIdent;
end;
{$Q+}

function TJassHighligther.FuncArray(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncCall(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncConstant(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncElse(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncElseif(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncEndfunction(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncEndglobals(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncEndif(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncEndloop(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncExitwhen(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncExtends(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncFalse(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncFunction(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncGlobals(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncIf(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncLocal(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncLoop(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncNative(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncNot(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncNothing(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncNull(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncReturn(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncReturns(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncSet(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncTakes(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncThen(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncTrue(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.FuncType(Index: Integer): TtkTokenKind;
begin
  if IsCurrentToken(KeyWords[Index]) then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TJassHighligther.AltFunc(Index: Integer): TtkTokenKind;
begin
  Result := tkIdentifier;
end;

function TJassHighligther.IdentKind(MayBe: PWideChar): TtkTokenKind;
var
  Key: Cardinal;
begin
  fToIdent := MayBe;
  Key := HashKey(MayBe);
  if Key <= High(fIdentFuncTable) then
    Result := fIdentFuncTable[Key](KeyIndices[Key])
  else
    Result := tkIdentifier;
end;

procedure TJassHighligther.SpaceProc;
begin
  inc(Run);
  fTokenID := tkSpace;
  while (FLine[Run] <= #32) and not IsLineEnd(Run) do inc(Run);
end;

procedure TJassHighligther.NullProc;
begin
  fTokenID := tkNull;
  inc(Run);
end;

procedure TJassHighligther.CRProc;
begin
  fTokenID := tkSpace;
  inc(Run);
  if fLine[Run] = #10 then
    inc(Run);
end;

procedure TJassHighligther.LFProc;
begin
  fTokenID := tkSpace;
  inc(Run);
end;

procedure TJassHighligther.ProcCommentOpenProc;
begin
  Inc(Run);
  if (fLine[Run] = '/') then
  begin
    fRange := rsProcComment;
    ProcCommentProc;
    fTokenID := tkComment;
  end
  else
    fTokenID := tkIdentifier;
end;

procedure TJassHighligther.ProcCommentProc;
begin
  fTokenID := tkComment;
  repeat
    if  then
    begin
      Inc(Run, 0);
      fRange := rsUnKnown;
      Break;
    end;
    if not IsLineEnd(Run) then
      Inc(Run);
  until IsLineEnd(Run);
end;

procedure TJassHighligther.StringOpenProc;
begin
  Inc(Run);
  fRange := rsString;
  StringProc;
  fTokenID := tkString;
end;

procedure TJassHighligther.StringProc;
var Escape:Boolean;
begin
  case fLine[Run] of
     #0: NullProc;
    #10: LFProc;
    #13: CRProc;
  else
    begin

  fTokenID := tkString;
  Escape := False;
  repeat
    case fLine[Run] of
       '"': begin
                 Inc(Run, 1);
                 if not Escape then
                  begin
                 fRange := rsUnknown;
                 Break;
                  end;
             end;
       '\': Escape := not Escape;
       else Escape := False;
    end;

    if not IsLineEnd(Run) then
      Inc(Run);
  until IsLineEnd(Run);


   end;
  end;
end;

procedure TJassHighligther.IntegerOpenProc;
begin
  Inc(Run);
  fRange := rsInteger;
  IntegerProc;
  fTokenID := tkInteger;
end;

procedure TJassHighligther.IntegerProc;
begin
  fTokenID := tkInteger;
  repeat
    if (fLine[Run] = '''') then
    begin
      Inc(Run, 1);
      fRange := rsUnKnown;
      Break;
    end;
    if not IsLineEnd(Run) then
      Inc(Run);
  until IsLineEnd(Run);
end;


constructor TJassHighligther.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fCaseSensitive := False;

  fCommentAttri := TSynHighLighterAttributes.Create(SYNS_AttrComment, SYNS_FriendlyAttrComment);
  fCommentAttri.Style := [fsItalic];
  fCommentAttri.Foreground := clNavy;
  AddAttribute(fCommentAttri);

  fIdentifierAttri := TSynHighLighterAttributes.Create(SYNS_AttrIdentifier, SYNS_FriendlyAttrIdentifier);
  AddAttribute(fIdentifierAttri);

  fIntegerAttri := TSynHighLighterAttributes.Create(SYNS_AttrInteger, SYNS_FriendlyAttrInteger);
  AddAttribute(fIntegerAttri);

  fKeyAttri := TSynHighLighterAttributes.Create(SYNS_AttrReservedWord, SYNS_FriendlyAttrReservedWord);
  fKeyAttri.Style := [fsBold];
  AddAttribute(fKeyAttri);

  fSpaceAttri := TSynHighLighterAttributes.Create(SYNS_AttrSpace, SYNS_FriendlyAttrSpace);
  AddAttribute(fSpaceAttri);

  fStringAttri := TSynHighLighterAttributes.Create(SYNS_AttrString, SYNS_FriendlyAttrString);
  AddAttribute(fStringAttri);

  SetAttributesOnChange(DefHighlightChange);
  InitIdent;
  fDefaultFilter := SYNS_Filterjass2;
  fRange := rsUnknown;
end;

procedure TJassHighligther.IdentProc;
begin
  fTokenID := IdentKind((fLine + Run));

inc(Run, fStringLen);

while Identifiers[fLine[Run]] do

Inc(Run);

end;

procedure TJassHighligther.UnknownProc;
begin
  inc(Run);
  fTokenID := tkUnknown;
end;

procedure TJassHighligther.NumberProc;
begin
fTokenID := tkInteger;

while fLine[Run] in ['0'..'9', '.'] do

Inc(Run);

end;

procedure TJassHighligther.Next;
begin
  fTokenPos := Run;
  case fRange of
    rsString: StringProc;
    rsCstyleComment: CstyleCommentProc;
  else
    case fLine[Run] of
      #0: NullProc;
      #10: LFProc;
      #13: CRProc;
      '/': ProcCommentOpenProc;
      '"': StringOpenProc;
      '''': IntegerOpenProc;
	  '0'..'9', '.': NumberProc;
      #1..#9, #11, #12, #14..#32: SpaceProc;
      'A'..'Z', 'a'..'z', '_': IdentProc;
    else
      UnknownProc;
    end;
  end;
  inherited;
end;

function TJassHighligther.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;
  else
    Result := nil;
  end;
end;

function TJassHighligther.GetEol: Boolean;
begin
  Result := Run = fLineLen + 1;
end;

function TJassHighligther.GetKeyWords(TokenKind: Integer): WideString;
begin
  Result := 
    'array,call,constant,else,elseif,endfunction,endglobals,endif,endloop,' +
    'exitwhen,extends,false,function,globals,if,local,loop,native,not,nothi' +
    'ng,null,return,returns,set,takes,then,true,type';
end;

function TJassHighligther.GetTokenID: TtkTokenKind;
begin
  Result := fTokenId;
end;

function TJassHighligther.GetTokenAttribute: TSynHighLighterAttributes;
begin
  case GetTokenID of
    tkComment: Result := fCommentAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkInteger: Result := fIntegerAttri;
    tkKey: Result := fKeyAttri;
    tkSpace: Result := fSpaceAttri;
    tkString: Result := fStringAttri;
    tkUnknown: Result := fIdentifierAttri;
  else
    Result := nil;
  end;
end;

function TJassHighligther.GetTokenKind: Integer;
begin
  Result := Ord(fTokenId);
end;

function TJassHighligther.IsIdentChar(AChar: WideChar): Boolean;
begin
  case AChar of
    '_', '0'..'9', 'a'..'z', 'A'..'Z':
      Result := True;
    else
      Result := False;
  end;
end;

function TJassHighligther.GetSampleSource: WideString;
begin
end;

function TJassHighligther.IsFilterStored: Boolean;
begin
  Result := fDefaultFilter <> SYNS_Filterjass2;
end;

class function TJassHighligther.GetFriendlyLanguageName: WideString;
begin
  Result := SYNS_FriendlyLangjass2;
end;

class function TJassHighligther.GetLanguageName: string;
begin
  Result := SYNS_Langjass2;
end;

procedure TJassHighligther.ResetRange;
begin
  fRange := rsUnknown;
end;

procedure TJassHighligther.SetRange(Value: Pointer);
begin
  fRange := TRangeState(Value);
end;

function TJassHighligther.GetRange: Pointer;
begin
  Result := Pointer(fRange);
end;

initialization
{$IFNDEF SYN_CPPB_1}
  RegisterPlaceableHighlighter(TJassHighligther);
{$ENDIF}
end.
