synhighlighterperl.pas

SynEditStudio delphi 代码编辑器

function TSynPerlSyn.Func878: TtkTokenKind;
begin
  if KeyComp('getpwent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func881: TtkTokenKind;
begin
  if KeyComp('$CHILD_ERROR') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func883: TtkTokenKind;
begin
  if KeyComp('shmwrite') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func890: TtkTokenKind;
begin
  if KeyComp('setpwent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func892: TtkTokenKind;
begin
  if KeyComp('shutdown') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func906: TtkTokenKind;
begin
  if KeyComp('syswrite') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func933: TtkTokenKind;
begin
  if KeyComp('$INPLACE_EDIT') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func954: TtkTokenKind;
begin
  if KeyComp('localtime') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func956: TtkTokenKind;
begin
  if KeyComp('$PROGRAM_NAME') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func965: TtkTokenKind;
begin
  if KeyComp('endnetent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func968: TtkTokenKind;
begin
  if KeyComp('rewinddir') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func974: TtkTokenKind;
begin
  if KeyComp('getnetent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func978: TtkTokenKind;
begin
  if KeyComp('$REAL_USER_ID') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func981: TtkTokenKind;
begin
  if KeyComp('quotemeta') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func985: TtkTokenKind;
begin
  if KeyComp('wantarray') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func986: TtkTokenKind;
begin
  if KeyComp('setnetent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func988: TtkTokenKind;
begin
  if KeyComp('$PERL_VERSION') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1056: TtkTokenKind;
begin
  if KeyComp('$REAL_GROUP_ID') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1077: TtkTokenKind;
begin
  if KeyComp('socketpair') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1079: TtkTokenKind;
begin
  if KeyComp('$SYSTEM_FD_MAX') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1084: TtkTokenKind;
begin
  if KeyComp('endhostent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1086: TtkTokenKind;
begin
  if KeyComp('endservent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1091: TtkTokenKind;
begin
  if KeyComp('getsockopt') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1093: TtkTokenKind;
begin
  if KeyComp('gethostent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1095: TtkTokenKind;
begin
  if KeyComp('getservent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1103: TtkTokenKind;
begin
  if KeyComp('setsockopt') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1105: TtkTokenKind;
begin
  if KeyComp('sethostent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1107: TtkTokenKind;
begin
  if KeyComp('setservent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1136: TtkTokenKind;
begin
  if KeyComp('$LIST_SEPARATOR') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1158: TtkTokenKind;
begin
  if KeyComp('$EXECUTABLE_NAME') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1165: TtkTokenKind;
begin
  if KeyComp('getpeername') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1169: TtkTokenKind;
begin
  if KeyComp('getsockname') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1172: TtkTokenKind;
begin
  if KeyComp('$FORMAT_FORMFEED') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1176: TtkTokenKind;
begin
  if KeyComp('diagnostics') then Result := tkPragma else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1202: TtkTokenKind;
begin
  if KeyComp('endprotoent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1211: TtkTokenKind;
begin
  if KeyComp('getprotoent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1215: TtkTokenKind;
begin
  if KeyComp('$FORMAT_TOP_NAME') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1218: TtkTokenKind;
begin
  if KeyComp('getpriority') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1223: TtkTokenKind;
begin
  if KeyComp('setprotoent') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1230: TtkTokenKind;
begin
  if KeyComp('setpriority') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1273: TtkTokenKind;
begin
  if KeyComp('$LAST_PAREN_MATCH') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1277: TtkTokenKind;
begin
  if KeyComp('getnetbyaddr') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1283: TtkTokenKind;
begin
  if KeyComp('getnetbyname') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1327: TtkTokenKind;
begin
  if KeyComp('$OUTPUT_AUTOFLUSH') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1343: TtkTokenKind;
begin
  if KeyComp('$EFFECTIVE_USER_ID') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1361: TtkTokenKind;
begin
  if KeyComp('$FORMAT_LINES_LEFT') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1379: TtkTokenKind;
begin
  if KeyComp('$INPUT_LINE_NUMBER') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1396: TtkTokenKind;
begin
  if KeyComp('gethostbyaddr') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1402: TtkTokenKind;
begin
  if KeyComp('gethostbyname') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1404: TtkTokenKind;
begin
  if KeyComp('getservbyname') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1409: TtkTokenKind;
begin
  if KeyComp('$MULTILINE_MATCHING') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1421: TtkTokenKind;
begin
  if KeyComp('$EFFECTIVE_GROUP_ID') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1425: TtkTokenKind;
begin
  if KeyComp('$FORMAT_PAGE_NUMBER') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1440: TtkTokenKind;
begin
  if KeyComp('getservbyport') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1520: TtkTokenKind;
begin
  if KeyComp('getprotobyname') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1523: TtkTokenKind;
begin
  if KeyComp('$SUBSCRIPT_SEPARATOR') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1673: TtkTokenKind;
begin
  if KeyComp('$FORMAT_LINES_PER_PAGE') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1752: TtkTokenKind;
begin
  if KeyComp('getprotobynumber') then Result := tkKey else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1762: TtkTokenKind;
begin
  if KeyComp('$INPUT_RECORD_SEPARATOR') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func1768: TtkTokenKind;
begin
  if KeyComp('$OUTPUT_FIELD_SEPARATOR') then Result := tkVariable else Result := tkIdentifier;
end;

function TSynPerlSyn.Func2167: TtkTokenKind;
begin
  if KeyComp('$FORMAT_LINE_BREAK_CHARACTERS') then Result := tkVariable else Result := tkIdentifier;
end;

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

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

procedure TSynPerlSyn.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
    case I of
      '&': fProcTable[I] := AndSymbolProc;
      #13: fProcTable[I] := CRProc;
      ':': fProcTable[I] := ColonProc;
      '#': fProcTable[I] := CommentProc;
      '=': fProcTable[I] := EqualProc;
      '>': fProcTable[I] := GreaterProc;
      '%', '@', '$', 'A'..'Z', 'a'..'z', '_': fProcTable[I] := IdentProc;
      #10: fProcTable[I] := LFProc;
      '<': fProcTable[I] := LowerProc;
      '-': fProcTable[I] := MinusProc;
      '!': fProcTable[I] := NotSymbolProc;
      #0: fProcTable[I] := NullProc;
      '0'..'9', '.': fProcTable[I] := NumberProc;
      '|': fProcTable[I] := OrSymbolProc;
      '+': fProcTable[I] := PlusProc;
      '/': fProcTable[I] := SlashProc;
      #1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc;
      '*': fProcTable[I] := StarProc;
      #34: fProcTable[I] := StringInterpProc;
      #39: fProcTable[I] := StringLiteralProc;
      '^': fProcTable[I] := XOrSymbolProc;
      '(', ')', '[', ']', '\', '{', '}', ',', ';', '?', '~':
        fProcTable[I] := SymbolProc;
    else
      fProcTable[I] := UnknownProc;
    end;
end;

constructor TSynPerlSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fCommentAttri := TSynHighlighterAttributes.Create(SYNS_AttrComment);
  fCommentAttri.Style:= [fsItalic];
  AddAttribute(fCommentAttri);
  fIdentifierAttri := TSynHighlighterAttributes.Create(SYNS_AttrIdentifier);
  AddAttribute(fIdentifierAttri);
  fInvalidAttri := TSynHighlighterAttributes.Create(SYNS_AttrIllegalChar);
  AddAttribute(fInvalidAttri);
  fKeyAttri := TSynHighlighterAttributes.Create(SYNS_AttrReservedWord);
  fKeyAttri.Style:= [fsBold];
  AddAttribute(fKeyAttri);
  fNumberAttri := TSynHighlighterAttributes.Create(SYNS_AttrNumber);
  AddAttribute(fNumberAttri);
  fOperatorAttri := TSynHighlighterAttributes.Create(SYNS_AttrOperator);
  AddAttribute(fOperatorAttri);
  fPragmaAttri := TSynHighlighterAttributes.Create(SYNS_AttrPragma);
  fPragmaAttri.Style := [fsBold];
  AddAttribute(fPragmaAttri);
  fSpaceAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpace);
  fSpaceAttri.Foreground := clWindow;
  AddAttribute(fSpaceAttri);
  fStringAttri := TSynHighlighterAttributes.Create(SYNS_AttrString);
  AddAttribute(fStringAttri);
  fSymbolAttri := TSynHighlighterAttributes.Create(SYNS_AttrSymbol);
  AddAttribute(fSymbolAttri);
  fVariableAttri := TSynHighlighterAttributes.Create(SYNS_AttrVariable);
  fVariableAttri.Style := [fsBold];
  AddAttribute(fVariableAttri);
  SetAttributesOnChange(DefHighlightChange);
  InitIdent;
  MakeMethodTables;
  fDefaultFilter := SYNS_FilterPerl;
end; { Create }

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

procedure TSynPerlSyn.AndSymbolProc;
begin
  case FLine[Run + 1] of
    '=':                               {bit and assign}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
    '&':
      begin
        if FLine[Run + 2] = '=' then   {logical and assign}
          inc(Run, 3)
        else