synhighlighterbat.pas

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

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

function TSynBatSyn.Func44: TtkTokenKind;
begin
  if KeyComp('set') then Result := tkKey else Result := tkIdentifier;
end;

function TSynBatSyn.Func49: TtkTokenKind;
begin
  if KeyComp('not') then Result := tkKey else Result := tkIdentifier;
end;

function TSynBatSyn.Func57: TtkTokenKind;
begin
  if KeyComp('goto') then Result := tkKey else Result := tkIdentifier;
end;

function TSynBatSyn.Func59: TtkTokenKind;
begin
  if KeyComp('copy') then Result := tkKey else Result := tkIdentifier;
end;

function TSynBatSyn.Func62: TtkTokenKind;
begin
  if KeyComp('shift') then Result := tkKey else
    if KeyComp('pause') then Result := tkKey else Result := tkIdentifier;
end;

function TSynBatSyn.Func66: TtkTokenKind;
begin
  if KeyComp('title') then Result := tkKey else Result := tkIdentifier;
end;

function TSynBatSyn.Func77: TtkTokenKind;
begin
  if KeyComp('exist') then Result := tkKey else Result := tkIdentifier;
end;

function TSynBatSyn.Func78: TtkTokenKind;
begin
  if KeyComp('start') then Result := tkKey else Result := tkIdentifier;
end;

function TSynBatSyn.Func130: TtkTokenKind;
begin
  if KeyComp('errorlevel') then Result := tkKey else Result := tkIdentifier;
end;

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

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

procedure TSynBatSyn.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
    case I of
      '%': fProcTable[I] := VariableProc;
      #13: fProcTable[I] := CRProc;
      ':': fProcTable[I] := CommentProc;
      'A'..'Q', 'S'..'Z', 'a'..'q', 's'..'z', '_': fProcTable[I] := IdentProc;
      #10: fProcTable[I] := LFProc;
      #0: fProcTable[I] := NullProc;
      '0'..'9': fProcTable[I] := NumberProc;
      'R', 'r': fProcTable[I] := REMCommentProc;
      #1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc;
      else fProcTable[I] := UnknownProc;
    end;
end;

constructor TSynBatSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fCommentAttri := TSynHighlighterAttributes.Create(SYNS_AttrComment);
  fCommentAttri.Style := [fsItalic];
  fCommentAttri.Foreground := clNavy;
  AddAttribute(fCommentAttri);
  fIdentifierAttri := TSynHighlighterAttributes.Create(SYNS_AttrIdentifier);
  AddAttribute(fIdentifierAttri);
  fKeyAttri := TSynHighlighterAttributes.Create(SYNS_AttrKey);
  fKeyAttri.Style := [fsBold];
  AddAttribute(fKeyAttri);
  fNumberAttri := TSynHighlighterAttributes.Create(SYNS_AttrNumber);
  fNumberAttri.Foreground := clBlue;
  AddAttribute(fNumberAttri);
  fSpaceAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpace);
  AddAttribute(fSpaceAttri);
  fVariableAttri := TSynHighlighterAttributes.Create(SYNS_AttrVariable);
  fVariableAttri.Foreground := clGreen;
  AddAttribute(fVariableAttri);
  SetAttributesOnChange(DefHighlightChange);
  InitIdent;
  MakeMethodTables;
  fDefaultFilter := SYNS_FilterBatch;
end;

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

procedure TSynBatSyn.VariableProc;
begin
  fTokenID := tkVariable;
  repeat
    Inc(Run);
  until not (fLine[Run] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
  if fLine[Run] = '%' then
    Inc(Run);
end;

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

procedure TSynBatSyn.CommentProc;
begin
  fTokenID := tkIdentifier;
  Inc(Run);
  if fLine[Run] = ':' then begin
    fTokenID := tkComment;
    repeat
      Inc(Run);
    until (fLine[Run] in [#0, #10, #13]);
  end;
end;

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

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

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

procedure TSynBatSyn.NumberProc;
begin
  fTokenID := tkNumber;
  repeat
    Inc(Run);
  until not (fLine[Run] in ['0'..'9', '.']);
end;

procedure TSynBatSyn.REMCommentProc;
begin
  if (FLine[Run+1] in ['E','e']) and (FLine[Run+2] in ['M','m'])
    and (FLine[Run+3] < #33) then
  begin
    fTokenID := tkComment;
    Inc(Run, 3);
    while (FLine[Run] <> #0) do begin
      case FLine[Run] of
        #10, #13: break;
      end; { case }
      Inc(Run);
    end; { while }
  end
  else
  begin
    fTokenID := tkIdentifier;
    IdentProc;
  end;
end;

procedure TSynBatSyn.SpaceProc;
begin
  fTokenID := tkSpace;
  repeat
    Inc(Run);
  until (fLine[Run] > #32) or (fLine[Run] in [#0, #10, #13]);
end;

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

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

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

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

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

function TSynBatSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
  case fTokenID of
    tkComment: Result := fCommentAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkKey: Result := fKeyAttri;
    tkNumber: Result := fNumberAttri;
    tkSpace: Result := fSpaceAttri;
    tkUnknown: Result := fIdentifierAttri;
    tkVariable: Result := fVariableAttri;
    else Result := nil;
  end;
end;

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

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

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

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

function TSynBatSyn.IsFilterStored: Boolean;
begin
  Result := fDefaultFilter <> SYNS_FilterBatch;
end;

class function TSynBatSyn.GetLanguageName: string;
begin
  Result := SYNS_LangBatch;
end;

function TSynBatSyn.GetSampleSource: string;
begin
  Result := 'rem MS-DOS batch file'#13#10 +
            'rem'#13#10 +
            '@echo off'#13#10 +
            'cls'#13#10 +
            'echo The command line is: %1 %2 %3 %4 %5'#13#10 +
            'rem'#13#10 +
            'rem now wait for the user ...'#13#10 +
            'pause'#13#10 +
            'copy c:\*.pas d:\'#13#10 +
            'if errorlevel 1 echo Error in copy action!';
end;

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