syngenu.pas

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

    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 else 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 + 'Key' + ' 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 + 'Key' + ' 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 < ' + KeyString + ' then Result := fIdentFuncTable[HashKey] else 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');

  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 fProcTable[I] := UnknownProc;');
  Writeln(OutFile, '    end;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'constructor ' + LexName + '.Create(AOwner: TComponent);');
  Writeln(OutFile, 'begin');

  I := 0;
  while I < IdentList.Count do
  begin
    if Copy(IdentList[I], Length(IdentPre) + 1, Length(IdentList[I])) = 'Key' then
      AttrName := CboAttrReservedWord.Text
    else
      if Copy(IdentList[I], Length(IdentPre) + 1, Length(IdentList[I])) = 'Identifier' then
        AttrName := CboAttrIdentifier.Text
      else
        AttrName := 'MWS_Attr' + Copy(IdentList[I], Length(IdentPre) + 1, Length(IdentList[I]));
    if (IdentList[I] <> IdentPre + 'Null') and (IdentList[I] <> IdentPre + 'Unknown') then
      Writeln(OutFile, '  f' + Copy(IdentList[I], Length(IdentPre) + 1, Length(IdentList[I]))
      + 'Attri := TmwHighLightAttributes.Create(' + AttrName + ');');
    inc(I);
  end;

  Writeln(OutFile, '  inherited Create(AOwner);');

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

  Writeln(OutFile, '  SetAttributesOnChange(DefHighlightChange);');
  Writeln(OutFile, '  InitIdent;');
  Writeln(OutFile, '  MakeMethodTables;');
  case CboFilter.ItemIndex of
    -1: FilterName := #39 + CboFilter.Text + #39;
    0 : FilterName := 'MWS_FilterPascal';
    1 : FilterName := 'MWS_FilterHP48';
    2 : FilterName := 'MWS_FilterCAClipper';
    3 : FilterName := 'MWS_FilterCPP';
    4 : FilterName := 'MWS_FilterJava';
    5 : FilterName := 'MWS_FilterPerl';
    6 : FilterName := 'MWS_FilterAWK';
    7 : FilterName := 'MWS_FilterHTML';
    8 : FilterName := 'MWS_FilterVBScript';
    9 : FilterName := 'MWS_FilterGalaxy';
    10: FilterName := 'MWS_FilterPython';
    11: FilterName := 'MWS_FilterSQL';
    12: FilterName := 'MWS_FilterHP';
    13: FilterName := 'MWS_FilterTclTk';
    14: FilterName := 'MWS_FilterRTF';
    15: FilterName := 'MWS_FilterBatch';
    16: FilterName := 'MWS_FilterDFM';
    17: FilterName := 'MWS_FilterX86Asm';
  end;
  Writeln(OutFile, '  fDefaultFilter := ' + FilterName + ';');
  Writeln(OutFile, '  fRange := rsUnknown;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'procedure ' + LexName + '.SetLine(NewValue: String; LineNumber: Integer);');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  fLine := PChar(NewValue);');
  Writeln(OutFile, '  Run := 0;');
  Writeln(OutFile, '  fLineNumber := LineNumber;');
  Writeln(OutFile, '  Next;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

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

  Writeln(OutFile, 'procedure ' + LexName + '.UnknownProc;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  inc(Run);');
  Writeln(OutFile, '  fTokenID := ' + IdentPre + 'Unknown;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'procedure ' + LexName + '.Next;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  fTokenPos := Run;');
  Writeln(OutFile, '  fProcTable[fLine[Run]];');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'function ' + LexName + '.GetEOL: Boolean;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := fTokenID = tkNull;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'function ' + LexName + '.GetRange: Pointer;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := Pointer(fRange);');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'function ' + LexName + '.GetToken: String;');
  Writeln(OutFile, 'var');
  Writeln(OutFile, '  Len: LongInt;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Len := Run - fTokenPos;');
  Writeln(OutFile, '  SetString(Result, (FLine + fTokenPos), Len);');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'function ' + LexName + '.GetTokenID: TtkTokenKind;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := fTokenId;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'function ' + LexName + '.GetTokenAttribute: TmwHighLightAttributes;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  case GetTokenID of');

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

  Writeln(OutFile, '    else Result := nil;');
  Writeln(OutFile, '  end;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'function ' + LexName + '.GetTokenKind: integer;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := Ord(fTokenId);');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'function ' + LexName + '.GetTokenPos: Integer;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := fTokenPos;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'procedure ' + LexName + '.ReSetRange;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  fRange := rsUnknown;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'procedure ' + LexName + '.SetRange(Value: Pointer);');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  fRange := TRangeState(Value);');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'function ' + LexName + '.GetIdentChars: TIdentChars;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := [' + IdentContent + '];');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'function ' + LexName + '.GetLanguageName: string;');
  Writeln(OutFile, 'begin');
  case CboLangName.ItemIndex of
    -1: LangName := #39 + CboLangName.Text + #39;
    0 : LangName := 'MWS_LangHP48';
    1 : LangName := 'MWS_LangCAClipper';
    2 : LangName := 'MWS_LangCPP';
    3 : LangName := 'MWS_LangJava';
    4 : LangName := 'MWS_LangPerl';
    5 : LangName := 'MWS_LangBatch';
    6 : LangName := 'MWS_LangDfm';
    7 : LangName := 'MWS_LangAWK';
    8 : LangName := 'MWS_LangHTML';
    9 : LangName := 'MWS_LangVBSScript';
    10 : LangName := 'MWS_LangGalaxy';
    11 : LangName := 'MWS_LangGeneral';
    12 : LangName := 'MWS_LangPascal';
    13 : LangName := 'MWS_LangX86Asm';
    14 : LangName := 'MWS_LangPython';
    15 : LangName := 'MWS_LangTclTk';
    16 : LangName := 'MWS_LangSQL';
  end;
  Writeln(OutFile, '  Result := ' + LangName + ';');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'function ' + LexName + '.GetCapability: THighlighterCapability;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := inherited GetCapability + [hcUserSettings, hcExportable];');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'procedure ' + LexName + '.SetLineForExport(NewValue: String);');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  fLine := PChar(NewValue);');
  Writeln(OutFile, '  Run := 0;');
  Writeln(OutFile, '  ExportNext;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile, '');

  Writeln(OutFile, 'procedure ' + LexName + '.ExportNext;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  fTokenPos := Run;');
  Writeln(OutFile, '  fProcTable[fLine[Run]];');
  Writeln(OutFile, '  if Assigned(Exporter) then');
  Writeln(OutFile, '    Case GetTokenID of');

  I := 0;
  while I < IdentList.Count do
  begin
    if (IdentList[I] <> IdentPre + 'Null') and (IdentList[I] <> IdentPre + 'Unknown') then
    begin
      if (IdentList[I] = IdentPre + 'Space') then Space := 'True' else Space := 'False';
      if (IdentList[I] = IdentPre + 'Comment') or (IdentList[I] = IdentPre + 'String') or (IdentList[I] = IdentPre + 'Symbol') then Tags := 'True' else Tags := 'False';
      Writeln(OutFile, '      ' + IdentList[I] + ': TmwCustomExport(Exporter).FormatToken(GetToken, f' + Copy(IdentList[I], Length(IdentPre) + 1, Length(IdentList[I])) + 'Attri, ' + Tags + ', ' + Space + ');');
    end;
    inc(I);
  end;

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

  Writeln(OutFile, 'Initialization');
  Writeln(OutFile, '  MakeIdentTable;');
  Writeln(OutFile, 'end.');

end;

procedure TGenFrm.CboLangNameChange(Sender: TObject);
begin
  if (CboLangName.Text <> '') and (CboFilter.Text <> '') then
    BtnStart.Enabled := True
  else
    BtnStart.Enabled := False;
end;

end.