synhighlighterfortran.pas

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

  if KeyComp('external') then Result := tkKey else Result := tkIdentifier;
end;

function TSynFortranSyn.Func101: TtkTokenKind;
begin
  if KeyComp('continue') then Result := tkKey else Result := tkIdentifier;
end;

function TSynFortranSyn.Func102: TtkTokenKind;
begin
  if KeyComp('function') then Result := tkKey else
    if KeyComp('dimension') then Result := tkKey else Result := tkIdentifier;
end;

function TSynFortranSyn.Func114: TtkTokenKind;
begin
  if KeyComp('equivalence') then Result := tkKey else Result := tkIdentifier;
end;

function TSynFortranSyn.Func127: TtkTokenKind;
begin
  if KeyComp('stucture') then Result := tkKey else Result := tkIdentifier;
end;

function TSynFortranSyn.Func144: TtkTokenKind;
begin
  if KeyComp('subroutine') then Result := tkKey else Result := tkIdentifier;
end;

function TSynFortranSyn.Func145: TtkTokenKind;
begin
  if KeyComp('structure') then Result := tkKey else Result := tkIdentifier;
end;

function TSynFortranSyn.AltFunc: TtkTokenKind;
begin
  Result := tkIdentifier;
end;

function TSynFortranSyn.IdentKind(MayBe: PChar): TtkTokenKind;
var
  HashKey: Integer;
begin
  fToIdent := MayBe;
  HashKey := KeyHash(MayBe);
  if HashKey < 146 then Result := fIdentFuncTable[HashKey] else Result := tkIdentifier;
end;

procedure TSynFortranSyn.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
    case I of
      #39: fProcTable[I] := AsciiCharProc;
      #13: fProcTable[I] := CRProc;
      ',': fProcTable[I] := CommaProc;
      '=': fProcTable[I] := EqualProc;
      '!': fProcTable[I] := ExclamationProc;
      '>': fProcTable[I] := GreaterProc;
      'A'..'Z', 'a'..'z', '_': fProcTable[I] := IdentProc;
      #10: fProcTable[I] := LFProc;
      '<': fProcTable[I] := LowerProc;
      '-': fProcTable[I] := MinusProc;
      '%': fProcTable[I] := ModSymbolProc;
      #0: fProcTable[I] := NullProc;
      '0'..'9': fProcTable[I] := NumberProc;
      '+': fProcTable[I] := PlusProc;
      '.': fProcTable[I] := PointProc;
      ')': fProcTable[I] := RoundCloseProc;
      '(': fProcTable[I] := RoundOpenProc;
      ';': fProcTable[I] := SemiColonProc;
      '/': fProcTable[I] := SlashProc;
      #1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc;
      '*': fProcTable[I] := StarProc;
      #34: fProcTable[I] := StringProc;
    else
      fProcTable[I] := UnknownProc;
    end;
end;

constructor TSynFortranSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fCommentAttri := TSynHighlighterAttributes.Create(SYNS_AttrComment);
  fCommentAttri.Style := [fsItalic];
  AddAttribute(fCommentAttri);
  fIdentifierAttri := TSynHighlighterAttributes.Create(SYNS_AttrIdentifier);
  AddAttribute(fIdentifierAttri);
  fKeyAttri := TSynHighlighterAttributes.Create(SYNS_AttrReservedWord);
  fKeyAttri.Style := [fsBold];
  AddAttribute(fKeyAttri);
  fNumberAttri := TSynHighlighterAttributes.Create(SYNS_AttrNumber);
  AddAttribute(fNumberAttri);
  fSpaceAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpace);
  AddAttribute(fSpaceAttri);
  fStringAttri := TSynHighlighterAttributes.Create(SYNS_AttrString);
  AddAttribute(fStringAttri);
  fSymbolAttri := TSynHighlighterAttributes.Create(SYNS_AttrSymbol);
  AddAttribute(fSymbolAttri);
  SetAttributesOnChange(DefHighlightChange);
  InitIdent;
  MakeMethodTables;
  fDefaultFilter := SYNS_FilterFortran;
end;

procedure TSynFortranSyn.SetLine(NewValue: String; LineNumber: Integer);
begin
  fLine := PChar(NewValue);
  Run := 0;
  fLineNumber := LineNumber;
  Next;
end;

procedure TSynFortranSyn.AsciiCharProc;
begin
  fTokenID := tkString;
  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 TSynFortranSyn.CRProc;
begin
  fTokenID := tkSpace;
  Inc(Run);
  if fLine[Run] = #10 then Inc(Run);
end;

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

procedure TSynFortranSyn.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 TSynFortranSyn.ExclamationProc;
begin
  inc(Run, 1);                        {Fortran Comments}
  fTokenID := tkComment;
  while FLine[Run] <> #0 do
  begin
    case FLine[Run] of
      #10, #13: break;
    end;
    inc(Run);
  end;
end;

procedure TSynFortranSyn.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 TSynFortranSyn.IdentProc;
begin
  if (FLine[Run] in ['C', 'c']) and (Run = 0) then
  begin   //Fortran comments
    inc(Run, 1);
    CommentProc;
  end
  else begin
    fTokenID := IdentKind((fLine + Run));
    inc(Run, fStringLen);
    while Identifiers[fLine[Run]] do inc(Run);
  end;
end;

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

procedure TSynFortranSyn.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 TSynFortranSyn.MinusProc;
begin
  {subtract}
  inc(Run);
  fTokenID := tkSymbol;
end;

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

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

procedure TSynFortranSyn.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 TSynFortranSyn.PlusProc;
begin
  {subtract}
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynFortranSyn.PointProc;
begin
  if (((UpCase(FLine[Run + 1]) = 'G') and (UpCase(FLine[Run + 2]) in ['E','T'])) {.ge. .gt.}
       or ((UpCase(FLine[Run + 1]) = 'L') and (UpCase(FLine[Run + 2]) in ['E','T'])) {.le. .lt.}
       or ((UpCase(FLine[Run + 1]) = 'N') and (UpCase(FLine[Run + 2]) = 'E')) {.ne.}
       or ((UpCase(FLine[Run + 1]) = 'E') and (UpCase(FLine[Run + 2]) = 'Q')) {.eq.}
       or ((UpCase(FLine[Run + 1]) = 'O') and (UpCase(FLine[Run + 2]) = 'R'))){.or.}
     and (FLine[Run + 3] = '.') then
    begin
      inc(Run, 4);
      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]) = 'T')
          and (UpCase(FLine[Run + 2]) = 'R')
          and (UpCase(FLine[Run + 3]) = 'U')
          and (UpCase(FLine[Run + 4]) = 'E')
          and (FLine[Run + 5] = '.') then  {.true.}
    begin
      inc(Run, 6);
      fTokenID := tkSymbol;
    end
  else if (UpCase(FLine[Run + 1]) = 'F')
          and (UpCase(FLine[Run + 2]) = 'A')
          and (UpCase(FLine[Run + 3]) = 'L')
          and (UpCase(FLine[Run + 4]) = 'S')
          and (UpCase(FLine[Run + 5]) = 'E')
          and (FLine[Run + 6] = '.') then  {.false.}
    begin
      inc(Run, 7);
      fTokenID := tkSymbol;
    end
  else                                 {point}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
end;

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

procedure TSynFortranSyn.RoundOpenProc;
begin
  inc(Run);
  FTokenID := tkSymbol;
end;

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

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

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

procedure TSynFortranSyn.StarProc;
begin
  if (Run = 0) then begin   //Fortran comments
    inc(Run);
    CommentProc;
  end
  else begin
    {star}
    inc(Run);
    fTokenID := tkSymbol;
  end;
end;

procedure TSynFortranSyn.CommentProc;
begin
  fTokenID := tkComment;
  while FLine[Run] <> #0 do
  begin
    case FLine[Run] of
      #10, #13: break;
    end; //case
    inc(Run);
  end; //while
end;

procedure TSynFortranSyn.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 TSynFortranSyn.UnknownProc;
begin
{$IFDEF SYN_MBCSSUPPORT}
  if FLine[Run] in LeadBytes then
    Inc(Run, 2)
  else
{$ENDIF}
  inc(Run);
  fTokenID := tkUnknown;
end;

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

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

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

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

function TSynFortranSyn.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 TSynFortranSyn.GetTokenKind: integer;
begin
  Result := Ord(fTokenId);
end;

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

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

function TSynFortranSyn.IsFilterStored: Boolean;
begin
  Result := fDefaultFilter <> SYNS_FilterFortran;
end;

class function TSynFortranSyn.GetLanguageName: string;
begin
  Result := SYNS_LangFortran;
end;

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