synhighlightereiffel.pas

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

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

function TSynEiffelSyn.Func99 :TtkTokenKind;
begin
  if KeyComp('external') then
    Result := tkKey
  else
    if KeyComp('current') then
      Result := tkPredefined
    else
      if KeyComp('identifier') then
        Result := tkLace
      else
        Result := tkIdentifier;
end;

function TSynEiffelSyn.Func101 :TtkTokenKind;
begin
  if KeyComp('system') then
    Result := tkLace
  else
    Result := tkIdentifier;
end;

function TSynEiffelSyn.Func108 :TtkTokenKind;
begin
  if KeyComp('invariant') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynEiffelSyn.Func113 :TtkTokenKind;
begin
  if KeyComp('optimize') then
    Result := tkLace
  else
    Result := tkIdentifier;
end;

function TSynEiffelSyn.Func116 :TtkTokenKind;
begin
  if KeyComp('precompiled') then
    Result := tkLace
  else
    Result := tkIdentifier;
end;

function TSynEiffelSyn.Func120 :TtkTokenKind;
begin
  if KeyComp('assertion') then
    Result := tkLace
  else
    Result := tkIdentifier;
end;

function TSynEiffelSyn.Func133 :TtkTokenKind;
begin
  if KeyComp('precursor') then
    Result := tkPredefined
  else
    Result := tkIdentifier;
end;

function TSynEiffelSyn.Func144 :TtkTokenKind;
begin
  if KeyComp('include_path') then
    Result := tkLace
  else
    Result := tkIdentifier;
end;

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

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

procedure TSynEiffelSyn.MakeMethodTables;
var
  I :Char;
begin
  for I := #0 to #255 do
    case I of
      #33, #35..#44, #46..#47, #58..#64, #91..#96, #123..#127:
        fProcTable[I] := OperatorAndSymbolProc;
      #0: fProcTable[I] := NullProc;
      #10: fProcTable[I] := LFProc;
      #13: fProcTable[I] := CRProc;
      '-': fProcTable[I] := EiffelCommentOpenProc;
      '"': fProcTable[I] := StringOpenProc;
      #1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc;
      'A'..'Z', 'a'..'z': fProcTable[I] := IdentProc;
      else
        fProcTable[I] := UnknownProc;
    end;
end;

procedure TSynEiffelSyn.SpaceProc;
begin
  fTokenID := tkSpace;
  repeat
    inc(Run);
  until not (fLine[Run] in [#1..#32]);
end;

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

procedure TSynEiffelSyn.CRProc;
begin
  fTokenID := tkSpace;
  inc(Run);
  if fLine[Run] = #10 then
    inc(Run);
end;

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

procedure TSynEiffelSyn.OperatorAndSymbolProc;
begin
  fTokenID := tkIdentifier;
  if fLine[Run] = #33 then
    begin
      fRange := rsOperatorAndSymbolProc;
      fTokenID := tkOperatorAndSymbols;
      Inc(Run);
      Exit;
    end;
  if fLine[Run] in [#35..#44] then
    begin
      fRange := rsOperatorAndSymbolProc;
      fTokenID := tkOperatorAndSymbols;
      Inc(Run);
      Exit;
    end;
  if fLine[Run] in [#46..#47] then
    begin
      fRange := rsOperatorAndSymbolProc;
      fTokenID := tkOperatorAndSymbols;
      Inc(Run);
      Exit;
    end;
  if fLine[Run] in [#58..#64] then
    begin
      fRange := rsOperatorAndSymbolProc;
      fTokenID := tkOperatorAndSymbols;
      Inc(Run);
      Exit;
    end;
  if fLine[Run] in [#91..#96] then
    begin
      fRange := rsOperatorAndSymbolProc;
      fTokenID := tkOperatorAndSymbols;
      Inc(Run);
      Exit;
    end;
  if fLine[Run] in [#123..#127] then
    begin
      fRange := rsOperatorAndSymbolProc;
      fTokenID := tkOperatorAndSymbols;
      Inc(Run);
      Exit;
    end;
end;

procedure TSynEiffelSyn.EiffelCommentOpenProc;
begin
  Inc(Run);
  if (fLine[Run - 1] = '-') and (fLine[Run] = '-') then
    begin
      fRange := rsEiffelComment;
      EiffelCommentProc;
      fTokenID := tkComment;
    end
  else
    fTokenID := tkOperatorAndSymbols;
end;

procedure TSynEiffelSyn.EiffelCommentProc;
begin
  fTokenID := tkComment;
  repeat
    if not (fLine[Run] in [#0, #10, #13]) then
      Inc(Run);
  until fLine[Run] in [#0, #10, #13];
end;

procedure TSynEiffelSyn.StringOpenProc;
begin
  Inc(Run);
  fRange := rsString;
  StringProc;
  fTokenID := tkString;
end;

procedure TSynEiffelSyn.StringProc;
begin
  fTokenID := tkString;
  repeat
    if (fLine[Run] = '"') then
      begin
        Inc(Run, 1);
        fRange := rsUnKnown;
        Break;
      end;
    if not (fLine[Run] in [#0, #10, #13]) then
      Inc(Run);
  until fLine[Run] in [#0, #10, #13];
end;

constructor TSynEiffelSyn.Create(AOwner :TComponent);
begin
  inherited Create(AOwner);
  fBasicTypesAttri := TSynHighLighterAttributes.Create(SYNS_AttrBasicTypes);
  fBasicTypesAttri.Style := [fsBold];
  fBasicTypesAttri.Foreground := clBlue;
  AddAttribute(fBasicTypesAttri);

  fCommentAttri := TSynHighLighterAttributes.Create(SYNS_AttrComment);
  fCommentAttri.Style := [fsItalic];
  fCommentAttri.Foreground := clTeal;
  AddAttribute(fCommentAttri);

  fIdentifierAttri := TSynHighLighterAttributes.Create(SYNS_AttrIdentifier);
  fIdentifierAttri.Foreground := clMaroon;
  AddAttribute(fIdentifierAttri);

  fKeyAttri := TSynHighLighterAttributes.Create(SYNS_AttrReservedWord);
  fKeyAttri.Style := [fsBold];
  fKeyAttri.Foreground := clNavy;
  AddAttribute(fKeyAttri);

  fLaceAttri := TSynHighLighterAttributes.Create(SYNS_AttrLace);
  fLaceAttri.Style := [fsBold];
  fLaceAttri.Foreground := clNavy;
  AddAttribute(fLaceAttri);

  fOperatorAndSymbolsAttri := TSynHighLighterAttributes.Create(SYNS_AttrOperatorAndSymbols);
  fOperatorAndSymbolsAttri.Style := [fsBold];
  fOperatorAndSymbolsAttri.Foreground := clOlive;
  AddAttribute(fOperatorAndSymbolsAttri);

  fPredefinedAttri := TSynHighLighterAttributes.Create(SYNS_AttrPredefined);
  fPredefinedAttri.Style := [fsBold];
  fPredefinedAttri.Foreground := clRed;
  AddAttribute(fPredefinedAttri);

  fResultValueAttri := TSynHighLighterAttributes.Create(SYNS_AttrResultValue);
  fResultValueAttri.Style := [fsBold];
  fResultValueAttri.Foreground := clPurple;
  AddAttribute(fResultValueAttri);

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

  fStringAttri := TSynHighLighterAttributes.Create(SYNS_AttrString);
  fStringAttri.Style := [fsItalic];
  fStringAttri.Foreground := clGray;
  AddAttribute(fStringAttri);

  SetAttributesOnChange(DefHighlightChange);
  InitIdent;
  MakeMethodTables;
  fDefaultFilter := SYNS_FilterEiffel;
  fRange := rsUnknown;
end;

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

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

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

procedure TSynEiffelSyn.Next;
begin
  fTokenPos := Run;
  fRange := rsUnknown;
  fProcTable[fLine[Run]];
end;

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

function TSynEiffelSyn.GetEol :Boolean;
begin
  Result := fTokenID = tkNull;
end;

function TSynEiffelSyn.GetKeyWords :string;
begin
  Result :=
    '-,!,#,$,%U,&,(,),*,.,/,//,/=,:,:=,;,@,[,\\,],^,|,+,<,<>,=,>,adapt,ali' +
    'as,all,and,Array,as,assertion,BIT,boolean,character,check,class,cluste' +
    'r,colon,comma,creation,current,debug,default,deferred,do,double,else,e' +
    'lseif,end,ensure,exclude,executable,expanded,export,external,false,fea' +
    'ture,from,frozen,generate,identifier,if,ignore,implies,include,include' +
    '_path,indexing,infix,inherit,inspect,integer,invariant,is,like,local,l' +
    'oop,make,no,not,object,obsolete,old,once,optimize,option,or,pointer,pr' +
    'ecompiled,precursor,prefix,real,redefine,rename,require,rescue,result,' +
    'retry,root,select,separate,string,strip,system,then,trace,true,undefin' +
    'e,unique,until,use,variant,visible,void,when,xor,yes';
end;

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

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

function TSynEiffelSyn.GetTokenAttribute :TSynHighLighterAttributes;
begin
  case GetTokenID of
    tkBasicTypes :Result := fBasicTypesAttri;
    tkComment :Result := fCommentAttri;
    tkIdentifier :Result := fIdentifierAttri;
    tkKey :Result := fKeyAttri;
    tkLace :Result := fLaceAttri;
    tkOperatorAndSymbols :Result := fOperatorAndSymbolsAttri;
    tkPredefined :Result := fPredefinedAttri;
    tkResultValue :Result := fResultValueAttri;
    tkSpace :Result := fSpaceAttri;
    tkString :Result := fStringAttri;
    tkUnknown :Result := fIdentifierAttri;
    else
      Result := nil;
  end;
end;

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

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

function TSynEiffelSyn.GetIdentChars :TSynIdentChars;
begin
  Result := ['_', 'a'..'z', 'A'..'Z'];
end;

function TSynEiffelSyn.GetSampleSource :string;
begin
  Result := '-- Eiffel sample source from SmartEiffel'#13#10 +
    'class FIBONACCI'#13#10 +
    '-- Eiffel comment'#13#10 +
    'creation make'#13#10 +
    #13#10 +
    'feature'#13#10 +
    #13#10 +
    '   make is'#13#10 +
    '      do'#13#10 +
    '         if argument_count /= 1 or else'#13#10 +
    '            not argument(1).is_integer'#13#10 +
    '          then'#13#10 +
    '            io.put_string("Usage: ");'#13#10 +
    '            io.put_string(argument(0));'#13#10 +
    '            io.put_string(" <Integer_value>%N");'#13#10 +
    '            die_with_code(exit_failure_code);'#13#10 +
    '         end;'#13#10 +
    '         io.put_integer(fibonacci(argument(1).to_integer));'#13#10 +
    '         io.put_new_line;'#13#10 +
    '      end;'#13#10 +
    '   -- Eiffel comment'#13#10 +
    '   fibonacci(i: INTEGER): INTEGER is'#13#10 +
    '      require -- Eiffel comment'#13#10 +
    '         i >= 0'#13#10 +
    '      do'#13#10 +
    '         if i = 0 then'#13#10 +
    '            Result := 1;'#13#10 +
    '         elseif i = 1 then'#13#10 +
    '            Result := 1;'#13#10 +
    '         else'#13#10 +
    '            Result := fibonacci(i - 1) + fibonacci(i - 2) ;'#13#10 +
    '         end;'#13#10 +
    '      end;'#13#10 +
    #13#10 +
    'end';
end;

function TSynEiffelSyn.IsFilterStored :Boolean;
begin
  Result := fDefaultFilter <> SYNS_FilterEiffel;
end;

class function TSynEiffelSyn.GetLanguageName :string;
begin
  Result := SYNS_LangEiffel;
end;

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

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

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

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