source: tags/1.1.0/UBFHighlighter.pas

unit UBFHighlighter;
(*
  This is an example how to implement your own highlighter.

  This example does allow to specify different colors for
  - text (defaults to not-highlighted)
  - spaces  (defaults to silver frame)
  - words, separated by spaces, that start with a,e,i,o,u  (defaults to bold)
  - the word "not"  (defaults to red background)

  See comments below and http://wiki.lazarus.freepascal.org/SynEdit_Highlighter

  How it works:

  - Creation
    The Highlighter creates Attributes that it can return the Words and Spaces.

  - SetLine
    Is called by SynEdit before a line gets painted (or before highlight info is needed)
    This is also called, each time the text changes fol *all* changed lines
    and may even be called for all lines after the change up to the end of text.

    After SetLine was called "GetToken*" should return information about the
    first token on the line.
    Note: Spaces are token too.

  - Next
    Scan to the next token, on the line that was set by "SetLine"
    "GetToken*"  should return info about that next token.

  - GetEOL
    Returns True, if "Next" was called while on the last token of the line.

  - GetTokenEx, GetTokenAttribute
    Provide info about the token found by "Next"

  - Next, GetEOL. GetToken*
    Are used by SynEdit to iterate over the Line.
    Important: The tokens returned for each line, must represent the original
    line-text (mothing added, nothing left out), and be returned in the correct order.

    They are called very often and should perform ath high speed.

  - GetToken, GetTokenPos, GetTokenKind
    SynEdit uses them e.g for finding matching brackets. If GetTokenKind returns different values per Attribute, then brackets only match, if they are of the same kind (e.g, if there was a string attribute, brackets outside a string would not match brackets inside a string)


*)

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics, SynEditHighlighter;

type

  { TSynBrainFuckHl }


  TSynBrainFuckHl = class(TSynCustomHighlighter)
  private
    FCommentAttri: TSynHighlighterAttributes;
    FIoAttri: TSynHighlighterAttributes;
    FLoopAttri: TSynHighlighterAttributes;
    FMemoryAttri: TSynHighlighterAttributes;
    FPointerAttri: TSynHighlighterAttributes;
    FSpaceAttri: TSynHighlighterAttributes;
    procedure SetCommentAttri(AValue: TSynHighlighterAttributes);
    procedure SetMemoryAttri(AValue: TSynHighlighterAttributes);
    procedure SetPointerAttri(AValue: TSynHighlighterAttributes);
    procedure SetSpaceAttri(AValue: TSynHighlighterAttributes);
    procedure SetIoAttri(AValue: TSynHighlighterAttributes);
    procedure SetLoopAttri(AValue: TSynHighlighterAttributes);
    function IsWhiteSpace(C: Char): Boolean;
  protected
    // accesible for the other examples
    FTokenPos, FTokenEnd: Integer;
    FLineText: String;
  public
    procedure SetLine(const NewValue: String; LineNumber: Integer); override;
    procedure Next; override;
    function  GetEol: Boolean; override;
    procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override;
    function  GetTokenAttribute: TSynHighlighterAttributes; override;
  public
    function GetToken: String; override;
    function GetTokenPos: Integer; override;
    function GetTokenKind: integer; override;
    function GetDefaultAttribute(Index: Integer): TSynHighlighterAttributes; override;
    constructor Create(AOwner: TComponent); override;
  published
    property IoAttri: TSynHighlighterAttributes read FIoAttri
      write SetIoAttri;
    property LoopAttri: TSynHighlighterAttributes read FLoopAttri
      write SetLoopAttri;
    property PointerAttri: TSynHighlighterAttributes read FPointerAttri
      write SetPointerAttri;
    property MemoryAttri: TSynHighlighterAttributes read FMemoryAttri
      write SetMemoryAttri;
    property SpaceAttri: TSynHighlighterAttributes read FSpaceAttri
      write SetSpaceAttri;
    property CommentAttri: TSynHighlighterAttributes read FCommentAttri
      write SetCommentAttri;
  end;

implementation

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

  (* Create and initialize the attributes *)
  FIoAttri := TSynHighlighterAttributes.Create('keyword', 'keyword');
  AddAttribute(FIoAttri);
  FIoAttri.Style := [fsBold];

  FLoopAttri := TSynHighlighterAttributes.Create('loop', 'loop');
  AddAttribute(FLoopAttri);
  FLoopAttri.Style := [fsBold];
  FLoopAttri.Foreground := clRed;

  FPointerAttri := TSynHighlighterAttributes.Create('pointer', 'pointer');
  AddAttribute(FPointerAttri);
  FPointerAttri.Style := [fsBold];
  FPointerAttri.Foreground := clBlue;

  FMemoryAttri := TSynHighlighterAttributes.Create('memory', 'memory');
  AddAttribute(FMemoryAttri);
  FMemoryAttri.Style := [fsBold];
  FMemoryAttri.Foreground := clGreen;

  FCommentAttri := TSynHighlighterAttributes.Create('comment', 'comment');
  AddAttribute(FCommentAttri);
  FCommentAttri.Foreground := clSilver;

  FSpaceAttri := TSynHighlighterAttributes.Create('space', 'space');
  AddAttribute(FSpaceAttri);
  //FSpaceAttri.FrameColor := clSilver;
  //FSpaceAttri.FrameEdges := sfeAround;

  // Ensure the HL reacts to changes in the attributes. Do this once, if all attributes are created
  SetAttributesOnChange(@DefHighlightChange);
end;

(* Setters for attributes / This allows using in Object inspector*)
procedure TSynBrainFuckHl.SetCommentAttri(AValue: TSynHighlighterAttributes);
begin
  FCommentAttri.Assign(AValue);
end;

procedure TSynBrainFuckHl.SetMemoryAttri(AValue: TSynHighlighterAttributes);
begin
  FMemoryAttri.Assign(AValue);
end;

procedure TSynBrainFuckHl.SetPointerAttri(AValue: TSynHighlighterAttributes);
begin
  FPointerAttri.Assign(AValue);
end;

procedure TSynBrainFuckHl.SetSpaceAttri(AValue: TSynHighlighterAttributes);
begin
  FSpaceAttri.Assign(AValue);
end;

procedure TSynBrainFuckHl.SetIoAttri(AValue: TSynHighlighterAttributes);
begin
  FIoAttri.Assign(AValue);
end;

procedure TSynBrainFuckHl.SetLoopAttri(AValue: TSynHighlighterAttributes);
begin
  FLoopAttri.Assign(AValue);
end;

function TSynBrainFuckHl.IsWhiteSpace(C: Char): Boolean;
begin
  Result := C in [#9, ' '];
end;

procedure TSynBrainFuckHl.SetLine(const NewValue: String; LineNumber: Integer);
begin
  inherited;
  FLineText := NewValue;
  // Next will start at "FTokenEnd", so set this to 1
  FTokenEnd := 1;
  Next;
end;

procedure TSynBrainFuckHl.Next;
var
  L: Integer;
begin
  // FTokenEnd should be at the start of the next Token (which is the Token we want)
  FTokenPos := FTokenEnd;
  // assume empty, will only happen for EOL
  FTokenEnd := FTokenPos;

  // Scan forward
  // FTokenEnd will be set 1 after the last char. That is:
  // - The first char of the next token
  // - or past the end of line (which allows GetEOL to work)

  L := Length(FLineText);
  If FTokenPos > L then
    // At line end
    Exit
  else
  if FLineText[FTokenEnd] in [#9, ' '] then
    // At Space? Find end of spaces
    while (FTokenEnd <= L) and (FLineText[FTokenEnd] in [#0..#32]) do
      Inc(FTokenEnd)
  else
    // At None-Space? Find end of None-spaces
    //while (FTokenEnd <= L) and not(FLineText[FTokenEnd] in [#9, ' ']) do
    Inc(FTokenEnd);
end;

function TSynBrainFuckHl.GetEol: Boolean;
begin
  Result := FTokenPos > Length(FLineText);
end;

procedure TSynBrainFuckHl.GetTokenEx(out TokenStart: PChar; out TokenLength: integer);
begin
  TokenStart := @FLineText[FTokenPos];
  TokenLength := FTokenEnd - FTokenPos;
end;

function TSynBrainFuckHl.GetTokenAttribute: TSynHighlighterAttributes;
begin
  // Match the text, specified by FTokenPos and FTokenEnd
  if IsWhiteSpace(FLineText[FTokenPos]) then
    Result := SpaceAttri
  else
  if FLineText[FTokenPos] in ['[', ']'] then
    Result := LoopAttri
  else
  if FLineText[FTokenPos] in ['<', '>'] then
    Result := PointerAttri
  else
  if FLineText[FTokenPos] in ['+', '-'] then
    Result := MemoryAttri
  else
  if FLineText[FTokenPos] in ['.', ','] then
    Result := IoAttri
  else
    Result := CommentAttri;
end;

function TSynBrainFuckHl.GetToken: String;
begin
  Result := Copy(FLineText, FTokenPos, FTokenEnd - FTokenPos);
end;

function TSynBrainFuckHl.GetTokenPos: Integer;
begin
  Result := FTokenPos - 1;
end;

function TSynBrainFuckHl.GetDefaultAttribute(Index: Integer): TSynHighlighterAttributes;
begin
  // Some default attributes
  case Index of
    SYN_ATTR_COMMENT: Result := FCommentAttri;
    SYN_ATTR_KEYWORD: Result := FIoAttri;
    SYN_ATTR_WHITESPACE: Result := FSpaceAttri;
    else Result := nil;
  end;
end;

function TSynBrainFuckHl.GetTokenKind: integer;
var
  a: TSynHighlighterAttributes;
begin
  // Map Attribute into a unique number
  a := GetTokenAttribute;
  Result := 0;
  if a = FSpaceAttri then Result := 1
  else if a = FIoAttri then Result := 2
  else if a = FCommentAttri then Result := 3
  else if a = FLoopAttri then Result := 4
  else if a = FPointerAttri then Result := 5
  else if a = FMemoryAttri then Result := 6;
end;

end.