synhighlighterm3.pas

一个mwEdit控件原码,比mwCuuEdit0.92a功能先进.

    case fLine[Run] of
      '\': if fLine[Run + 1] = #39 then
             Inc(Run);
      #39: begin
             Inc(Run);
             if fLine[Run] <> #39 then
               break;
           end;
    end;
    Inc(Run);
  end;
end;

procedure TSynM3Syn.SymCommentHelpProc;
begin
  fTokenID := tkComment;
  SymNestedHelperProc('(', ')');
end;

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

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

procedure TSynM3Syn.SymLFProc;
begin
  fTokenID := tkSpace;
  Inc(Run);
end;

procedure TSynM3Syn.SymNestedHelperProc(AOpenChar, ACloseChar: char);
begin
  case fLine[Run] of
     #0: SymNullProc;
    #10: SymLFProc;
    #13: SymCRProc;
  else
    repeat
      if fLine[Run]= AOpenChar then begin
        Inc(Run);
        if fLine[Run] = '*' then begin
          Inc(Run);
          Inc(fRange.Level);
        end;
      end else if fLine[Run] = '*' then begin
        Inc(Run);
        if fLine[Run] = ACloseChar then begin
          Inc(Run);
          if fRange.Level > 0 then
            Dec(fRange.Level);
          if fRange.Level = 0 then begin
            fRange.TokenRange := Ord(trNone);
            break
          end;
        end;
      end else
        Inc(Run);
    until fLine[Run] in [#0, #10, #13];
  end;
end;

procedure TSynM3Syn.SymNullProc;
begin
  fTokenID := tkNull;
end;

procedure TSynM3Syn.SymNumberProc;
const
  Digits: array[0..15] of char = '0123456789abcdef';
var
  BasedNumber: boolean;
  i, MaxDigit: integer;
  ValidDigits: TSynIdentChars;
begin
  fTokenID := tkNumber;
  BasedNumber := FALSE;
  MaxDigit := 9;
  // skip leading zeros, but they can be numbers too
  while fLine[Run] = '0' do
    Inc(Run);
  if not Identifiers[fLine[Run]] then
    exit;
  // check for numbers with a base prefix
  if (fLine[Run] in ['2'..'9']) and (fLine[Run + 1] = '_') then begin
    BasedNumber := TRUE;
    MaxDigit := Ord(fLine[Run]) - Ord('0') - 1;
    Inc(Run, 2);
  end else if (fLine[Run] ='1') and (fLine[Run + 1] in ['0'..'6'])
    and (fLine[Run + 2] = '_')
  then begin
    BasedNumber := TRUE;
    MaxDigit := 10 + Ord(fLine[Run + 1]) - Ord('0') - 1;
    Inc(Run, 3);
  end;
  if BasedNumber then begin
    ValidDigits := [];
    i := MaxDigit;
    while i >= 10 do begin
      Include(ValidDigits, Digits[i]);
      Include(ValidDigits, UpCase(Digits[i]));
      Dec(i);
    end;
    while i >= 0 do begin
      Include(ValidDigits, Digits[i]);
      Dec(i);
    end;
    // advance over all valid digits, but at least one has to be there
    if fLine[Run] in ValidDigits then begin
      repeat
        Inc(Run);
      until not (fLine[Run] in ValidDigits);
    end else
      fTokenID := tkSyntaxError;
  end else begin
    // "normal" numbers
    repeat
      Inc(Run);
    until not (fLine[Run] in ['0'..'9']);
    // can include a decimal point and an exponent
    if fLine[Run] = '.' then begin
      Inc(Run);
      if fLine[Run] in ['0'..'9'] then begin
        repeat
          Inc(Run);
        until not (fLine[Run] in ['0'..'9']);
      end else
        fTokenID := tkSyntaxError; // must be a number after the '.'
    end;
    // can include an exponent
    if fLine[Run] in ['d', 'D', 'e', 'E', 'x', 'X'] then begin
      Inc(Run);
      if fLine[Run] in ['+', '-'] then
        Inc(Run);
      if fLine[Run] in ['0'..'9'] then begin
        repeat
          Inc(Run);
        until not (fLine[Run] in ['0'..'9']);
      end else // exponent must include a number
        fTokenID := tkSyntaxError;
    end;
  end;
  // it's a syntax error if there are any Identifier chars left
  if Identifiers[fLine[Run]] then begin
    fTokenID := tkSyntaxError;
    repeat
      Inc(Run);
    until not Identifiers[fLine[Run]];
  end;
end;

procedure TSynM3Syn.SymPragmaProc;
begin
  Inc(Run);
  if fLine[Run] = '*' then begin
    Inc(Run);
    fRange.TokenRange := Ord(trPragma);
    Inc(fRange.Level);
    if fLine[Run] in [#0, #10, #13] then
      fTokenID := tkPragma
    else
      SymPragmaHelpProc;
  end else
    fTokenID := tkSymbol;
end;

procedure TSynM3Syn.SymPragmaHelpProc;
begin
  fTokenID := tkPragma;
  SymNestedHelperProc('<', '>');
end;

procedure TSynM3Syn.SymRoundOpenProc;
begin
  Inc(Run);
  if fLine[Run] = '*' then begin
    Inc(Run);
    fRange.TokenRange := Ord(trComment);
    Inc(fRange.Level);
    if fLine[Run] in [#0, #10, #13] then
      fTokenID := tkComment
    else
      SymCommentHelpProc;
  end else begin
    fTokenID := tkSymbol;
    if fLine[Run] = '.' then
      Inc(Run);
  end;
end;

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

procedure TSynM3Syn.SymStringProc;
begin
  fTokenID := tkString;
  Inc(Run);
  while not (fLine[Run] in [#0, #10, #13]) do begin
    case fLine[Run] of
      #34: begin
             Inc(Run);
             break;
           end;
      '\': if fLine[Run + 1] in [#34, '\'] then
             Inc(Run);
    end;
    Inc(Run);
  end;
end;

procedure TSynM3Syn.SymSymbolProc;
begin
  Inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynM3Syn.SymUnknownProc;
begin
  Inc(Run);
  fTokenID := tkUnknown;
end;

procedure TSynM3Syn.Next;
begin
  fTokenPos := Run;
  case TTokenRange(fRange.TokenRange) of
    trComment: SymCommentHelpProc;
    trPragma: SymPragmaHelpProc;
  else
    fProcTable[fLine[Run]];
  end;
end;

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

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

class function TSynM3Syn.GetLanguageName: string;
begin
  Result := SYNS_LangModula3;
end;

function TSynM3Syn.GetRange: pointer;
begin
  result := fRange.p;
end;

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

function TSynM3Syn.GetTokenAttribute: TSynHighlighterAttributes;
begin
  case fTokenID of
    tkComment: Result := fCommentAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkKey: Result := fKeyAttri;
    tkNumber: Result := fNumberAttri;
    tkPragma: Result:= fPragmaAttri;
    tkReserved: Result := fReservedAttri;
    tkSpace: Result := fSpaceAttri;
    tkString: Result := fStringAttri;
    tkSymbol: Result := fSymbolAttri;
    tkSyntaxError: Result := fSyntaxErrorAttri;
    tkUnknown: Result := fIdentifierAttri;
  else
    Result := nil;
  end;
end;

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

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

function TSynM3Syn.GetTokenPos: integer;
begin
  Result := fTokenPos;
end;

procedure TSynM3Syn.ResetRange;
begin
  fRange.p := nil;
end;

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

procedure TSynM3Syn.SetRange(Value: pointer);
begin
  fRange.p := Value;
end;

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