syngenunit.pas

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

    Writeln(OutFile, 'Contributors.txt file.');
    Writeln(OutFile);
    Writeln(OutFile, 'Alternatively, the contents of this file may be used under the terms of the');
    Writeln(OutFile, 'GNU General Public License Version 2 or later (the "GPL"), in which case');
    Writeln(OutFile, 'the provisions of the GPL are applicable instead of those above.');
    Writeln(OutFile, 'If you wish to allow use of your version of this file only under the terms');
    Writeln(OutFile, 'of the GPL and not to allow others to use your version of this file');
    Writeln(OutFile, 'under the MPL, indicate your decision by deleting the provisions above and');
    Writeln(OutFile, 'replace them with the notice and other provisions required by the GPL.');
    Writeln(OutFile, 'If you do not delete the provisions above, a recipient may use your version');
    Writeln(OutFile, 'of this file under either the MPL or the GPL.');
    Writeln(OutFile);
    Writeln(OutFile, '$' + 'Id: ' + '$');
    Writeln(OutFile);
    Writeln(OutFile, 'You may retrieve the latest version of this file at the SynEdit home page,');
    Writeln(OutFile, 'located at http://SynEdit.SourceForge.net');
    Writeln(OutFile);
    Writeln(OutFile, '-------------------------------------------------------------------------------}');
  end
  else
  begin
    Writeln(OutFile, '{+-----------------------------------------------------------------------------+');
    Writeln(OutFile, ' | Class:       ' + LexName);
    Writeln(OutFile, ' | Created:     ' + ISODate);
    Writeln(OutFile, ' | Last change: ' + ISODate);
    Writeln(OutFile, ' | Author:      ' + EditAuthor.Text);
    Writeln(OutFile, ' | Description: ' + EditDescription.Text);
    Writeln(OutFile, ' | Version:     ' + EditVersion.Text);
    Writeln(OutFile, ' |');
    Writeln(OutFile, ' | Copyright (c) ' + Format('%d', [sysTime.wYear]) + #32 +
      EditAuthor.Text + '. All rights reserved.');
    Writeln(OutFile, ' |');
    Writeln(OutFile, ' | Generated with SynGen.');
    Writeln(OutFile, ' +----------------------------------------------------------------------------+}');
  end;
  Writeln(OutFile);
  Writeln(OutFile, 'unit ' + Uname + ';');
  Writeln(OutFile);
  Writeln(OutFile, '{$I SynEdit.inc}');
  Writeln(OutFile);
  Writeln(OutFile, 'interface');
  Writeln(OutFile);
  Writeln(OutFile, 'uses');
  Writeln(OutFile, '{$IFDEF SYN_CLX}');
  Writeln(OutFile, '  QGraphics,');
  Writeln(OutFile, '  QSynEditTypes,');
  Writeln(OutFile, '  QSynEditHighlighter,');
  Writeln(OutFile, '{$ELSE}');
  Writeln(OutFile, '  Graphics,');
  Writeln(OutFile, '  SynEditTypes,');
  Writeln(OutFile, '  SynEditHighlighter,');
  Writeln(OutFile, '{$ENDIF}');
  Writeln(OutFile, '  SysUtils,');
  Writeln(OutFile, '  Classes;');
  Writeln(OutFile);
  Writeln(OutFile, 'type');
  Writeln(OutFile, '  T' + IdentPre + 'TokenKind = (');
end;

procedure TFrmMain.ParseCharsets;
begin
  Lex.Next;
  while Lex.RunId <> IdStop do
  begin
    case Lex.RunId of
      IdCharset: RetrieveCharset;
    else
      Lex.Next;
    end;
  end;
end;

procedure TFrmMain.ParseEnclosedBy;
begin
  Lex.Next;
  while not (Lex.RunId in [IdStop, IdNull]) do
    RetrieveEnclosedBy;
end;

procedure TFrmMain.ParseSampleSource;
begin
  Lex.Next;
  if (Lex.RunId = IdCRLF) then
    Lex.Next;
    
  while not (Lex.RunId in [IdStop, IdNull]) do
    RetrieveSampleSource;
end;

procedure TFrmMain.RetrieveCharset;
var
  aSet: TLexCharsets;
begin
  aSet := TLexCharsets.Create;
  aSet.Charset := Lex.RunToken;
  while Lex.RunId <> IDIdentifier do Lex.Next;
  aSet.SetName := Lex.RunToken;
  while Lex.RunId <> IDBeginProc do Lex.Next;
  Lex.Next;
  while Lex.RunId in [IdCRLF, IdSpace]do Lex.Next;
  while not(Lex.RunId = IdEndProc) do
  begin
    aSet.ProcData:=aSet.ProcData+Lex.RunToken;
    Lex.Next;
  end;
  SetList.Add(aSet);
  Lex.Next;
end;

procedure TFrmMain.RetrieveSampleSource;
var
  sLine: String;
begin
  sLine := '';
  while not (Lex.RunId in [IdCRLF, IdNull, IdStop]) do
  begin
    sLine := sLine + Lex.RunToken;
    Lex.Next;
  end;
  if (Lex.RunId = IdCRLF) then
    Lex.Next;

  SampleSourceList.Add(sLine);
end;


procedure TFrmMain.RetrieveEnclosedBy;
var
  aThing: TLexEnclosedBy;
  sLine: String;
  iPos: Integer;
begin
  while Lex.RunId in [IdCRLF, IdSpace] do Lex.Next;

  sLine := '';
  while not (Lex.RunId in [IdCRLF, IdNull, IdStop]) do
  begin
    sLine := sLine + Lex.RunToken;
    Lex.Next;
  end;

  if (sLine <> '') then
  begin
    aThing := TLexEnclosedBy.Create;

    iPos := Pos(',', sLine);
    aThing.TokenName := Copy(sLine, 1, iPos - 1);
    Delete(sLine, 1, iPos);

    iPos := Pos(',', sLine);
    aThing.ProcName := Copy(sLine, 1, iPos - 1);
    Delete(sLine, 1, iPos);

    iPos := Pos(',', sLine);
    aThing.StartsWith := Copy(sLine, 1, iPos - 1);
    Delete(sLine, 1, iPos);

    iPos := Pos(',', sLine);
    if (iPos > 0) then
    begin
      aThing.EndsWith := Copy(sLine, 1, iPos - 1);
      Delete(sLine, 1, iPos);
      if (Pos('MULTILINE', UpperCase(sLine)) = 1) then
        aThing.MultiLine := True;
    end
    else
      aThing.EndsWith := sLine;

    EnclosedList.Add(aThing);
  end
  else if (Lex.RunId <> IdStop) then
    Lex.Next;
end; { RetrieveEnclosedBy }


function TFrmMain.FilterInvalidChars(const Value: String): String;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(Value) do
  begin
    if IsValidIdent(Result + Value[i]) then
      Result := Result + Value[i];
  end;
end; { FilterInvalidChars }


function TFrmMain.GetFilterName: String;
var
  FilterName: String;
begin
  FilterName := '';
  case CboFilter.ItemIndex of
    -1: FilterName := 'SYNS_Filter' + FilterInvalidChars(CboLangName.Text);
    0 : FilterName := 'SYNS_FilterPascal';
    1 : FilterName := 'SYNS_FilterHP48';
    2 : FilterName := 'SYNS_FilterCAClipper';
    3 : FilterName := 'SYNS_FilterCPP';
    4 : FilterName := 'SYNS_FilterJava';
    5 : FilterName := 'SYNS_FilterPerl';
    6 : FilterName := 'SYNS_FilterAWK';
    7 : FilterName := 'SYNS_FilterHTML';
    8 : FilterName := 'SYNS_FilterVBScript';
    9 : FilterName := 'SYNS_FilterGalaxy';
    10: FilterName := 'SYNS_FilterPython';
    11: FilterName := 'SYNS_FilterSQL';
    12: FilterName := 'SYNS_FilterTclTk';
    13: FilterName := 'SYNS_FilterRTF';
    14: FilterName := 'SYNS_FilterBatch';
    15: FilterName := 'SYNS_FilterDFM';
    16: FilterName := 'SYNS_FilterX86Asm';
    17: FilterName := 'SYNS_FilterGembase';
    18: FilterName := 'SYNS_FilterINI';
    19: FilterName := 'SYNS_FilterML';
    20: FilterName := 'SYNS_FilterVisualBASIC';
    21: FilterName := 'SYNS_FilterADSP21xx';
    22: FilterName := 'SYNS_FilterPHP';
    23: FilterName := 'SYNS_FilterCache';
    24: FilterName := 'SYNS_FilterCSS';
    25: FilterName := 'SYNS_FilterJScript';
    26: FilterName := 'SYNS_FilterKIX';
    27: FilterName := 'SYNS_FilterBaan';
    28: FilterName := 'SYNS_FilterFoxpro';
    29: FilterName := 'SYNS_FilterFortran';
    30: FilterName := 'SYNS_FilterAsm68HC11';
  end;
  Result := FilterName;
end;

function TFrmMain.GetLangName: String;
var
  LangName: String;
begin
  case CboLangName.ItemIndex of
    -1: LangName := 'SYNS_Lang' + FilterInvalidChars(CboLangName.Text);
    0 : LangName := 'SYNS_LangHP48';
    1 : LangName := 'SYNS_LangCAClipper';
    2 : LangName := 'SYNS_LangCPP';
    3 : LangName := 'SYNS_LangJava';
    4 : LangName := 'SYNS_LangPerl';
    5 : LangName := 'SYNS_LangBatch';
    6 : LangName := 'SYNS_LangDfm';
    7 : LangName := 'SYNS_LangAWK';
    8 : LangName := 'SYNS_LangHTML';
    9 : LangName := 'SYNS_LangVBSScript';
    10 : LangName := 'SYNS_LangGalaxy';
    11 : LangName := 'SYNS_LangGeneral';
    12 : LangName := 'SYNS_LangPascal';
    13 : LangName := 'SYNS_LangX86Asm';
    14 : LangName := 'SYNS_LangPython';
    15 : LangName := 'SYNS_LangTclTk';
    16 : LangName := 'SYNS_LangSQL';
    17 : LangName := 'SYNS_LangGembase';
    18 : LangName := 'SYNS_LangINI';
    19 : LangName := 'SYNS_LangML';
    20 : LangName := 'SYNS_LangVisualBASIC';
    21 : LangName := 'SYNS_LangADSP21xx';
    22 : LangName := 'SYNS_LangPHP';
    23 : LangName := 'SYNS_LangSybaseSQL';
    24 : LangName := 'SYNS_LangGeneralMulti';
    25 : LangName := 'SYNS_LangCache';
    26 : LangName := 'SYNS_LangCSS';
    27 : LangName := 'SYNS_LangJScript';
    28 : LangName := 'SYNS_LangKIX';
    29 : LangName := 'SYNS_LangBaan';
    30 : LangName := 'SYNS_LangFoxpro';
    31 : LangName := 'SYNS_LangFortran';
    32 : LangName := 'SYNS_Lang68HC11';
  end;
  Result := LangName;
end;

procedure TFrmMain.WriteRest;
var
  I, J: Integer;
  LineLength: Integer;
  KeyString: String;
  NameString: String;
  AttrName: String;
  AttrTemp: String;
  TempStringList: TStringList;
  sPrefix: String;
  DefAttri: TLexDefaultAttri;
begin
  IdentList.Sort;
  SetList.Sort(CompareSets);
  I := 0;
  while I < IdentList.Count - 1 do
  begin
    Writeln(OutFile, '    ' + IdentList[I] + ',');
    inc(I);
  end;
  Writeln(OutFile, '    ' + IdentList[I] + ');');
  Writeln(OutFile);
  Write(OutFile,   '  TRangeState = (rsUnKnown');
  for I := 0 to (EnclosedList.Count - 1) do
    Write(OutFile, ', rs' + TLexEnclosedBy(EnclosedList[I]).ProcName);
  Writeln(OutFile, ');');
  Writeln(OutFile);
  Writeln(OutFile, '  TProcTableProc = procedure of object;');
  Writeln(OutFile);
  Writeln(OutFile, '  PIdentFuncTableFunc = ^TIdentFuncTableFunc;');
  Writeln(OutFile, '  TIdentFuncTableFunc = function: T' + IdentPre + 'TokenKind of object;');
  Writeln(OutFile);
  KeyString := IntToStr(TLexKeys(KeyList[KeyList.Count - 1]).Key);
  Writeln(OutFile, 'const');
  Writeln(OutFile, '  MaxKey = ' + KeyString + ';');
  Writeln(OutFile);
  Writeln(OutFile, 'type');
  Writeln(OutFile, '  ' + LexName + ' = class(TSynCustomHighlighter)');
  Writeln(OutFile, '  private');
  Writeln(OutFile, '    fLineRef: string;');
  Writeln(OutFile, '    fLine: PChar;');
  Writeln(OutFile, '    fLineNumber: Integer;');
  Writeln(OutFile, '    fProcTable: array[#0..#255] of TProcTableProc;');
  Writeln(OutFile, '    fRange: TRangeState;');
  Writeln(OutFile, '    Run: LongInt;');

  if ListBoxFields.Items.Count > 0 then
    for i := 0 to ListBoxFields.Items.Count - 1 do
      Writeln(OutFile, '    ' + ListBoxFields.Items[i] + ';');

  Writeln(OutFile, '    fStringLen: Integer;');
  Writeln(OutFile, '    fToIdent: PChar;');
  Writeln(OutFile, '    fTokenPos: Integer;');
  Writeln(OutFile, '    fTokenID: TtkTokenKind;');
  Writeln(OutFile, '    fIdentFuncTable: array[0 .. MaxKey] of TIdentFuncTableFunc;');

  I := 0;
  while I < IdentList.Count do
  begin
    if (IdentList[I] <> IdentPre + 'Null') and (IdentList[I] <> IdentPre + 'Unknown') then
      Writeln(OutFile, '    f' + Copy(IdentList[I], Length(IdentPre) + 1, Length(IdentList[I])) + 'Attri: TSynHighlighterAttributes;');
    inc(I);
  end;

  Writeln(OutFile, '    function KeyHash(ToHash: PChar): Integer;');
  Writeln(OutFile, '    function KeyComp(const aKey: string): Boolean;');

  I := 0;
  while I < KeyList.Count do
  begin
    if I = 0 then
      Writeln(OutFile, '    function Func' + IntToStr(TLexKeys(KeyList[I]).Key) + ': T' + IdentPre + 'TokenKind;') else
      if (TLexKeys(KeyList[I - 1]).Key <> TLexKeys(KeyList[I]).Key) then
        Writeln(OutFile, '    function Func' + IntToStr(TLexKeys(KeyList[I]).Key) + ': T' + IdentPre + 'TokenKind;');
    inc(I);
  end;

  I := 0;
  while I < SetList.Count do
  begin
    Writeln(OutFile, '    procedure ' + TLexCharsets(SetList[I]).SetName + 'Proc;');
    inc(I);
  end;

  Writeln(OutFile, '    procedure UnknownProc;');
  Writeln(OutFile, '    function AltFunc: T' + IdentPre + 'TokenKind;');
  Writeln(OutFile, '    procedure InitIdent;');
  Writeln(OutFile, '    function IdentKind(MayBe: PChar): T' + IdentPre + 'TokenKind;');
  Writeln(OutFile, '    procedure MakeMethodTables;');