SynEdit Highlighter -Meine Tokenerkennung funktioneriert nicht richtig

[Johasch]

Hallo,
ich versuche einen SynEdit Highlighter für Textdateien mit Markern zu realisieren. Dafür möchte ich alle Texte die zwischen '< >' '( )' und '{ }' farblich markieren. Habe dafür eine Version aus dem Internet modifiziert.
Das funktioniert auch schon ganz gut, allerdings nur wenn der Marker vor oder nach einem Leerzeichen steht. Ist das nicht der Fall, wird es nicht richtig erkannt. [img][

Markierungen.png (38.25 KiB) 169 mal betrachtet

/img]

Alle meine Versuche, dies zu korrigieren endeten immer in einer Endlosschleife.
Eine weitere Frage: Gibt es auch eine Möglichkeit, nur bestimmte Begriffe zwischen den Klammern zu akzeptieren? Wie z.b nur Nummern zwischen '(' und ')'?

Das ist meine Version vom Highlighter:

Code: Alles auswählen

unit SynPages;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, ComCtrls, Graphics, Controls, SynEdit,
  SynEditHighlighter, SynEditTypes;

 type
  TMySynHighlighter = class(TSynCustomHighlighter)
  private
    fIdentifierAttri: TSynHighlighterAttributes;
    fCurlyAttri: TSynHighlighterAttributes;
    fRoundAttri: TSynHighlighterAttributes;
    fAngledAttri: TSynHighlighterAttributes;
    procedure SetIdentifierAttri(AValue: TSynHighlighterAttributes);
    procedure SetRoundAttri(AValue: TSynHighlighterAttributes);
    procedure SetCurlyAttri(AValue: TSynHighlighterAttributes);
    procedure SetAngledAttri(AValue: TSynHighlighterAttributes);
  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 RoundAttri: TSynHighlighterAttributes read fRoundAttri
      write SetRoundAttri;
    property CurlyAttri: TSynHighlighterAttributes read fCurlyAttri
      write SetCurlyAttri;
    property AngledAttri: TSynHighlighterAttributes read FAngledAttri
      write SetAngledAttri;
    property IdentifierAttri: TSynHighlighterAttributes read fIdentifierAttri
      write SetIdentifierAttri;
  end;



// *****************************************************************************

implementation

// *****************************************************************************



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

  (* Create and initialize the attributes *)

  fIdentifierAttri := TSynHighlighterAttributes.Create('ident', 'ident');
  AddAttribute(fIdentifierAttri);

   // Setup attributes for formatting the text
  fCurlyAttri := TSynHighlighterAttributes.Create('CurlyText', 'Curly Text');
  fCurlyAttri.Foreground := clRed; // Highlights text between { } in Red
  fCurlyAttri.Style      := [fsbold];
  AddAttribute(fCurlyAttri);

  fRoundAttri := TSynHighlighterAttributes.Create('Round', 'Round Text');
  fRoundAttri.Foreground := clBlue; // Highlights text between ( ) in Blue
  fRoundAttri.Style      := [fsbold];
  AddAttribute(fRoundAttri);

  fAngledAttri := TSynHighlighterAttributes.Create('AngledText', 'Angled Text');
  fAngledAttri.Foreground := clGreen; // Highlights text between <  > in Green
  fAngledAttri.Style      := [fsbold];
  AddAttribute(fAngledAttri);

  // 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 TMySynHighlighter.SetIdentifierAttri(AValue: TSynHighlighterAttributes);
begin
  fIdentifierAttri.Assign(AValue);
end;

procedure TMySynHighlighter.SetRoundAttri(AValue: TSynHighlighterAttributes);
begin
  fRoundAttri.Assign(AValue);
end;
procedure TMySynHighlighter.SetCurlyAttri(AValue: TSynHighlighterAttributes);
begin
  fRoundAttri.Assign(AValue);
end;
procedure TMySynHighlighter.SetAngledAttri(AValue: TSynHighlighterAttributes);
begin
  fRoundAttri.Assign(AValue);
end;

procedure TMySynHighlighter.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 TMySynHighlighter.Next;
var
  l: Integer;
  //const s : string = '([{';
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 exit // Line end reached


  //else
  //if pos(FLineText[FTokenEnd],s) > 0 then begin {inc(FTokenEnd); exit;} end
  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 TMySynHighlighter.GetEol: Boolean;
begin
  Result := FTokenPos > length(FLineText);
end;

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

function TMySynHighlighter.GetTokenAttribute: TSynHighlighterAttributes;
begin
  // Match the text, specified by FTokenPos and FTokenEnd

  if FLineText[FTokenPos]      = '(' then Result := RoundAttri
  else if FLineText[FTokenPos] = '{' then Result := CurlyAttri
  else if FLineText[FTokenPos] = '<' then Result := AngledAttri
  else
    Result := IdentifierAttri;
end;

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

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

function TMySynHighlighter.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
begin
  // Some default attributes
  case Index of
    SYN_ATTR_IDENTIFIER: Result := fIdentifierAttri;
    else Result := nil;
  end;
end;

function TMySynHighlighter.GetTokenKind: integer;
var
  a: TSynHighlighterAttributes;
begin
  // Map Attribute into a unique number
  a := GetTokenAttribute;
  Result := 0;
  if a = fIdentifierAttri then Result := 3;
end;

end.
                                                           

Bin für jeden Hinweis dankbar.

[thunderbird2012]

Das Problem liegt in Next.

Dort werden Tokens aktuell nur an Leerzeichen bzw. Tabs getrennt:

Code: Alles auswählen

while (FTokenEnd <= l) and not(FLineText[FTokenEnd] in [#9, ' ']) do
  inc(FTokenEnd);

Dadurch wird z. B. nachgab<RF> als ein einziges Token behandelt.
GetTokenAttribute schaut aber nur auf das erste Zeichen des Tokens – dort steht 'n', also greift IdentifierAttri und nicht AngledAttri.

Dasselbe gilt für Fälle wie <Ts>{v}: Solange Next nicht an (, {, < (und den zugehörigen schließenden Zeichen) neu aufteilt, bleiben Marker und Text zusammengeklebt und werden nicht korrekt erkannt.

Kurz: Die Marker funktionieren nur mit Whitespace davor/danach, weil Next dort keine neuen Tokens beginnt.

[Johasch]

Danke, das habe ich mir schon so gedacht.
Ich hatte schon versucht, die Aufteilung zu ändern - bin dann aber immer in einer Endlosschleife hängen geblieben. Wie könnte man den Code ändern, damit die Aufteilung passt?

[thunderbird2012]

Du musst diesem Code ändern

Code: Alles auswählen

procedure TMySynHighlighter.Next;
var
  l: Integer;
  CloseCh: Char;
begin
  FTokenPos := FTokenEnd;
  FTokenEnd := FTokenPos;

  l := Length(FLineText);
  if FTokenPos > l then
    Exit;

  // Leerzeichen / Tabs
  if FLineText[FTokenEnd] in [#9, ' '] then
  begin
    while (FTokenEnd <= l) and (FLineText[FTokenEnd] in [#0..#32]) do
      Inc(FTokenEnd);
  end
  // Marker: (...), {...}, <...>
  else if FLineText[FTokenEnd] in ['(', '{', '<'] then
  begin
    case FLineText[FTokenEnd] of
      '(': CloseCh := ')';
      '{': CloseCh := '}';
      else CloseCh := '>';
    end;
    Inc(FTokenEnd);
    while (FTokenEnd <= l) and (FLineText[FTokenEnd] <> CloseCh) do
      Inc(FTokenEnd);
    if FTokenEnd <= l then
      Inc(FTokenEnd); // schließendes Zeichen mitnehmen
  end
  // normaler Text bis zum nächsten Leerzeichen oder Marker-Anfang
  else
  begin
    while (FTokenEnd <= l)
      and not (FLineText[FTokenEnd] in [#9, ' ', '(', '{', '<']) do
      Inc(FTokenEnd);
  end;
end;

Voraussetzung: GetTokenAttribute bleibt so, dass es am ersten Zeichen entscheidet ((, {, <).

[Johasch]

Super - Danke! Das ist genau, was ich wollte. Und gibt mir jetzt auch einige Ideen, wie ich selbst weiterexperimentiere kann.