syngenunit.pas

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

  Writeln(OutFile, '    procedure NullProc;');
  if (IdentList.IndexOf(IdentPre + 'Space') >= 0) then
    Writeln(OutFile, '    procedure SpaceProc;');
  Writeln(OutFile, '    procedure CRProc;');
  Writeln(OutFile, '    procedure LFProc;');
  for I := 0 to (EnclosedList.Count - 1) do
  begin
    Writeln(OutFile, '    procedure ' + TLexEnclosedBy(EnclosedList[I]).ProcName + 'OpenProc;');
    Writeln(OutFile, '    procedure ' + TLexEnclosedBy(EnclosedList[I]).ProcName + 'Proc;');
  end;
  Writeln(OutFile, '  protected');
  Writeln(OutFile, '    function GetIdentChars: TSynIdentChars; override;');
  Writeln(OutFile, '    function GetSampleSource: string; override;');
  Writeln(OutFile, '    function IsFilterStored: Boolean; override;');
  Writeln(OutFile, '  public');
  Writeln(OutFile, '    constructor Create(AOwner: TComponent); override;');
  Writeln(OutFile, '    {$IFNDEF SYN_CPPB_1} class {$ENDIF}');
  Writeln(OutFile, '    function GetLanguageName: string; override;');
  Writeln(OutFile, '    function GetRange: Pointer; override;');
  Writeln(OutFile, '    procedure ResetRange; override;');
  Writeln(OutFile, '    procedure SetRange(Value: Pointer); override;');
  Writeln(OutFile, '    function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override;');
  Writeln(OutFile, '    function GetEol: Boolean; override;');
  if ChkGetKeyWords.Checked then
    Writeln(OutFile, '    function GetKeyWords: string;');
  Writeln(OutFile, '    function GetTokenID: TtkTokenKind;');
  Writeln(OutFile, '    procedure SetLine(NewValue: String; LineNumber: Integer); override;');
  Writeln(OutFile, '    function GetToken: String; override;');
  Writeln(OutFile, '    function GetTokenAttribute: TSynHighlighterAttributes; override;');
  Writeln(OutFile, '    function GetTokenKind: integer; override;');
  Writeln(OutFile, '    function GetTokenPos: Integer; override;');
  Writeln(OutFile, '    procedure Next; override;');
  Writeln(OutFile, '  published');

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

  Writeln(OutFile, '  end;');
  Writeln(OutFile);
  Writeln(OutFile, 'implementation');
  Writeln(OutFile);
  Writeln(OutFile, 'uses');
  Writeln(OutFile, '{$IFDEF SYN_CLX}');
  Writeln(OutFile, '  QSynEditStrConst;');
  Writeln(OutFile, '{$ELSE}');
  Writeln(OutFile, '  SynEditStrConst;');
  Writeln(OutFile, '{$ENDIF}');
  Writeln(OutFile);
  if (CboFilter.ItemIndex = -1) or (CboLangName.ItemIndex = -1) then
  begin
    Writeln(OutFile, '{$IFDEF SYN_COMPILER_3_UP}');
    Writeln(OutFile, 'resourcestring');
    Writeln(OutFile, '{$ELSE}');
    Writeln(OutFile, 'const');
    Writeln(OutFile, '{$ENDIF}');
    if (CboFilter.ItemIndex = -1) then
      Writeln(OutFile, '  SYNS_Filter' + FilterInvalidChars(CboLangName.Text) + ' = ''' + CboFilter.Text + ''';');
    if (CboLangName.ItemIndex = -1) then
      Writeln(OutFile, '  SYNS_Lang' + FilterInvalidChars(CboLangName.Text) + ' = ''' + CboLangName.Text + ''';');

    I := 0;
    while I < IdentList.Count do
    begin
      AttrTemp := Copy(IdentList[I], Length(IdentPre) + 1, Length(IdentList[I]));
      if (CboAttrIdentifier.Items.IndexOf('SYNS_Attr' + AttrTemp) < 0) and (AttrTemp <> 'Unknown') then
        Writeln(OutFile, '  SYNS_Attr' + FilterInvalidChars(AttrTemp) + ' = ''' + AttrTemp + ''';');
      Inc(i);
    end;
    Writeln(OutFile);
  end;
  Writeln(OutFile, 'var');
  Writeln(OutFile, '  Identifiers: array[#0..#255] of ByteBool;');
  Writeln(OutFile, '  mHashTable : array[#0..#255] of Integer;'#13#10);
  if Sensitivity then
  begin
    Writeln(OutFile, 'procedure MakeIdentTable;');
    Writeln(OutFile, 'var');
    Writeln(OutFile, '  I: Char;');
    Writeln(OutFile, 'begin');
    Writeln(OutFile, '  for I := #0 to #255 do');
    Writeln(OutFile, '  begin');
    Writeln(OutFile, '    case I of');
    Writeln(OutFile, '      ' + IdentContent + ': Identifiers[I] := True;');
    Writeln(OutFile, '    else');
    Writeln(OutFile, '      Identifiers[I] := False;');
    Writeln(OutFile, '    end;');
    Writeln(OutFile, '    case I in [''_'', ''A''..''Z'', ''a''..''z''] of');
    Writeln(OutFile, '      True:');
    Writeln(OutFile, '        begin');
    Writeln(OutFile, '          if (I > #64) and (I < #91) then');
    Writeln(OutFile, '            mHashTable[I] := Ord(I) - 64');
    Writeln(OutFile, '          else if (I > #96) then');
    Writeln(OutFile, '            mHashTable[I] := Ord(I) - 95;');
    Writeln(OutFile, '        end;');
    Writeln(OutFile, '    else');
    Writeln(OutFile, '      mHashTable[I] := 0;');
    Writeln(OutFile, '    end;');
    Writeln(OutFile, '  end;');
    Writeln(OutFile, 'end;');
    Writeln(OutFile);
  end
  else
  begin
    Writeln(OutFile, 'procedure MakeIdentTable;');
    Writeln(OutFile, 'var');
    Writeln(OutFile, '  I, J: Char;');
    Writeln(OutFile, 'begin');
    Writeln(OutFile, '  for I := #0 to #255 do');
    Writeln(OutFile, '  begin');
    Writeln(OutFile, '    case I of');
    Writeln(OutFile, '      ' + IdentContent + ': Identifiers[I] := True;');
    Writeln(OutFile, '    else');
    Writeln(OutFile, '      Identifiers[I] := False;');
    Writeln(OutFile, '    end;');
    Writeln(OutFile, '    J := UpCase(I);');
    Writeln(OutFile, '    case I in [''_'', ''A''..''Z'', ''a''..''z''] of');
    Writeln(OutFile, '      True: mHashTable[I] := Ord(J) - 64');
    Writeln(OutFile, '    else');
    Writeln(OutFile, '      mHashTable[I] := 0;');
    Writeln(OutFile, '    end;');
    Writeln(OutFile, '  end;');
    Writeln(OutFile, 'end;');
    Writeln(OutFile);
  end;

  Writeln(OutFile, 'procedure ' + LexName + '.InitIdent;');
  Writeln(OutFile, 'var');
  Writeln(OutFile, '  I: Integer;');
  Writeln(OutFile, '  pF: PIdentFuncTableFunc;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  pF := PIdentFuncTableFunc(@fIdentFuncTable);');
  Writeln(OutFile, '  for I := Low(fIdentFuncTable) to High(fIdentFuncTable) do');
  Writeln(OutFile, '  begin');
  Writeln(OutFile, '    pF^ := AltFunc;');
  Writeln(OutFile, '    Inc(pF);');
  Writeln(OutFile, '  end;');

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

  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  Writeln(OutFile, 'function ' + LexName + '.KeyHash(ToHash: PChar): Integer;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := 0;');
  Writeln(OutFile, '  while ToHash^ in [' + IdentContent + '] do');
  Writeln(OutFile, '  begin');
  Writeln(OutFile, '    inc(Result, mHashTable[ToHash^]);');
  Writeln(OutFile, '    inc(ToHash);');
  Writeln(OutFile, '  end;');
  Writeln(OutFile, '  fStringLen := ToHash - fToIdent;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  if Sensitivity then
  begin
    Writeln(OutFile, 'function ' + LexName + '.KeyComp(const aKey: String): Boolean;');
    Writeln(OutFile, 'var');
    Writeln(OutFile, '  I: Integer;');
    Writeln(OutFile, '  Temp: PChar;');
    Writeln(OutFile, 'begin');
    Writeln(OutFile, '  Temp := fToIdent;');
    Writeln(OutFile, '  if Length(aKey) = fStringLen then');
    Writeln(OutFile, '  begin');
    Writeln(OutFile, '    Result := True;');
    Writeln(OutFile, '    for i := 1 to fStringLen do');
    Writeln(OutFile, '    begin');
    Writeln(OutFile, '      if Temp^ <> aKey[i] then');
    Writeln(OutFile, '      begin');
    Writeln(OutFile, '        Result := False;');
    Writeln(OutFile, '        break;');
    Writeln(OutFile, '      end;');
    Writeln(OutFile, '      inc(Temp);');
    Writeln(OutFile, '    end;');
    Writeln(OutFile, '  end else Result := False;');
    Writeln(OutFile, 'end;');
    Writeln(OutFile);
  end else
  begin
    Writeln(OutFile, 'function ' + LexName + '.KeyComp(const aKey: String): Boolean;');
    Writeln(OutFile, 'var');
    Writeln(OutFile, '  I: Integer;');
    Writeln(OutFile, '  Temp: PChar;');
    Writeln(OutFile, 'begin');
    Writeln(OutFile, '  Temp := fToIdent;');
    Writeln(OutFile, '  if Length(aKey) = fStringLen then');
    Writeln(OutFile, '  begin');
    Writeln(OutFile, '    Result := True;');
    Writeln(OutFile, '    for i := 1 to fStringLen do');
    Writeln(OutFile, '    begin');
    Writeln(OutFile, '      if mHashTable[Temp^] <> mHashTable[aKey[i]] then');
    Writeln(OutFile, '      begin');
    Writeln(OutFile, '        Result := False;');
    Writeln(OutFile, '        break;');
    Writeln(OutFile, '      end;');
    Writeln(OutFile, '      inc(Temp);');
    Writeln(OutFile, '    end;');
    Writeln(OutFile, '  end');
    Writeln(OutFile, '  else');
    Writeln(OutFile, '    Result := False;');
    Writeln(OutFile, 'end;');
    Writeln(OutFile);
  end;

  I := 0;
  while I < KeyList.Count do
  begin
    KeyString := IntToStr(TLexKeys(KeyList[I]).Key);
    Writeln(OutFile, 'function ' + LexName + '.Func' + KeyString + ': T' + IdentPre + 'TokenKind;');
    Writeln(OutFile, 'begin');
    KeyString := '';
    if I < KeyList.Count - 1 then
      while TLexKeys(KeyList[I]).Key = TLexKeys(KeyList[I + 1]).Key do
      begin
        NameString := TLexKeys(KeyList[I]).KeyName;
        Writeln(OutFile, KeyString + '  if KeyComp(' + #39 + NameString + #39 + ') then Result := ' + IdentPre +  TLexKeys(KeyList[I]).TokenType + ' else');
        inc(I);
        KeyString := KeyString + '  ';
        if I >= KeyList.Count - 1 then break;
      end;
    NameString := TLexKeys(KeyList[I]).KeyName;
    Writeln(OutFile, KeyString + '  if KeyComp(' + #39 + NameString + #39 + ') then Result := ' + IdentPre + TLexKeys(KeyList[I]).TokenType + ' else Result := ' + IdentPre + 'Identifier;');
    Writeln(OutFile, 'end;');
    Writeln(OutFile);
    inc(I);
  end;

  Writeln(OutFile, 'function ' + LexName + '.AltFunc: T' + IdentPre + 'TokenKind;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := ' + IdentPre + 'Identifier;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  KeyString := IntToStr(TLexKeys(KeyList[KeyList.Count - 1]).Key + 1);

  Writeln(OutFile, 'function ' + LexName + '.IdentKind(MayBe: PChar): T' + IdentPre + 'TokenKind;');
  Writeln(OutFile, 'var');
  Writeln(OutFile, '  HashKey: Integer;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  fToIdent := MayBe;');
  Writeln(OutFile, '  HashKey := KeyHash(MayBe);');
  Writeln(OutFile, '  if HashKey <= MaxKey then');
  Writeln(OutFile, '    Result := fIdentFuncTable[HashKey]');
  Writeln(OutFile, '  else');
  Writeln(OutFile, '    Result := ' + IdentPre + 'Identifier;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  Writeln(OutFile, 'procedure ' + LexName + '.MakeMethodTables;');
  Writeln(OutFile, 'var');
  Writeln(OutFile, '  I: Char;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  for I := #0 to #255 do');
  Writeln(OutFile, '    case I of');
  Writeln(OutFile, '      #0: fProcTable[I] := NullProc;');
  Writeln(OutFile, '      #10: fProcTable[I] := LFProc;');
  Writeln(OutFile, '      #13: fProcTable[I] := CRProc;');

  for I := 0 to (EnclosedList.Count - 1) do
  begin
    if (TLexEnclosedBy(EnclosedList[I]).StartsWith <> '') then
    begin
      Writeln(OutFile, '      ''' +
        StuffString(TLexEnclosedBy(EnclosedList[I]).StartsWith[1]) + ''': fProcTable[I] := ' +
        TLexEnclosedBy(EnclosedList[I]).ProcName + 'OpenProc;');
    end;
  end;
  if (IdentList.IndexOf(IdentPre + 'Space') >= 0) then
  begin
    Writeln(OutFile, '      #1..#9,');
    Writeln(OutFile, '      #11,');
    Writeln(OutFile, '      #12,');
    Writeln(OutFile, '      #14..#32 : fProcTable[I] := SpaceProc;');
  end;
  I := 0;
  while I < SetList.Count do
  begin
    Writeln(OutFile, '      ' + TLexCharsets(SetList[I]).Charset + ': fProcTable[I] := '+
      TLexCharsets(SetList[I]).SetName + 'Proc;');
    Inc(I);
  end;
  Writeln(OutFile, '    else');
  Writeln(OutFile, '      fProcTable[I] := UnknownProc;');
  Writeln(OutFile, '    end;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  if (IdentList.IndexOf(IdentPre + 'Space') >= 0) then
  begin
    Writeln(OutFile, 'procedure ' + LexName + '.SpaceProc;');
    Writeln(OutFile, 'begin');
    Writeln(OutFile, '  fTokenID := ' + IdentPre + 'Space;');
    Writeln(OutFile, '  repeat');
    Writeln(OutFile, '    inc(Run);');
    Writeln(OutFile, '  until not (fLine[Run] in [#1..#32]);');
    Writeln(OutFile, 'end;');
    Writeln(OutFile);
  end;

  Writeln(OutFile, 'procedure ' + LexName + '.NullProc;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  fTokenID := ' + IdentPre + 'Null;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  Writeln(OutFile, 'procedure ' + LexName + '.CRProc;');
  Writeln(OutFile, 'begin');
  if (IdentList.IndexOf(IdentPre + 'Space') >= 0) then
    Writeln(OutFile, '  fTokenID := ' + IdentPre + 'Space;')
  else
    Writeln(OutFile, '  fTokenID := ' + IdentPre + 'Unknown;');
  Writeln(OutFile, '  inc(Run);');
  Writeln(OutFile, '  if fLine[Run] = #10 then');
  Writeln(OutFile, '    inc(Run);');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);
  
  Writeln(OutFile, 'procedure ' + LexName + '.LFProc;');
  Writeln(OutFile, 'begin');
  if (IdentList.IndexOf(IdentPre + 'Space') >= 0) then
    Writeln(OutFile, '  fTokenID := ' + IdentPre + 'Space;')
  else
    Writeln(OutFile, '  fTokenID := ' + IdentPre + 'Unknown;');
  Writeln(OutFile, '  inc(Run);');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  for I := 0 to (EnclosedList.Count - 1) do
  begin
    Writeln(OutFile, 'procedure ' + LexName + '.' + TLexEnclosedBy(EnclosedList[I]).ProcName + 'OpenProc;');
    Writeln(OutFile, 'begin');
    Writeln(OutFile, '  Inc(Run);');
    if (Length(TLexEnclosedBy(EnclosedList[I]).StartsWith) > 1) then
    begin
      Write(OutFile, '  if ');
      for J := 2 to Length(TLexEnclosedBy(EnclosedList[I]).StartsWith) do
      begin
        if (J > 2) then
        begin
          Writeln(OutFile, ' and');
          Write(OutFile, '     ');
        end;
        Write(OutFile, '(fLine[Run' + AddInt(J - 2) + '] = ''' + StuffString(TLexEnclosedBy(EnclosedList[I]).StartsWith[J]) + ''')');