synhighlighteradsp21xx.pas

用delphi写的delphi源代码 用delphi写的delphi源代码 用delphi写的delphi源代码 用delphi写的delphi源代码

  AddAttribute(fNumberAttri);

  fRegisterAttri := TSynHighlighterAttributes.Create(SYNS_AttrRegister);
  fRegisterAttri.ForeGround := clBlue;
  AddAttribute(fRegisterAttri);

  fConditionAttri := TSynHighlighterAttributes.Create(SYNS_AttrCondition);
  fConditionAttri.ForeGround := clFuchsia;
  AddAttribute(fConditionAttri);

  fSpaceAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpace);
  AddAttribute(fSpaceAttri);

  fSymbolAttri := TSynHighlighterAttributes.Create(SYNS_AttrSymbol);
  AddAttribute(fSymbolAttri);

  fStringAttri := TSynHighlighterAttributes.Create(SYNS_AttrString);
  AddAttribute(fStringAttri);

  fNullAttri := TSynHighlighterAttributes.Create(SYNS_AttrNull);
  AddAttribute(fNullAttri);

  fUnknownAttri := TSynHighlighterAttributes.Create(SYNS_AttrUnknownWord);
  AddAttribute(fUnknownAttri);

  SetAttributesOnChange(DefHighlightChange);

  InitIdent;
  MakeMethodTables;
  fRange := rsUnknown;
  fDefaultFilter := SYNS_FilterADSP21xx;
end;

procedure TSynADSP21xxSyn.SetLine(NewValue: string; LineNumber:Integer);
begin
  fLine := PChar(NewValue);
  Run := 0;
  Next;
end;

procedure TSynADSP21xxSyn.BraceCloseProc;
begin
  inc(Run);
  fTokenId := tkSymbol;
end;

procedure TSynADSP21xxSyn.StringProc;
begin
  fTokenID := tkString;
  if (FLine[Run + 1] = #39) and (FLine[Run + 2] = #39) then inc(Run, 2);
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
    end;
    inc(Run);
  until FLine[Run] = #39;
  if FLine[Run] <> #0 then inc(Run);
end;

procedure TSynADSP21xxSyn.PascalCommentProc;
begin
  fTokenID := tkComment;
  case FLine[Run] of
    #0:
      begin
        NullProc;
        exit;
      end;
    #10:
      begin
        LFProc;
        exit;
      end;
    #13:
      begin
        CRProc;
        exit;
      end;
  end;

  while FLine[Run] <> #0 do
    case FLine[Run] of
      '}':
        begin
          fRange := rsUnKnown;
          inc(Run);
          break;
        end;
      #10: break;
      #13: break;
      else inc(Run);
    end;
end;

procedure TSynADSP21xxSyn.CCommentProc;
begin
  fTokenID := tkComment;
  case FLine[Run] of
    #0: begin
          NullProc;
          exit;
        end;
    #10:begin
         LFProc;
         exit;
        end;
    #13:begin
          CRProc;
          exit;
        end;
  end;

  while FLine[Run] <> #0 do
    case FLine[Run] of
      '*':
        begin
          if FLine[Run+1] = '/' then
          begin
            fRange := rsUnknown;
            inc(Run, 2);
            break;
          end
          else
            Inc(Run);
        end;
      #10: break;
      #13: break;
      else inc(Run);
    end;
end;

procedure TSynADSP21xxSyn.BraceOpenProc;
begin
  fTokenID := tkComment;
  fRange := rsPascalComment;
  inc(Run);
  while FLine[Run] <> #0 do
    case FLine[Run] of
      '}':
        begin
          fRange := rsUnKnown;
          inc(Run);
          break;
        end;
      #10: break;
      #13: break;
    else inc(Run);
    end;
end;


procedure TSynADSP21xxSyn.IncludeCloseProc;
begin
  inc(Run);
  fTokenId := tkSymbol;
end;

procedure TSynADSP21xxSyn.CRProc;
begin
  fTokenID := tkSpace;
  Case FLine[Run + 1] of
    #10: inc(Run, 2);
  else inc(Run);
  end;
end;

procedure TSynADSP21xxSyn.ExclamationProc;
begin
  fTokenID := tkComment;
  repeat
    inc(Run);
  until fLine[Run] in [#0, #10, #13];
end;

procedure TSynADSP21xxSyn.IdentProc;
begin
  fTokenID := IdentKind((fLine + Run));
  inc(Run, fStringLen);
  while Identifiers[fLine[Run]] do
    inc(Run);
end;

procedure TSynADSP21xxSyn.IntegerProc;
begin
  inc(Run);
  fTokenID := tkNumber;
  while FLine[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do inc(Run);
end;

procedure TSynADSP21xxSyn.LFProc;
begin
  fTokenID := tkSpace;
  inc(Run);
end;

procedure TSynADSP21xxSyn.NullProc;
begin
  fTokenID := tkNull;
end;

procedure TSynADSP21xxSyn.NumberProc;
begin
  inc(Run);
  fTokenID := tkNumber;
  while FLine[Run] in ['0'..'9', 'A'..'F', 'a'..'f','x','X','.', 'e', 'E'] do
  begin
    case FLine[Run] of
      '.':
        if FLine[Run + 1] = '.' then break;
    end;
    inc(Run);
  end;
end;

procedure TSynADSP21xxSyn.HexNumber;
begin
  inc(Run);
  fTokenID := tkNumber;
  fRange := rsUnKnown;
  while FLine[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do
  begin
    inc(Run);
  end;
end;

procedure TSynADSP21xxSyn.BinaryNumber;
begin
  inc(Run);
  fRange := rsUnKnown;
  while FLine[Run] in ['0'..'1'] do
  begin
    inc(Run);
  end;
  if FLine[Run] in ['2'..'9', 'A'..'F', 'a'..'f'] then
    fTokenID := tkIdentifier
  else
    fTokenID := tkNumber;
end;

procedure TSynADSP21xxSyn.SlashProc;
begin
  if FLine[Run + 1] = '*' then
  begin
    fTokenID := tkComment;
    fRange := rsCComment;
    inc(Run, 2);
    while FLine[Run] <> #0 do
      case FLine[Run] of
        '*':  begin
                if FLine[Run+1] = '/' then
                begin
                  inc(Run, 2);
                  fRange := rsUnknown;
                  break;
                end
                else inc(Run);
              end;
        #10: break;
        #13: break;
        else inc(Run);
      end;
    end
  else
  begin
    inc(Run);
    fTokenID := tkSymbol;
  end;
end;

procedure TSynADSP21xxSyn.SpaceProc;
begin
  inc(Run);
  fTokenID := tkSpace;
  while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
end;

procedure TSynADSP21xxSyn.UnknownProc;
begin
{$IFDEF SYN_MBCSSUPPORT}
  if FLine[Run] in LeadBytes then
    Inc(Run, 2)
  else
{$ENDIF}
  inc(Run);
  fTokenID := tkUnknown;
end;

procedure TSynADSP21xxSyn.Next;
begin
  fTokenPos := Run;
  case fRange of
    rsPascalComment: PascalCommentProc;
    rsCComment: CCommentProc;
    rsHexNumber: HexNumber;
    rsBinaryNumber: BinaryNumber;
  else
    fRange := rsUnknown;
    fProcTable[fLine[Run]];
  end;
end;

function TSynADSP21xxSyn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
begin
  case Index of
    SYN_ATTR_COMMENT: Result := fCommentAttri;
    SYN_ATTR_IDENTIFIER: Result := fIdentifierAttri;
    SYN_ATTR_KEYWORD: Result := fKeyAttri;
    SYN_ATTR_STRING: Result := fStringAttri;
    SYN_ATTR_WHITESPACE: Result := fSpaceAttri;
    SYN_ATTR_SYMBOL: Result := fSymbolAttri;
  else
    Result := nil;
  end;
end;

function TSynADSP21xxSyn.GetEol: Boolean;
begin
  Result := fTokenId = tkNull;
end;

function TSynADSP21xxSyn.GetToken: string;
var
  Len: LongInt;
begin
  Len := Run - fTokenPos;
  SetString(Result, (FLine + fTokenPos), Len);
end;

function TSynADSP21xxSyn.GetTokenID: TTokenKind;
begin
  Result := fTokenId;
end;

function TSynADSP21xxSyn.GetTokenKind: integer;
begin
  Result := Ord(GetTokenID);
end;

function TSynADSP21xxSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
  case GetTokenID of
    tkComment: Result := fCommentAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkKey: Result := fKeyAttri;
    tkNumber: Result := fNumberAttri;
    tkSpace: Result := fSpaceAttri;
    tkString: Result := fStringAttri;
    tkSymbol: Result := fSymbolAttri;
    tkRegister: Result := fRegisterAttri;
    tkCondition: Result := fConditionAttri;
    tkUnknown: Result := fSymbolAttri;
  else
    Result := nil;
  end;
end;

function TSynADSP21xxSyn.GetTokenPos: Integer;
begin
  Result := fTokenPos;
end;

function TSynADSP21xxSyn.GetRange: Pointer;
begin
  Result := Pointer(fRange);
end;

procedure TSynADSP21xxSyn.SetRange(Value: Pointer);
begin
  fRange := TRangeState(Value);
end;

procedure TSynADSP21xxSyn.ResetRange;
begin
  fRange:= rsUnknown;
end;

procedure TSynADSP21xxSyn.EnumUserSettings(settings: TStrings);
begin
  { returns the user settings that exist in the registry }
  {$IFNDEF SYN_CLX}
  with TBetterRegistry.Create do
  begin
    try
      RootKey := HKEY_CURRENT_USER;
      // we need some method to make the following statement more universal!
      if OpenKeyReadOnly('\SOFTWARE\Wynand\DSPIDE\1.0') then
      begin
        try
          GetKeyNames(settings);
        finally
          CloseKey;
        end;
      end;
    finally
      Free;
    end;
  end;
  {$ENDIF}
end;

function TSynADSP21xxSyn.UseUserSettings(settingIndex: integer): boolean;
// Possible parameter values:
//   index into TStrings returned by EnumUserSettings
// Possible return values:
//   true : settings were read and used
//   false: problem reading settings or invalid version specified - old settings
//          were preserved

    {$IFNDEF SYN_CLX}
    function ReadDspIDESetting(settingTag: string; attri: TSynHighlighterAttributes; key: string): boolean;
    begin
      try
        Result := attri.LoadFromBorlandRegistry(HKEY_CURRENT_USER,
               '\Software\Wynand\DspIDE\1.0\Editor\Highlight',key,false);
      except Result := false; end;
    end;
    {$ENDIF}
var
  tmpNumberAttri    : TSynHighlighterAttributes;
  tmpKeyAttri       : TSynHighlighterAttributes;
  tmpSymbolAttri    : TSynHighlighterAttributes;
  tmpCommentAttri   : TSynHighlighterAttributes;
  tmpConditionAttri : TSynHighlighterAttributes;
  tmpIdentifierAttri: TSynHighlighterAttributes;
  tmpSpaceAttri     : TSynHighlighterAttributes;
  tmpRegisterAttri  : TSynHighlighterAttributes;
  StrLst            : TStringList;

begin  // UseUserSettings
  StrLst := TStringList.Create;
  try
    EnumUserSettings(StrLst);
    if settingIndex >= StrLst.Count then
      Result := false
    else
    begin
      tmpNumberAttri    := TSynHighlighterAttributes.Create('');
      tmpKeyAttri       := TSynHighlighterAttributes.Create('');
      tmpSymbolAttri    := TSynHighlighterAttributes.Create('');
      tmpCommentAttri   := TSynHighlighterAttributes.Create('');
      tmpConditionAttri := TSynHighlighterAttributes.Create('');
      tmpIdentifierAttri:= TSynHighlighterAttributes.Create('');
      tmpSpaceAttri     := TSynHighlighterAttributes.Create('');
      tmpRegisterAttri  := TSynHighlighterAttributes.Create('');

      tmpNumberAttri    .Assign(fNumberAttri);
      tmpKeyAttri       .Assign(fKeyAttri);
      tmpSymbolAttri    .Assign(fSymbolAttri);
      tmpCommentAttri   .Assign(fCommentAttri);
      tmpConditionAttri .Assign(fConditionAttri);
      tmpIdentifierAttri.Assign(fIdentifierAttri);
      tmpSpaceAttri     .Assign(fSpaceAttri);
      tmpRegisterAttri  .Assign(fRegisterAttri);
      {$IFNDEF SYN_CLX}
      Result := ReadDspIDESetting(StrLst[settingIndex],fCommentAttri,'Comment')       and
                ReadDspIDESetting(StrLst[settingIndex],fIdentifierAttri,'Identifier') and
                ReadDspIDESetting(StrLst[settingIndex],fKeyAttri,'Reserved word')     and
                ReadDspIDESetting(StrLst[settingIndex],fNumberAttri,'BinaryNumber')   and
                ReadDspIDESetting(StrLst[settingIndex],fSpaceAttri,'Whitespace')      and
                ReadDspIDESetting(StrLst[settingIndex],fSymbolAttri,'Symbol')         and
                ReadDspIDESetting(StrLst[settingIndex],fConditionAttri,'Condition')   and
                ReadDspIDESetting(StrLst[settingIndex],fRegisterAttri,'Symbol');
      {$ELSE}
      Result := False;
      {$ENDIF}
      if not Result then
      begin
        fNumberAttri     .Assign(tmpNumberAttri);
        fKeyAttri        .Assign(tmpKeyAttri);
        fSymbolAttri     .Assign(tmpSymbolAttri);
        fCommentAttri    .Assign(tmpCommentAttri);
        fConditionAttri  .Assign(tmpConditionAttri);
        fIdentifierAttri .Assign(tmpIdentifierAttri);
        fSpaceAttri      .Assign(tmpSpaceAttri);
        fConditionAttri  .Assign(tmpConditionAttri);
        fRegisterAttri   .Assign(tmpRegisterAttri);
      end;
      tmpNumberAttri    .Free;
      tmpKeyAttri       .Free;
      tmpSymbolAttri    .Free;
      tmpCommentAttri   .Free;
      tmpConditionAttri .Free;
      tmpIdentifierAttri.Free;
      tmpSpaceAttri     .Free;
      tmpRegisterAttri  .Free;
    end;
  finally StrLst.Free; end;
end;

function TSynADSP21xxSyn.GetIdentChars: TSynIdentChars;
begin
  Result := TSynValidStringChars;
end;

function TSynADSP21xxSyn.IsFilterStored: Boolean;
begin
  Result := fDefaultFilter <> SYNS_FilterADSP21xx;
end;

class function TSynADSP21xxSyn.GetLanguageName: string;
begin
  Result := SYNS_LangADSP21xx;
end;

class function TSynADSP21xxSyn.GetCapabilities: TSynHighlighterCapabilities;
begin
  Result := inherited GetCapabilities + [hcUserSettings];
end;

initialization
  MakeIdentTable;
{$IFNDEF SYN_CPPB_1}
  RegisterPlaceableHighlighter(TSynADSP21xxSyn);
{$ENDIF}
end.