synhighlighterprogress.pas

SynEditStudio delphi 代码编辑器

        Result := TtkTokenKind(Entry.Kind);
        exit;
      end;
    Entry := Entry.Next;
  end;
  Result := tkIdentifier;
end;

procedure TSynProgressSyn.DoAddKeyword(AKeyword: string; AKind: integer);
var
  HashValue: integer;
begin
  HashValue := KeyHash(PChar(AKeyword));
  fHashList[HashValue] := TSynHashEntry.Create(AKeyword, AKind);
end;

procedure TSynProgressSyn.MakeMethodTables;
var
  i: char;
begin
  for I := #0 to #255 do
    case I of
      #0: fProcTable[I] := NullProc;
      #1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc;
      'A'..'Z','a'..'z','_': fProcTable[I] := IdentProc;
      '0'..'9': fProcTable[I] := NumberProc;
      '''': fProcTable[I] := AsciiCharProc;
      '"': fProcTable[I] := StringProc;
      '{': fProcTable[I] := BraceOpenProc;
      '+','-','*','@',':','=','<','>','.','^','(',')','[',']':
        fProcTable[I] := SymbolProc;
      '&': fProcTable[I] := PreprocessorDefinitionProc;
      '/': fProcTable[I] := SlashProc;
      else
        fProcTable[I] := UnknownProc;
    end;
end;

constructor TSynProgressSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fHashList := TSynHashEntryList.Create;

  fCommentAttri := TSynHighlighterAttributes.Create(SYNS_AttrComment);
  fCommentAttri.Foreground := clRed;
  AddAttribute(fCommentAttri);

  fEventAttri := TSynHighlighterAttributes.Create(SYNS_AttrEvent);
  fEventAttri.Foreground := clOlive;
  AddAttribute(fEventAttri);

  fIdentifierAttri := TSynHighlighterAttributes.Create(SYNS_AttrIdentifier);
  fIdentifierAttri.Foreground := clNavy;
  AddAttribute(fIdentifierAttri);

  fIncludeAttri := TSynHighlighterAttributes.Create(SYNS_AttrInclude);
  fIncludeAttri.Foreground := clPurple;
  AddAttribute(fIncludeAttri);

  fKeyAttri := TSynHighlighterAttributes.Create(SYNS_AttrReservedWord);
  fKeyAttri.Foreground := clMaroon;
  AddAttribute(fKeyAttri);

  fNonreservedKeyAttri := TSynHighlighterAttributes.Create(SYNS_AttrNonReservedKeyword);
  fNonReservedKeyAttri.Foreground := clTeal;
  AddAttribute(fNonReservedKeyAttri);

  fNumberAttri := TSynHighlighterAttributes.Create(SYNS_AttrNumber);
  fNumberAttri.Foreground := clMaroon;
  AddAttribute(fNumberAttri);

  fPreprocessorAttri := TSynHighlighterAttributes.Create(SYNS_AttrPreprocessor);
  fPreprocessorAttri.Foreground := clPurple;
  AddAttribute(fPreProcessorAttri);

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

  fDataTypeAttri := TSynHighlighterAttributes.Create(SYNS_AttrDataType);
  fDataTypeAttri.Foreground := clSilver;
  AddAttribute(fDataTypeAttri);

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

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

  MakeMethodTables;
  fDefaultFilter := SYNS_FilterProgress;
  fIdentChars := TSynValidStringChars + ['-'];

  EnumerateKeywords(Ord(tkKey), DefaultKeywords, IdentChars, DoAddKeyword);
  EnumerateKeywords(Ord(tkNonReserved), DefaultNonReservedKeywords,
    IdentChars, DoAddKeyword);
  EnumerateKeywords(Ord(tkEvent), DefaultEvents, IdentChars, DoAddKeyword);
  EnumerateKeywords(Ord(tkDataType), DefaultDataTypes, IdentChars,
    DoAddKeyword);
  SetAttributesOnChange(DefHighlightChange);
end;

destructor TSynProgressSyn.Destroy;
begin
  fHashList.Free;
  inherited Destroy;
end;

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

procedure TSynProgressSyn.IdentProc;
begin
  fTokenID := IdentKind(fLine + Run);
  inc(Run, fStringLen);
end;

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

procedure TSynProgressSyn.NumberProc;
var
  p: PChar;
begin
  fTokenID := tkNumber;
  p := PChar(@fLine[Run]);
  repeat
    Inc(p);
  until not (p^ in ['0'..'9']);
  Run := p - fLine;
end;

procedure TSynProgressSyn.PreprocessorDefinitionProc;
var
  p: PChar;
begin
  fTokenID := tkPreprocessor;
  p := PChar(@fLine[Run]);
  while p^ <> #0 do
  begin
    case p^ of
      '~': if (p+1)^ = #0 then
             fRange := rsPreprocessorDef;
    end;
    inc(p);
  end;
  Run := p - fLine;
end;

procedure TSynProgressSyn.SpaceProc;
var
  p: PChar;
begin
  fTokenID := tkSpace;
  p := PChar(@fLine[Run]);
  repeat
    Inc(p);
  until not (p^ in [#1..#9, #11, #12, #14..#32]);
  Run := p - fLine;
end;

procedure TSynProgressSyn.StringProc;
var
  p: PChar;
begin
  fTokenID := tkString;
  p := PChar(@fLine[Run]);
  repeat
    Inc(p);
  until (p^ = #0) or (p^ = '"');
  if (p^ = '"') then Inc(p);
  Run := p - fLine;
end;

procedure TSynProgressSyn.SymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

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

procedure TSynProgressSyn.AsciiCharProc;
var
  p: PChar;
begin
  fTokenID := tkString;
  p := PChar(@fLine[Run]);
  repeat
    inc(p);
  until (p^ = #0) or (p^ = '''');
  if (p^ = '''') then Inc(p);
  Run := p - fLine;
end;

procedure TSynProgressSyn.SlashProc;
var
  p: PChar;
begin
  p := PChar(@fLine[Run]);
  inc(p);
  case p^ of
    '*': begin  {c style comments}
           fTokenID := tkComment;
           fRange := rsComment;
           fCommentLevel := 1;
           inc(p);
           while (p^ <> #0) and (fRange = rsComment) do
           begin
             case p^ of
               '*': begin
                      inc(p);
                      if p^ = '/' then
                      begin
                        inc(p);
                        dec(fCommentLevel);
                        if FCommentLevel = 0 then
                          fRange := rsNone;
                      end;
                    end;
               '/': begin
                      inc(p);
                      if p^ = '*' then
                      begin
                        inc(p);
                        inc(fCommentLevel); // Max 65535 commentlevels.
                      end;
                    end;
             else
               inc(p);
             end;
           end;
         end;
  else  {division}
    fTokenID := tkSymbol;
  end;
  Run := p - fLine;
end;

procedure TSynProgressSyn.CommentRangeProc;
var
  p: PChar;
begin
  fTokenID := tkComment;
  p := PChar(@fLine[Run]);

  if p^ = #0 then
  begin
    NullProc;
    exit;
  end;

  while (p^ <> #0) and (fRange = rsComment) do
  begin
    case p^ of
      '*': begin
             inc(p);
             if p^ = '/' then
             begin
               inc(p);
               dec(fCommentLevel);
               if fCommentLevel = 0 then
                 fRange := rsNone;
             end;
           end;
      '/': begin
             inc(p);
             if p^ = '*' then
             begin
               inc(p);
               inc(fCommentLevel);
             end;
           end;
    else
      inc(p);
    end;
  end;