synhighlighterprogress.pas

SynEditStudio delphi 代码编辑器

  Run := p - fLine;
end;

procedure TSynProgressSyn.IncludeRangeProc;
var
  p: PChar;
begin
  fTokenID := tkInclude;
  p := PChar(@fLine[Run]);

  if p^ = #0 then
  begin
    NullProc;
    exit;
  end;

  while p^ <> #0 do
  begin
    case p^ of
      '}': begin
             dec(fIncludeLevel);
             if fIncludeLevel = 0 then
             begin
               fRange := rsNone;
               break;
             end
             else
               inc(p);
           end;
    else
      inc(p);
    end;
  end;
  Run := p - fLine;
end;

procedure TSynProgressSyn.PreprocessorRangeProc;
var
  p: PChar;
begin
  fTokenID := tkPreprocessor;
  p := PChar(@fLine[Run]);

  if p^ = #0 then
  begin
    NullProc;
    exit;
  end;

  while (p^ <> #0) and (fRange = rsPreprocessor) do
  begin
    case p^ of
      '{': inc(fPreprocessorLevel);
      '}': begin
             dec(fPreprocessorLevel);
             if fPreprocessorLevel = 0 then
               fRange := rsNone;
           end;
    end;
    inc(p);
  end;
  Run := p - fLine;
end;

procedure TSynProgressSyn.PreprocessorDefinitionRangeProc;
var
  p: PChar;
begin
  fTokenID := tkPreprocessor;
  p := PChar(@fLine[Run]);

  if Run = 0 then
    fRange := rsNone;

  if p^ = #0 then
  begin
    NullProc;
    exit;
  end;

  while p^ <> #0 do
  begin
    case p^ of
      '~': if (p+1)^ = #0 then
             fRange := rsPreprocessorDef;
    end;
    inc(p);
  end;
  Run := p - fLine;
end;

procedure TSynProgressSyn.BraceOpenProc;
var
  p: PChar;

  function LevelCount: Integer;
  begin
    if fTokenID = tkInclude then
      Result := fIncludeLevel
    else
      Result := fPreprocessorLevel;
  end;

begin
  p := PChar(@fLine[Run]);

  inc(p);
  case p^ of
    'A'..'Z', 'a'..'z', '_': fTokenID := tkInclude;
    '&'                    : fTokenID := tkPreprocessor;
  else
    fTokenID := tkUnknown;
  end;

  case fTokenID of
    tkInclude     : fIncludeLevel      := 1;
    tkPreprocessor: fPreprocessorLevel := 1;
  end;

  while LevelCount > 0 do
  begin
    case p^ of
      #0 : begin
             if fTokenID = tkInclude then
               fRange := rsInclude
             else
               fRange := rsPreprocessor;
             break;
           end;
      '}': case fTokenID of
             tkInclude     : dec(fIncludeLevel);
             tkPreprocessor: dec(fPreprocessorLevel);
           end;
      '{': case fTokenID of
             tkInclude     : inc(fIncludeLevel);
             tkPreprocessor: inc(fPreprocessorLevel);
           end;
    end;
    inc(p);
  end;
  Run := p - fLine;
end;

procedure TSynProgressSyn.Next;
begin
  fTokenPos := Run;
  case fRange of
    rsInclude        : IncludeRangeProc;
    rsPreprocessor   : PreprocessorRangeProc;
    rsPreprocessorDef: PreprocessorDefinitionRangeProc;
    rsComment        : CommentRangeProc;
  else
    fProcTable[fLine[Run]];
  end;
end;

function TSynProgressSyn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
begin
  Result := nil;
end;

function TSynProgressSyn.GetEol: Boolean;
begin
  Result := fTokenID = tkNull;
end;

function TSynProgressSyn.GetRange: Pointer;
var
  rng: TRangeInfo;
begin
  rng.Range := Ord(fRange);
  rng.Level := 0;
  case fRange of
    rsComment     : rng.Level := fCommentLevel;
    rsInclude     : rng.Level := fIncludeLevel;
    rsPreProcessor: rng.Level := fPreProcessorLevel;
  end;
  Result := rng.Ptr;
end;

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

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

function TSynProgressSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
  case GetTokenID of
    tkComment: Result := fCommentAttri;
    tkEvent: Result := fEventAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkInclude: Result := fIncludeAttri;
    tkKey: Result := fKeyAttri;
    tkNonReserved: Result := fNonReservedKeyAttri;
    tkNumber: Result := fNumberAttri;
    tkPreprocessor: Result := fPreprocessorAttri;
    tkSpace: Result := fSpaceAttri;
    tkDataType: Result := fDataTypeAttri;
    tkString: Result := fStringAttri;
    tkSymbol: Result := fSymbolAttri;
    tkUnknown: Result := fSymbolAttri;
    else Result := nil;
  end;
end;

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

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

procedure TSynProgressSyn.ResetRange;
begin
  fRange := rsNone;
  fCommentLevel := 0;
  fIncludeLevel := 0;
  fPreprocessorLevel := 0;
end;

procedure TSynProgressSyn.SetRange(Value: Pointer);
var
  rng: TRangeInfo;
begin
  rng := TRangeInfo(Value);
  fRange := TRangeState(rng.Range);
  fCommentLevel := 0;
  fIncludeLevel := 0;
  fPreprocessorLevel := 0;
  case fRange of
    rsComment     : fCommentLevel := rng.Level;
    rsInclude     : fIncludeLevel := rng.Level;
    rsPreProcessor: fPreprocessorLevel := rng.Level;
  end;
end;

function TSynProgressSyn.GetIdentChars: TSynIdentChars;
begin
  Result := fIdentChars;
end;

function TSynProgressSyn.IsFilterStored: Boolean;
begin
  Result := fDefaultFilter <> SYNS_FilterProgress;
end;

class function TSynProgressSyn.GetLanguageName: string;
begin
  Result := SYNS_LangProgress;
end;

function TSynProgressSyn.GetSampleSource: String;
begin
  Result := '&scoped-define FirstChar 65'#13#10+
            '&scoped-define LastChar  90'#13#10+
            #13#10+
            'def var i as int no-undo.'#13#10+
            'def var s as char no-undo.'#13#10+
            #13#10+
            'function GetRandomChar returns char (input SomeValue as int):'#13#10+
            '  return chr(random({&FirstChar}, {&LastChar})).'#13#10+
            'end.'#13#10+
            #13#10+
            'procedure ClearString:'#13#10+
            '  def input-output param str as char no-undo.'#13#10+
            '  str = "".'#13#10+
            'end.'#13#10+
            #13#10+
            'run ClearString(input-output s).'#13#10+
            'do i = 1 to 100:'#13#10+
            '  s = s + GetRandomChar(17).'#13#10+
            'end.'#13#10+
            'display s.';
end;

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