jvhleditor.pas

数据表对拷程序。 做这个程序的本意是

{-----------------------------------------------------------------------------
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/MPL-1.1.html

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

The Original Code is: JvHLEditor.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <[e-mail]>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s):

Last Modified: 2002-07-04

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

component   : TJvHLEditor
description : JvEditor with built-in highlighting for:
              pascal, cbuilder, sql, python, jscript,
              vbscript, perl, ini, html, not quite c

Known Issues:
  (rom) source cleaning incomplete
  (rom) GetAttr should be broken up further
-----------------------------------------------------------------------------}

{$I JVCL.INC}

{ history
 (JVCL Library versions) :
  1.03:
    - first release;
  1.11:
    - improvements in custom reserved words support;
    - comments works better in custom reserved words;
  1.17:
    - python highlighting by Rafal Smotrzyk - [e-mail];
  1.17.2:
    - jscript, vbscript highlighting by Rafal Smotrzyk - [e-mail];
  1.17.6:
    - html highlighting;
  1.12.2:
    - fixed bug with pressing End-key if CursorBeoyondEOF enabled
      (greetings to Andre N Belokon)
  1.23:
    - fixed another bug in comment checking (range check error)
    (greetings to Willo vd Merwe)
  1.23.1:
    - first version of perl highlighter;
  1.41:
    - fixed another bug in comment checking;
  1.51.3 (JVCL Library 1.51 with Update 3):
    - fixed bug: exception on comments in "c++, java, sql" - mode;
  1.51.4 (JVCL Library 1.51 with Update 4):
    - ini-file highlighter;
    - fixed bug: custom reserved words not working;
  1.61:
    - new: in html-highlighter unknown (not html) tag highlighted with
      "statement" color. This allows to use html-highlighter to display
      xml-files.
  2.10.2: (changes by Andreas Hausladen)
    - C/C++ line continuation symbol '\' extends the highlight colors to the
      next line (LongToken=True)
    - "Not Quite C" highlighter (C similar, for programming LEGO MindStorm(R) robots)
    - fixed bug: SetBlockColor raise an exception (AV) if iEnd becomes greater than
      MAX_X
    - in TRAHLEditor.GetAttr all IsXxxKeyWord get a CONST string, so no compiler
      magic LStrAddRef is needed.
    - some speed optimations
    - new property DelphiColors: Boolean
    - renamed all "Identifer" to "Identifier". published property "Identifer"
      still exists but uses "FIdentifier"
    - added some new DelphiKeyWord
    - fixed bug: RescanLong() may exceed FLongDesc[] dimension
  2.10.3
    - faster RescanLong
    - faster KeyWord search for drawing

}

unit JvHLEditor;

interface

uses
  SysUtils, Classes, Graphics,
  JvEditor, JvHLParser;

const
  { Max_Line - maximum line numbers, scanned by editor for comments }
  Max_Line = 64 * 1024;

type
  THighLighter = (hlNone, hlPascal, hlCBuilder, hlSql, hlPython, hlJava, hlVB,
    hlHtml, hlPerl, hlIni, hlCocoR, hlPhp, hlNQC);

  TJvSymbolColor = class(TPersistent)
  private
    FStyle: TFontStyles;
    FForeColor: TColor;
    FBackColor: TColor;
  public
    constructor Create;
    procedure SetColor(const ForeColor, BackColor: TColor; const Style: TFontStyles);
    procedure Assign(Source: TPersistent); override;
  published
    // (rom) defaults and constructor added
    property Style: TFontStyles read FStyle write FStyle default [];
    property ForeColor: TColor read FForeColor write FForeColor default clWindowText;
    property BackColor: TColor read FBackColor write FBackColor default clWindow;
  end;

  TJvColors = class(TPersistent)
  private
    FComment: TJvSymbolColor;
    FNumber: TJvSymbolColor;
    FString: TJvSymbolColor;
    FSymbol: TJvSymbolColor;
    FReserved: TJvSymbolColor;
    FIdentifier: TJvSymbolColor;
    FPreproc: TJvSymbolColor;
    FFunctionCall: TJvSymbolColor;
    FDeclaration: TJvSymbolColor;
    FStatement: TJvSymbolColor;
    FPlainText: TJvSymbolColor;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Comment: TJvSymbolColor read FComment write FComment;
    property Number: TJvSymbolColor read FNumber write FNumber;
    property Strings: TJvSymbolColor read FString write FString;
    property Symbol: TJvSymbolColor read FSymbol write FSymbol;
    property Reserved: TJvSymbolColor read FReserved write FReserved;
    property Identifier: TJvSymbolColor read FIdentifier write FIdentifier;
    property Preproc: TJvSymbolColor read FPreproc write FPreproc;
    property FunctionCall: TJvSymbolColor read FFunctionCall write FFunctionCall;
    property Declaration: TJvSymbolColor read FDeclaration write FDeclaration;
    property Statement: TJvSymbolColor read FStatement write FStatement;
    property PlainText: TJvSymbolColor read FPlainText write FPlainText;
  end;

  TOnReservedWord = procedure(Sender: TObject; Token: string;
    var Reserved: Boolean) of object;

  TJvHLEditor = class(TJvEditor)
  private
    Parser: TJvIParser;
    FHighLighter: THighLighter;
    FColors: TJvColors;
    FLine: string;
    FLineNum: Integer;
    FLong: Integer;
    FLongTokens: Boolean;
    FLongDesc: array [0..Max_Line] of Byte;
    FSyntaxHighlighting: Boolean;
    FOnReservedWord: TOnReservedWord;

//    FCachedHighligher: THighLighter;

    // Coco/R
    ProductionsLine: Integer;
    function RescanLong(iLine: Integer): Boolean;
    procedure CheckInLong;
    function FindLongEnd: Integer;
    procedure SetHighLighter(Value: THighLighter);
    function GetDelphiColors: Boolean;
    procedure SetDelphiColors(Value: Boolean);
  protected
    procedure Loaded; override;
    procedure GetAttr(Line, ColBeg, ColEnd: Integer); override;
    procedure TextModified(ACaretX, ACaretY: Integer; Action: TModifiedAction;
      const Text: string); override;
    function GetReservedWord(const Token: string; var Reserved: Boolean): Boolean; virtual;
    function UserReservedWords: Boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property HighLighter: THighLighter read FHighLighter write SetHighLighter default hlPascal;
    property Colors: TJvColors read FColors write FColors;
    property DelphiColors: Boolean read GetDelphiColors write SetDelphiColors;
    property LongTokens: Boolean read FLongTokens write FLongTokens default True;
    property OnReservedWord: TOnReservedWord read FOnReservedWord write FOnReservedWord;
    property SyntaxHighlighting: Boolean read FSyntaxHighlighting write FSyntaxHighlighting stored False;
  end;

implementation

uses
  Math,
  JvStrUtil;

const
  lgNone            = 0;
  lgComment1        = 1;
  lgComment2        = 2;
  lgString          = 4;
  lgTag             = 5;
  lgPreproc         = 6;
  lgUndefined       = 255;

function StrScan(const Str: PChar; Chr: Char): PChar;
{ faster than the SysUtils.StrScan function on Pentium CPUs }
begin
  Result := Str;
  while (Result[0] <> #0) do
  begin
    if Result[0] = Chr then Exit;
    Inc(Result);
  end;
  Result := nil;
end;

function LastNoSpaceChar(const S: String): Char;
var i: integer;
begin
  Result := #0;
  i := Length(S);
  while (i > 0) and (S[i] = ' ') do Dec(i);
  if i > 0 then Result := S[i];
end;

function GetTrimChar(const S: String; Index: Integer): Char;
var LS, l: Integer;
begin
  LS := Length(S);
  if LS <> 0 then
  begin
    l := 1;
    while (l <= LS) and (s[l] = ' ') do Inc(l);
    if l <= LS then
      Result := S[l - 1 + Index]
    else
      Result := S[Index];
  end
  else
    Result := #0;
end;

function HasStringOpenEnd(Lines: TStrings; iLine: Integer): Boolean;
{ find C/C++ "line breaker" '\' }
var
  i: integer;
  IsOpen: Boolean;
  P, F: PChar;
  S: string;
begin
  Result := False;
  if (iLine < 0) or (iLine >= Lines.Count) then exit;
  i := iLine - 1;
  IsOpen := False;
  if (i >= 0) and (LastNoSpaceChar(Lines[i]) = '\') then // check prior lines
    IsOpen := HasStringOpenEnd(Lines, i);
  S := Lines[iLine];
  F := PChar(S);
  P := F;
  repeat
    P := StrScan(P, '"');
    if P <> nil then
    begin
      if (P = F) or (P[-1] <> '\') then
        IsOpen := not IsOpen
      else
      begin
       // count the backslashes
        i := 1;
        while (P-1-i > F) and (P[-1-i] = '\') do inc(i);
        if i and $01 = 0 then IsOpen := not IsOpen; { faster than: if i mod 2 = 0 then IsOpen := not IsOpen; }
      end;
      inc(P);
    end;
  until P = nil;
  Result := IsOpen;
end;

//=== TJvSymbolColor =========================================================

constructor TJvSymbolColor.Create;
begin
  inherited Create;
  FStyle :=  [];
  FForeColor := clWindowText;
  FBackColor := clWindow;
end;

procedure TJvSymbolColor.SetColor(const ForeColor, BackColor: TColor; const Style: TFontStyles);
begin
  FForeColor := ForeColor;
  FBackColor := BackColor;
  FStyle := Style;
end;

procedure TJvSymbolColor.Assign(Source: TPersistent);
begin
  if Source is TJvSymbolColor then
  begin
    FForeColor := TJvSymbolColor(Source).FForeColor;
    FBackColor := TJvSymbolColor(Source).FBackColor;
    FStyle := TJvSymbolColor(Source).FStyle;
  end
  else
    inherited Assign(Source);
end;

//=== TJvColors ==============================================================

constructor TJvColors.Create;
begin
  inherited Create;
  FComment := TJvSymbolColor.Create;
  FNumber := TJvSymbolColor.Create;
  FString := TJvSymbolColor.Create;
  FSymbol := TJvSymbolColor.Create;
  FReserved := TJvSymbolColor.Create;
  FStatement := TJvSymbolColor.Create;
  FIdentifier := TJvSymbolColor.Create;
  FPreproc := TJvSymbolColor.Create;
  FFunctionCall := TJvSymbolColor.Create;
  FDeclaration := TJvSymbolColor.Create;
  FPlainText := TJvSymbolColor.Create;
  FComment.SetColor(clOlive, clWindow, [fsItalic]);
  FNumber.SetColor(clNavy, clWindow, []);
  FString.SetColor(clPurple, clWindow, []);
  FSymbol.SetColor(clBlue, clWindow, []);
  FReserved.SetColor(clWindowText, clWindow, [fsBold]);
  FStatement.SetColor(clWindowText, clWindow, [fsBold]);
  FIdentifier.SetColor(clWindowText, clWindow, []);
  FPreproc.SetColor(clGreen, clWindow, []);
  FFunctionCall.SetColor(clWindowText, clWindow, []);
  FDeclaration.SetColor(clWindowText, clWindow, []);
  FPlainText.SetColor(clWindowText, clWindow, []);
end;

destructor TJvColors.Destroy;
begin
  FComment.Free;
  FNumber.Free;
  FString.Free;
  FSymbol.Free;
  FReserved.Free;
  FStatement.Free;
  FIdentifier.Free;
  FPreproc.Free;
  FFunctionCall.Free;
  FDeclaration.Free;
  FPlainText.Free;
  inherited Destroy;
end;

procedure TJvColors.Assign(Source: TPersistent);
begin
  if Source is TJvColors then
  begin
    FComment.Assign(TJvColors(Source).FComment);
    FNumber.Assign(TJvColors(Source).FNumber);
    FString.Assign(TJvColors(Source).FString);
    FSymbol.Assign(TJvColors(Source).FSymbol);
    FReserved.Assign(TJvColors(Source).FReserved);
    FStatement.Assign(TJvColors(Source).FStatement);
    FIdentifier.Assign(TJvColors(Source).FIdentifier);
    FPreproc.Assign(TJvColors(Source).FPreproc);
    FFunctionCall.Assign(TJvColors(Source).FFunctionCall);
    FDeclaration.Assign(TJvColors(Source).FDeclaration);
    FPlainText.Assign(TJvColors(Source).FPlainText);
  end
  else
    inherited Assign(Source);
end;


//=== TJvHLEditor ============================================================

constructor TJvHLEditor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Parser := TJvIParser.Create;
  Parser.ReturnComments := True;
  FHighLighter := hlPascal;
  FColors := TJvColors.Create;
  FLongTokens := True;
  FSyntaxHighlighting := True;
  ProductionsLine := High(Integer);
end;

destructor TJvHLEditor.Destroy;
begin
  Parser.Free;
  FColors.Free;
  inherited Destroy;
end;

procedure TJvHLEditor.Loaded;
begin
  inherited Loaded;
  RescanLong(0);
end;

procedure TJvHLEditor.SetHighLighter(Value: THighLighter);
begin
  if FHighLighter <> Value then
  begin
    FHighLighter := Value;
    case FHighLighter of
      hlPascal:
        Parser.Style := psPascal;
      hlCBuilder, hlSql, hlJava, hlNQC:
        Parser.Style := psCpp;
      hlPython:
        Parser.Style := psPython;
      hlVB:
        Parser.Style := psVB;
      hlHtml:
        Parser.Style := psHtml;
      hlPerl:
        Parser.Style := psPerl;
      hlIni:
        Parser.Style := psPascal;
      hlCocoR:
        Parser.Style := psCocoR;
      hlPhp:
        Parser.Style := psPhp;
    end;
    RescanLong(0);
    Invalidate;
  end;
end;

procedure TJvHLEditor.GetAttr(Line, ColBeg, ColEnd: Integer);
var
  Token: string;