SynEdit: PasHighLighter, fixed highlighting procedure names in interface declaration. Issue #0035238

git-svn-id: trunk@60700 -
2025-04-30 23:23:39 +02:00 · 2019-03-16 16:21:01 +00:00 · 2019-03-16 16:21:01 +00:00 · f531a8c563
commit f531a8c563
parent af7f589fd8
4 changed files with 235 additions and 83 deletions
--- a/components/synedit/synhighlighterpas.pp
+++ b/components/synedit/synhighlighterpas.pp
@ -1407,7 +1407,7 @@ begin
    StartPascalCodeFoldBlock(cfbtRecord);
    fRange := fRange - [rsVarTypeInSpecification];
    if CompilerMode = pcmDelphi then
-      fRange := fRange + [rsAtClass] - [rsAfterEqual]; // highlight helper
+      fRange := fRange + [rsAtClass] - [rsAfterEqual, rsAfterEqualOrColon]; // highlight helper
    Result := tkKey;
  end
  else if KeyComp('Array') then Result := tkKey
@ -1600,15 +1600,17 @@ begin
    if rsProperty in fRange then Result := tkKey else Result := tkIdentifier;
  end
  else if KeyComp('Interface') then begin
-    if (rsAfterEqualOrColon in fRange) and (PasCodeFoldRange.BracketNestLevel = 0)
+    if (rsAfterEqual in fRange) and (PasCodeFoldRange.BracketNestLevel = 0)
    then begin
-      fRange := fRange + [rsAtClass];
+      // type IFoo = INTERFACE
+      fRange := fRange + [rsAtClass] - [rsVarTypeInSpecification, rsAfterEqual];
      StartPascalCodeFoldBlock(cfbtClass);
    end
    else
    if not(rsAfterEqualOrColon in fRange) and
       (fRange * [rsInterface, rsImplementation] = []) then
    begin
+      // unit section INTERFACE
      CloseBeginEndBlocksBeforeProc;
      if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then
        EndPascalCodeFoldBlockLastLine;
--- a/components/synedit/test/SynTest.lpi
+++ b/components/synedit/test/SynTest.lpi
@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
  <ProjectOptions>
-    <Version Value="11"/>
+    <Version Value="12"/>
    <PathDelim Value="\"/>
    <General>
      <SessionStorage Value="InIDEConfig"/>
@ -12,8 +12,8 @@
      <Language Value=""/>
      <CharSet Value=""/>
    </VersionInfo>
-    <BuildModes Count="1">
-      <Item1 Name="default" Default="True"/>
+    <BuildModes>
+      <Item Name="default" Default="True"/>
    </BuildModes>
    <PublishOptions>
      <Version Value="2"/>
@ -48,121 +48,121 @@
        <PackageName Value="FCL"/>
      </Item5>
    </RequiredPackages>
-    <Units Count="23">
-      <Unit0>
+    <Units>
+      <Unit>
        <Filename Value="SynTest.lpr"/>
        <IsPartOfProject Value="True"/>
-      </Unit0>
-      <Unit1>
+      </Unit>
+      <Unit>
        <Filename Value="testsynselection.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestSynSelection"/>
-      </Unit1>
-      <Unit2>
+      </Unit>
+      <Unit>
        <Filename Value="testbase.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestBase"/>
-      </Unit2>
-      <Unit3>
+      </Unit>
+      <Unit>
        <Filename Value="testsynbeautifier.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestSynBeautifier"/>
-      </Unit3>
-      <Unit4>
+      </Unit>
+      <Unit>
        <Filename Value="testsyncroedit.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestSyncroEdit"/>
-      </Unit4>
-      <Unit5>
+      </Unit>
+      <Unit>
        <Filename Value="testtrimspace.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestTrimSpace"/>
-      </Unit5>
-      <Unit6>
+      </Unit>
+      <Unit>
        <Filename Value="testhighlightxml.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestHighlightXml"/>
-      </Unit6>
-      <Unit7>
+      </Unit>
+      <Unit>
        <Filename Value="testhighlightmulti.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestHighlightMulti"/>
-      </Unit7>
-      <Unit8>
+      </Unit>
+      <Unit>
        <Filename Value="testbasicsynedit.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestBasicSynEdit"/>
-      </Unit8>
-      <Unit9>
+      </Unit>
+      <Unit>
        <Filename Value="testfoldedview.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestFoldedView"/>
-      </Unit9>
-      <Unit10>
+      </Unit>
+      <Unit>
        <Filename Value="testhighlightpas.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestHighlightPas"/>
-      </Unit10>
-      <Unit11>
+      </Unit>
+      <Unit>
        <Filename Value="testmarkupwordgroup.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestMarkupwordGroup"/>
-      </Unit11>
-      <Unit12>
+      </Unit>
+      <Unit>
        <Filename Value="testbookmarks.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestBookMarks"/>
-      </Unit12>
-      <Unit13>
+      </Unit>
+      <Unit>
        <Filename Value="testsynsharededits.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestSynSharedEdits"/>
-      </Unit13>
-      <Unit14>
+      </Unit>
+      <Unit>
        <Filename Value="testblockindent.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestBlockIndent"/>
-      </Unit14>
-      <Unit15>
+      </Unit>
+      <Unit>
        <Filename Value="testhighlighterlfm.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestHighlighterLfm"/>
-      </Unit15>
-      <Unit16>
+      </Unit>
+      <Unit>
        <Filename Value="testhighlightfoldbase.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestHighlightFoldBase"/>
-      </Unit16>
-      <Unit17>
+      </Unit>
+      <Unit>
        <Filename Value="testsyntextarea.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestSynTextArea"/>
-      </Unit17>
-      <Unit18>
+      </Unit>
+      <Unit>
        <Filename Value="testnavigation.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestNavigation"/>
-      </Unit18>
-      <Unit19>
+      </Unit>
+      <Unit>
        <Filename Value="testmarkupifdef.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestMarkupIfDef"/>
-      </Unit19>
-      <Unit20>
+      </Unit>
+      <Unit>
        <Filename Value="testpaintcolormerging.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestPaintColorMerging"/>
-      </Unit20>
-      <Unit21>
+      </Unit>
+      <Unit>
        <Filename Value="testmarkupfoldcoloring.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestMarkupFoldColoring"/>
-      </Unit21>
-      <Unit22>
+      </Unit>
+      <Unit>
        <Filename Value="testsynmulticaret.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="TestSynMultiCaret"/>
-      </Unit22>
+      </Unit>
    </Units>
  </ProjectOptions>
  <CompilerOptions>
--- a/components/synedit/test/testhighlightfoldbase.pas
+++ b/components/synedit/test/testhighlightfoldbase.pas
@ -5,8 +5,8 @@ unit TestHighlightFoldBase;
 interface

 uses
-  SysUtils, TestBase,
-  SynEdit, SynEditHighlighterFoldBase;
+  SysUtils, TestBase, SynEdit, SynEditHighlighterFoldBase, SynEditHighlighter,
+  SynEditMiscClasses, LazLoggerBase;

 type

@ -21,7 +21,17 @@ type

 type

-  { TTestBaseHighlighterPas }
+  TExpTokenInfo = record
+    ExpKind: Integer;
+    ExpAttr: TSynHighlighterAttributes;
+    Flags: set of (etiKind, etiAttr);
+  end;
+
+operator := (a: Integer) : TExpTokenInfo;
+operator := (a: TSynHighlighterAttributes) : TExpTokenInfo;
+operator + (a: Integer; b: TSynHighlighterAttributes) : TExpTokenInfo;
+
+type

  { TTestBaseHighlighterFoldBase }

@ -29,6 +39,7 @@ type
  protected
    FTheHighLighter: TSynCustomFoldHighlighter;
    function CreateTheHighLighter: TSynCustomFoldHighlighter; virtual; abstract;
+    procedure InitTighLighterAttr; virtual;
    procedure SetUp; override;
    procedure TearDown; override;
    procedure ReCreateEdit; reintroduce;
@ -40,12 +51,36 @@ type
    procedure CheckFoldInfoCounts(Name: String; Filter: TSynFoldActions; Expected: Array of Integer);
    procedure CheckFoldInfoCounts(Name: String; Filter: TSynFoldActions; Group: Integer; Expected: Array of Integer);

+    procedure CheckTokensForLine(Name: String; LineIdx: Integer; ExpTokens: Array of TExpTokenInfo);
+
    function FoldActionsToString(AFoldActions: TSynFoldActions): String;
  end;


 implementation

+operator := (a: Integer) : TExpTokenInfo;
+begin
+  result := default(TExpTokenInfo);
+  result.ExpKind := a;
+  result.Flags := [etiKind];
+end;
+
+operator := (a: TSynHighlighterAttributes) : TExpTokenInfo;
+begin
+  result := default(TExpTokenInfo);
+  result.ExpAttr := a;
+  result.Flags := [etiAttr];
+end;
+
+operator + (a: Integer; b: TSynHighlighterAttributes) : TExpTokenInfo;
+begin
+  result := default(TExpTokenInfo);
+  result.ExpKind := a;
+  result.ExpAttr := b;
+  result.Flags := [etiKind, etiAttr];
+end;
+
 function ExpVLine(ALine: Integer; AExp: array of integer): TTestExpValuesForLine;
 var
  i: Integer;
@ -58,6 +93,21 @@ end;

 { TTestBaseHighlighterFoldBase }

+procedure TTestBaseHighlighterFoldBase.InitTighLighterAttr;
+var
+  i: Integer;
+begin
+  for i := 0 to FTheHighLighter.AttrCount - 1 do begin
+    DebugLn(['# ', i, ' ', FTheHighLighter.Attribute[i].StoredName]);
+    FTheHighLighter.Attribute[i].Foreground := 10000 + i; // unique foreground colors
+    FTheHighLighter.Attribute[i].Foreground := 10000 + i; // unique foreground colors
+    if FTheHighLighter.Attribute[i] is TSynHighlighterAttributesModifier then begin
+      TSynHighlighterAttributesModifier(FTheHighLighter.Attribute[i]).ForeAlpha := 0;
+      TSynHighlighterAttributesModifier(FTheHighLighter.Attribute[i]).ForePriority := 100+i;
+    end;
+  end;
+end;
+
 procedure TTestBaseHighlighterFoldBase.SetUp;
 begin
  FTheHighLighter := nil;
@ -79,6 +129,7 @@ begin
  FreeAndNil(FTheHighLighter);
  inherited ReCreateEdit;
  FTheHighLighter := CreateTheHighLighter;
+  InitTighLighterAttr;
  SynEdit.Highlighter := FTheHighLighter;
 end;

@ -142,6 +193,38 @@ begin
  end;
 end;

+procedure TTestBaseHighlighterFoldBase.CheckTokensForLine(Name: String;
+  LineIdx: Integer; ExpTokens: array of TExpTokenInfo);
+
+  function AttrVal(a: TSynHighlighterAttributes): Integer;
+  begin
+    if a = nil then exit(-1);
+    if a is TSynSelectedColorMergeResult then
+      TSynSelectedColorMergeResult(a).ProcessMergeInfo;
+    Result := a.Foreground; // compare the color
+  end;
+var
+  c: Integer;
+  e: TExpTokenInfo;
+begin
+  FTheHighLighter.StartAtLineIndex(LineIdx);
+  c := 0;
+  while not FTheHighLighter.GetEol do begin
+    e := ExpTokens[c];
+    //DebugLn([FTheHighLighter.GetToken,' (',FTheHighLighter.GetTokenKind ,') at ', FTheHighLighter.GetTokenPos]);
+    if etiKind in e.Flags then
+      AssertEquals(Name + ' Kind @ TokenId Line='+IntToStr(LineIdx)+' pos='+IntToStr(c),  e.ExpKind, FTheHighLighter.GetTokenKind);
+    if etiAttr in e.Flags then
+      AssertEquals(Name + ' Attr @ TokenId Line='+IntToStr(LineIdx)+' pos='+IntToStr(c),  AttrVal(e.ExpAttr), AttrVal(FTheHighLighter.GetTokenAttribute));
+
+    FTheHighLighter.Next;
+    inc(c);
+    if c >= length(ExpTokens) then
+      break;
+  end;
+  AssertEquals(Name+ 'TokenId Line='+IntToStr(LineIdx)+'  amount of tokens', length(ExpTokens), c );
+end;
+
 function TTestBaseHighlighterFoldBase.FoldActionsToString(AFoldActions: TSynFoldActions): String;
 var
  s: string;
--- a/components/synedit/test/testhighlightpas.pas
+++ b/components/synedit/test/testhighlightpas.pas
@ -5,8 +5,9 @@ unit TestHighlightPas;
 interface

 uses
-  Classes, SysUtils, testregistry, TestBase, Forms, LCLProc, TestHighlightFoldBase,
-  SynEdit, SynEditTypes, SynHighlighterPas, SynEditHighlighterFoldBase;
+  Classes, SysUtils, testregistry, TestBase, Forms, LCLProc,
+  TestHighlightFoldBase, SynEdit, SynEditTypes, SynHighlighterPas,
+  SynEditHighlighterFoldBase, SynEditHighlighter;

 type

@ -47,13 +48,13 @@ type
    function TestTextFoldInfo4(AIfCol: Integer): TStringArray;
    function TestTextFoldInfo5: TStringArray;

-    procedure CheckTokensForLine(Name: String; LineIdx: Integer; ExpTokens: Array of TtkTokenKind);
  published
    procedure TestFoldInfo;
    procedure TestExtendedKeywordsAndStrings;
    procedure TestContextForProcModifiers;
    procedure TestContextForProperties;
    procedure TestContextForProcedure;
+    procedure TestContextForInterface;
    procedure TestContextForDeprecated;
    procedure TestContextForClassModifier; // Sealed abstract
    procedure TestContextForClassHelper;
@ -67,6 +68,21 @@ type

 implementation

+operator := (a: TtkTokenKind) : TExpTokenInfo;
+begin
+  result := default(TExpTokenInfo);
+  result.ExpKind := ord(a);
+  result.Flags := [etiKind];
+end;
+
+operator + (a: TtkTokenKind; b: TSynHighlighterAttributes) : TExpTokenInfo;
+begin
+  result := default(TExpTokenInfo);
+  result.ExpKind := ord(a);
+  result.ExpAttr := b;
+  result.Flags := [etiKind, etiAttr];
+end;
+
 { TTestBaseHighlighterPas }

 function TTestBaseHighlighterPas.PasHighLighter: TSynPasSyn;
@ -287,24 +303,6 @@ begin
  Result[12] := '';
 end;

-procedure TTestHighlighterPas.CheckTokensForLine(Name: String; LineIdx: Integer;
-  ExpTokens: array of TtkTokenKind);
-var
-  c: Integer;
-begin
-  PasHighLighter.StartAtLineIndex(LineIdx);
-  c := 0;
-  while not PasHighLighter.GetEol do begin
-    //DebugLn([PasHighLighter.GetToken,' (',PasHighLighter.GetTokenID ,') at ', PasHighLighter.GetTokenPos]);
-    AssertEquals(Name + 'TokenId Line='+IntToStr(LineIdx)+' pos='+IntToStr(c),  ord(ExpTokens[c]), ord(PasHighLighter.GetTokenID));
-    PasHighLighter.Next;
-    inc(c);
-    if c >= length(ExpTokens) then
-      break;
-  end;
-  AssertEquals(Name+ 'TokenId Line='+IntToStr(LineIdx)+'  amount of tokens', length(ExpTokens), c );
-end;
-
 procedure TTestHighlighterPas.TestFoldInfo;
 begin
  ReCreateEdit;
@ -665,12 +663,24 @@ begin
 end;

 procedure TTestHighlighterPas.TestContextForProcedure;
+var
+  AtP, AtI, AtK: TSynHighlighterAttributes;
 begin
  ReCreateEdit;
+  AtP := PasHighLighter.ProcedureHeaderName;
+  AtI := PasHighLighter.IdentifierAttri;
+  AtK := PasHighLighter.KeywordAttribute;
+
  SetLines
    ([ 'Unit A;',
       'interface',
       '',
+       'type',
+       '  IBar = interface',
+       '     procedure p1;',
+       '     procedure p2;',
+       '  end;',
+       '',
       'var',
       '  Foo: Procedure of object;', // no folding // do not end var block
       '',
@ -699,16 +709,73 @@ begin
       ''
    ]);
  EnableFolds([cfbtBeginEnd..cfbtNone]);
-  CheckFoldOpenCounts('', [ 1, 1, 0, 1 {var}, 0, 0, 1 {type}, 0, 0, 0, 0 {Proc}, 0,
+  CheckFoldOpenCounts('', [ 1, 1, 0,
+                            1 {type}, 1, 0, 0, 0, 0,
+                            1 {var}, 0, 0, 1 {type}, 0, 0, 0,
+                            0 {Proc}, 0,
                            1 {impl}, 0, 1 {var}, 0, 0, 1 {type}, 0, 0, 0,
                            1 {proc}, 1 {var}, 0, 0, 0, 0, 0
                     ]);
-  AssertEquals('Len var 1 ',   2, PasHighLighter.FoldLineLength(3, 0));
-  AssertEquals('Len type 1 ',  3, PasHighLighter.FoldLineLength(6, 0));
-  AssertEquals('Len var 2 ',   2, PasHighLighter.FoldLineLength(14, 0));
-  AssertEquals('Len type 2 ',  3, PasHighLighter.FoldLineLength(17, 0));
-  AssertEquals('Len var 3 ',   2, PasHighLighter.FoldLineLength(22, 0));
+  AssertEquals('Len var 1 ',   2, PasHighLighter.FoldLineLength(9, 0));
+  AssertEquals('Len type 1 ',  3, PasHighLighter.FoldLineLength(12, 0));
+  AssertEquals('Len var 2 ',   2, PasHighLighter.FoldLineLength(20, 0));
+  AssertEquals('Len type 2 ',  3, PasHighLighter.FoldLineLength(23, 0));
+  AssertEquals('Len var 3 ',   2, PasHighLighter.FoldLineLength(28, 0));

+
+  CheckTokensForLine('IBar.p1',   5, [ tkSpace, tkKey + AtK, tkSpace, tkIdentifier + AtP, tkSymbol ]);
+  CheckTokensForLine('IBar.p2',   6, [ tkSpace, tkKey + AtK, tkSpace, tkIdentifier + AtP, tkSymbol ]);
+  CheckTokensForLine('foo p of', 10, [ tkSpace, tkIdentifier, tkSymbol, tkSpace,
+    tkKey + AtK, tkSpace, tkKey + AtK {of}, tkSpace, tkKey, tkSymbol
+    ]);
+  CheckTokensForLine('TBar',     14, [ tkSpace, tkKey + AtK, tkSymbol, tkSymbol, tkSymbol,
+    tkSpace, tkIdentifier + AtI, tkSymbol
+    ]);
+
+
+end;
+
+procedure TTestHighlighterPas.TestContextForInterface;
+var
+  AtP, AtI, AtK: TSynHighlighterAttributes;
+begin
+  ReCreateEdit;
+  AtK := PasHighLighter.KeywordAttribute;
+
+  SetLines
+    ([ 'Unit A;',
+       'interface',
+       '',
+       'type',
+       '  IBar = interface',
+       '     procedure p1;',
+       '     procedure p2;',
+       '  end;',
+       '',
+       'var',
+       '  IBar2: interface', // not allowed "anonymous class"
+       '     procedure p1;',
+       '     procedure p2;',
+       '',
+       'implementation',
+       ''
+    ]);
+  EnableFolds([cfbtBeginEnd..cfbtNone]);
+  CheckFoldOpenCounts('', [ 1, 1, 0,
+                            1 {type}, 1, 0, 0, 0, 0,
+                            1 {var},  0, 0, 0, 0, 0
+                            // implementation
+                     ]);
+  AssertEquals('Len type ',  5, PasHighLighter.FoldLineLength(3, 0));
+  AssertEquals('Len intf ',  3, PasHighLighter.FoldLineLength(4, 0));
+  AssertEquals('Len var  ',  1, PasHighLighter.FoldLineLength(9, 0)); // ends at next procedure
+
+  CheckTokensForLine('unit "interface"',  1,
+    [ tkKey + AtK ]);
+  CheckTokensForLine('type "interface"',  4,
+    [ tkSpace, tkIdentifier, tkSpace, tkSymbol, tkSpace, tkKey + AtK ]);
+  CheckTokensForLine('var "interface"',  10,
+    [ tkSpace, tkIdentifier, tkSymbol, tkSpace, tkKey + AtK ]); // not allowed, still a keyword
 end;

 procedure TTestHighlighterPas.TestContextForDeprecated;