syngenu.pas

来自「本人买的<<VC++项目开发实例>>源代码配套光盘.」· PAS 代码 · 共 1,035 行 · 第 1/3 页

{+--------------------------------------------------------------------------+
 | Unit:        SynGenU
 | Created:     12.98
 | Author:      Martin Waldenburg
 | Description: Generator for skeletons of HighLighters to use in mwEdit, drived by a simple grammar.
 | Version:     0.75 Beta
 | Copyright (c) 1998 Martin Waldenburg
 | All rights reserved.
 |
 | Version history:
 |   up to 0.7: source maintained by the autor, version history unknown
 |   0.71:
 |     - Stefan van As
 |       - Fixed bug with uses clause.
 |       - Modified/completed the following procedures: MakeIdentTable,
 |         Create, Destroy, SetLine, UnknownProc, Next, GetEol, GetTokenID,
 |         SetHighLightChange, GetIdentChars, GetAttribCount, GetAttribute,
 |         GetLanguageName, GetCapability, ExportNext.
 |       - Added the following procedures: Register, AssignAttributes.
 |   0.72:
 |     - Michael Hieke
 |       - Improved speed of scanning by declaring the KeyComp parameter as
 |         const. This removes the reference counting for this string parameter.
 |       - Removed OnToken event from the Next function.
 |       - Improved speed of the InitIdent procedure.
 |   0.73:
 |     - Stefan van As
 |       - Added AddAttribute for every attribute member to constructor. This
 |         inserts attribute objects to the mwHighLighter list that holds
 |         pointers to attributes.
 |       - Removed GetAttribCount and GetAttribute (these methods are obsolete
 |         now mwHighLighter enumerates the attributes).
 |       - Removed the attribute destructors and the overriden destructor (is
 |         obsolete now mwHighLighter frees the attributes).
 |       - Deleted the overriden attribute enumeration methods GetAttribCount
 |         and GetAttribute.
 |       - Removed HighLightChange and SetHighLightChange (these methods are
 |         obsolete now mwHighLighter uses DefHighLightChange
 |         and SetAttributesOnChange). Added call
 |         SetAttributesOnChange(DefHighLightChange) to constructor instead.
 |       - Added GetTokenKind method. Needed for mwHighLighter
 |         ScanAllLineTokens method.
 |       - Constructor uses string constants for attribute names as defined
 |         in mwLocalStr.
 |       - Removed obsolete fEOL field and simplified GetEOL method.
 |       - Removed everything related to the fCanvas member (fCanvas, SetCanvas)
 |       - Removed AssignAttributes and attributes assignment from Next method
 |       - Added GetTokenAttribute method (returns the token attribute for the
 |         current token).
 |   0.74:
 |     - Stefan van As
 |       - Uses attribute names, default filters and language names from
 |         mwLocalStr.pas
 |       - Added variable attribute name assignment for Identifier and
 |         Reserved word attributes.
 |       - Added variable attribute assignment for Unknown token.
 |     - Michael Hieke
 |       - Moved Identifiers and mHashTable variables into implemetation section
 |   0.75:
 |     - Michael Hieke
 |       - Added mwEdit.inc file to highlighter source.
 |       - Added PIdentFuncTableFunc type.
 |       - Minor changes to indentation and formatting of created source file.
 |       - Removed fRoundCount field of created highlighter.
 |       - Changed default palette name of created highlighter.
 |
 | LICENCE CONDITIONS
 |
 | USE OF THE ENCLOSED SOFTWARE
 | INDICATES YOUR ASSENT TO THE
 | FOLLOWING LICENCE CONDITIONS.
 |
 | These Licence Conditions are exlusively
 | governed by the Law and Rules of the
 | Federal Republic of Germany.
 |
 | Redistribution and use in source and binary form, with or without
 | modification, are permitted provided that the following conditions
 | are met:
 |
 | 1. Redistributions of source code must retain the above copyright
 |    notice, this list of conditions and the following disclaimer.
 |    If the source is modified, the complete original and unmodified
 |    source code has to distributed with the modified version.
 |
 | 2. Redistributions in binary form must reproduce the above
 |    copyright notice, these licence conditions and the disclaimer
 |    found at the end of this licence agreement in the documentation
 |    and/or other materials provided with the distribution.
 |
 | 3. Software using this code must contain a visible line of credit.
 |
 | 4. If my code is used in a "for profit" product, you have to donate
 |    to a registered charity in an amount that you feel is fair.
 |    You may use it in as many of your products as you like.
 |    Proof of this donation must be provided to the author of
 |    this software.
 |
 | 5. If you for some reasons don't want to give public credit to the
 |    author, you have to donate three times the price of your software
 |    product, or any other product including this component in any way,
 |    but no more than $500 US and not less than $200 US, or the
 |    equivalent thereof in other currency, to a registered charity.
 |    You have to do this for every of your products, which uses this
 |    code separately.
 |    Proof of this donations must be provided to the author of
 |    this software.
 |
 | 6. If you write your own grammars, then the results createt by mwSynGen
 |    are entirely yours.
 |    You don't need to make any donations however credit would be
 |    appreciated.
 |
 | DISCLAIMER:
 |
 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS'.
 |
 | ALL EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
 | PARTICULAR PURPOSE ARE DISCLAIMED.
 |
 | IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 | THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 |
 |  [e-mail]
+--------------------------------------------------------------------------+}
unit SynGenU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, mGenLex;

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

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

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

  TGenFrm = class(TForm)
    BtnStart: TButton;
    OpenDialog: TOpenDialog;
    LblFilter: TLabel;
    LblLangName: TLabel;
    CboLangName: TComboBox;
    CboFilter: TComboBox;
    GrpAttrNames: TGroupBox;
    LblIdentifier: TLabel;
    CboAttrIdentifier: TComboBox;
    CboAttrReservedWord: TComboBox;
    LblReservedWord: TLabel;
    LblUnknownTokenAttr: TLabel;
    CboUnknownTokenAttr: TComboBox;
    procedure BtnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CboLangNameChange(Sender: TObject);
  private
    LexName: String;
    IdentPre: String;
    IdentStart: String;
    IdentContent: String;
    OutFile: TextFile;
    Sensitivity: Boolean;
    Stream: TMemoryStream;
    Lex: TmwGenLex;
    KeyList: TList;
    SetList: TList;
    IdentList: TStringList;
    procedure MakeHashTable;
    procedure MakeSensitiveHashTable;
    procedure FillKeyList;
    procedure OutFileCreate(InName: String);
    procedure ParseCharsets;
    procedure RetriveCharset;
    function KeyHash(ToHash: String): Integer;
    function SensKeyHash(ToHash: String): Integer;
    procedure WriteRest;
  public
  end;

var
  GenFrm: TGenFrm;

implementation

{$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 := 0 else        //mh 1999-12-03
      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 := 0 else //mh 1999-12-03
      if TLexCharsets(Item1).SetName > TLexCharsets(Item2).SetName then Result := 1;
end;

procedure TGenFrm.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 TGenFrm.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 TGenFrm.SensKeyHash(ToHash: String): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(ToHash) do
    inc(Result, mSKeyHashTable[ToHash[I]]);
end;

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

procedure TGenFrm.FormCreate(Sender: TObject);
var i: Integer;
begin
  CboLangNameChange(Self);
  for i := GenFrm.ComponentCount - 1 downto 0 do
    if GenFrm.Components[i] is TComboBox then
      if TComboBox(GenFrm.Components[i]).Parent = GrpAttrNames then
      begin
        TComboBox(GenFrm.Components[i]).Items.Clear;
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrAssembler');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrAsm');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrComment');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrIdentifier');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrKey');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrNumber');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrOperator');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrPreprocessor');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrReservedWord');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrSpace');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrSymbol');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrString');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrText');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrAsmComment');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrAsmKey');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrASP');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrDocumentation');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrEscapeAmpersand');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrIllegalChar');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrInvalidSymbol');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrInternalFunction');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrMessage');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrNull');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrPragma');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrRpl');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrRplKey');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrRplComment');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrSecondReservedWord');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrSystemValue');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrUnknownWord');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrValue');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrVariable');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrIcon');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrBrackets');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrMiscellaneous');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrSystem');
        TComboBox(GenFrm.Components[i]).Items.Add('MWS_AttrUser');
      end;
  CboAttrIdentifier.ItemIndex := CboAttrIdentifier.Items.IndexOf('MWS_AttrIdentifier');
  CboAttrReservedWord.ItemIndex := CboAttrReservedWord.Items.IndexOf('MWS_AttrReservedWord');
  CboUnknownTokenAttr.ItemIndex := 0;
  Stream := TMemoryStream.Create;
  Lex := TmwGenLex.Create;
  KeyList := TList.Create;
  SetList := TList.Create;
  IdentList := TStringList.Create;
  MakeHashTable;
  MakeSensitiveHashTable;
end;

procedure TGenFrm.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  Lex.Free;
  Stream.Free;
  IdentList.Free;
  for I := 0 to KeyList.Count - 1 do TObject(KeyList[I]).Free;
  KeyList.Free;
  for I := 0 to SetList.Count - 1 do TObject(SetList[I]).Free;
  SetList.Free;
end;