synhighlighterfoxpro.pas

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

end;

procedure TSynFoxproSyn.BraceOpenProc;
begin
  fTokenID := tkString;
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
      #92:
        if FLine[Run + 1] = #10 then inc(Run);
    end;
    inc(Run);
  until FLine[Run] = '}';
  if FLine[Run] <> #0 then inc(Run);
end;

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

procedure TSynFoxproSyn.ColonProc;
begin
  {colon}
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.CommaProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.EqualProc;
begin
  case FLine[Run + 1] of
    '=':                               {logical equal}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
  else                                 {assign}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
end;

procedure TSynFoxproSyn.GreaterProc;
begin
  Case FLine[Run + 1] of
    '=':                               {greater than or equal to}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
    '>':
      begin
        if FLine[Run + 2] = '=' then   {shift right assign}
          inc(Run, 3)
        else                           {shift right}
          inc(Run, 2);
        fTokenID := tkSymbol;
      end;
  else                                 {greater than}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
end;

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

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

procedure TSynFoxproSyn.LowerProc;
begin
  case FLine[Run + 1] of
    '=':                               {less than or equal to}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
    '<':
      begin
        if FLine[Run + 2] = '=' then   {shift left assign}
          inc(Run, 3)
        else                           {shift left}
          inc(Run, 2);
        fTokenID := tkSymbol;
      end;
  else                                 {less than}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
end;

procedure TSynFoxproSyn.MinusProc;
begin
  {subtract}
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.ModSymbolProc;
begin
  {mod}
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.NotSymbolProc;
begin
  {not}
  inc(Run);
  fTokenID := tkSymbol;
end;

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

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

procedure TSynFoxproSyn.OrSymbolProc;
begin
  {or}
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.PlusProc;
begin
  {subtract}
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.PointProc;
begin
  if ((UpCase(FLine[Run + 1]) = 'T')           {.t.}
       or (UpCase(FLine[Run + 1]) = 'F'))      {.f.}
     and (FLine[Run + 2] = '.') then
  begin
      inc(Run, 3);
      fTokenID := tkSymbol;
  end
  else if (((UpCase(FLine[Run + 1]) = 'A')
              and (UpCase(FLine[Run + 2]) = 'N')
              and (UpCase(FLine[Run + 3]) = 'D'))    {.and.}
           or ((UpCase(FLine[Run + 1]) = 'N')
              and (UpCase(FLine[Run + 2]) = 'O')
              and (UpCase(FLine[Run + 3]) = 'T')))    {.not.}
          and (FLine[Run + 4] = '.') then
  begin
      inc(Run, 5);
      fTokenID := tkSymbol;
  end
  else if (UpCase(FLine[Run + 1]) = 'O') 
          and (UpCase(FLine[Run + 2]) = 'R')
          and (FLine[Run + 3] = '.') then  {.or.}
  begin
      inc(Run, 4);
      fTokenID := tkSymbol;
  end
  else                                 {point}
  begin
    inc(Run);
    fTokenID := tkSymbol;
  end;
end;

procedure TSynFoxproSyn.QuestionProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.RoundCloseProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.RoundOpenProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.SemiColonProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.SlashProc;
begin
  {division}
  inc(Run);
  fTokenID := tkSymbol;
end;

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

procedure TSynFoxproSyn.SquareCloseProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.SquareOpenProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFoxproSyn.StarProc;
begin
  if Run = 0 then
  begin                        {Foxpro Comments}
    inc(Run);
    fTokenID := tkComment;
    while FLine[Run] <> #0 do
    begin
      case FLine[Run] of
        #10, #13: break;
      end;
      inc(Run);
    end;
  end else begin
    {star}
    inc(Run);
    fTokenID := tkSymbol;
  end;
end;

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

procedure TSynFoxproSyn.TildeProc;
begin
  inc(Run);
  fTokenId := tkSymbol;
end;

procedure TSynFoxproSyn.XOrSymbolProc;
begin
  {xor}
  inc(Run);
  fTokenID := tkSymbol;
end;

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

procedure TSynFoxproSyn.Next;
begin
  fTokenPos := Run;
  fProcTable[fLine[Run]];
end;

function TSynFoxproSyn.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 TSynFoxproSyn.GetEol: Boolean;
begin
  Result := fTokenID = tkNull;
end;

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

function TSynFoxproSyn.GetTokenID: TtkTokenKind;
begin
  Result := fTokenId;
end;

function TSynFoxproSyn.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;
    tkUnknown: Result := fIdentifierAttri;
    else Result := nil;
  end;
end;

function TSynFoxproSyn.GetTokenKind: integer;
begin
  Result := Ord(fTokenId);
end;

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

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

function TSynFoxproSyn.IsFilterStored: Boolean;
begin
  Result := fDefaultFilter <> SYNS_FilterFoxpro;
end;

class function TSynFoxproSyn.GetLanguageName: string;                    
begin
  Result := SYNS_LangFoxpro;
end;

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