synhighlightercpm.pas

SynEditStudio delphi 代码编辑器

function TSynCPMSyn.Func198: TtkTokenKind;
begin
  if KeyComp('LOWERLEVELSTOO') then Result := tkKey else Result := tkIdentifier;
end;

function TSynCPMSyn.Func210: TtkTokenKind;
begin
  if KeyComp('PROPERTYGROUP') then Result := tkKey else Result := tkIdentifier;
end;

function TSynCPMSyn.Func211: TtkTokenKind;
begin
  if KeyComp('PREVREPEATINSTANCE') then Result := tkSystem else Result := tkIdentifier;
end;

function TSynCPMSyn.Func212: TtkTokenKind;
begin
  if KeyComp('DISTINCT_EXECUTE') then Result := tkKey else Result := tkIdentifier;
end;

function TSynCPMSyn.Func213: TtkTokenKind;
begin
  if KeyComp('NEXTREPEATINSTANCE') then Result := tkSystem else
    if KeyComp('SUPPLIESOFMEMBERS') then Result := tkKey else Result := tkIdentifier;
end;

function TSynCPMSyn.Func271: TtkTokenKind;
begin
  if KeyComp('ALLQUALITYPROPERTIES') then Result := tkKey else Result := tkIdentifier;
end;

function TSynCPMSyn.Func273: TtkTokenKind;
begin
  if KeyComp('V_PAR_LANGUAGE_FIELDS') then Result := tkSpecialVar else Result := tkIdentifier;
end;

function TSynCPMSyn.Func291: TtkTokenKind;
begin
  if KeyComp('V_PAR_LANGUAGE_COUNT') then Result := tkSpecialVar else Result := tkIdentifier;
end;

function TSynCPMSyn.AltFunc: TtkTokenKind;
begin
  Result := tkIdentifier;
end; { AltFunc }


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


procedure TSynCPMSyn.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
  begin
    case I of
      #0       : fProcTable[I] := NullProc;
      #10      : fProcTable[I] := LFProc;
      #13      : fProcTable[I] := CRProc;
      #1..#9,
      #11,
      #12,
      #14..#32 : fProcTable[I] := SpaceProc;
      '"'      : fProcTable[I] := StringProc;
      '0'..'9' : fProcTable[I] := NumberProc;
      'A'..'Z',
      'a'..'z',
      '_'      : case I of
                   'V', 'v',
                   'S', 's'  : fProcTable[I] := VariableProc;
                 else
                   fProcTable[I] := IdentProc;
                 end;
      '{'      : fProcTable[I] := BraceOpenProc;
      '}',
      '!',
      '%',
      '&',
      '('..'/',
      ':'..'@',
      '['..'^',
      '`', '~' : begin
                   case I of
                     ';': fProcTable[I] := SemiColonProc;
                   else
                     fProcTable[I] := SymbolProc;
                   end;
                 end;
    else
      fProcTable[I] := UnknownProc;
    end;
  end;
end; { MakeMethodTables }


constructor TSynCPMSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fCommentAttri := TSynHighLighterAttributes.Create(SYNS_AttrComment);
  fCommentAttri.Foreground := clNavy;
  fCommentAttri.Style := [fsItalic];
  AddAttribute(fCommentAttri);

  fIdentifierAttri := TSynHighLighterAttributes.Create(SYNS_AttrIdentifier);
  AddAttribute(fIdentifierAttri);

  fKeyAttri := TSynHighLighterAttributes.Create(SYNS_AttrReservedWord);
  fKeyAttri.Foreground := clGreen;
  fKeyAttri.Style := [fsBold];
  AddAttribute(fKeyAttri);

  fNumberAttri := TSynHighlighterAttributes.Create(SYNS_AttrNumber);
  AddAttribute(fNumberAttri);
  
  fSpaceAttri := TSynHighLighterAttributes.Create(SYNS_AttrSpace);
  AddAttribute(fSpaceAttri);

  fSQLKeyAttri := TSynHighLighterAttributes.Create(SYNS_AttrSQLKey);
  fSQLKeyAttri.ForeGround := clTeal;
  fSQLKeyAttri.Style := [fsBold];
  AddAttribute(fSQLKeyAttri);

  fStringAttri := TSynHighLighterAttributes.Create(SYNS_AttrString);
  AddAttribute(fStringAttri);

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

  fSpecialVarAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpecialVariable);
  fSpecialVarAttri.Style := [fsBold];
  AddAttribute(fSpecialVarAttri);

  fSystemAttri := TSynHighlighterAttributes.Create(SYNS_AttrSystem);
  fSystemAttri.Foreground := $000080FF;
  fSystemAttri.Style := [fsBold];
  AddAttribute(fSystemAttri);

  fVariableAttri := TSynHighlighterAttributes.Create(SYNS_AttrVariable);
  fVariableAttri.Foreground := clMaroon;
  AddAttribute(fVariableAttri);

  SetAttributesOnChange(DefHighlightChange);
  InitIdent;
  MakeMethodTables;
  fRange := rsUnknown;
  fCommentLevel := 0;
  fDefaultFilter := SYNS_FilterCPM;
end; { Create }


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


procedure TSynCPMSyn.BraceOpenProc;
begin
  fRange := rsBraceComment;
  BraceCommentProc;
  fTokenID := tkComment;
end; { BraceOpenProc }


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


procedure TSynCPMSyn.VariableProc;
begin
  fTokenID := IdentKind((fLine + Run));
  if (fTokenID = tkIdentifier) then
  begin
    if (fLine[Run + 1] = '_') then
      fTokenID := tkVariable
  end;
  inc(Run, fStringLen);
  while Identifiers[fLine[Run]] do
    Inc(Run);
end; { VariableProc }


procedure TSynCPMSyn.NullProc;
begin
  fTokenID := tkNull;
end; { NullProc }


procedure TSynCPMSyn.SpaceProc;
begin
  fTokenID := tkSpace;
  repeat
    inc(Run);
  until not (fLine[Run] in [#1..#32]);
end; { SpaceProc }


procedure TSynCPMSyn.StringProc;
begin
  fTokenID := tkString;
  repeat
    Inc(Run);
  until fLine[Run] in [#0, #10, #13, '"'];
  if (fLine[Run] = '"') then
  begin
    Inc(Run);
    if (fLine[Run] = '"') then
      Inc(Run);
  end;
end; { StringProc }


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


procedure TSynCPMSyn.Next;
begin
  fTokenPos := Run;
  case fRange of
    rsBraceComment: BraceCommentProc;
  else
    fProcTable[fLine[Run]];
  end;
end; { Next }


function TSynCPMSyn.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; { GetDefaultAttribute }


function TSynCPMSyn.GetEol: Boolean;
begin
  Result := fTokenID = tkNull;
end; { GetEol }


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


function TSynCPMSyn.GetTokenID: TtkTokenKind;
begin
  Result := fTokenId;
end; { GetTokenID }


function TSynCPMSyn.GetTokenAttribute: TSynHighLighterAttributes;
begin
  case GetTokenID of
    tkComment: Result := fCommentAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkKey: Result := fKeyAttri;
    tkNumber: Result := fNumberAttri;
    tkSpace: Result := fSpaceAttri;
    tkSQLKey: Result := fSQLKeyAttri;
    tkString: Result := fStringAttri;
    tkSymbol: Result := fSymbolAttri;
    tkSpecialVar: Result := fSpecialVarAttri;
    tkSystem: Result := fSystemAttri;
    tkVariable: Result := fVariableAttri; 
    tkUnknown: Result := fIdentifierAttri;
  else
    Result := nil;
  end;
end; { GetTokenAttribute }


function TSynCPMSyn.GetTokenKind: integer;
begin
  Result := Ord(fTokenId);
end; { GetTokenKind }


function TSynCPMSyn.GetTokenPos: Integer;
begin
  Result := fTokenPos;
end; { GetTokenPos }


function TSynCPMSyn.GetIdentChars: TSynIdentChars;
begin
  Result := TSynValidStringChars;
end; { getIdentChars }


class function TSynCPMSyn.GetLanguageName: string;
begin
  Result := SYNS_LangCPM;
end; { GetLanguageName }


procedure TSynCPMSyn.BraceCommentProc;
begin
  case fLine[Run] of
     #0: NullProc;
    #10: LFProc;
    #13: CRProc;
  else
    begin
      fTokenID := tkComment;
      repeat
        if fLine[Run] = '{' then
          Inc(fCommentLevel)
        else if fLine[Run] = '}' then
        begin
          Dec(fCommentLevel);
          if (fCommentLevel < 1) then
          begin
            Inc(Run);
            fRange := rsUnKnown;
            fCommentLevel := 0;
            Break;
          end;
        end;
        Inc(Run);
      until fLine[Run] in [#0, #10, #13];
    end;
  end;
end; { BraceCommentProc }


procedure TSynCPMSyn.CRProc;
begin
  fTokenID := tkSpace;
  inc(Run);
  if fLine[Run] = #10 then
    inc(Run);
end; { CRProc }


procedure TSynCPMSyn.LFProc;
begin
  fTokenID := tkSpace;
  inc(Run);
end; { LFProc }


function TSynCPMSyn.GetSampleSource: string;
begin
  Result := '{ COAS Product Manager report (RDF) }'#13#10 +
            'PARAM'#13#10 +
            '  LANGUAGE;'#13#10 +
            '  CONTINUE;'#13#10 +
            'END; { Param }'#13#10 +
            #13#10 +
            'GLOBALS'#13#10 +
            '  LANGUAGE = LOCAL;'#13#10 +
            'END; { Globals }'#13#10 +
            #13#10 +
            'DEFINITION BLOCK "MAIN"'#13#10 +
            'VARIABLES'#13#10 +
            '  S_Query = "";'#13#10 +
            '  V_OraErr = -1;'#13#10 +
            '  V_Count;'#13#10 +
            'BEGIN'#13#10 +
            '  ASSIGN(S_Query, "SELECT * FROM DUAL");'#13#10 +
            '  SQL_CREATE(V_OraErr, S_Query);'#13#10 +
            '  ASSIGN(V_Count, V_NoneReal);'#13#10 +
            'END;';
end; { GetSampleSource }


function TSynCPMSyn.IsFilterStored: Boolean;
begin
  Result := fDefaultFilter <> SYNS_FilterCPM;
end; { IsFilterStored }


procedure TSynCPMSyn.SemiColonProc;
begin
  Inc(Run);
  fTokenID := tkSymbol;
end; { SemiColonProc }


procedure TSynCPMSyn.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; { NumberProc }


procedure TSynCPMSyn.SymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end; { SymbolProc }


procedure TSynCPMSyn.ResetRange;
begin
  inherited;
  fRange := rsUnknown;
  fCommentLevel := 0;
end; { ResetRange }


procedure TSynCPMSyn.SetRange(Value: Pointer);
var
  AValue: LongInt;
begin
  inherited;
  AValue := Longint(Value);
  fCommentLevel := AValue div $10000;
  fRange := TRangeState(AValue mod $10000);
end; { SetRange }


function TSynCPMSyn.GetRange: Pointer;
begin
  Result := Pointer((fCommentLevel * $10000) + Integer(fRange));
end; { GetRange }


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