SynEdit: PasHighLighter, fix class sections (private/public/...). Issue #40614 / broken in commit cbf59cc75a

components/synedit/synhighlighterpas.pp

@@ -92,10 +92,10 @@ type
     rsAtClass,
     rsInObjcProtocol,
     rsAfterClass,
+    rsInTypeHelper,
     rsAfterIdentifierOrValue, // anywhere where a ^ deref can happen "foo^", "foo^^", "foo()^", "foo[]^"
     rsAfterIdentifierOrValueAdd,
 
-    rsAtClosingBracket,   // ')'
     rsAtCaseLabel,
     rsAtProcName,    // after a procedure/function/... keyword, when the name is expected (not for types)
                      // also after "unit unitname" to detect "deprecated"
@@ -1417,7 +1417,12 @@ begin
   if KeyComp('For') then begin
     Result := tkKey;
     if TopPascalCodeFoldBlockType in PascalStatementBlocks then
-      StartPascalCodeFoldBlock(cfbtForDo);
+      StartPascalCodeFoldBlock(cfbtForDo)
+    else
+    if rsInTypeHelper in FOldRange then begin
+      fRange := fRange + [rsInTypeHelper];
+      FOldRange := FOldRange - [rsInTypeHelper];
+    end;
   end
   else
   if KeyComp('Shl') then begin
@@ -1722,9 +1727,10 @@ begin
   end
   else if KeyComp('Record') then begin
     StartPascalCodeFoldBlock(cfbtRecord);
-    fRange := fRange - [rsVarTypeInSpecification];
+    fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual, rsAfterEqualOrColon] + [rsAfterSemiColon];
+    FOldRange := FOldRange - [rsAfterSemiColon];
     if CompilerMode = pcmDelphi then
-      fRange := fRange + [rsAtClass] - [rsAfterEqual, rsAfterEqualOrColon]; // highlight helper
+      fRange := fRange + [rsAtClass]; // highlight helper
     Result := tkKey;
   end
   else if KeyComp('Array') then Result := tkKey
@@ -1763,12 +1769,14 @@ begin
   // TODO: "class helper" fold at "class", but "type helper" fold at "helper"
   else if KeyComp('helper') then begin
     if (rsAtClass in fRange) and (PasCodeFoldRange.BracketNestLevel = 0)
-    then
-      Result := tkKey
+    then begin
+      Result := tkKey;
+      fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual] + [rsInTypeHelper];
+    end
     else
     if (rsAfterEqualThenType in fRange) and TypeHelpers then begin
       Result := tkKey;
-      fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual];
+      fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual] + [rsInTypeHelper];
       StartPascalCodeFoldBlock(cfbtClass); // type helper
     end
     else
@@ -3712,10 +3720,6 @@ begin
   fTokenID := tkSymbol;
   fRange := fRange + [rsAfterIdentifierOrValueAdd];
   PasCodeFoldRange.DecBracketNestLevel;
-  if (PasCodeFoldRange.BracketNestLevel = 0) then begin
-    if (fRange * [rsAfterClass] <> []) then
-      fRange := fRange + [rsAtClosingBracket];
-  end;
 end;
 
 procedure TSynPasSyn.SquareOpenProc;
@@ -3960,6 +3964,7 @@ end;
 procedure TSynPasSyn.Next;
 var
   IsAtCaseLabel: Boolean;
+  OldNestLevel: Integer;
 begin
   fAsmStart := False;
   FIsPasDocKey := False;
@@ -3989,6 +3994,7 @@ begin
         SlashContinueProc
       else begin
         FOldRange := fRange;
+        OldNestLevel := PasCodeFoldRange.BracketNestLevel;
         if (PasCodeFoldRange.BracketNestLevel = 1) then // procedure foo; [attr...]
           FOldRange := FOldRange - [rsWasInProcHeader];
         FTokenFlags := [];
@@ -4014,17 +4020,24 @@ begin
 
         if not (FTokenID in [tkSpace, tkComment, tkIDEDirective, tkDirective]) then begin
           if (PasCodeFoldRange.BracketNestLevel = 0) and
-             not(rsAtClosingBracket in fRange)
+             (OldNestLevel = 0)
           then
             fRange := fRange - [rsAfterClass];
+          if (PasCodeFoldRange.BracketNestLevel > 0) or
+             (OldNestLevel > 0)
+          then
+            FOldRange := FOldRange - [rsInTypeHelper];
 
           fRange := fRange -
             (FOldRange * [rsAfterEqualOrColon, rsAfterSemiColon,
                           rsAtPropertyOrReadWrite, rsAfterClassField,
                           rsAfterIdentifierOrValue, rsAfterEqualThenType,
-                          rsWasInProcHeader, rsAtProcName, rsAfterProcName]
-            ) -
-            [rsAtClosingBracket];
+                          rsWasInProcHeader, rsAtProcName, rsAfterProcName,
+                          rsInTypeHelper]
+            );
+
+          if (FTokenID = tkIdentifier) and (rsInTypeHelper in FOldRange) then
+            fRange := fRange + [rsAfterSemiColon];
 
           if rsAtClass in fRange then begin
             if FOldRange * [rsAtClass, rsAfterClass] <> [] then
@@ -4034,7 +4047,6 @@ begin
           end
         end
         else begin
-          fRange := fRange - [rsAtClosingBracket];
           if rsAtClass in fRange then
             fRange := fRange + [rsAfterClass];
         end;

components/synedit/test/testhighlightpas.pas

@@ -1715,9 +1715,12 @@ begin
       ([ 'Unit A; interface',
          'type',
          'TFoo = class helper for TBar',
-           'helper, sealed, abstract: Integer;',
+           'helper, sealed, abstract, public: Integer;',
            'procedure Foo; abstract;',
           'end;',
+         'TFoo = class helper for TBar',
+         'protected',
+         'end;',
          ''
       ]);
     CheckTokensForLine('class declaration"',  2,
@@ -1726,11 +1729,21 @@ begin
         tkSpace, tkIdentifier
       ]);
     CheckTokensForLine('var in class "',  3,
-      [ tkIdentifier, tkSymbol, tkSpace,  tkIdentifier, tkSymbol, tkSpace,  tkIdentifier, tkSymbol,
+      [ tkIdentifier, tkSymbol, tkSpace,  tkIdentifier, tkSymbol, tkSpace,
+        tkIdentifier, tkSymbol, tkSpace,  tkIdentifier, tkSymbol,
         tkSpace, tkIdentifier, tkSymbol
       ]);
     CheckTokensForLine('procedure in class "',  4,
       [ tkKey, tkSpace, tkIdentifier + FAttrProcName,  tkSymbol, tkSpace, tkKey,  tkSymbol ]);
+    CheckTokensForLine('end',  5,
+      [ tkKey, tkSymbol ]);
+    CheckTokensForLine('class declaration"',  6,
+      [ tkIdentifier, tkSpace, tkSymbol, tkSpace,
+        tkKey {class}, tkSpace, tkKey {helper}, tkSpace, tkKey {for},
+        tkSpace, tkIdentifier
+      ]);
+    CheckTokensForLine('class section',  7,
+      [ tkKey ]);
 
 
     ReCreateEdit;
@@ -1742,6 +1755,8 @@ begin
            'helper, sealed, abstract: Integer;',
            'procedure Foo; abstract;',
           'end;',
+         'TFoo = class helper(helper) for helper',
+         'protected',
          ''
       ]);
     CheckTokensForLine('class declaration"',  2,
@@ -1756,6 +1771,8 @@ begin
       ]);
     CheckTokensForLine('procedure in class "',  4,
       [ tkKey, tkSpace, tkIdentifier + FAttrProcName,  tkSymbol, tkSpace, tkKey,  tkSymbol ]);
+    CheckTokensForLine('class section',  7,
+      [ tkKey ]);
   end;
 end;
 
@@ -1785,6 +1802,11 @@ procedure TTestHighlighterPas.TestContextForTypeHelper;
         tkKey {type}, tkSpace, tkIdentifier {helper}, tkSpace, tkKey {for}, tkSpace, tkIdentifier, tkSymbol
       ]);
     AssertEquals('not a helper, switched off / no fold', 0, PasHighLighter.FoldOpenCount(11));
+
+    CheckTokensForLine('class section',  14,
+      [ tkKey ]);
+    CheckTokensForLine('NOT class section',  18,
+      [ tkIdentifier ]);
   end;
 
 var
@@ -1813,6 +1835,13 @@ begin
          '{$modeswitch typehelpers-}',
          'helper = type helper for helper;',
          '{$modeswitch typehelpers}',
+         'helper = type helper for helper',
+         'protected',
+         'end;',
+         '{$modeswitch typehelpers-}',
+         'helper = type helper for helper',
+         'protected',
+         '{$modeswitch typehelpers}',
          ''
       ]);
 
@@ -1884,6 +1913,9 @@ begin
          'TFoo = record helper for TBar',
            'helper, sealed, abstract: Integer;',
           'end;',
+         'TFoo = record helper for TBar',
+          'protected;',
+          'end;',
          ''
       ]);
     CheckTokensForLine('record declaration"',  2,
@@ -1895,6 +1927,8 @@ begin
       [ tkIdentifier, tkSymbol, tkSpace,  tkIdentifier, tkSymbol, tkSpace,  tkIdentifier, tkSymbol,
         tkSpace, tkIdentifier, tkSymbol
       ]);
+    CheckTokensForLine('class section',  6,
+      [ tkKey ]);
 
 
     ReCreateEdit;