{*******************************************************}
{               RichEdit Syntax HighLight               }
{                     version 3.0                       }
{ Author:                                               }
{ Serhiy Perevoznyk                                     }
{ serge_perevoznyk@hotmail.com                          }
{                                                       }
{*******************************************************}

{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.

The Original Code is: SynHighlighterSQL.pas, released 2000-04-21.
The Original Code is based on the wmSQLSyn.pas and wmSybaseSyn.pas files from
the mwEdit component suite by Martin Waldenburg and other developers, the
Initial Author of these files is Willo van der Merwe. Initial Author of
SynHighlighterSQL.pas is Michael Hieke.
Portions created by Willo van der Merwe are Copyright 1999 Willo van der Merwe.
Portions created by Michael Hieke are Copyright 2000 Michael Hieke.
All Rights Reserved.
The Original Code can be obtained from http://synedit.sourceforge.net/
}

unit psvSQL;


interface

uses
  SysUtils, 
  Windows, 
  Messages, 
  Classes, 
  Controls, 
  Graphics, 
  psvRichSyntax;

Type
  TtkTokenKind = (
    tkComment,
    tkIdentifier,
    tkKey,
    tkNull,
    tkNumber,
    tkString,
    tkSymbol,
    tkUnknown);

  TRangeState = (rsANil, rsAnsiC, rsUnKnown);

  TProcTableProc = procedure of Object;
  TIdentFuncTableFunc = function: TtkTokenKind of Object;

type
  TpsvSQLRTF = class(TpsvRTFSyntax)
  private
    fRange: TRangeState;
    fLine: PChar;
    fProcTable: array[#0..#255] of TProcTableProc;
    Run: LongInt;
    fStringLen: Integer;
    fLineNumber : Integer;
    fToIdent: PChar;
    fTokenPos: Integer;
    FTokenID: TtkTokenKind;
    fIdentFuncTable: array[0..156] of TIdentFuncTableFunc;
    function KeyHash(ToHash: PChar): Integer;
    function KeyComp(const aKey: String): Boolean;
    function Func15:TtkTokenKind;
    function Func19:TtkTokenKind;
    function Func20:TtkTokenKind;
    function Func21:TtkTokenKind;
    function Func23:TtkTokenKind;
    function Func25:TtkTokenKind;
    function Func27:TtkTokenKind;
    function Func28:TtkTokenKind;
    function Func29:TtkTokenKind;
    function Func30:TtkTokenKind;
    function Func31:TtkTokenKind;
    function Func33:TtkTokenKind;
    function Func35:TtkTokenKind;
    function Func37:TtkTokenKind;
    function Func39:TtkTokenKind;
    function Func40:TtkTokenKind;
    function Func41:TtkTokenKind;
    function Func43:TtkTokenKind;
    function Func44:TtkTokenKind;
    function Func47:TtkTokenKind;
    function Func48:TtkTokenKind;
    function Func49:TtkTokenKind;
    function Func50:TtkTokenKind;
    function Func51:TtkTokenKind;
    function Func52:TtkTokenKind;
    function Func53:TtkTokenKind;
    function Func55:TtkTokenKind;
    function Func56:TtkTokenKind;
    function Func57:TtkTokenKind;
    function Func58:TtkTokenKind;
    function Func59:TtkTokenKind;
    function Func60:TtkTokenKind;
    function Func61:TtkTokenKind;
    function Func62:TtkTokenKind;
    function Func63:TtkTokenKind;
    function Func64:TtkTokenKind;
    function Func66:TtkTokenKind;
    function Func67:TtkTokenKind;
    function Func69:TtkTokenKind;
    function Func70:TtkTokenKind;
    function Func73:TtkTokenKind;
    function Func74:TtkTokenKind;
    function Func76:TtkTokenKind;
    function Func77:TtkTokenKind;
    function Func78:TtkTokenKind;
    function Func79:TtkTokenKind;
    function Func83:TtkTokenKind;
    function Func84:TtkTokenKind;
    function Func85:TtkTokenKind;
    function Func87:TtkTokenKind;
    function Func91:TtkTokenKind;
    function Func94:TtkTokenKind;
    function Func96:TtkTokenKind;
    function Func97:TtkTokenKind;
    function Func98:TtkTokenKind;
    function Func99:TtkTokenKind;
    function Func100:TtkTokenKind;
    function Func102:TtkTokenKind;
    function Func103:TtkTokenKind;
    function Func105:TtkTokenKind;
    function Func106:TtkTokenKind;
    function Func111:TtkTokenKind;
    function Func112:TtkTokenKind;
    function Func114:TtkTokenKind;
    function Func115:TtkTokenKind;
    function Func116:TtkTokenKind;
    function Func117:TtkTokenKind;
    function Func122:TtkTokenKind;
    function Func133:TtkTokenKind;
    function Func134:TtkTokenKind;
    function Func137:TtkTokenKind;
    function Func156:TtkTokenKind;
    procedure AndSymbolProc;
    procedure BackslashProc;
    procedure CRProc;
    procedure ColonProc;
    procedure CommaProc;
    procedure CommentProc;
    procedure EqualProc;
    procedure GreaterProc;
    procedure IdentProc;
    procedure LFProc;
    procedure LowerProc;
    procedure MinusProc;
    procedure NullProc;
    procedure NumberProc;
    procedure OrSymbolProc;
    procedure PlusProc;
    procedure QuestionProc;
    procedure RoundCloseProc;
    procedure RoundOpenProc;
    procedure SemiColonProc;
    procedure SlashProc;
    procedure SpaceProc;
    procedure SquareCloseProc;
    procedure SquareOpenProc;
    procedure StarProc;
    procedure StringInterpProc;
    procedure StringLiteralProc;
    procedure XOrSymbolProc;
    procedure UnknownProc;
    procedure AnsiCProc;
    function AltFunc: TtkTokenKind;
    procedure InitIdent;
    function IdentKind(MayBe: PChar): TtkTokenKind;
    procedure MakeMethodTables;
   protected
    procedure PrepareToken(var AToken : string); override;
    function GetEol: Boolean; override;
    function GetRange: Pointer; 
    function GetTokenID: TtkTokenKind;
    procedure SetLine(NewValue : string; LineNumber : Integer); override;
    function GetToken: String;  override;
    function GetTokenAttribute: integer; override;
    function GetTokenKind: integer; 
    function GetTokenPos: Integer; 
    procedure Next;  override;
    procedure SetRange(Value: Pointer); 
    procedure ReSetRange; 
    function PrepareOutput(Attr: integer; AToken : string): string; override;
   public
    constructor Create; override;
    procedure SetupDefaultColors; override;
  end;


implementation


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
      '_', '0'..'9', 'a'..'z', 'A'..'Z': Identifiers[I] := True;
    else Identifiers[I] := False;
    end;
    J := UpperCase(I)[1];
    Case I of
      'a'..'z', 'A'..'Z', '_': mHashTable[I] := Ord(J) - 64;
    else mHashTable[Char(I)] := 0;
    end;
  end;
end;

procedure TpsvSQLRTF.InitIdent;
var
  I: Integer;
begin
  for I := 0 to 156 do
    Case I of
      15: fIdentFuncTable[I] := Func15;
      19: fIdentFuncTable[I] := Func19;
      20: fIdentFuncTable[I] := Func20;
      21: fIdentFuncTable[I] := Func21;
      23: fIdentFuncTable[I] := Func23;
      25: fIdentFuncTable[I] := Func25;
      27: fIdentFuncTable[I] := Func27;
      28: fIdentFuncTable[I] := Func28;
      29: fIdentFuncTable[I] := Func29;
      30: fIdentFuncTable[I] := Func30;
      31: fIdentFuncTable[I] := Func31;
      33: fIdentFuncTable[I] := Func33;
      35: fIdentFuncTable[I] := Func35;
      37: fIdentFuncTable[I] := Func37;
      39: fIdentFuncTable[I] := Func39;
      40: fIdentFuncTable[I] := Func40;
      41: fIdentFuncTable[I] := Func41;
      43: fIdentFuncTable[I] := Func43;
      44: fIdentFuncTable[I] := Func44;
      47: fIdentFuncTable[I] := Func47;
      48: fIdentFuncTable[I] := Func48;
      49: fIdentFuncTable[I] := Func49;
      50: fIdentFuncTable[I] := Func50;
      51: fIdentFuncTable[I] := Func51;
      52: fIdentFuncTable[I] := Func52;
      53: fIdentFuncTable[I] := Func53;
      55: fIdentFuncTable[I] := Func55;
      56: fIdentFuncTable[I] := Func56;
      57: fIdentFuncTable[I] := Func57;
      58: fIdentFuncTable[I] := Func58;
      59: fIdentFuncTable[I] := Func59;
      60: fIdentFuncTable[I] := Func60;
      61: fIdentFuncTable[I] := Func61;
      62: fIdentFuncTable[I] := Func62;
      63: fIdentFuncTable[I] := Func63;
      64: fIdentFuncTable[I] := Func64;
      66: fIdentFuncTable[I] := Func66;
      67: fIdentFuncTable[I] := Func67;
      69: fIdentFuncTable[I] := Func69;
      70: fIdentFuncTable[I] := Func70;
      73: fIdentFuncTable[I] := Func73;
      74: fIdentFuncTable[I] := Func74;
      76: fIdentFuncTable[I] := Func76;
      77: fIdentFuncTable[I] := Func77;
      78: fIdentFuncTable[I] := Func78;
      79: fIdentFuncTable[I] := Func79;
      83: fIdentFuncTable[I] := Func83;
      84: fIdentFuncTable[I] := Func84;
      85: fIdentFuncTable[I] := Func85;
      87: fIdentFuncTable[I] := Func87;
      91: fIdentFuncTable[I] := Func91;
      94: fIdentFuncTable[I] := Func94;
      96: fIdentFuncTable[I] := Func96;
      97: fIdentFuncTable[I] := Func97;
      98: fIdentFuncTable[I] := Func98;
      99: fIdentFuncTable[I] := Func99;
      100: fIdentFuncTable[I] := Func100;
      102: fIdentFuncTable[I] := Func102;
      103: fIdentFuncTable[I] := Func103;
      105: fIdentFuncTable[I] := Func105;
      106: fIdentFuncTable[I] := Func106;
      111: fIdentFuncTable[I] := Func111;
      112: fIdentFuncTable[I] := Func112;
      114: fIdentFuncTable[I] := Func114;
      115: fIdentFuncTable[I] := Func115;
      116: fIdentFuncTable[I] := Func116;
      117: fIdentFuncTable[I] := Func117;
      122: fIdentFuncTable[I] := Func122;
      133: fIdentFuncTable[I] := Func133;
      134: fIdentFuncTable[I] := Func134;
      137: fIdentFuncTable[I] := Func137;
      156: fIdentFuncTable[I] := Func156;
    else fIdentFuncTable[I] := AltFunc;
    end;
end;

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

function TpsvSQLRTF.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; { KeyComp }

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

function TpsvSQLRTF.Func19: TtkTokenKind;
begin
  if KeyComp('AND') then Result := tkKey else
    if KeyComp('DO') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func20: TtkTokenKind;
begin
  if KeyComp('AS') then Result := tkKey else
    if KeyComp('CACHE') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func21: TtkTokenKind;
begin
  if KeyComp('AT') then Result := tkKey else
    if KeyComp('OF') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func23: TtkTokenKind;
begin
  if KeyComp('END') then Result := tkKey else
    if KeyComp('IN') then Result := tkKey else
      if KeyComp('ASC') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func25: TtkTokenKind;
begin
  if KeyComp('ALL') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func27: TtkTokenKind;
begin
  if KeyComp('BY') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func28: TtkTokenKind;
begin
  if KeyComp('READ') then Result := tkKey else
    if KeyComp('IS') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func29: TtkTokenKind;
begin
  if KeyComp('NO') then Result := tkKey else
    if KeyComp('ON') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func30: TtkTokenKind;
begin
  if KeyComp('CHECK') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func31: TtkTokenKind;
begin
  if KeyComp('DESC') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func33: TtkTokenKind;
begin
  if KeyComp('OR') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func35: TtkTokenKind;
begin
  if KeyComp('TO') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func37: TtkTokenKind;
begin
  if KeyComp('LIKE') then Result := tkKey else
    if KeyComp('BEGIN') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func39: TtkTokenKind;
begin
  if KeyComp('FOR') then Result := tkKey else
    if KeyComp('DEBUG') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func40: TtkTokenKind;
begin
  if KeyComp('ANY') then Result := tkKey else
    if KeyComp('TABLE') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func41: TtkTokenKind;
begin
  if KeyComp('ELSE') then Result := tkKey else
    if KeyComp('KEY') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func43: TtkTokenKind;
begin
  if KeyComp('LEFT') then Result := tkKey else
    if KeyComp('CAST') then Result := tkKey else
      if KeyComp('PLAN') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func44: TtkTokenKind;
begin
  if KeyComp('SET') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func47: TtkTokenKind;
begin
  if KeyComp('THEN') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func48: TtkTokenKind;
begin
  if KeyComp('MERGE') then Result := tkKey else
    if KeyComp('DECLARE') then Result := tkKey else
      if KeyComp('JOIN') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func49: TtkTokenKind;
begin
  if KeyComp('SCHEMA') then Result := tkKey else
    if KeyComp('ESCAPE') then Result := tkKey else
      if KeyComp('NOT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func50: TtkTokenKind;
begin
  if KeyComp('AFTER') then Result := tkKey else
    if KeyComp('WHEN') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func51: TtkTokenKind;
begin
  if KeyComp('DELETE') then Result := tkKey else
    if KeyComp('FULL') then Result := tkKey else
      if KeyComp('BEFORE') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func52: TtkTokenKind;
begin
  if KeyComp('FROM') then Result := tkKey else
    if KeyComp('SOME') then Result := tkKey else
      if KeyComp('CREATE') then Result := tkKey else
        if KeyComp('NAMES') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func53: TtkTokenKind;
begin
  if KeyComp('DROP') then Result := tkKey else
    if KeyComp('WAIT') then Result := tkKey else
      if KeyComp('DATABASE') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func55: TtkTokenKind;
begin
  if KeyComp('SHARED') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func56: TtkTokenKind;
begin
  if KeyComp('DOMAIN') then Result := tkKey else
    if KeyComp('INDEX') then Result := tkKey else
      if KeyComp('LEVEL') then Result := tkKey else
        if KeyComp('ALTER') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func57: TtkTokenKind;
begin
  if KeyComp('WHILE') then Result := tkKey else
    if KeyComp('AUTO') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func58: TtkTokenKind;
begin
  if KeyComp('INTO') then Result := tkKey else
    if KeyComp('EXIT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func59: TtkTokenKind;
begin
  if KeyComp('VIEW') then Result := tkKey else
    if KeyComp('NULL') then Result := tkKey else
      if KeyComp('WHERE') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func60: TtkTokenKind;
begin
  if KeyComp('ACTIVE') then Result := tkKey else
    if KeyComp('ORDER') then Result := tkKey else
      if KeyComp('BASE_NAME') then Result := tkKey else
        if KeyComp('GRANT') then Result := tkKey else
          if KeyComp('INNER') then Result := tkKey else
            if KeyComp('WITH') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func61: TtkTokenKind;
begin
  if KeyComp('HAVING') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func62: TtkTokenKind;
begin
  if KeyComp('RIGHT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func63: TtkTokenKind;
begin
  if KeyComp('USER') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func64: TtkTokenKind;
begin
  if KeyComp('SELECT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func66: TtkTokenKind;
begin
  if KeyComp('ONLY') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func67: TtkTokenKind;
begin
  if KeyComp('RETAIN') then Result := tkKey else
    if KeyComp('UPDATE') then Result := tkKey else
      if KeyComp('WORK') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func69: TtkTokenKind;
begin
  if KeyComp('DEFAULT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func70: TtkTokenKind;
begin
  if KeyComp('FILTER') then Result := tkKey else
    if KeyComp('SHADOW') then Result := tkKey else
      if KeyComp('USING') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func73: TtkTokenKind;
begin
  if KeyComp('UNION') then Result := tkKey else
    if KeyComp('COUNT') then Result := tkKey else
      if KeyComp('COMMIT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func74: TtkTokenKind;
begin
  if KeyComp('ROLLBACK') then Result := tkKey else
    if KeyComp('BETWEEN') then Result := tkKey else
      if KeyComp('FOREIGN') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func76: TtkTokenKind;
begin
  if KeyComp('ASCENDING') then Result := tkKey else
    if KeyComp('REVOKE') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func77: TtkTokenKind;
begin
  if KeyComp('GROUP') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func78: TtkTokenKind;
begin
  if KeyComp('COLUMN') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func79: TtkTokenKind;
begin
  if KeyComp('OUTER') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func83: TtkTokenKind;
begin
  if KeyComp('EXECUTE') then Result := tkKey else
    if KeyComp('INACTIVE') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func84: TtkTokenKind;
begin
  if KeyComp('DESCENDING') then Result := tkKey else
    if KeyComp('TRIGGER') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func85: TtkTokenKind;
begin
  if KeyComp('INSERT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func87: TtkTokenKind;
begin
  if KeyComp('UNIQUE') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func91: TtkTokenKind;
begin
  if KeyComp('EXTRACT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func94: TtkTokenKind;
begin
  if KeyComp('CURSOR') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func96: TtkTokenKind;
begin
  if KeyComp('EXISTS') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func97: TtkTokenKind;
begin
  if KeyComp('PARAMETER') then Result := tkKey else
    if KeyComp('COMPUTED') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func98: TtkTokenKind;
begin
  if KeyComp('DISTINCT') then Result := tkKey else
    if KeyComp('SUSPEND') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func99: TtkTokenKind;
begin
  if KeyComp('EXTERNAL') then Result := tkKey else
    if KeyComp('CURRENT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func100: TtkTokenKind;
begin
  if KeyComp('PRIMARY') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func102: TtkTokenKind;
begin
  if KeyComp('FUNCTION') then Result := tkKey else
    if KeyComp('COMMITTED') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func103: TtkTokenKind;
begin
  if KeyComp('GENERATOR') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func105: TtkTokenKind;
begin
  if KeyComp('PROCEDURE') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func106: TtkTokenKind;
begin
  if KeyComp('CONTAINING') then Result := tkKey else
    if KeyComp('PROTECTED') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func111: TtkTokenKind;
begin
  if KeyComp('EXCEPTION') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func112: TtkTokenKind;
begin
  if KeyComp('SNAPSHOT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func114: TtkTokenKind;
begin
  if KeyComp('ISOLATION') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func115: TtkTokenKind;
begin
  if KeyComp('PASSWORD') then Result := tkKey else
    if KeyComp('RETURNS') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func116: TtkTokenKind;
begin
  if KeyComp('CONDITIONAL') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func117: TtkTokenKind;
begin
  if KeyComp('POSITION') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func122: TtkTokenKind;
begin
  if KeyComp('PRIVILEGES') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func133: TtkTokenKind;
begin
  if KeyComp('CONSTRAINT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func134: TtkTokenKind;
begin
  if KeyComp('TRANSACTION') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func137: TtkTokenKind;
begin
  if KeyComp('UNCOMMITTED') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func156: TtkTokenKind;
begin
  if KeyComp('ENTRY_POINT') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.AltFunc: TtkTokenKind;
begin
  Result := tkIdentifier;
end;

function TpsvSQLRTF.IdentKind(MayBe: PChar): TtkTokenKind;
var
  HashKey: Integer;
begin
  fToIdent := MayBe;
  HashKey := KeyHash(MayBe);
  if HashKey < 157 then Result := fIdentFuncTable[HashKey] else Result := tkIdentifier;
end;

procedure TpsvSQLRTF.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
    case I of
      '&': fProcTable[I] := AndSymbolProc;
      '\': fProcTable[I] := BackslashProc;
      #13: fProcTable[I] := CRProc;
      ':': fProcTable[I] := ColonProc;
      ',': fProcTable[I] := CommaProc;
      '#': fProcTable[I] := CommentProc;
      '=': fProcTable[I] := EqualProc;
      '>': fProcTable[I] := GreaterProc;
      'A'..'Z', 'a'..'z', '_': fProcTable[I] := IdentProc;
      #10: fProcTable[I] := LFProc;
      '<': fProcTable[I] := LowerProc;
      '-': fProcTable[I] := MinusProc;
      #0: fProcTable[I] := NullProc;
      '0'..'9', '.': fProcTable[I] := NumberProc;
      '|': fProcTable[I] := OrSymbolProc;
      '+': fProcTable[I] := PlusProc;
      '?': fProcTable[I] := QuestionProc;
      ')': fProcTable[I] := RoundCloseProc;
      '(': fProcTable[I] := RoundOpenProc;
      ';': fProcTable[I] := SemiColonProc;
      '/': fProcTable[I] := SlashProc;
      #1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc;
      ']': fProcTable[I] := SquareCloseProc;
      '[': fProcTable[I] := SquareOpenProc;
      '*': fProcTable[I] := StarProc;
      #34: fProcTable[I] := StringInterpProc;
      #39: fProcTable[I] := StringLiteralProc;
      '^': fProcTable[I] := XOrSymbolProc;
    else fProcTable[I] := UnknownProc;
    end;
end;


constructor TpsvSQLRTF.Create;
begin
  inherited Create;
  InitIdent;
  MakeMethodTables;
  CreateColorTable([clNavy, clBlack, clBlack, clBlack, clBlack, clBlue, clBlack]);
end; { Create }

procedure TpsvSQLRTF.SetLine(NewValue : string; LineNumber : Integer);
begin
  fLine := PChar(NewValue);
  Run := 0;
  fLineNumber := LineNumber;
  Next;
end;{ SetLine }

procedure TpsvSQLRTF.AndSymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.BackslashProc;
begin
  fTokenID := tkSymbol;                {reference}
  inc(Run);
end;

procedure TpsvSQLRTF.CRProc;
begin
  fTokenID := tkSymbol;
  Case FLine[Run + 1] of
    #10: inc(Run, 2);
  else inc(Run);
  end;
end;

procedure TpsvSQLRTF.ColonProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.CommaProc;
begin
  inc(Run);
  fTokenID := tkSymbol;                {comma}
end;

procedure TpsvSQLRTF.CommentProc;
begin
  fTokenID := tkComment;
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
    end;
    inc(Run);
  until FLine[Run] = #0;
end;

procedure TpsvSQLRTF.EqualProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.GreaterProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.IdentProc;
begin
  {regular identifier}
  fTokenID := IdentKind((fLine + Run));
  inc(Run, fStringLen);
  while Identifiers[fLine[Run]] do inc(Run);
end;

procedure TpsvSQLRTF.LFProc;
begin
  fTokenID := tkSymbol;
  inc(Run);
end;

procedure TpsvSQLRTF.LowerProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.MinusProc;
begin
  case FLine[Run + 1] of
    '-' :
      begin
        inc(Run, 2);
        fTokenID := tkComment;
        while FLine[Run] <> #0 do
          begin
            case FLine[Run] of
              #10, #13 : break;
            end;
            inc(Run);
          end;
      end;
    else
      begin
        inc(Run);
        fTokenID := tkSymbol;
      end;
  end;
end;

procedure TpsvSQLRTF.NullProc;
begin
  fTokenID := tkNull;
end;

procedure TpsvSQLRTF.NumberProc;
begin
{begin}                                                                         //mh 2000-01-07
  inc(Run);
  if not (fLine[Run] in ['0'..'9']) then begin
    fTokenID := tkSymbol;
    exit;
  end;
{end}                                                                           //mh 2000-01-07
  fTokenID := tkNumber;
  while FLine[Run] in
      ['0'..'9', '-', '_', '.', 'A'..'F', 'a'..'f', 'x', 'X'] do
  begin
    case FLine[Run] of
      '.':
        if FLine[Run + 1] = '.' then break;
      '-':                             {check for e notation}
        if not ((FLine[Run + 1] = 'e') or (FLine[Run + 1] = 'E')) then break;
    end;
    inc(Run);
  end;
end;

procedure TpsvSQLRTF.OrSymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.PlusProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.QuestionProc;
begin
  fTokenID := tkSymbol;                {conditional op}
  inc(Run);
end;

procedure TpsvSQLRTF.RoundCloseProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.RoundOpenProc;
begin
  inc(Run);
  FTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.SemiColonProc;
begin
  inc(Run);
  fTokenID := tkSymbol;                {semicolon}
end;

procedure TpsvSQLRTF.SlashProc;
begin
  case FLine[Run + 1] of
    '/':                               {c++ style comments}
      begin
        inc(Run, 2);
        fTokenID := tkComment;
        while FLine[Run] <> #0 do
        begin
          case FLine[Run] of
            #10, #13: break;
          end;
          inc(Run);
        end;
      end;
    '*':                               {c style comments}
      begin
        fTokenID := tkComment;
        fRange := rsAnsiC;
        inc(Run);
        while fLine[Run] <> #0 do
          case fLine[Run] of
            '*':
              if fLine[Run + 1] = '/' then
              begin
                inc(Run, 2);
                fRange := rsUnKnown;
                break;
              end else inc(Run);
            #10: break;
            #13: break;
          else inc(Run);
          end;
      end;
  else                                 {division}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
end;

procedure TpsvSQLRTF.SpaceProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
  while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
end;

procedure TpsvSQLRTF.SquareCloseProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.SquareOpenProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.StarProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.StringInterpProc;
begin
  fTokenID := tkString;
  if (FLine[Run + 1] = #34) and (FLine[Run + 2] = #34) then inc(Run, 2);
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
      #92:
        { backslash quote not the ending one }
        if FLine[Run + 1] = #34 then inc(Run);
    end;
    inc(Run);
  until FLine[Run] = #34;
  if FLine[Run] <> #0 then inc(Run);
end;

procedure TpsvSQLRTF.StringLiteralProc;
begin
  fTokenID := tkString;
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
    end;
    inc(Run);
  until FLine[Run] = #39;
  if FLine[Run] <> #0 then inc(Run);
end;

procedure TpsvSQLRTF.XOrSymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvSQLRTF.UnknownProc;
begin
  inc(Run);
end;

procedure TpsvSQLRTF.AnsiCProc;
begin
  fTokenID := tkComment;
  case FLine[Run] of
    #0:
      begin
        NullProc;
        exit;
      end;
    #10:
      begin
        LFProc;
        exit;
      end;
    #13:
      begin
        CRProc;
        exit;
      end;
  end;

  while FLine[Run] <> #0 do
    case FLine[Run] of
      '*':
        if fLine[Run + 1] = '/' then
        begin
          inc(Run, 2);
          fRange := rsUnKnown;
          break;
        end
        else inc(Run);
      #10: break;
      #13: break;
    else inc(Run);
    end;
end;

procedure TpsvSQLRTF.Next;
begin
  fTokenPos := Run;
  Case fRange of
    rsAnsiC: AnsiCProc;
    else
      fRange := rsUnknown;
      fProcTable[fLine[Run]];
  end;
end;

{begin}                                                                         //mh 2000-01-17
function TpsvSQLRTF.GetEol: Boolean;
begin
  Result := fTokenId = tkNull;
end;

function TpsvSQLRTF.GetRange: Pointer;
begin
 Result := Pointer(fRange);
end;

function TpsvSQLRTF.GetToken: String;
var
  Len: LongInt;
begin
  Len := Run - fTokenPos;
  SetString(Result, (FLine + fTokenPos), Len);
end;

function TpsvSQLRTF.GetTokenID: TtkTokenKind;
begin
  Result := fTokenId;
end;

function TpsvSQLRTF.GetTokenAttribute: integer;
begin
  case fTokenID of
    tkComment: Result := 1;
    tkIdentifier: Result := 2;
    tkKey: Result := 3;
    tkNumber: Result := 4;
    tkSymbol: Result := 5;
    tkString: Result := 6;
    tkUnknown: Result := 7;
    else Result := 8;
  end;
end;

function TpsvSQLRTF.GetTokenKind: integer;
begin
  Result := Ord(fTokenId);
end;

function TpsvSQLRTF.GetTokenPos: Integer;
begin
 Result := fTokenPos;
end;

procedure TpsvSQLRTF.ReSetRange;
begin
  fRange:= rsUnknown;
end;

procedure TpsvSQLRTF.SetRange(Value: Pointer);
begin
  fRange := TRangeState(Value);
end;

procedure TpsvSQLRTF.PrepareToken(var AToken : string);
var St : string;
begin
  St := AToken;
  St := StringReplace(St,'\','\\',[rfReplaceAll]);
  St := StringReplace(St,'{','\{',[rfReplaceAll]);
  St := StringReplace(St,'}','\}',[rfReplaceAll]);
  AToken := St;
end;

function TpsvSQLRTF.PrepareOutput(Attr: integer; AToken : string): string;
begin
  case Attr of 
    1 : Result  := '\cf1 \i '+ AToken +'\i0 ';
    3 : Result  := '\cf3 \b '+ AToken + '\b0 ';
  else
   Result := Format('\cf%d %s',[Attr,AToken]);
  end;
end;

procedure TpsvSQLRTF.SetupDefaultColors;
begin
  CreateColorTable([clNavy, clBlack, clBlack, clBlack, clBlack, clBlue, clBlack]);
end;

initialization
  MakeIdentTable;
end.

