synunihighlighter.pas

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

{
@abstract(TSynUniSyn main source)
@authors(Fantasist [[e-mail]], Vit [[e-mail]],
         Vitalik [[e-mail]], Quadr0 [[e-mail]])
@created(2003)
@lastmod(2006-07-23)
}

{$IFNDEF QSynUniHighlighter}
unit SynUniHighlighter;
{$ENDIF}

{$I SynUniHighlighter.inc}

interface

uses
{$IFDEF SYN_CLX}
  Qt,
  Types,
  QGraphics,
  QSynEditTypes,
  QSynEditHighlighter,
  QSynUniClasses,
  QSynUniRules,
{$ELSE}
  Windows,
  Graphics,
  Registry,
  {$IFDEF DEBUG}
  Dialogs,
  {$ENDIF}
  SynEditTypes,
  SynEditHighlighter,
  {$IFDEF CODEFOLDING}
  SynEditCodeFolding,
  {$ENDIF}
  SynUniClasses,
  SynUniRules,
{$ENDIF}
  Classes,
  SysUtils;

type
  TSynUniSyn = class(TSynCustomHighlighter)
  private
    fActiveScheme: TSynScheme;
    fFileName: string;
    ImportFormats: TList;
    fMainRules: TSynRange;

    function AttributeExists(AName: string): Boolean;
    function GetAttributeName(AName: string): string;
    procedure AddAllAttributes(ARange: TSynRange); //: for working with fAttributes
    procedure SetScheme(Value: TSynScheme);
    procedure ReadSyntax(Reader: TReader);
    procedure WriteSyntax(Writer: TWriter);
  public
    function GetLanguageNameProp: string; override;
  protected
    CurrRange: TSynRange;
    CurrToken: TSynToken;
    fEol: Boolean;
    fLine: PChar;
    fLineNumber: Integer;
    fPrEol: Boolean;
    fPrepared: Boolean;
    fTokenPos: Integer;
    Run: LongInt;

    procedure DefineProperties(Filer: TFiler); override;
    function GetIdentChars(): TSynIdentChars; override;
    function GetSampleSource(): string; override;
    procedure SetSampleSource(Value: string); override;
    function GetDefaultFilter: string; override;
  public
    EditorProperties: TEditorProperties;
    Info: TSynInfo;
    Schemes: TSynUniSchemes;
    FormatVersion: string;
    {$IFDEF CUSTOMDATA}CustomData: TStringList;{$ENDIF}

    //SchemeFileName: string; //ver1.8
    //SchemeName: string;     //ver1.8
    //fSchemes: TStringList;  //ver1.8
    //fSchemeIndex: Integer;  //ver1.8
    //fImportFormats: TList;  //ver1.8

    constructor Create(AOwner: TComponent); overload; override;
    destructor Destroy(); override;

    function GetAsStream(): TMemoryStream;
    function GetDefaultAttribute(Index: Integer): TSynHighlighterAttributes; override;
    function GetEol(): Boolean; override;
    function GetRange(): Pointer; override; { Returns current Range }
    function GetToken(): string; override; // Current token (string from fTokenPos to Run)
    function GetTokenAttribute(): TSynHighlighterAttributes; override; {Abstract}
    function GetTokenKind(): Integer; override;
    function GetTokenPos(): Integer; override;

    procedure Next(); override;
    procedure ResetRange(); override; { Reset current range to MainRules }
    procedure SetLine(NewValue: string; LineNumber: Integer); override; { Set current line in SynEdit for highlighting }
    procedure SetRange(Value: Pointer); override;

    procedure Reset();
    procedure Clear();
    procedure Prepare();

    procedure LoadFromStream(AStream: TStream);
    function LoadFromFile(AFileName: string) : Boolean;override;
    procedure SaveToStream(AStream: TStream);
    function SaveToFile(AFileName: string): Boolean;override;

    //procedure CreateStandardRules(); 忮痦篁?

    property ActiveScheme: TSynScheme read fActiveScheme write SetScheme;
    property FileName: string read fFileName write fFileName;
    property MainRules: TSynRange read fMainRules;
  end;

implementation

uses
  SynUniFormatNativeXml20,
  SynUniFormatNativeXmlAuto;

//----------------------------------------------------------------------------
{* * * * * * * * * * * * * * * * TSynUniSyn * * * * * * * * * * * * * * * * * *}
//----------------------------------------------------------------------------
constructor TSynUniSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  {$IFDEF PROTECTED_ATTRIBUTES}
  fAttributes.Duplicates := dupIgnore;//dupError;  //: for working with fAttributes
  fAttributes.Sorted := FALSE;//TRUE;              //: for working with fAttributes 
  {$ENDIF}  
  fPrepared := False;

  Info := TSynInfo.Create();
  Schemes := TSynUniSchemes.Create();
  fMainRules := TSynRange.Create();
  fMainRules.Parent := fMainRules;

  fEol := False;
  fPrEol := False;
  CurrRange := MainRules;
  ImportFormats := TList.Create();
  {$IFDEF CUSTOMDATA}CustomData := TStringList.Create();{$ENDIF}

  EditorProperties := TEditorProperties.Create();
  FormatVersion := '';
end;

//----------------------------------------------------------------------------
destructor TSynUniSyn.Destroy();
begin
  {$IFDEF PROTECTED_ATTRIBUTES}
  fAttributes.Clear(); //: for working with fAttributes
  {$ENDIF}
  if Assigned(CurrToken) and CurrToken.Temporary then
    FreeAndNil(CurrToken);
  FreeAndNil(fMainRules);
  FreeAndNil(Info);
  FreeAndNil(Schemes);
  FreeList(ImportFormats);
  {$IFDEF CUSTOMDATA}CustomData.Free();{$ENDIF}
  FreeAndNil(EditorProperties);
  inherited;
end;

//----------------------------------------------------------------------------
function TSynUniSyn.AttributeExists(AName: string): Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to AttrCount - 1 do
  begin
    if Attribute[i].Name = AName then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

//----------------------------------------------------------------------------
function TSynUniSyn.GetAttributeName(AName: string): string;
var
  i: Integer;
  NewName: string;
begin
  Result := AName;
  if AttributeExists(AName) then
  begin
    i := 1;
    while True and (i <= 100) { ?黩? :-) } do
    begin
      Inc(i);
      NewName := AName + ' (' + IntToStr(i) + ')';
      if not AttributeExists(NewName) then
      begin
        Result := NewName;
        break;
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------
procedure TSynUniSyn.AddAllAttributes(ARange: TSynRange);
//: for working with fAttributes
var
  i: Integer;
begin
  {$IFDEF WRITABLE_ATTRIBUTE_NAME}
  ARange.Attributes.Name := GetAttributeName(ARange.Name);
  {$ENDIF}
  //###try AddAttribute(Range.Attributes); except end;
  try AddAttribute(ARange.ValidAttribs); except end;
  for i := 0 to ARange.KeyListCount - 1 do
  begin
    {$IFDEF WRITABLE_ATTRIBUTE_NAME}
    ARange.KeyLists[i].Attributes.Name := GetAttributeName(ARange.KeyLists[i].Name);
    {$ENDIF}
    //###AddAttribute(Range.KeyLists[i].Attributes);
    AddAttribute(ARange.KeyLists[i].ValidAttribs);
  end;
  for i := 0 to ARange.SetCount - 1 do
  begin
    {$IFDEF WRITABLE_ATTRIBUTE_NAME}
    ARange.Sets[i].Attributes.Name := GetAttributeName(ARange.Sets[i].Name);
    {$ENDIF}
    AddAttribute(ARange.Sets[i].Attributes);
  end;
  for i := 0 to ARange.RangeCount - 1 do
    AddAllAttributes(ARange.Ranges[i]);
end;

//----------------------------------------------------------------------------
procedure TSynUniSyn.SetScheme(Value: TSynScheme);

  procedure AssignScheme(ARange: TSynRange);
  var
    i: Integer;
    Item: TSynAttributes;
  begin
    if ARange <> MainRules then
    begin
      Item := Value.GetStyleName(ARange.Style);
      {$IFNDEF SYNEDIT11}
      if Item <> nil then
        ARange.Attributes.AssignColorAndStyle(Item);
      {$ENDIF}
    end;
    for i := 0 to aRange.RangeCount - 1 do
    begin
      Item := Value.GetStyleName(ARange.Ranges[i].Style);
      {$IFNDEF SYNEDIT11}
      if Item <> nil then
        ARange.Ranges[i].Attributes.AssignColorAndStyle(Item);
      {$ENDIF}
      if (ARange.Ranges[i].RangeCount > 0) or (ARange.Ranges[i].KeyListCount > 0)
        or (ARange.Ranges[i].SetCount > 0) then
          AssignScheme(ARange.Ranges[i]);
    end;
    for i := 0 to aRange.KeyListCount - 1 do
    begin
      Item := Value.GetStyleName(ARange.KeyLists[i].Style);
      {$IFNDEF SYNEDIT11}
      if Item <> nil then
        ARange.KeyLists[i].Attributes.AssignColorAndStyle(Item);
      {$ENDIF}
    end;
    for i := 0 to ARange.SetCount - 1 do
    begin
      Item := Value.GetStyleName(ARange.Sets[i].Style);
      {$IFNDEF SYNEDIT11}
      if Item <> nil then
        ARange.Sets[i].Attributes.AssignColorAndStyle(Item);
      {$ENDIF}
    end;
  end;

begin
  fActiveScheme := Value;
  AssignScheme(fMainRules);
end;

//----------------------------------------------------------------------------
procedure TSynUniSyn.SetLine(NewValue: string; LineNumber: Integer);
begin
  if not CurrRange.Prepared then // If current Range isn't ready,
    Prepare(); // then prepare it and its sub-ranges

  fLine := PChar(NewValue);     // Current string of SynEdit
  Run := 0;                     // Set Position of "parser" at the first char of string
  fTokenPos := 0;               // Set Position of current token at the first char of string
  fLineNumber := LineNumber;    // Number of current line in SynEdit
  fEol := False;                // End of Line
  fPrEol := False;              // Previous End of Line
  CurrToken := nil;
  Next();                       // Find first token in the line
end;

//----------------------------------------------------------------------------
procedure TSynUniSyn.Next();
var
  atr: TSynHighlighterAttributes;
begin
  if Assigned(CurrToken) and CurrToken.Temporary then
    FreeAndNil(CurrToken);
  if fPrEol then begin // if it was end of line then
    // if current range close on end of line then
    if (CurrRange.CloseOnEol) or (CurrRange.CloseOnTerm) then begin
      if CurrRange.AllowPreviousClose then begin
        CurrRange := CurrRange.Parent;
        while (CurrRange.CloseOnEol) or (CurrRange.CloseOnTerm) do
          CurrRange := CurrRange.Parent;
      end else
        CurrRange := CurrRange.Parent;
    end;
    {atr := TSynHighlighterAttributes.Create('123');
    atr.Foreground := clRed;
    atr.Background := clYellow;
    CurrToken := TSynToken.Create(atr);
    CurrToken.Temporary := True;}
    fEol := True; // We are at the end of line
    Exit;
  end;

  fTokenPos := Run; // Start of cf current token is end of previsious
  // if current range closes on delimeter and current symbol is delimeter then
  if (CurrRange.CloseOnTerm) and (fLine[Run] in CurrRange.Delimiters) then begin
    if CurrRange.AllowPreviousClose then begin
      CurrRange := CurrRange.Parent;
      while (CurrRange.CloseOnTerm) do
        CurrRange := CurrRange.Parent;
    end
    else
      CurrRange := CurrRange.Parent;
  end;

  if not CurrRange.SymbolList[CurrRange.CaseFunct(fLine[Run])].GetToken(CurrRange, fLine, Run, CurrToken) then
  begin // If we can't find token from current position
    //TODO: 忸珈铈眍 耱铊?玎镨蹴篁?