synhighlightercac.pas

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

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

function TSynCACSyn.Func105: TtkTokenKind;
begin
  if KeyComp('REQUEST') then Result := tkKey else
    if KeyComp('PROCEDURE') then Result := tkKey else Result := tkIdentifier;
end;

function TSynCACSyn.Func116: TtkTokenKind;
begin
  if KeyComp('PARAMETERS') then Result := tkKey else Result := tkIdentifier;
end;

function TSynCACSyn.Func124: TtkTokenKind;
begin
  if KeyComp('TRANSFORM') then Result := tkKey else Result := tkIdentifier;
end;

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

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

procedure TSynCACSyn.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
    case I of
      '@': fProcTable[I] := SymbolProc;
      '&': fProcTable[I] := SymbolProc;
      '{': fProcTable[I] := SymbolProc;
      '}': fProcTable[I] := SymbolProc;
      #13: fProcTable[I] := CRProc;
      ':': fProcTable[I] := SymbolProc;
      ',': fProcTable[I] := SymbolProc;
      '#': fProcTable[I] := DirectiveProc;
      '=': fProcTable[I] := SymbolProc;
      '>': fProcTable[I] := SymbolProc;
      'A'..'Z', 'a'..'z': fProcTable[I] := IdentProc;
      '$': fProcTable[I] := SymbolProc;
      #10: fProcTable[I] := LFProc;
      '<': fProcTable[I] := SymbolProc;
      '-': fProcTable[I] := SymbolProc;
      '!': fProcTable[I] := SymbolProc;
      #0: fProcTable[I] := NullProc;
      '0'..'9': fProcTable[I] := NumberProc;
      '+': fProcTable[I] := SymbolProc;
      '.': fProcTable[I] := SymbolProc;
      '?': fProcTable[I] := SymbolProc;
      ')': fProcTable[I] := SymbolProc;
      '(': fProcTable[I] := SymbolProc;
      ';': fProcTable[I] := SymbolProc;
      '/': fProcTable[I] := SlashProc;
      #1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc;
      ']': fProcTable[I] := SymbolProc;
      '[': fProcTable[I] := SymbolProc;
      '*': fProcTable[I] := StarProc;
      #39, #34: fProcTable[I] := StringProc;
      else fProcTable[I] := UnknownProc;
    end;
end;

constructor TSynCACSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fCommentAttri := TSynHighlighterAttributes.Create(SYNS_AttrComment);
  fCommentAttri.Style := [fsItalic];
  AddAttribute(fCommentAttri);
  fIdentifierAttri := TSynHighlighterAttributes.Create(SYNS_AttrIdentifier);
  AddAttribute(fIdentifierAttri);
  fKeyAttri := TSynHighlighterAttributes.Create(SYNS_AttrReservedWord);
  fKeyAttri.Style := [fsBold];
  AddAttribute(fKeyAttri);
  fNumberAttri := TSynHighlighterAttributes.Create(SYNS_AttrNumber);
  AddAttribute(fNumberAttri);
  fSpaceAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpace);
  AddAttribute(fSpaceAttri);
  fStringAttri := TSynHighlighterAttributes.Create(SYNS_AttrString);
  AddAttribute(fStringAttri);
  fOperatorAttri := TSynHighlighterAttributes.Create(SYNS_AttrOperator);
  AddAttribute(fOperatorAttri);
  fDirecAttri := TSynHighlighterAttributes.Create(SYNS_AttrPreprocessor);
  AddAttribute(fDirecAttri);
  InitIdent;
  SetAttributesOnChange(DefHighlightChange);
  MakeMethodTables;
  fRange := rsUnknown;
  fDefaultFilter := SYNS_FilterCAClipper;
end;

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

procedure TSynCACSyn.CStyleProc;
begin
  fTokenID := tkComment;
  case FLine[Run] of
    #0:
      begin
        NullProc;
        exit;
      end;
    #10:
      begin
        LFProc;
        exit;
      end;

    #13:
      begin
        CRProc;
        exit;
      end;
  end;

  while fLine[Run] <> #0 do
    case fLine[Run] of
      '*':
        if fLine[Run + 1] = '/' then
        begin
          fRange := rsUnknown;
          inc(Run, 2);
          break;
        end else inc(Run);
      #10: break;
      #13: break;
    else inc(Run);
    end;
end;

procedure TSynCACSyn.CRProc;
begin
  fTokenID := tkSpace;
  case FLine[Run + 1] of
    #10: inc(Run, 2);
  else inc(Run);
  end;
end;

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

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

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

procedure TSynCACSyn.NumberProc;
begin
  inc(Run);
  fTokenID := tkNumber;
  while FLine[Run] in ['0'..'9', '.', 'e', 'E'] do
  begin
    case FLine[Run] of
      '.':
        if FLine[Run + 1] = '.' then break;
    end;
    inc(Run);
  end;
end;

procedure TSynCACSyn.SlashProc;
begin
  case FLine[Run + 1] of
    '/':
      begin
        inc(Run, 2);
        fTokenID := tkComment;
        while FLine[Run] <> #0 do
        begin
          case FLine[Run] of
            #10, #13: break;
          end;
          inc(Run);
        end;
      end;
    '*':
      begin
        fTokenID := tkComment;
        fRange := rsCStyle;
        inc(Run, 2);
        while fLine[Run] <> #0 do
          case fLine[Run] of
            '*':
              if fLine[Run + 1] = '/' then
              begin
                fRange := rsUnknown;
                inc(Run, 2);
                break;
              end else inc(Run);
            #10: break;
            #13: break;
          else inc(Run);
          end;
      end;
  else
    begin
      inc(Run);
      fTokenID := tkOperator;
    end;
  end;
end;

procedure TSynCACSyn.SpaceProc;
begin
  inc(Run);
  fTokenID := tkSpace;
  while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
end;

procedure TSynCACSyn.SymbolProc;
begin
  inc(Run);
  fTokenID := tkOperator;
end;

procedure TSynCACSyn.StringProc;
var
  ActiveStr: string[1];
begin
  fTokenID := tkString;
  ActiveStr := FLine[Run];
  if ((FLine[Run + 1] = #39) and (FLine[Run + 2] = #39)) or
    ((FLine[Run + 1] = #34) and (FLine[Run + 2] = #34)) then inc(Run, 2);
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
    end;
    inc(Run);
  until (FLine[Run] = ActiveStr);
  if FLine[Run] <> #0 then inc(Run);
end;

procedure TSynCACSyn.DirectiveProc;
begin
  fTokenID := tkDirective;
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
      '/': if FLine[Run + 1] = '/' then break;
      #34, #39: break;
    end;
    inc(Run);
  until FLine[Run] = #0;
end;

procedure TSynCACSyn.UnknownProc;
begin
  inc(Run);
end;

procedure TSynCACSyn.Next;
begin
  fTokenPos := Run;
  case fRange of
    rsCStyle: CStyleProc;
  else fProcTable[fLine[Run]];
  end;
end;

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

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

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

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

function TSynCACSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
  case fTokenID of
    tkComment: Result := fCommentAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkKey: Result := fKeyAttri;
    tkNumber: Result := fNumberAttri;
    tkSpace: Result := fSpaceAttri;
    tkString: Result := fStringAttri;
    tkDirective: Result := fDirecAttri;
    tkOperator: Result := fOperatorAttri;
    tkUnknown: Result := fOperatorAttri;
    else Result := nil;
  end;
end;

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

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

procedure TSynCACSyn.ReSetRange;
begin
  fRange := rsUnknown;
end;

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

class function TSynCACSyn.GetLanguageName: string;
begin
  Result := SYNS_LangCAClipper;
end;

procedure TSynCACSyn.StarProc;
begin
// if Run is 0 there could be an access violation
  if (Run = 0) or (fLine[Run - 1] in [#0, #10, #13]) then
  begin
    fTokenID := tkComment;
    repeat
      Inc(Run);
    until fLine[Run] in [#0, #10, #13];
  end else begin

    inc(Run);
    fTokenID := tkOperator;
  end;
end;

initialization
  MakeIdentTable;
{$IFNDEF SYN_CPPB_1}                                                            //mh 2000-07-14
  RegisterPlaceableHighlighter(TSynCACSyn);
{$ENDIF}
end.