synhighlightereiffel.pas

用delphi写的delphi源代码 用delphi写的delphi源代码 用delphi写的delphi源代码 用delphi写的delphi源代码

{-------------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

Code template generated with SynGen.
The original code is: SynHighlighterEiffel.pas, released 2004-03-08.
Description: Eiffel Syntax Parser/Highlighter
The initial author of this file is Massimo Maria Ghisalberti (nissl).
Copyright (c) 2004, all rights reserved.

Contributors to the SynEdit and mwEdit projects are listed in the
Contributors.txt file.

Alternatively, the contents of this file may be used under the terms of the
GNU General Public License Version 2 or later (the "GPL"), in which case
the provisions of the GPL are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms
of the GPL and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the GPL.
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.

$Id: SynHighlighterEiffel.pas,v 1.3 2004/07/31 16:20:08 markonjezic Exp $

You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net

-------------------------------------------------------------------------------}
{
@abstract(Provides an Eiffel highlighter for SynEdit)
@author(Massimo Maria Ghisalberti ([e-mail], [e-mail] - www.linee.it)
@created(03-08-2004)
@lastmod(03-08-2004)
The SynHighlighterEiffel unit provides SynEdit with an Eiffel highlighter.
}

{$IFNDEF QSYNHIGHLIGHTEREIFFEL}
unit SynHighlighterEiffel;
{$ENDIF}

{$I SynEdit.inc}

interface

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

type
  TtkTokenKind = (
    tkBasicTypes,
    tkComment,
    tkIdentifier,
    tkKey,
    tkLace,
    tkNull,
    tkOperatorAndSymbols,
    tkPredefined,
    tkResultValue,
    tkSpace,
    tkString,
    tkUnknown);

  TRangeState = (rsUnKnown, rsEiffelComment, rsString, rsOperatorAndSymbolProc);

  TProcTableProc = procedure of object;

  PIdentFuncTableFunc = ^TIdentFuncTableFunc;
  TIdentFuncTableFunc = function :TtkTokenKind of object;

const
  MaxKey = 144;

type
  TSynEiffelSyn = class(TSynCustomHighlighter)
  private
    fLineRef :string;
    fLine :PChar;
    fLineNumber :Integer;
    fProcTable :array[#0..#255] of TProcTableProc;
    fRange :TRangeState;
    Run :LongInt;
    fStringLen :Integer;
    fToIdent :PChar;
    fTokenPos :Integer;
    fTokenID :TtkTokenKind;
    fIdentFuncTable :array[0..MaxKey] of TIdentFuncTableFunc;
    fBasicTypesAttri :TSynHighlighterAttributes;
    fCommentAttri :TSynHighlighterAttributes;
    fIdentifierAttri :TSynHighlighterAttributes;
    fKeyAttri :TSynHighlighterAttributes;
    fLaceAttri :TSynHighlighterAttributes;
    fOperatorAndSymbolsAttri :TSynHighlighterAttributes;
    fPredefinedAttri :TSynHighlighterAttributes;
    fResultValueAttri :TSynHighlighterAttributes;
    fSpaceAttri :TSynHighlighterAttributes;
    fStringAttri :TSynHighlighterAttributes;
    function KeyHash(ToHash :PChar) :Integer;
    function KeyComp(const aKey :string) :Boolean;
    function Func0 :TtkTokenKind;
    function Func15 :TtkTokenKind;
    function Func19 :TtkTokenKind;
    function Func20 :TtkTokenKind;
    function Func21 :TtkTokenKind;
    function Func23 :TtkTokenKind;
    function Func25 :TtkTokenKind;
    function Func28 :TtkTokenKind;
    function Func29 :TtkTokenKind;
    function Func30 :TtkTokenKind;
    function Func31 :TtkTokenKind;
    function Func33 :TtkTokenKind;
    function Func36 :TtkTokenKind;
    function Func37 :TtkTokenKind;
    function Func39 :TtkTokenKind;
    function Func41 :TtkTokenKind;
    function Func42 :TtkTokenKind;
    function Func43 :TtkTokenKind;
    function Func45 :TtkTokenKind;
    function Func47 :TtkTokenKind;
    function Func49 :TtkTokenKind;
    function Func50 :TtkTokenKind;
    function Func52 :TtkTokenKind;
    function Func54 :TtkTokenKind;
    function Func55 :TtkTokenKind;
    function Func56 :TtkTokenKind;
    function Func57 :TtkTokenKind;
    function Func58 :TtkTokenKind;
    function Func59 :TtkTokenKind;
    function Func62 :TtkTokenKind;
    function Func63 :TtkTokenKind;
    function Func64 :TtkTokenKind;
    function Func65 :TtkTokenKind;
    function Func66 :TtkTokenKind;
    function Func68 :TtkTokenKind;
    function Func69 :TtkTokenKind;
    function Func71 :TtkTokenKind;
    function Func73 :TtkTokenKind;
    function Func74 :TtkTokenKind;
    function Func75 :TtkTokenKind;
    function Func76 :TtkTokenKind;
    function Func77 :TtkTokenKind;
    function Func78 :TtkTokenKind;
    function Func82 :TtkTokenKind;
    function Func83 :TtkTokenKind;
    function Func84 :TtkTokenKind;
    function Func85 :TtkTokenKind;
    function Func86 :TtkTokenKind;
    function Func87 :TtkTokenKind;
    function Func89 :TtkTokenKind;
    function Func93 :TtkTokenKind;
    function Func95 :TtkTokenKind;
    function Func97 :TtkTokenKind;
    function Func98 :TtkTokenKind;
    function Func99 :TtkTokenKind;
    function Func101 :TtkTokenKind;
    function Func108 :TtkTokenKind;
    function Func113 :TtkTokenKind;
    function Func116 :TtkTokenKind;
    function Func120 :TtkTokenKind;
    function Func133 :TtkTokenKind;
    function Func144 :TtkTokenKind;
    procedure IdentProc;
    procedure OperatorAndSymbolProc;
    procedure UnknownProc;
    function AltFunc :TtkTokenKind;
    procedure InitIdent;
    function IdentKind(MayBe :PChar) :TtkTokenKind;
    procedure MakeMethodTables;
    procedure NullProc;
    procedure SpaceProc;
    procedure CRProc;
    procedure LFProc;
    procedure EiffelCommentOpenProc;
    procedure EiffelCommentProc;
    procedure StringOpenProc;
    procedure StringProc;
  protected
    function GetIdentChars :TSynIdentChars; override;
    function GetSampleSource :string; override;
    function IsFilterStored :Boolean; override;
  public
    constructor Create(AOwner :TComponent); 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 :string;
    function GetTokenID :TtkTokenKind;
    procedure SetLine(NewValue :string; LineNumber :Integer); override;
    function GetToken :string; override;
    function GetTokenAttribute :TSynHighlighterAttributes; override;
    function GetTokenKind :integer; override;
    function GetTokenPos :Integer; override;
    procedure Next; override;
  published
    property BasicTypesAttri :TSynHighlighterAttributes read fBasicTypesAttri write fBasicTypesAttri;
    property CommentAttri :TSynHighlighterAttributes read fCommentAttri write fCommentAttri;
    property IdentifierAttri :TSynHighlighterAttributes read fIdentifierAttri write fIdentifierAttri;
    property KeyAttri :TSynHighlighterAttributes read fKeyAttri write fKeyAttri;
    property LaceAttri :TSynHighlighterAttributes read fLaceAttri write fLaceAttri;
    property OperatorAndSymbolsAttri :TSynHighlighterAttributes read fOperatorAndSymbolsAttri write fOperatorAndSymbolsAttri;
    property PredefinedAttri :TSynHighlighterAttributes read fPredefinedAttri write fPredefinedAttri;
    property ResultValueAttri :TSynHighlighterAttributes read fResultValueAttri write fResultValueAttri;
    property SpaceAttri :TSynHighlighterAttributes read fSpaceAttri write fSpaceAttri;
    property StringAttri :TSynHighlighterAttributes read fStringAttri write fStringAttri;
  end;

implementation

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

var
  Identifiers :array[#0..#255] of ByteBool;
  mHashTable :array[#0..#255] of Integer;

procedure MakeIdentTable;
var
  I, J :Char;
begin
  for I := #0 to #255 do
    begin
      case I of
        '_', 'a'..'z', 'A'..'Z' :Identifiers[I] := True;
        else
          Identifiers[I] := False;
      end;
      J := UpCase(I);
      case I in ['_', 'A'..'Z', 'a'..'z'] of
        True :mHashTable[I] := Ord(J) - 64
        else
          mHashTable[I] := 0;
      end;
    end;
end;

procedure TSynEiffelSyn.InitIdent;
var
  I :Integer;
  pF :PIdentFuncTableFunc;
begin
  pF := PIdentFuncTableFunc(@fIdentFuncTable);
  for I := Low(fIdentFuncTable) to High(fIdentFuncTable) do
    begin
      pF^ := AltFunc;
      Inc(pF);
    end;
  fIdentFuncTable[0] := Func0;
  fIdentFuncTable[15] := Func15;
  fIdentFuncTable[19] := Func19;
  fIdentFuncTable[20] := Func20;
  fIdentFuncTable[21] := Func21;
  fIdentFuncTable[23] := Func23;
  fIdentFuncTable[25] := Func25;
  fIdentFuncTable[28] := Func28;
  fIdentFuncTable[29] := Func29;
  fIdentFuncTable[30] := Func30;
  fIdentFuncTable[31] := Func31;
  fIdentFuncTable[33] := Func33;
  fIdentFuncTable[36] := Func36;
  fIdentFuncTable[37] := Func37;
  fIdentFuncTable[39] := Func39;
  fIdentFuncTable[41] := Func41;
  fIdentFuncTable[42] := Func42;
  fIdentFuncTable[43] := Func43;
  fIdentFuncTable[45] := Func45;
  fIdentFuncTable[47] := Func47;
  fIdentFuncTable[49] := Func49;
  fIdentFuncTable[50] := Func50;
  fIdentFuncTable[52] := Func52;
  fIdentFuncTable[54] := Func54;
  fIdentFuncTable[55] := Func55;
  fIdentFuncTable[56] := Func56;
  fIdentFuncTable[57] := Func57;
  fIdentFuncTable[58] := Func58;
  fIdentFuncTable[59] := Func59;
  fIdentFuncTable[62] := Func62;
  fIdentFuncTable[63] := Func63;
  fIdentFuncTable[64] := Func64;
  fIdentFuncTable[65] := Func65;
  fIdentFuncTable[66] := Func66;
  fIdentFuncTable[68] := Func68;
  fIdentFuncTable[69] := Func69;
  fIdentFuncTable[71] := Func71;
  fIdentFuncTable[73] := Func73;
  fIdentFuncTable[74] := Func74;
  fIdentFuncTable[75] := Func75;
  fIdentFuncTable[76] := Func76;
  fIdentFuncTable[77] := Func77;
  fIdentFuncTable[78] := Func78;
  fIdentFuncTable[82] := Func82;
  fIdentFuncTable[83] := Func83;
  fIdentFuncTable[84] := Func84;
  fIdentFuncTable[85] := Func85;
  fIdentFuncTable[86] := Func86;
  fIdentFuncTable[87] := Func87;
  fIdentFuncTable[89] := Func89;
  fIdentFuncTable[93] := Func93;
  fIdentFuncTable[95] := Func95;
  fIdentFuncTable[97] := Func97;
  fIdentFuncTable[98] := Func98;
  fIdentFuncTable[99] := Func99;
  fIdentFuncTable[101] := Func101;
  fIdentFuncTable[108] := Func108;
  fIdentFuncTable[113] := Func113;
  fIdentFuncTable[116] := Func116;
  fIdentFuncTable[120] := Func120;
  fIdentFuncTable[133] := Func133;
  fIdentFuncTable[144] := Func144;
end;

function TSynEiffelSyn.KeyHash(ToHash :PChar) :Integer;
begin
  Result := 0;
  while ToHash^ in ['_', 'a'..'z', 'A'..'Z'] do
    begin
      inc(Result, mHashTable[ToHash^]);
      inc(ToHash);
    end;
  fStringLen := ToHash - fToIdent;
end;

function TSynEiffelSyn.KeyComp(const aKey :string) :Boolean;
var
  I :Integer;
  Temp :PChar;
begin
  Temp := fToIdent;
  if Length(aKey) = fStringLen then
    begin
      Result := True;
      for i := 1 to fStringLen do
        begin
          if mHashTable[Temp^] <> mHashTable[aKey[i]] then
            begin
              Result := False;
              break;
            end;
          inc(Temp);
        end;
    end
  else
    Result := False;
end;

function TSynEiffelSyn.Func0 :TtkTokenKind;
begin
  if KeyComp('@') then
    Result := tkOperatorAndSymbols
  else
    if KeyComp(']') then
      Result := tkOperatorAndSymbols
    else
      if KeyComp('*') then
        Result := tkOperatorAndSymbols
      else
        if KeyComp('&') then
          Result := tkOperatorAndSymbols
        else
          if KeyComp('|') then
            Result := tkOperatorAndSymbols
          else
            if KeyComp('#') then
              Result := tkOperatorAndSymbols
            else
              if KeyComp('.') then
                Result := tkOperatorAndSymbols
              else
                if KeyComp('=') then
                  Result := tkOperatorAndSymbols
                else
                  if KeyComp('(') then
                    Result := tkOperatorAndSymbols
                  else
                    if KeyComp('/') then
                      Result := tkOperatorAndSymbols
                    else
                      if KeyComp('[') then
                        Result := tkOperatorAndSymbols
                      else
                        if KeyComp('\\') then
                          Result := tkOperatorAndSymbols
                        else
                          if KeyComp('$') then
                            Result := tkOperatorAndSymbols
                          else
                            if KeyComp('<') then
                              Result := tkOperatorAndSymbols
                            else
                              if KeyComp(':=') then
                                Result := tkOperatorAndSymbols
                              else
                                if KeyComp('^') then
                                  Result := tkOperatorAndSymbols
                                else
                                  if KeyComp('!') then
                                    Result := tkOperatorAndSymbols
                                  else
                                    if KeyComp('<>') then
                                      Result := tkOperatorAndSymbols
                                    else
                                      if KeyComp('>') then
                                        Result := tkOperatorAndSymbols
                                      else
                                        if KeyComp('+') then
                                          Result := tkOperatorAndSymbols
                                        else
                                          if KeyComp('/=') then
                                            Result := tkOperatorAndSymbols
                                          else
                                            if KeyComp('//') then
                                              Result := tkOperatorAndSymbols
                                            else
                                              if KeyComp(':') then
                                                Result := tkOperatorAndSymbols
                                              else
                                                if KeyComp(';') then
                                                  Result := tkOperatorAndSymbols
                                                else
                                                  if KeyComp('-') then
                                                    Result := tkOperatorAndSymbols
                                                  else
                                                    if KeyComp(')') then
                                                      Result := tkOperatorAndSymbols
                                                    else
                                                      Result := tkIdentifier;
end;

function TSynEiffelSyn.Func15 :TtkTokenKind;
begin
  if KeyComp('if') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynEiffelSyn.Func19 :TtkTokenKind;
begin
  if KeyComp('do') then
    Result := tkKey
  else
    if KeyComp('and') then
      Result := tkKey
    else
      Result := tkIdentifier;
end;

function TSynEiffelSyn.Func20 :TtkTokenKind;
begin
  if KeyComp('as') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynEiffelSyn.Func21 :TtkTokenKind;