syngenunit.pas

来自「一个mwEdit控件原码,比mwCuuEdit0.92a功能先进.」· PAS 代码 · 共 1,810 行 · 第 1/5 页

{-------------------------------------------------------------------------------
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: SynGenUnit.pas, released 2000-04-19.
Description: Generator for skeletons of HighLighters to use in SynEdit,
drived by a simple grammar.

The Original Code is based on SynGenU.pas by Martin Waldenburg, part of
the mwEdit component suite.
Portions created by Martin Waldenburg are Copyright (C) 1998 Martin Waldenburg.
All Rights Reserved.
Portions created by Pieter Polak are Copyright (C) 2001 Pieter Polak.
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: SynGenUnit.pas,v 1.18 2003/04/30 13:09:15 etrusco Exp $

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

Todo:
  - Remember the last opened MSG file
  - Double-click a MSG file opens SynGen
  - SynGen should not halt when TOpenFileDialog is cancelled
  - Add user-defined default attributes to TSynXXXSyn.Create
  - SynEdit to edit the MSG file (using the highlighter for MSG files)
  - Store language names list and attribute names list in INI file
  - SynEdit with Pascal highlighter to preview the created highlighter source
  - Allow to define different type of keywords in MSG file

Known Issues:
-------------------------------------------------------------------------------}

unit SynGenUnit;

{$I SynEdit.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, GenLex, ComCtrls, Menus;

var
  mKeyHashTable: array[#0..#255] of Integer;
  mSKeyHashTable: array[#0..#255] of Integer;

type
  TLexKeys = Class
  public
    KeyName: String;
    Key: Integer;
    TokenType: String;
  end;

  TLexCharsets = Class
  public
    SetName: String;
    Charset: String;
    ProcData: String;
    FuncData: String;
  end;

  TLexEnclosedBy = class
  public
    TokenName: String;
    ProcName: String;
    StartsWith: String;
    EndsWith: String;
    MultiLine: Boolean;
    constructor Create;
  end;

  TLexDefaultAttri = class
  public
    Style: String;
    Foreground: String;
    Background: String;
    constructor Create;
  end;

  TFrmMain = class(TForm)
    BtnStart: TButton;
    OpenDialog: TOpenDialog;
    PageControl: TPageControl;
    TabLanguage: TTabSheet;
    LblFilter: TLabel;
    CboFilter: TComboBox;
    LblLangName: TLabel;
    CboLangName: TComboBox;
    TabAttributes: TTabSheet;
    GrpAttrNames: TGroupBox;
    LblIdentifier: TLabel;
    LblReservedWord: TLabel;
    CboAttrIdentifier: TComboBox;
    CboAttrReservedWord: TComboBox;
    LblUnknownTokenAttr: TLabel;
    CboUnknownTokenAttr: TComboBox;
    TabFields: TTabSheet;
    BtnAdd: TButton;
    BtnDelete: TButton;
    EditAddField: TEdit;
    ListBoxFields: TListBox;
    MainMenu: TMainMenu;
    MnuFile: TMenuItem;
    MnuOpen: TMenuItem;
    MnuExit: TMenuItem;
    TabHighlighter: TTabSheet;
    LblAuthor: TLabel;
    LblDescription: TLabel;
    LblVersion: TLabel;
    EditAuthor: TEdit;
    EditDescription: TEdit;
    EditVersion: TEdit;
    MnuStart: TMenuItem;
    ChkGetKeyWords: TCheckBox;
    ChkGPLHeader: TCheckBox;
    Hash1: TMenuItem;
    procedure BtnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CboLangNameChange(Sender: TObject);
    procedure ListBoxFieldsClick(Sender: TObject);
    procedure BtnAddClick(Sender: TObject);
    procedure BtnDeleteClick(Sender: TObject);
    procedure EditAddFieldChange(Sender: TObject);
    procedure EditAddFieldKeyPress(Sender: TObject; var Key: Char);
    procedure MnuExitClick(Sender: TObject);
    procedure MnuOpenClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Hash1Click(Sender: TObject);
  private
    LexName: String;
    IdentPre: String;
    IdentStart: String;
    IdentContent: String;
    FFileName: string;
    IniFile: string;
    OutFile: TextFile;
    Sensitivity: Boolean;
    Stream: TMemoryStream;
    Lex: TGenLex;
    KeyList: TList;
    SetList: TList;
    EnclosedList: TList;
    SampleSourceList: TStringList;
    IdentList: TStringList;
    procedure ClearAll;
    function GetFilterName: String;
    function GetLangName: String;
    function FilterInvalidChars(const Value: String): String;
    procedure MakeHashTable;
    procedure MakeSensitiveHashTable;
    procedure FillKeyList;
    procedure FillTokenTypeList;
    procedure OutFileCreate(InName: String);
    procedure ParseCharsets;
    procedure ParseEnclosedBy;
    procedure ParseSampleSource;
    procedure RetrieveCharset;
    procedure RetrieveEnclosedBy;
    procedure RetrieveSampleSource;
    procedure WriteSettings;
    function PerformFileOpen: Boolean;
    function KeyHash(ToHash: String): Integer;
    function SensKeyHash(ToHash: String): Integer;
    procedure WriteRest;
  public
  end;

var
  FrmMain: TFrmMain;

implementation

uses
  Registry;

{$R *.DFM}

function CompareKeys(Item1, Item2: Pointer): Integer;
begin
  Result := 0;
  if TLexKeys(Item1).Key < TLexKeys(Item2).Key then
    Result := -1
  else if TLexKeys(Item1).Key > TLexKeys(Item2).Key then
    Result := 1;
end;

function CompareSets(Item1, Item2: Pointer): Integer;
begin
  Result := 0;
  if TLexCharsets(Item1).SetName < TLexCharsets(Item2).SetName then
    Result := -1
  else
    if TLexCharsets(Item1).SetName > TLexCharsets(Item2).SetName then Result := 1;
end;

function AddInt(const aValue: Integer): String;
begin
  if (aValue < 0) then
    Result := ' - ' + IntToStr(Abs(aValue))
  else if (aValue > 0) then
    Result := ' + ' + IntToStr(aValue)
  else
    Result := '';
end;

function StuffString(const Value: String): String;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(Value) do
  begin
    if (Value[i] = '''') then
      Result := Result + ''''''
    else
      Result := Result + Value[i];
  end;
end;

constructor TLexEnclosedBy.Create;
begin
  inherited Create;
  TokenName := '';
  ProcName := '';
  StartsWith := '';
  EndsWith := '';
  MultiLine := False;
end;

constructor TLexDefaultAttri.Create;
begin
  inherited Create;
  Style := '';
  Foreground := '';
  Background := '';
end;

procedure TFrmMain.MakeSensitiveHashTable;
var
  I: Char;
begin
  for I := #0 to #255 do
  begin
    case I in ['_', 'A'..'Z', 'a'..'z'] of
      True:
        begin
          if (I > #64) and (I < #91) then mSKeyHashTable[I] := Ord(I) - 64 else
            if (I > #96) then mSKeyHashTable[I] := Ord(I) - 95;
        end;
    else mSKeyHashTable[I] := 0;
    end;
  end;
end;

procedure TFrmMain.MakeHashTable;
var
  I, J: Char;
begin
  for I := #0 to #255 do
  begin
    J := UpperCase(I)[1];
    Case I in ['_', 'A'..'Z', 'a'..'z'] of
      True: mKeyHashTable[I] := Ord(J) - 64;
    else
      mKeyHashTable[I] := 0;
    end;
  end;
end;

function TFrmMain.SensKeyHash(ToHash: String): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(ToHash) do
    inc(Result, mSKeyHashTable[ToHash[I]]);
end;

function TFrmMain.KeyHash(ToHash: String): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(ToHash) do
    inc(Result, mKeyHashTable[ToHash[I]]);
end;

procedure TFrmMain.WriteSettings;
begin
  with TRegIniFile.Create(IniFile) do
  try
    WriteString('General', 'OpenDir', OpenDialog.InitialDir);
    WriteBool(FFileName, 'GetKeyWords', ChkGetKeyWords.Checked);
    WriteBool(FFileName, 'ChkGPLHeader', ChkGPLHeader.Checked);
    WriteString(FFileName, 'Author', EditAuthor.Text);
    WriteString(FFileName, 'Description', EditDescription.Text);
    WriteString(FFileName, 'Version', EditVersion.Text);
    WriteString(FFileName, 'Filter', CboFilter.Text);
    WriteString(FFileName, 'Language', CboLangName.Text);
    WriteString(FFileName, 'AttrIdentifier', CboAttrIdentifier.Text);
    WriteString(FFileName, 'AttrReservedWord', CboAttrReservedWord.Text);
    WriteString(FFileName, 'UnknownTokenAttr', CboUnknownTokenAttr.Text);
    WriteString(FFileName, 'Fields', ListBoxFields.Items.CommaText);
  finally
    Free;
  end;
end;

function TFrmMain.PerformFileOpen: Boolean;
var
  UserName: PChar;
{$IFDEF SYN_COMPILER_5_UP}
  Count: Cardinal;
{$ELSE}
  Count: Integer;
{$ENDIF}
begin
  if OpenDialog.Execute then
  begin
    Count := 0;
    Result := True;
    FFileName := ExtractFileName(OpenDialog.FileName);
    Caption := 'SynEdit Highlighter Generator - ' + FFileName;
    OpenDialog.InitialDir := ExtractFilePath(OpenDialog.FileName);
    GetUserName(nil, Count); // retrieve the required size of the user name buffer
    UserName := StrAlloc(Count); // allocate memory for the user name
    GetUserName(UserName, Count); // retrieve the user name
    with TRegIniFile.Create(IniFile) do
    try
      EditAuthor.Text := ReadString(FFileName, 'Author', StrPas(UserName));
      EditDescription.Text := ReadString(FFileName, 'Description', 'Syntax Parser/Highlighter');
      EditVersion.Text := ReadString(FFileName, 'Version', '0.1');
      CboFilter.Text := ReadString(FFileName, 'Filter', 'All files (*.*)|*.*');
      CboLangName.Text := ReadString(FFileName, 'Language', '');
      ChkGetKeyWords.Checked := ReadBool(FFileName, 'GetKeyWords', True);
      ChkGPLHeader.Checked := ReadBool(FFileName, 'ChkGPLHeader', True);
      CboAttrIdentifier.ItemIndex := CboAttrIdentifier.Items.IndexOf
        (ReadString(FFileName, 'AttrIdentifier', 'SYNS_AttrIdentifier'));
      CboAttrReservedWord.ItemIndex := CboAttrReservedWord.Items.IndexOf
        (ReadString(FFileName, 'AttrReservedWord', 'SYNS_AttrReservedWord'));