unit SynHighlighterISXCode;

{
  Inno Setup
  Copyright (C) 1997-2004 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  SynEdit highlighter for the My Inno Setup Extensions [Code] section.

  To be able to compile this unit, you'll have to move the TSysPasSyn.Run field
  from the private section to the protected section. This does not affect
  TSysPasSyn's functionality so if needed you can continue using it in your
  own projects.

  $jrsoftware: issrc/Components/SynHighlighterISXCode.pas,v 1.9 2004/07/15 19:50:31 jr Exp $
}

interface

uses
  Classes, SynEditHighlighter, SynHighlighterPas;

type
  TSynISXCodeSynTokenID = (tkConstant, tkDirective, tkEventFunction, tkSynPasSyn);

  TSynISXCodeSyn = class(TSynPasSyn)
  private
    fLine: PChar;
    fLineNumber: Integer;
    fTokenID: TSynISXCodeSynTokenID;
    fTokenPos: Integer;
    fEventFunctionsList: TStringList;
    fConstantAttri: TSynHighlighterAttributes;
    fDirectiveAttri: TSynHighlighterAttributes;
    fEventFunctionAttri: TSynHighlighterAttributes;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetEol: Boolean; override;
    function GetToken: String; override;
    function GetTokenAttribute: TSynHighlighterAttributes; override;
    function GetTokenKind: integer; override;
    function GetTokenPos: Integer; override;
    procedure SetLine(NewValue: String; LineNumber: Integer); override;
    procedure Next; override;
  published
    property ConstantAttri: TSynHighlighterAttributes read fConstantAttri
      write fConstantAttri;
    property DirectiveAttri: TSynHighlighterAttributes read fDirectiveAttri
      write fDirectiveAttri;
    property EventFunctionAttri: TSynHighlighterAttributes read fEventFunctionAttri
      write fEventFunctionAttri;
  end;

procedure Register;

implementation

uses
  SysUtils, SynEditStrConst,
{$IFDEF SYN_CLX}
  QGraphics;
{$ELSE}
  Graphics;
{$ENDIF}

const
  EventFunctions: string =
    'InitializeSetup,DeinitializeSetup,CurStepChanged,NextButtonClick,' +
    'BackButtonClick,ShouldSkipPage,CurPageChanged,CheckPassword,NeedRestart,' +
    'UpdateReadyMemo,RegisterPreviousData,CheckSerial,InitializeWizard,' +
    'GetCustomSetupExitCode,InitializeUninstall,DeinitializeUninstall,' +
    'CurUninstallStepChanged,UninstallNeedRestart,CancelButtonClick';

constructor TSynISXCodeSyn.Create(AOwner: TComponent);
begin
  inherited;

  fEventFunctionsList := TStringList.Create();
  fEventFunctionsList.CommaText := LowerCase(EventFunctions);

  fConstantAttri := TSynHighlighterAttributes.Create('Constant');
  AddAttribute(fConstantAttri);

  fDirectiveAttri := TSynHighlighterAttributes.Create(SYNS_AttrDirective);
  fDirectiveAttri.Foreground := clRed;
  AddAttribute(fDirectiveAttri);

  fEventFunctionAttri := TSynHighlighterAttributes.Create('Event function');
  fEventFunctionAttri.Style := [fsBold];
  AddAttribute(fEventFunctionAttri);
end;

destructor TSynISXCodeSyn.Destroy;
begin
  fEventFunctionsList.Free();

  inherited;
end;

function TSynISXCodeSyn.GetEol: Boolean;
begin
  if fTokenID <> tkSynPasSyn then
    Result := False
  else
    Result := inherited GetEol;
end;

function TSynISXCodeSyn.GetToken: string;
var
  Len: LongInt;
begin
  if fTokenID <> tkSynPasSyn then begin
    Len := Run - fTokenPos;
    SetString(Result, (FLine + fTokenPos), Len);
  end else
    Result := inherited GetToken;
end;

function TSynISXCodeSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
  case fTokenID of
    tkConstant: Result := fConstantAttri;
    tkDirective: Result := fDirectiveAttri;
    tkEventFunction: Result := fEventFunctionAttri;
    tkSynPasSyn: Result := inherited GetTokenAttribute;
  else
    Result := nil;
  end;
end;

function TSynISXCodeSyn.GetTokenKind: integer;
begin
  if fTokenID <> tkSynPasSyn then
    Result := Ord(fTokenId)
  else
    Result := Ord(High(TSynISXCodeSynTokenID)) + inherited GetTokenKind + 1;
end;

function TSynISXCodeSyn.GetTokenPos: Integer;
begin
  if fTokenID <> tkSynPasSyn then
    Result := fTokenPos
  else
    Result := inherited GetTokenPos;
end;

procedure TSynISXCodeSyn.SetLine(NewValue: String; LineNumber: Integer);
begin
  fLine := PChar(NewValue);
  Run := 0;
  fLineNumber := LineNumber;
  inherited;
end;

procedure TSynISXCodeSyn.Next;
var
  I, Len, TmpRun: Integer;
  Token: String;
begin
  fTokenPos := Run;
  fTokenID := tkSynPasSyn;
  case fLine[Run] of 
    '{':
      begin
        if fLine[Run+1] = '#' then begin
          fTokenID := tkConstant;
          Inc(Run);
          repeat
            if fLine[Run] = '}' then begin
              Inc(Run);
              Break;
            end;
            Inc(Run);
          until fLine[Run] in [#0, #10, #13];
        end;
      end;
    '#':
      begin
        fTokenID := tkDirective;
        for I := Run-1 downto 0 do begin
          if fLine[I] > ' ' then begin
            // If the '#' is not the first non-whitespace character on the
            // line, then it isn't the start of a directive.
            fTokenID := tkSynPasSyn;
            Break;
          end;
        end;
        if fTokenID = tkDirective then begin
          repeat
            Inc(Run);
          until (fLine[Run] in [#0, #10, #13]);
        end;
      end;
    'A'..'Z', 'a'..'z', '_':
      begin
        TmpRun := Run;
        Inc(TmpRun);
        while fLine[TmpRun] in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do
          Inc(TmpRun);
        Len := TmpRun - fTokenPos;
        SetString(Token, (FLine + fTokenPos), Len);
        if fEventFunctionsList.IndexOf(LowerCase(Token)) <> -1 then begin
          fTokenID := tkEventFunction;
          Run := TmpRun;
        end;
      end;
  end;

  if fTokenID = tkSynPasSyn then begin
    inherited;
    //Inc(Run, Length(inherited GetToken));
  end;
end;

procedure Register;
begin
  RegisterComponents('SynEdit Other', [TSynISXCodeSyn]);
end;

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