syngenunit.pas

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

      end;
      Writeln(OutFile, ' then');
      Writeln(OutFile, '  begin');
      Writeln(OutFile, '    fRange := rs' + TLexEnclosedBy(EnclosedList[I]).ProcName + ';');
      Writeln(OutFile, '    ' + TLexEnclosedBy(EnclosedList[I]).ProcName + 'Proc;');
      Writeln(OutFile, '    fTokenID := ' + IdentPre + TLexEnclosedBy(EnclosedList[I]).TokenName + ';');
      Writeln(OutFile, '  end');
      Writeln(OutFile, '  else');
      if (IdentList.IndexOf(IdentPre + 'Symbol') >= 0) then
        Writeln(OutFile, '    fTokenID := ' + IdentPre + 'Symbol;')
      else
        Writeln(OutFile, '    fTokenID := ' + IdentPre + 'Identifier;');
    end
    else
    begin
      Writeln(OutFile, '  fRange := rs' + TLexEnclosedBy(EnclosedList[I]).ProcName + ';');
      Writeln(OutFile, '  ' + TLexEnclosedBy(EnclosedList[I]).ProcName + 'Proc;');
      Writeln(OutFile, '  fTokenID := ' + IdentPre + TLexEnclosedBy(EnclosedList[I]).TokenName + ';');
    end;
    Writeln(OutFile, 'end;');
    Writeln(OutFile);
    Writeln(OutFile, 'procedure ' + LexName + '.' + TLexEnclosedBy(EnclosedList[I]).ProcName + 'Proc;');
    Writeln(OutFile, 'begin');
    if TLexEnclosedBy(EnclosedList[I]).MultiLine then
    begin
      Writeln(OutFile, '  case fLine[Run] of');
      Writeln(OutFile, '     #0: NullProc;');
      Writeln(OutFile, '    #10: LFProc;');
      Writeln(OutFile, '    #13: CRProc;');
      Writeln(OutFile, '  else');
      Writeln(OutFile, '    begin');
      sPrefix := '    ';
    end
    else
      sPrefix := '';
    Writeln(OutFile, sPrefix, '  fTokenID := ' + IdentPre + TLexEnclosedBy(EnclosedList[I]).TokenName + ';');
    Writeln(OutFile, sPrefix, '  repeat');
    Write(OutFile, sPrefix, '    if ');
    for J := 1 to Length(TLexEnclosedBy(EnclosedList[I]).EndsWith) do
    begin
      if (J > 1) then
      begin
        Writeln(OutFile, ' and');
        Write(OutFile, sPrefix, '       ');
      end;
      Write(OutFile, '(fLine[Run' + AddInt(J - 1) + '] = ''' + StuffString(TLexEnclosedBy(EnclosedList[I]).EndsWith[J]) + ''')');
    end;    
    Writeln(OutFile, ' then');
    Writeln(OutFile, sPrefix, '    begin');
    Writeln(OutFile, sPrefix, '      Inc(Run, ' + IntToStr(Length(TLexEnclosedBy(EnclosedList[I]).EndsWith)) + ');');
    Writeln(OutFile, sPrefix, '      fRange := rsUnKnown;');
    Writeln(OutFile, sPrefix, '      Break;');
    Writeln(OutFile, sPrefix, '    end;');
    Writeln(OutFile, sPrefix, '    if not (fLine[Run] in [#0, #10, #13]) then');
    Writeln(OutFile, sPrefix, '      Inc(Run);');
    Writeln(OutFile, sPrefix, '  until fLine[Run] in [#0, #10, #13];');
    Writeln(OutFile, sPrefix, 'end;');
    if TLexEnclosedBy(EnclosedList[I]).MultiLine then
    begin
      Writeln(OutFile, '  end;');
      Writeln(OutFile, 'end;');
    end;
    Writeln(OutFile);
  end;
  
  Writeln(OutFile, 'constructor ' + LexName + '.Create(AOwner: TComponent);');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  inherited Create(AOwner);');
  I := 0;
  while I < IdentList.Count do
  begin
    AttrTemp := Copy(IdentList[I], Length(IdentPre) + 1, Length(IdentList[I]));
    if AttrTemp = 'Key' then
      AttrName := CboAttrReservedWord.Text
    else if AttrTemp = 'Identifier' then
      AttrName := CboAttrIdentifier.Text
    else
      AttrName := 'SYNS_Attr' + FilterInvalidChars(AttrTemp);

    if (IdentList[I] <> IdentPre + 'Null') and (IdentList[I] <> IdentPre + 'Unknown') then
    begin
      AttrTemp := 'f' + AttrTemp + 'Attri';
      Writeln(OutFile, '  ' + AttrTemp + ' := TSynHighLighterAttributes.Create(' + AttrName + ');');
      if Assigned(IdentList.Objects[i]) then
      begin
        DefAttri := TLexDefaultAttri(IdentList.Objects[i]);
        if (DefAttri.Style <> '') then
          Writeln(OutFile, '  ' + AttrTemp + '.Style := ' + DefAttri.Style + ';');
        if (DefAttri.Foreground <> '') then
          Writeln(OutFile, '  ' + AttrTemp + '.Foreground := ' + DefAttri.Foreground + ';');
        if (DefAttri.Background <> '') then
          Writeln(OutFile, '  ' + AttrTemp + '.Background := ' + DefAttri.Background + ';');
      end
      else if (IdentList[I] = IdentPre + 'Key') then
        Writeln(OutFile, '  ' + AttrTemp + '.Style := [fsBold];')
      else if (IdentList[I] = IdentPre + 'Comment') then
      begin
        Writeln(OutFile, '  ' + AttrTemp + '.Style := [fsItalic];');
        Writeln(OutFile, '  ' + AttrTemp + '.Foreground := clNavy;');
      end;
      Writeln(OutFile, '  AddAttribute(' + AttrTemp + ');');
      Writeln(OutFile);
    end;
    Inc(I);
  end;

  Writeln(OutFile, '  SetAttributesOnChange(DefHighlightChange);');
  Writeln(OutFile, '  InitIdent;');
  Writeln(OutFile, '  MakeMethodTables;');

  Writeln(OutFile, '  fDefaultFilter := ' + GetFilterName + ';');
  Writeln(OutFile, '  fRange := rsUnknown;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  Writeln(OutFile, 'procedure ' + LexName + '.SetLine(NewValue: String; LineNumber: Integer);');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  fLineRef := NewValue;' );
  Writeln(OutFile, '  fLine := PChar(fLineRef);');
  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, '{$IFDEF SYN_MBCSSUPPORT}');
  Writeln(OutFile, '  if FLine[Run] in LeadBytes then');
  Writeln(OutFile, '    Inc(Run,2)');
  Writeln(OutFile, '  else');
  Writeln(OutFile, '{$ENDIF}');
  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;');
  if (EnclosedList.Count > 0) then
  begin
    Writeln(OutFile, '  case fRange of');
    for I := 0 to (EnclosedList.Count - 1) do
    begin
      if TLexEnclosedBy(EnclosedList[I]).MultiLine then
      begin
        Writeln(OutFile, '    rs' + TLexEnclosedBy(EnclosedList[I]).ProcName +
                         ': ' + TLexEnclosedBy(EnclosedList[I]).ProcName + 'Proc;');
      end;
    end;
    Writeln(OutFile, '  else');
    Writeln(OutFile, '    begin');
    Writeln(OutFile, '      fRange := rsUnknown;');
    Writeln(OutFile, '      fProcTable[fLine[Run]];');
    Writeln(OutFile, '    end;');
    Writeln(OutFile, '  end;');
  end
  else
    Writeln(OutFile, '  fProcTable[fLine[Run]];');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  Writeln(OutFile, 'function ' + LexName + '.GetDefaultAttribute(Index: integer): TSynHighLighterAttributes;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  case Index of');
  if (IdentList.IndexOf(IdentPre + 'Comment') >= 0) then
    Writeln(OutFile, '    SYN_ATTR_COMMENT    : Result := fCommentAttri;');
  if (IdentList.IndexOf(IdentPre + 'Identifier') >= 0) then
    Writeln(OutFile, '    SYN_ATTR_IDENTIFIER : Result := fIdentifierAttri;');
  if (IdentList.IndexOf(IdentPre + 'Key') >= 0) then
    Writeln(OutFile, '    SYN_ATTR_KEYWORD    : Result := fKeyAttri;');
  if (IdentList.IndexOf(IdentPre + 'String') >= 0) then
    Writeln(OutFile, '    SYN_ATTR_STRING     : Result := fStringAttri;');
  if (IdentList.IndexOf(IdentPre + 'Space') >= 0) then
    Writeln(OutFile, '    SYN_ATTR_WHITESPACE : Result := fSpaceAttri;');
  if (IdentList.IndexOf(IdentPre + 'Symbol') >= 0) then
    Writeln(OutFile, '    SYN_ATTR_SYMBOL     : Result := fSymbolAttri;');
  Writeln(OutFile, '  else');
  Writeln(OutFile, '    Result := nil;');
  Writeln(OutFile, '  end;');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

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

  if ChkGetKeyWords.Checked then
  begin
    Writeln(OutFile, 'function ' + LexName + '.GetKeyWords: string;');
    Writeln(OutFile, 'begin');
    TempStringList := TStringList.Create;
    try
      TempStringList.Sorted := True;
      for I := 0 to KeyList.Count - 1 do
        TempStringList.Add(TLexKeys(KeyList[I]).KeyName);
      if TempStringList.Count > 0 then
      begin
        Writeln(OutFile, '  Result := ');
        for I := 0 to Trunc(Int(Length(TempStringList.CommaText) div 70)) - 1 do
        begin
          if I = 0 then LineLength := 69 else LineLength := 70;
          Writeln(OutFile, '    ' + #39 + Copy(TempStringList.CommaText,
            I * 70, LineLength) + #39 + #32 + #43);
        end;
        I := Trunc(Int(Length(TempStringList.CommaText) div 70));
        Writeln(OutFile, '    ' + #39 + Copy(TempStringList.CommaText,
           I * 70, Length(TempStringList.CommaText)) + #39 + ';')
      end else
        Writeln(OutFile, '  Result := ' + #39 + #39 + ';');
    finally
      TempStringList.Free;
    end;
    Writeln(OutFile, 'end;');
    Writeln(OutFile);
  end;

  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: TSynHighLighterAttributes;');
  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');
  Writeln(OutFile, '    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, 'function ' + LexName + '.GetIdentChars: TSynIdentChars;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := [' + IdentContent + '];');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  Writeln(OutFile, 'function ' + LexName + '.GetSampleSource: string;');
  Writeln(OutFile, 'begin');
  if (SampleSourceList.Count = 0) then
  begin
    Writeln(OutFile, '  Result := ''Sample source for: ''#13#10 +');
    Writeln(OutFile, '            ''' + EditDescription.Text + ''';');
  end
  else
  begin
    Write(OutFile, '  Result := ');
    for i := 0 to (SampleSourceList.Count - 1) do
    begin
      if (i > 0) then
      begin
        Writeln(OutFile, '#13#10 +');
        Write(OutFile, '            ');
      end;
      if (SampleSourceList[i] <> '') then
        Write(OutFile, '''', StuffString(SampleSourceList[i]), '''');
    end;
    Writeln(OutFile, ';');
  end;
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  Writeln(OutFile, 'function ' + LexName + '.IsFilterStored: Boolean;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := fDefaultFilter <> ' + GetFilterName + ';');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  Writeln(OutFile, '{$IFNDEF SYN_CPPB_1} class {$ENDIF}');
  Writeln(OutFile, 'function ' + LexName + '.GetLanguageName: string;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := ' + GetLangName + ';');
  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 + '.GetRange: Pointer;');
  Writeln(OutFile, 'begin');
  Writeln(OutFile, '  Result := Pointer(fRange);');
  Writeln(OutFile, 'end;');
  Writeln(OutFile);

  Writeln(OutFile, 'initialization');
  Writeln(OutFile, '  MakeIdentTable;');
  Writeln(OutFile, '{$IFNDEF SYN_CPPB_1}');
  Writeln(OutFile, '  RegisterPlaceableHighlighter(' + LexName + ');');
  Writeln(OutFile, '{$ENDIF}');
  Writeln(OutFile, 'end.');
end;

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

procedure TFrmMain.ListBoxFieldsClick(Sender: TObject);
begin
  BtnDelete.Enabled := True;
end;