synhighlightermulti.pas

一个mwEdit控件原码,比mwCuuEdit0.92a功能先进.

{-------------------------------------------------------------------------------
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: SynHighlighterMulti.pas, released 2000-06-23.
The Original Code is based on mwMultiSyn.pas by Willo van der Merwe, part of the
mwEdit component suite.

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: SynHighlighterMulti.pas,v 1.33 2004/02/26 17:58:28 maelh Exp $

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

Known Issues:
-------------------------------------------------------------------------------}
{
@abstract(Provides a Multiple-highlighter syntax highlighter for SynEdit)
@author(Willo van der Merwe <[e-mail]>, converted to SynEdit by David Muir <[e-mail]>)
@created(1999, converted to SynEdit 2000-06-23)
@lastmod(2000-06-23)
The SynHighlighterMulti unit provides SynEdit with a multiple-highlighter syntax highlighter.
This highlighter can be used to highlight text in which several languages are present, such as HTML.
For example, in HTML as well as HTML tags there can also be JavaScript and/or VBScript present.
}
{$IFNDEF QSYNHIGHLIGHTERMULTI}
unit SynHighlighterMulti;
{$ENDIF}

{$I SynEdit.inc}

interface

uses
{$IFDEF SYN_CLX}
  QSynEditTypes,
  QSynEditHighlighter,
{$ELSE}
  Windows,
  SynEditTypes,
  SynEditHighlighter,
{$ENDIF}
  Classes;

type
  //GBN 31/01/2002
  TOnCheckMarker = procedure (Sender: TObject; var StartPos, MarkerLen: Integer;
    var MarkerText: String; Line: Integer) of object;

  TScheme = class(TCollectionItem)
  private
    fEndExpr: string;
    fStartExpr: string;
    fHighlighter: TSynCustomHighLighter;
    fMarkerAttri: TSynHighlighterAttributes;
    fSchemeName: TComponentName;
    fCaseSensitive: Boolean;
    //GBN 31/01/2002 - Start
    fOnCheckStartMarker: TOnCheckMarker;
    fOnCheckEndMarker: TOnCheckMarker;
    //GBN 31/01/2002 - End
    function ConvertExpression(const Value: string): string;
    procedure MarkerAttriChanged(Sender: TObject);
    procedure SetMarkerAttri(const Value: TSynHighlighterAttributes);
    procedure SetHighlighter(const Value: TSynCustomHighlighter);
    procedure SetEndExpr(const Value: string);
    procedure SetStartExpr(const Value: string);
    procedure SetCaseSensitive(const Value: Boolean);

  protected
{$IFDEF SYN_COMPILER_3_UP}
    function GetDisplayName: String; override;
    procedure SetDisplayName(const Value: String); override;
{$ENDIF}
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property CaseSensitive: Boolean read fCaseSensitive write SetCaseSensitive
      default True;
    property StartExpr: string read fStartExpr write SetStartExpr;
    property EndExpr: string read fEndExpr write SetEndExpr;
    property Highlighter: TSynCustomHighlighter read fHighlighter
      write SetHighlighter;
    property MarkerAttri: TSynHighlighterAttributes read fMarkerAttri
      write SetMarkerAttri;
    property SchemeName: TComponentName read fSchemeName write fSchemeName;
    //GBN 31/01/2002 - Start
    property OnCheckStartMarker: TOnCheckMarker read fOnCheckStartMarker write fOnCheckStartMarker;
    property OnCheckEndMarker: TOnCheckMarker read fOnCheckEndMarker write fOnCheckEndMarker;
    //GBN 31/01/2002 - End
  end;

  TgmSchemeClass = class of TScheme;

  TSynMultiSyn = class;

  TSchemes = class(TCollection)
  private
    fOwner: TSynMultiSyn;
    function GetItems(Index: integer): TScheme;
    procedure SetItems(Index: integer; const Value: TScheme);
{$IFDEF SYN_COMPILER_3_UP}
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
{$ENDIF}
  public
    constructor Create(aOwner: TSynMultiSyn);
    property Items[aIndex: integer]: TScheme read GetItems write SetItems;
      default;
  end;

  TMarker = class
  protected
    fScheme: integer;
    fStartPos: integer;
    fMarkerLen: integer;
    fMarkerText: string;
    fIsOpenMarker: boolean;
  public
    constructor Create(aScheme, aStartPos, aMarkerLen: integer;
      aIsOpenMarker: boolean; const aMarkerText: string);
  end;


  TRangeOperation = (roGet, roSet);

  TRangeProc = procedure (Operation: TRangeOperation; var Range: cardinal) of object;

  TCustomRangeEvent = procedure (Sender: TSynMultiSyn; Operation: TRangeOperation;
    var Range: pointer) of object;

  {
  * Usage notes *
    If you don't need to nest MultiSyns as Schemes, just as DefaultHighlighter,
  you can nest up to 2 MultiSyns, each of them containing up to 7 Schemes. This
  is the way MultiSyn works best. (implemented in NewRangeProc)
    If you need to use a MultiSyn nested as Scheme, then you can nest up to
  5 MultiSyns, but Ranges aren't persisted across occurrences of Schemes that
  have multiple lines. (implemented in OldRangeProc)
    Clarification: when I say "you can nest up to X" MultiSyns, I mean having
  X+1 levels of MultiSyns.

  MultiSyn doesn't work by default with dynamic highlighters; you must use
  OnCustomRange. This is because dynamic highlighters' Ranges are pointers,
  but MultiSyn needs Ranges to be ordinal values smaller than 16 (4 bits).

  OnCustomRange:
    When Operation is roGet, user should store in the 'Range' parameter the
    information to allow restoring the current state of the highlighter.
    When Operation is roSet, user should restore highlighter state (CurrScheme,
    DefaultHighlighter.Range and, if the case, Schemes[CurrScheme].Range)
    according to 'Range' value.
  CurrScheme:
    Index of the scheme that is currently parsing. DefaultHighlighter maps to -1.

  * Implementation notes *
  fTmpLine:
    The (partial) line that the current scheme is parsing. It's necessary
    because SetLine takes a string as parameter, but most highlighters
    use a PChar to point to it, breaking reference count.
    When the editor calls 'Next' so the highlighter returns the next token,
    the string may have gone or may have changed.
  fTmpRange:
    Using the OldRangeProc, fTmpRange was the only way to restore the Range
    of the DefaultHighlighter after a Scheme spanned across multiple lines.
    With the NewRangeProc, the only use for it is restoring DefaultHighLighter's
    Range in case a nested MultiSyn uses the highlighter too.
  }

  TSynMultiSyn = class(TSynCustomHighLighter)
  private
    fRangeProc: TRangeProc;
    fDefaultLanguageName: String;
    fMarkers: TList;
    fMarker: TMarker;
    fNextMarker: integer;
    fCurrScheme: integer;
    fTmpLine: String;
    fTmpRange: pointer;
    fOnCustomRange: TCustomRangeEvent;
    procedure SetDefaultHighlighter(const Value: TSynCustomHighLighter);
    function GetMarkers(aIndex: integer): TMarker;
    property Markers[aIndex: integer]: TMarker read GetMarkers;
    //GBN 31/01/2002 - Start
    procedure DoCheckMarker(Scheme:TScheme; StartPos, MarkerLen: Integer;
      const MarkerText: String; Start: Boolean; Line: Integer);
    //GBN 31/01/2002 - End
    procedure SetOnCustomRange(const Value: TCustomRangeEvent);
  protected
    fSchemes: TSchemes;
    fDefaultHighlighter: TSynCustomHighLighter;
    fLine: string;
    fLineNumber: Integer;
    fTokenPos: integer;
    fRun: Integer;
    fSampleSource: string;
    procedure Loaded; override;
    procedure SetSchemes(const Value: TSchemes);
    procedure ClearMarkers;
    function GetIdentChars: TSynIdentChars; override;
    function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override;
    function GetAttribCount: integer; override;
    function GetAttribute(idx: integer): TSynHighlighterAttributes; override;
    procedure HookHighlighter(aHL: TSynCustomHighlighter);
    procedure UnhookHighlighter(aHL: TSynCustomHighlighter);
    procedure Notification(aComp: TComponent; aOp: TOperation); override;
    function GetSampleSource: string; override;
    procedure SetSampleSource(Value: string); override;
    //
    procedure OldRangeProc(Operation: TRangeOperation; var Range: cardinal);
    procedure NewRangeProc(Operation: TRangeOperation; var Range: cardinal);
    procedure UserRangeProc(Operation: TRangeOperation; var Range: cardinal);
  public
    class function GetLanguageName: string; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetEol: Boolean; override;
    function GetRange: Pointer; override;
    function GetToken: string; override;
    function GetTokenAttribute: TSynHighlighterAttributes; override;
    function GetTokenKind: integer; override;
    function GetTokenPos: Integer; override;
    procedure Next; override;
    procedure SetLine(NewValue: string; LineNumber: Integer); override;
    procedure SetRange(Value: Pointer); override;
    procedure ResetRange; override;
    function UpdateRangeProcs: boolean;
    property CurrScheme: integer read fCurrScheme write fCurrScheme;
    property CurrLine: string read fLine;
{$IFNDEF SYN_CLX}
    function LoadFromRegistry(RootKey: HKEY; Key: string): boolean; override;
    function SaveToRegistry(RootKey: HKEY; Key: string): boolean; override;
{$ENDIF}
  published
    property Schemes: TSchemes read fSchemes write SetSchemes;
    property DefaultHighlighter: TSynCustomHighLighter read fDefaultHighlighter
      write SetDefaultHighlighter;
    property DefaultLanguageName: String read fDefaultLanguageName
      write fDefaultLanguageName;
    property OnCustomRange: TCustomRangeEvent read fOnCustomRange write SetOnCustomRange;
  end;

implementation

uses
{$IFDEF SYN_CLX}
  QGraphics,
  QSynEditMiscProcs,
  QSynRegExpr,
  QSynEditStrConst,
{$ELSE}
  Graphics,
  SynEditMiscProcs,
  SynRegExpr,
  SynEditStrConst,
{$ENDIF}
  SysUtils;

procedure CheckExpression(const aExpr: string);
var
  iParser: TRegExpr;
begin
  iParser := TRegExpr.Create;
  try
    iParser.Expression := aExpr;
    try
      iParser.Compile;
    except
      on E: ERegExpr do
      begin
        if E.ErrorCode < 1000 then
          E.Message := Format( '"%s" is not a valid Regular Expression.'#13'Error (pos %d): %s',
            [ aExpr, E.CompilerErrorPos, Copy( iParser.ErrorMsg(E.ErrorCode), 16, MaxInt) ] );
        raise;
      end;
    end;
  finally
    iParser.Free;
  end;
end;

{ TMarker }

constructor TMarker.Create(aScheme, aStartPos,
  aMarkerLen: integer; aIsOpenMarker: boolean; const aMarkerText: string);
begin
  fScheme := aScheme;
  fStartPos := aStartPos;
  fMarkerLen := aMarkerLen;
  fIsOpenMarker := aIsOpenMarker;
  fMarkerText := aMarkerText;
end;

{ TSynMultiSyn }

procedure TSynMultiSyn.ClearMarkers;
var
  i: integer;
begin
  for i := 0 to fMarkers.Count - 1 do
    TObject(fMarkers[i]).Free;
  fMarkers.Clear;
end;

constructor TSynMultiSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fSchemes := TSchemes.Create(Self);
  fCurrScheme := -1;
  fMarkers := TList.Create;
  fRangeProc := NewRangeProc;
end;

destructor TSynMultiSyn.Destroy;
begin
  ClearMarkers;
  { unhook notification handlers }
  Schemes.Clear;
  DefaultHighlighter := nil;
  inherited Destroy;
  fSchemes.Free;
  fMarkers.Free;
end;

function TSynMultiSyn.GetAttribCount: integer;
var
  cScheme: integer;
begin
  Result := Schemes.Count;
  if DefaultHighlighter <> nil then
    Inc( Result, DefaultHighlighter.AttrCount );
  for cScheme := 0 to Schemes.Count -1 do
    if Schemes[cScheme].Highlighter <> nil then
      Inc( Result, Schemes[cScheme].Highlighter.AttrCount );
end;

function TSynMultiSyn.GetAttribute(
  idx: integer): TSynHighlighterAttributes;