SynEdit, Pas Highlighter: show ^x as string

git-svn-id: trunk@47509 -

components/synedit/synhighlighterpas.pp

@@ -78,6 +78,7 @@ type
     // we need to detect:    type TFoo = procedure; // must not fold
     //                       var  foo: procedure;   // must not fold
     rsAfterEqualOrColon,   // very first word after "=" or ":"
+    rsAfterEqual,          // between "=" and ";" (or block end) // a ^ means ctrl-char, not pointer to type
 
     // Detect if class/object is   type TFoo = class; // forward declaration
     //                                  TBar = class of TFoo;
@@ -91,8 +92,9 @@ type
     rsInProcHeader,       // Declaration or implementation header of a Procedure, function, constructor...
     rsAfterClassMembers,  // Encountered a procedure, function, property, constructor or destructor in a class
     rsAfterClassField,    // after ";" of a field (static needs highlight)
-    rsVarTypeInSpecification // between ":"/"=" and ";" in a var or type section (or class members)
+    rsVarTypeInSpecification, // between ":"/"=" and ";" in a var or type section (or class members)
                               // var a: Integer; type b = Int64;
+    rsInTypeBlock
   );
   TRangeStates = set of TRangeState;
 
@@ -450,6 +452,7 @@ type
     procedure OctalProc;
     procedure LFProc;
     procedure LowerProc;
+    procedure CaretProc;
     procedure NullProc;
     procedure NumberProc;
     procedure PointProc;
@@ -1374,6 +1377,7 @@ begin
       if TopPascalCodeFoldBlockType in [cfbtProcedure]
       then StartPascalCodeFoldBlock(cfbtLocalVarType)
       else StartPascalCodeFoldBlock(cfbtVarType);
+      fRange := fRange + [rsInTypeBlock];
     end;
     Result := tkKey;
   end
@@ -2283,8 +2287,9 @@ begin
       '0'..'9': fProcTable[I] := @NumberProc;
       'A'..'Z', 'a'..'z', '_':
         fProcTable[I] := @IdentProc;
+      '^': fProcTable[I] := @CaretProc;
       '{': fProcTable[I] := @BraceOpenProc;
-      '}', '!', '"', '('..'/', ':'..'@', '['..'^', '`', '~':
+      '}', '!', '"', '('..'/', ':'..'@', '[', ']', '\', '`', '~':
         begin
           case I of
             '(': fProcTable[I] := @RoundOpenProc;
@@ -2737,6 +2742,26 @@ begin
   if fLine[Run] in ['=', '>'] then inc(Run);
 end;
 
+procedure TSynPasSyn.CaretProc;
+var
+  t: TPascalCodeFoldBlockType;
+begin
+  inc(Run);
+  fTokenID := tkSymbol;
+
+  t := TopPascalCodeFoldBlockType;
+  if (t in PascalStatementBlocks - [cfbtAsm]) or   //cfbtClass, cfbtClassSection,
+     ( ( (t in [cfbtVarType, cfbtLocalVarType]) or
+         ((t in [cfbtProcedure]) and (PasCodeFoldRange.BracketNestLevel > 0))
+       ) and
+       (fRange * [rsInTypeBlock, rsAfterEqual] = [rsAfterEqual]) )
+  then begin
+    if Run<fLineLen then
+      inc(Run);
+    fTokenID := tkString;
+  end;
+end;
+
 procedure TSynPasSyn.NullProc;
 begin
   if (Run = 0) and (rsSlash in fRange) then begin
@@ -2868,7 +2893,7 @@ procedure TSynPasSyn.EqualSignProc;
 begin
   inc(Run);
   fTokenID := tkSymbol;
-  fRange := fRange + [rsAfterEqualOrColon];
+  fRange := fRange + [rsAfterEqualOrColon, rsAfterEqual];
   if (TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType, cfbtClass, cfbtClassSection, cfbtRecord]) and
      not(rsAfterClassMembers in fRange)
   then
@@ -2906,7 +2931,7 @@ begin
      (PasCodeFoldRange.BracketNestLevel = 0)
   then
     fRange := fRange - [rsProperty, rsInProcHeader];
-  fRange := fRange - [rsVarTypeInSpecification];
+  fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual];
 end;
 
 procedure TSynPasSyn.SlashProc;
@@ -3034,13 +3059,11 @@ begin
              not(rsAtClosingBracket in fRange)
           then
             fRange := fRange - [rsAfterClass];
-          if rsAfterEqualOrColon in FOldRange then
+
-            fRange := fRange - [rsAfterEqualOrColon];
+          fRange := fRange -
-          if rsAtPropertyOrReadWrite in FOldRange then
+            (FOldRange * [rsAfterEqualOrColon, rsAtPropertyOrReadWrite, rsAfterClassField]) -
-            fRange := fRange - [rsAtPropertyOrReadWrite];
+            [rsAtClosingBracket];
-          fRange := fRange - [rsAtClosingBracket];
+
-          if rsAfterClassField in FOldRange then
-            fRange := fRange - [rsAfterClassField];
           if rsAtClass in fRange then begin
             if FOldRange * [rsAtClass, rsAfterClass] <> [] then
               fRange := fRange + [rsAfterClass] - [rsAtClass]
@@ -3745,6 +3768,9 @@ var
   nd: TSynFoldNodeInfo;
 begin
   BlockType := TopPascalCodeFoldBlockType;
+  if BlockType in [cfbtVarType, cfbtLocalVarType] then
+    fRange := fRange - [rsInTypeBlock];
+  fRange := fRange - [rsAfterEqual];
   DecreaseLevel := TopCodeFoldBlockType < CountPascalCodeFoldBlockOffset;
   if FCatchNodeInfo then begin // exclude subblocks, because they do not increase the foldlevel yet
     BlockEnabled := FFoldConfig[ord(BlockType)].Enabled;

components/synedit/test/testhighlightpas.pas

@@ -58,6 +58,7 @@ type
     procedure TestContextForClassHelper;
     procedure TestContextForRecordHelper;
     procedure TestContextForStatic;
+    procedure TestCaretAsString;
     procedure TestFoldNodeInfo;
   end;
 
@@ -1076,6 +1077,51 @@ begin
                      ]);
 end;
 
+procedure TTestHighlighterPas.TestCaretAsString;
+begin
+  ReCreateEdit;
+  SetLines
+    ([ 'Unit A; interface',  // 0
+       'var',
+         'a:char=^o;',
+         'b:^char=nil;',
+       'type',
+         'c=^char;',         // 5
+       'implementation',
+       'function x(f:^char=^k):^v;', // actually the compiler does not allow ^ as pointer for result
+       'var',
+         'a:char=^o;',
+         'b:^char=nil;',     // 10
+       'type',
+         'c=^char;',
+       'begin',
+         'i:=^f;',
+       'end;',                   // 15
+       ''
+    ]);
+
+  CheckTokensForLine('a:char=^o;',   2,
+                     [tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkString, tkSymbol]);
+  CheckTokensForLine('b:^char=nil;',   3,
+                     [tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol, tkKey, tkSymbol]);
+  CheckTokensForLine('c=^char;',   5,
+                     [tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol]);
+
+  CheckTokensForLine('function x(f:^char=^k):^v;',   7,
+                     [tkKey, tkSpace, tkIdentifier, tkSymbol, tkIdentifier,  // function x(f
+                      tkSymbol, tkSymbol, tkIdentifier, tkSymbol, tkString,  // :^char=^k
+                      tkSymbol, tkSymbol, tkSymbol, tkIdentifier, tkSymbol]);          // ):^v;
+  CheckTokensForLine('LOCAL a:char=^o;',   9,
+                     [tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkString, tkSymbol]);
+  CheckTokensForLine('LOCAL b:^char=nil;',   10,
+                     [tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol, tkKey, tkSymbol]);
+  CheckTokensForLine('LOCAL c=^char;',   12,
+                     [tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol]);
+  CheckTokensForLine('i:=^f',   14,
+                     [tkIdentifier, tkSymbol, tkString, tkSymbol]);
+
+end;
+
 procedure TTestHighlighterPas.TestFoldNodeInfo;
   Procedure CheckNode(ALine: TLineIdx; AFilter: TSynFoldActions; AFoldGroup: Integer;
     AColumn: integer;