SynHighlight Problem mit Hash Tabelle

Rund um die LCL und andere Komponenten
Antworten
Warf
Beiträge: 1908
Registriert: Di 23. Sep 2014, 17:46
OS, Lazarus, FPC: Win10 | Linux
CPU-Target: x86_64

SynHighlight Problem mit Hash Tabelle

Beitrag von Warf »

Hey ho,

ich habe aktuell ein kleine Problemchen, ich schreibe grade einen SyntaxHighlighter für eine Programmiersprache, und bei der Hash Tabelle habe ich allerdings ein kleines Problemchen, ich nutze diese Funktion zum Hashen:

Code: Alles auswählen

function TAALSynHighlight.HashToken(toHash: PChar; out Len: integer): byte;
begin
  Result := 0;
  Len := 0;
  while ToHash^ in ['_', '0'..'9', 'a'..'z', 'A'..'Z'] do
  begin
    if CaseInsensitive And (toHash^ in ['A'..'Z']) then
      Result := (Result + Ord(toHash^)-ord('A')+ord('a')) mod 256
    else
      Result := (Result + Ord(toHash^)) mod 256;
    Inc(ToHash);
    Inc(Len);
  end;
end


Nur jetzt ist leider das Problem, dass in dem Syntax Highlighter ich einen anderen Wert bekomme als in dem Projekt mit dem ich die Hashes der Keywords generiere (welche in dem Highlighter abgefragt werden):

Code: Alles auswählen

procedure TForm1.Button3Click(Sender: TObject);
 
function GetHash(toHash: PChar; out Len: integer): byte;
begin
  Result := 0;
  Len := 0;
  while ToHash^ in ['_', '0'..'9', 'a'..'z', 'A'..'Z'] do
  begin
    if CaseInsensitive And (toHash^ in ['A'..'Z']) then
      Result := (Result + Ord(toHash^)-ord('A')+ord('a')) mod 256
    else
      Result := (Result + Ord(toHash^)) mod 256;
    Inc(ToHash);
    Inc(Len);
  end;
end;
 
var
  x: Byte;
  Dummy: Integer;
  tmp: PHashInfo;
begin
  x := GetHash(PChar(Edit1.Text), Dummy);
  new(tmp);
  tmp^.Key := Edit1.Text;
  tmp^.Kind := TTokenType(ComboBox1.ItemIndex);
  FHashList[x].Add(tmp);
  ListBox1.Items.Add(Edit1.Text);
end;


Der Komplette SyntaxHighlighter

Code: Alles auswählen

unit AALHighlighter;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Graphics, SynEditTypes, SynEditHighlighter, Dialogs;
 
type
  TTokenType = (tkComment, tkIdentifier, tkFunction, tkSymbol, tkNumber, tkSpace,
    tkString, tkUnknown, tkVar, tkUndefined);
  PHashInfo = ^THashInfo;
 
  THashInfo = record
    Key: ansistring;
    Kind: TTokenType;
  end;
 
  { TAALSynHighlight }
 
  TAALSynHighlight = class(TSynCustomHighlighter)
  private
    FStrAttr, FCommentAttr, FIdentifierAttr, FKeyAttr,
    FFunctionAttr, FNumberAttr, FSpaceAttr, FTextAttr,
    FVarAttr: TSynHighlighterAttributes;
    // AttributeField & setter
  protected
    FTokenPos, FTokenEnd, FLineNum: integer;
    FToken: string;
    FTok: TTokenType;
    FTokLen: integer;
    FTokenHash: byte;
    FLineText: string;
    FHashList: array[0..255] of TList;
    function GetAttr(a: TTokenType): TSynHighlighterAttributes;
  public
    function HashToken(toHash: PChar; out Len: integer): byte;
    procedure CheckHash;
    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;
    destructor Destroy; override;
  published
    // Attribute Properties
  end;
 
const
  CaseInsensitive = false;
  SingleToken = ['!', '+', '-', '*', '=', '<', '>', '/', '(', ')',
    '[', ']', '{', '}', '?', '#', ':', '.'];
 
implementation
 
procedure TAALSynHighlight.CheckHash;
function KeyComp(aKey: String): Boolean;
var i: Integer;
  t: String;
begin
  if CaseInsensitive then
  begin
    t:=LowerCase(FToken);
    aKey:=LowerCase(aKey);
   end
   else
    t:=FToken;
  if Length(aKey)<>FTokLen then
  begin
    Result:=False;
    Exit;
   end;
  Result:=True;
  for i:=1 to FTokLen do
    if t[i]<>aKey[i] then
    begin
      Result:=False;
      Break;
      end;
end;
var i: Integer;
begin
  FTok:=tkUnknown;
  for i:=0 to FHashList[FTokenHash].Count-1 do
    if KeyComp(PHashInfo(FHashList[FTokenHash])^.Key) then
    begin
      FTok:=PHashInfo(FHashList[FTokenHash])^.Kind;
      Break;
      end;
end;
 
function TAALSynHighlight.GetAttr(a: TTokenType): TSynHighlighterAttributes;
begin
  Result := nil;
  case a of
    tkComment: Result := FCommentAttr;
    tkIdentifier: Result := FIdentifierAttr;
    tkFunction: Result := FFunctionAttr;
    tkSymbol: Result := FKeyAttr;
    tkNumber: Result := FNumberAttr;
    tkSpace: Result := FSpaceAttr;
    tkString: Result := FStrAttr;
    tkVar: Result := FVarAttr;
    else
      Result := FTextAttr;
  end;
end;
 
constructor TAALSynHighlight.Create(AOwner: TComponent);
 
  procedure LoadHLTable;
  var
    fs: TFileStream;
    tmp: PHashInfo;
    i, x, n, a: integer;
  begin
    fs := TFileStream.Create(IncludeLeadingPathDelimiter(ExtractFilePath(ParamStr(0))) +
      'HL/HL.lst', fmOpenRead);
    try
      for x := 0 to 255 do
      begin
        fs.Read(n, SizeOf(n));
        for i := 0 to n - 1 do
        begin
          new(tmp);
          fs.Read(tmp^.Kind, SizeOf(tmp^.Kind));
          fs.Read(a, SizeOf(a));
          SetLength(tmp^.Key, a);
          fs.Read(tmp^.Key[1], a);
          FHashList[x].Add(tmp);
        end;
      end;
    finally
      fs.Free;
    end;
  end;
 
var
  i: integer;
begin
  inherited Create(AOwner);
    FStrAttr:= TSynHighlighterAttributes.Create('String', 'String');
    FStrAttr.Foreground:=$000000CC;
    FCommentAttr:= TSynHighlighterAttributes.Create('Comment', 'Comment');
    FCommentAttr.Foreground:=$000099FF;
    FIdentifierAttr:= TSynHighlighterAttributes.Create('Indentifier', 'Identifier');
    FIdentifierAttr.Foreground:=$00FF6600;
    FKeyAttr:= TSynHighlighterAttributes.Create('Symbol', 'Symbol');
    FKeyAttr.Foreground:=$00333333;
    FFunctionAttr:= TSynHighlighterAttributes.Create('Function', 'Function');
    FFunctionAttr.Foreground:=$00FF9100;
    FNumberAttr:= TSynHighlighterAttributes.Create('Number', 'Number');
    FNumberAttr.Foreground:=$00FF0000;
    FSpaceAttr:= TSynHighlighterAttributes.Create('Space', 'Space');
    FTextAttr:= TSynHighlighterAttributes.Create('Text', 'Text');
    FTextAttr.Foreground:=$00333333;
    FVarAttr:= TSynHighlighterAttributes.Create('Variable', 'Variable');
    FVarAttr.Foreground:=$00000099;
  for i := 0 to 255 do
    FHashList[i] := TList.Create;
  LoadHLTable;
end;
 
procedure TAALSynHighlight.SetLine(const NewValue: string; LineNumber: integer);
begin
  inherited;
  FLineText := NewValue;
  // Next will start at "FTokenEnd", so set this to 1
  FTokenEnd := 1;
  Next;
end;
 
function TAALSynHighlight.HashToken(toHash: PChar; out Len: integer): byte;
begin
  Result := 0;
  Len := 0;
  while ToHash^ in ['_', '0'..'9', 'a'..'z', 'A'..'Z'] do
  begin
    if CaseInsensitive And (toHash^ in ['A'..'Z']) then
      Result := (Result + Ord(toHash^)-ord('A')+ord('a')) mod 256
    else
      Result := (Result + Ord(toHash^)) mod 256;
    Inc(ToHash);
    Inc(Len);
  end;
end;
 
procedure TAALSynHighlight.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
    exit
  else
  if FLineText[FTokenEnd] in [#9, ' '] then
  begin
    while (FTokenEnd <= l) and (FLineText[FTokenEnd] in [#0..#32]) do
      Inc(FTokenEnd);
    FTokLen := FTokenEnd - FTokenPos;
    FToken := copy(FLineText, FTokenPos, FTokLen);
    FTok := tkSpace;
  end
  else if FLineText[FTokenEnd] in SingleToken then
  begin
    Inc(FTokenEnd);
    FToken := FLineText[FTokenPos];
    FTokLen := 1;
    FTok := tkSymbol;
  end
  else if FLineText[FTokenEnd] = '$' then
  begin
    Inc(FTokenEnd);
    FTokenHash := HashToken(@FLineText[FTokenEnd], FTokLen);
    Inc(FTokLen);
    Inc(FTokenEnd, FTokLen);
    FToken := copy(FLineText, FTokenPos, FTokLen);
    FTok := tkVar;
  end
  else if FLineText[FTokenEnd] = '"' then
  begin
    inc(FTokenEnd);
    FTok:=tkString;
    while (FTokenEnd<=l) And (FLineText[FTokenEnd] <> '"') do
      Inc(FTokenEnd);
    inc(FTokenEnd);
    FTokLen:=FTokenEnd-FTokenPos;
    FToken := copy(FLineText, FTokenPos, FTokLen);
   end
  else if FLineText[FTokenEnd] in ['0'..'9'] then
  begin
    FTok:=tkNumber;
    while (FTokenEnd<=l) And (FLineText[FTokenEnd] in ['0'..'9', '.']) do
      Inc(FTokenEnd);
    FTokLen:=FTokenEnd-FTokenPos;
    FToken := copy(FLineText, FTokenPos, FTokLen);
   end
   else
  begin
    FTokenHash := HashToken(@FLineText[FTokenEnd], FTokLen);
    Inc(FTokenEnd, FTokLen);
    FToken := copy(FLineText, FTokenPos, FTokLen);
    FTok := tkUndefined;
  end;
end;
 
function TAALSynHighlight.GetEol: boolean;
begin
  Result := FTokenPos > length(FLineText);
end;
 
procedure TAALSynHighlight.GetTokenEx(out TokenStart: PChar; out TokenLength: integer);
begin
  TokenStart := @FLineText[FTokenPos];
  TokenLength := FTokLen;
end;
 
function TAALSynHighlight.GetTokenAttribute: TSynHighlighterAttributes;
begin
  if FTok=tkUndefined then
    CheckHash;
  Result := GetAttr(FTok);
end;
 
function TAALSynHighlight.GetToken: string;
begin
  Result := FToken;
end;
 
function TAALSynHighlight.GetTokenPos: integer;
begin
  Result := FTokenPos - 1;
end;
 
function TAALSynHighlight.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
begin
  case Index of
    SYN_ATTR_COMMENT: Result := FCommentAttr;
    SYN_ATTR_IDENTIFIER: Result := FIdentifierAttr;
    SYN_ATTR_KEYWORD: Result := FKeyAttr;
    SYN_ATTR_STRING: Result := FStrAttr;
    SYN_ATTR_WHITESPACE: Result := FSpaceAttr;
    SYN_ATTR_SYMBOL: Result := FKeyAttr;
  else
    Result := nil;
  end;
end;
 
function TAALSynHighlight.GetTokenKind: integer;
begin
  Result := Ord(FTok);
end;
 
destructor TAALSynHighlight.Destroy;
 
  procedure FreeLst(l: TList);
  var
    i: integer;
  begin
    for i := 0 to l.Count - 1 do
      Dispose(PHashInfo(l[i]));
    l.Free;
  end;
 
var
  i: integer;
begin
  for i := 0 to 255 do
    FreeLst(FHashList[i]);
  inherited;
end;
 
end.


Die HL.lst welche ich verwende um die HashTable zu befüllen generiere ich mit der oben Stehende Methode und Sichere mit:

Code: Alles auswählen

 
procedure TForm1.SaveHlTable(Path: string);
var
  fs: TFileStream;
  tmp: THashInfo;
  i, x, a: integer;
 
begin
  fs := TFileStream.Create(Path, fmCreate);
  try
    for x := 0 to 255 do
    begin
      fs.Write(FHashList[x].Count, SizeOf(integer));
      for i := 0 to FHashList[x].Count - 1 do
      begin
        tmp := PHashInfo(FHashList[x][i])^;
        fs.Write(tmp.Kind, SizeOf(tmp.Kind));
        a := Length(tmp.Key);
        fs.Write(a, SizeOf(a));
        fs.Write(tmp.Key[1], a);
      end;
    end;
  finally
    fs.Free;
  end;
 
end;


Das HL.lst Generator Projekt liegt anbei
Dateianhänge
HLGenerator.zip
(3.55 KiB) 115-mal heruntergeladen

Antworten