IDE, SynEdit: PascalHighlighter, CustomWords (Tokens, must be identifier) for comment and string. Custom color for comment by type // vs (* . Includes Issue #40881

components/synedit/synhighlighterpas.pp

@@ -61,9 +61,16 @@ type
   TSynPasMultilineStringMode  = (spmsmDoubleQuote);
   TSynPasMultilineStringModes = set of TSynPasMultilineStringMode;
 
-  TtkTokenKind = (tkAsm, tkComment, tkIdentifier, tkKey, tkModifier, tkNull, tkNumber,
+  TtkTokenKindEx = (
+    tkAsm, tkComment, tkIdentifier, tkKey, tkModifier, tkNull, tkNumber,
     tkSpace, tkString, tkSymbol, tkDirective, tkIDEDirective,
-    tkUnknown);
+    tkUnknown,
+    // for custom token only
+    tkSlashComment, tkAnsiComment, tkBorComment
+    );
+  TtkTokenKindExs= set of TtkTokenKindEx;
+
+  TtkTokenKind = tkAsm..tkUnknown;
   TtkTokenKinds= set of TtkTokenKind;
 
   TRangeState = (
@@ -498,16 +505,16 @@ type
     procedure DoTokensChanged(Sender: TObject);
   private
     FMarkup: TSynHighlighterAttributesModifier;
-    FMatchTokenKinds: TtkTokenKinds;
+    FMatchTokenKinds: TtkTokenKindExs;
     FTokens: TStrings;
 
-    procedure SetMatchTokenKinds(AValue: TtkTokenKinds);
+    procedure SetMatchTokenKinds(AValue: TtkTokenKindExs);
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
     property OnMarkupChange: TNotifyEvent read FOnMarkupChange write FOnMarkupChange;
   public
     constructor Create;
     destructor Destroy; override;
-    property MatchTokenKinds: TtkTokenKinds read FMatchTokenKinds write SetMatchTokenKinds;
+    property MatchTokenKinds: TtkTokenKindExs read FMatchTokenKinds write SetMatchTokenKinds;
     property Tokens: TStrings read FTokens;
     property Markup: TSynHighlighterAttributesModifier read FMarkup;
   end;
@@ -582,7 +589,7 @@ type
   TSynPasSyn = class(TSynCustomFoldHighlighter)
   private type
     TSynPasSynCustomTokenInfoListEx = record
-      TokenKind: TtkTokenKind;
+      TokenKind: TtkTokenKindEx;
       List: TStringList;
     end;
     PSynPasSynCustomTokenInfoListEx = ^TSynPasSynCustomTokenInfoListEx;
@@ -594,11 +601,12 @@ type
     FSynCustomTokens: array of TSynPasSynCustomToken;
     FNeedCustomTokenBuild: boolean;
     FCustomTokenInfo: array [byte] of record
-      MatchTokenKinds: TtkTokenKinds;
+      MatchTokenKinds: TtkTokenKindExs;
       Lists: array of TSynPasSynCustomTokenInfoListEx;
     end;
-    FCustomTokenMarkup: TSynHighlighterAttributesModifier;
+    FCustomTokenMarkup, FCustomCommentTokenMarkup: TSynHighlighterAttributesModifier;
-    FCustomTokenMergedMarkup: TSynSelectedColorMergeResult;
+    FCustomTokenMarkupSlash, FCustomTokenMarkupAnsi, FCustomTokenMarkupBor: TSynHighlighterAttributesModifier;
+    FCustomTokenMergedMarkup, FCustomCommentTokenMergedMarkup: TSynSelectedColorMergeResult;
 
     FCurIDEDirectiveAttri: TSynSelectedColorMergeResult;
     FCurCaseLabelAttri: TSynSelectedColorMergeResult;
@@ -637,7 +645,7 @@ type
     FStringKeywordMode: TSynPasStringMode;
     FStringMultilineMode: TSynPasMultilineStringModes;
     FSynPasRangeInfo: TSynPasRangeInfo;
-    FAtLineStart: Boolean; // Line had only spaces or comments sofar
+    FAtLineStart, FInString: Boolean; // Line had only spaces or comments sofar
     fLineStr: string;
     fLine: PChar;
     fLineLen: integer;
@@ -824,6 +832,7 @@ type
     procedure SemicolonProc;                                                    //mh 2000-10-08
     procedure SlashProc;
     procedure SlashContinueProc;
+    procedure SlashCommentProc;
     procedure SpaceProc;
     procedure StringProc;
     procedure DoubleQuoteProc;
@@ -833,6 +842,16 @@ type
     procedure SetD4syntax(const Value: boolean);
 
     function CanApplyExtendedDeclarationAttribute(AMode: TSynPasTypeAttributeMode): boolean; inline;
+    function GetCustomSymbolToken(ATokenID: TtkTokenKindEx; ALen: integer;
+             out ACustomMarkup: TSynHighlighterAttributesModifier;
+             APeekOnly: boolean = False
+             ): boolean; inline;
+    function GetCustomTokenAndNext(ATokenID: TtkTokenKindEx; out ACustomMarkup: TSynHighlighterAttributesModifier;
+             APeekOnly: boolean = False
+             ): boolean; inline;
+    function GetCustomToken(ATokenID: TtkTokenKindEx; AnHash: byte; ATokenStart: PChar; ATokenLen: integer;
+             out ACustomMarkup: TSynHighlighterAttributesModifier
+             ): boolean; inline;
     procedure CheckForAdditionalAttributes;
 
     // Divider
@@ -1548,7 +1567,7 @@ begin
 end;
 
 procedure TSynPasSyn.RebuildCustomTokenInfo;
-  function FindList(AnHash: Byte; ATokenKind: TtkTokenKind): PSynPasSynCustomTokenInfoListEx;
+  function FindList(AnHash: Byte; ATokenKind: TtkTokenKindEx): PSynPasSynCustomTokenInfoListEx;
   var
     x: Integer;
   begin
@@ -1570,11 +1589,16 @@ procedure TSynPasSyn.RebuildCustomTokenInfo;
 var
   i, j, h: Integer;
   t: String;
-  tk: TtkTokenKind;
+  mtk: TtkTokenKindExs;
+  tk: TtkTokenKindEx;
   Lst: PSynPasSynCustomTokenInfoListEx;
 begin
   FNeedCustomTokenBuild := False;
   FCustomTokenMarkup := nil;
+  FCustomCommentTokenMarkup := nil;
+  FCustomTokenMarkupSlash := nil;
+  FCustomTokenMarkupAnsi := nil;
+  FCustomTokenMarkupBor := nil;
   for i := 0 to 255 do begin
     for j := 0 to length(FCustomTokenInfo[i].Lists) - 1 do
       FreeAndNil(FCustomTokenInfo[i].Lists[j].List);
@@ -1583,8 +1607,11 @@ begin
   end;
 
   for i := 0 to Length(FSynCustomTokens) - 1 do begin
-    if FSynCustomTokens[i].MatchTokenKinds = [] then
+    mtk := FSynCustomTokens[i].MatchTokenKinds;
+    if mtk = [] then
       continue;
+    if tkComment in mtk then
+      mtk := mtk - [tkComment] + [tkSlashComment, tkAnsiComment, tkBorComment];
 
     for j := 0 to FSynCustomTokens[i].FTokens.Count - 1 do begin
       t := FSynCustomTokens[i].FTokens[j];
@@ -1596,8 +1623,25 @@ begin
       fToIdent := 0;
       h := KeyHash and 255;
 
-      FCustomTokenInfo[h].MatchTokenKinds := FCustomTokenInfo[h].MatchTokenKinds + FSynCustomTokens[i].MatchTokenKinds;
+      FCustomTokenInfo[h].MatchTokenKinds := FCustomTokenInfo[h].MatchTokenKinds + mtk;
-      for tk in FSynCustomTokens[i].MatchTokenKinds do begin
+      for tk in mtk do begin
+        case tk of
+          tkSlashComment:
+            if t = '*' then begin
+              FCustomTokenMarkupSlash := FSynCustomTokens[i].Markup;
+              continue;
+            end;
+          tkAnsiComment:
+            if t = '*' then begin
+              FCustomTokenMarkupAnsi := FSynCustomTokens[i].Markup;
+              continue;
+            end;
+          tkBorComment:
+            if t = '*' then begin
+              FCustomTokenMarkupBor := FSynCustomTokens[i].Markup;
+              continue;
+            end;
+        end;
         Lst := FindList(h, tk);
         Lst^.List.AddObject(UpperCase(t), FSynCustomTokens[i]);
       end;
@@ -3980,6 +4024,7 @@ begin
   FPasDocWordList := TStringList.Create;
 
   FCustomTokenMergedMarkup := TSynSelectedColorMergeResult.Create;
+  FCustomCommentTokenMergedMarkup := TSynSelectedColorMergeResult.Create;
 
   FNestedBracketAttribs := TSynHighlighterAttributesModifierCollection.Create(Self);
   FNestedBracketAttribs.OnAttributeChange := @DefHighlightChange;
@@ -4010,6 +4055,7 @@ begin
   FreeAndNil(FCurStructMemberExtraAttri);
   FreeAndNil(FCurPasDocAttri);
   FreeAndNil(FCustomTokenMergedMarkup);
+  FreeAndNil(FCustomCommentTokenMergedMarkup);
   FreeAndNil(FPasDocWordList);
   CustomTokenCount := 0;
   for i := 0 to 255 do
@@ -4041,6 +4087,8 @@ begin
   FSynPasRangeInfo.MinLevelRegion := FSynPasRangeInfo.EndLevelRegion;
   fLineNumber := LineNumber;
   FAtLineStart := True;
+  FInString := False;
+  FCustomCommentTokenMarkup := nil;
   if not IsCollectingNodeInfo then
     Next;
 end; { SetLine }
@@ -4132,26 +4180,50 @@ end;
 procedure TSynPasSyn.BorProc;
 var
   p: LongInt;
+  IsInWord, WasInWord, ct: Boolean;
 begin
-  p:=Run;
+  FCustomCommentTokenMarkup := FCustomTokenMarkupBor;
   fTokenID := tkComment;
   if rsIDEDirective in fRange then
     fTokenID := tkIDEDirective;
 
-  if FUsePasDoc and not(rsIDEDirective in fRange) and (fLine[Run] = '@') then begin
+  if (not (FIsInNextToEOL or IsScanning)) and not(rsIDEDirective in fRange) then begin
+    if FUsePasDoc and (fLine[Run] = '@') then begin
       if CheckPasDoc then
         exit;
     end;
+    if (IsLetterChar[fline[Run]]) and
+       ( (Run = 0) or
+         not((IsLetterChar[fline[Run-1]] or IsUnderScoreOrNumberChar[fline[Run-1]]))
+       )
+    then begin
+      if GetCustomTokenAndNext(tkBorComment, FCustomTokenMarkup) then
+        exit;
+    end;
+  end;
 
+  IsInWord := False;
+  WasInWord := (FIsInNextToEOL or IsScanning) or (rsIDEDirective in fRange); // don't run checks
+  p:=Run;
   repeat
     case fLine[p] of
     #0,#10,#13: break;
-    '}':
+    '}': begin
+        if (not (FIsInNextToEOL or IsScanning)) and not(rsIDEDirective in fRange) then begin
+          Run := p;
+          ct := GetCustomSymbolToken(tkAnsiComment, 1, FCustomTokenMarkup, Run <> fTokenPos);
+          if ct and (Run <> fTokenPos) then
+            exit;
+        end;
         if TopPascalCodeFoldBlockType=cfbtNestedComment then
         begin
           Run:=p;
           EndPascalCodeFoldBlock;
           p:=Run;
+          if FCustomTokenMarkup <> nil then begin
+            inc(Run);
+            exit;
+          end;
       end else begin
           fRange := fRange - [rsBor, rsIDEDirective];
           Inc(p);
@@ -4159,12 +4231,22 @@ begin
             EndPascalCodeFoldBlock;
           break;
         end;
+      end;
     '{':
       if NestedComments then begin
+        Run := p;
+        if (not (FIsInNextToEOL or IsScanning)) and not(rsIDEDirective in fRange) then begin
+          ct := GetCustomSymbolToken(tkAnsiComment, 1, FCustomTokenMarkup, Run <> fTokenPos);
+          if ct and (Run <> fTokenPos) then
+            exit;
+        end;
         fStringLen := 1;
-        Run:=p;
         StartPascalCodeFoldBlock(cfbtNestedComment);
         p:=Run;
+        if FCustomTokenMarkup <> nil then begin
+          inc(Run);
+          exit;
+        end;
       end;
     '@': begin
         if fLine[p+1] = '@' then
@@ -4177,8 +4259,20 @@ begin
           inc(p)
         end;
       end;
+    otherwise begin
+        if (not WasInWord) and IsLetterChar[fline[p]] then begin
+          Run := p;
+          if GetCustomTokenAndNext(tkBorComment, FCustomTokenMarkup, True) then
+            exit;
+        end
+      end;
     end;
     Inc(p);
+
+    if (not (FIsInNextToEOL or IsScanning)) and not(rsIDEDirective in fRange) then begin
+      WasInWord := IsInWord;
+      IsInWord := (IsLetterChar[fline[p]] or IsUnderScoreOrNumberChar[fline[p]]);
+    end;
   until (p>=fLineLen);
   Run:=p;
 end;
@@ -4401,10 +4495,18 @@ begin
       end;
     end
     else begin
+      fTokenID := tkComment;
       fRange := fRange + [rsBor];
       dec(Run);
       StartPascalCodeFoldBlock(cfbtBorCommand);
+
+      FCustomCommentTokenMarkup := FCustomTokenMarkupBor;
+      if not (FIsInNextToEOL or IsScanning) then
+        GetCustomSymbolToken(tkBorComment, 1, FCustomTokenMarkup);
+
       inc(Run);
+      if FCustomTokenMarkup <> nil then
+        exit;
     end;
     if FUsePasDoc and (fLine[Run] = '@') and CheckPasDoc(True) then
       exit;
@@ -4631,21 +4733,45 @@ begin
 end;
 
 procedure TSynPasSyn.AnsiProc;
+var
+  IsInWord, WasInWord, ct: Boolean;
 begin
   fTokenID := tkComment;
+  FCustomCommentTokenMarkup := FCustomTokenMarkupAnsi;
+
+  if (not (FIsInNextToEOL or IsScanning)) then begin
     if FUsePasDoc and (fLine[Run] = '@') then begin
       if CheckPasDoc then
         exit;
     end;
+    if (IsLetterChar[fline[Run]]) and
+       ( (Run = 0) or
+         not((IsLetterChar[fline[Run-1]] or IsUnderScoreOrNumberChar[fline[Run-1]]))
+       )
+    then begin
+      if GetCustomTokenAndNext(tkAnsiComment, FCustomTokenMarkup) then
+        exit;
+    end;
+  end;
 
+
+  IsInWord := False;
+  WasInWord := (FIsInNextToEOL or IsScanning); // don't run checks
   repeat
     if fLine[Run]=#0 then
       break
     else if (fLine[Run] = '*') and (fLine[Run + 1] = ')') then
     begin
+      if not (FIsInNextToEOL or IsScanning) then begin
+        ct := GetCustomSymbolToken(tkAnsiComment, 2, FCustomTokenMarkup, Run <> fTokenPos);
+        if ct and (Run <> fTokenPos) then
+          exit;
+      end;
       Inc(Run, 2);
       if TopPascalCodeFoldBlockType=cfbtNestedComment then begin
         EndPascalCodeFoldBlock;
+        if FCustomTokenMarkup <> nil then
+          exit;
       end else begin
         fRange := fRange - [rsAnsi];
         if TopPascalCodeFoldBlockType=cfbtAnsiComment then
@@ -4657,9 +4783,16 @@ begin
     if (pcsNestedComments in ModeSwitches) and
        (fLine[Run] = '(') and (fLine[Run + 1] = '*') then
     begin
+      if not (FIsInNextToEOL or IsScanning) then begin
+        ct := GetCustomSymbolToken(tkAnsiComment, 2, FCustomTokenMarkup, Run <> fTokenPos);
+        if ct and (Run <> fTokenPos) then
+          exit;
+      end;
       fStringLen := 2;
       StartPascalCodeFoldBlock(cfbtNestedComment);
       Inc(Run,2);
+      if FCustomTokenMarkup <> nil then
+        exit;
     end else
     if FUsePasDoc and (fLine[Run] = '@') then begin
       if fLine[Run+1] = '@' then
@@ -4669,8 +4802,18 @@ begin
         exit;
       Inc(Run);
     end
+    else
+    if (not WasInWord) and IsLetterChar[fline[Run]] then begin
+      if GetCustomTokenAndNext(tkAnsiComment, FCustomTokenMarkup, True) then
+        exit;
+    end
     else
       Inc(Run);
+
+    if not (FIsInNextToEOL or IsScanning) then begin
+      WasInWord := IsInWord;
+      IsInWord := (IsLetterChar[fline[Run]] or IsUnderScoreOrNumberChar[fline[Run]]);
+    end;
   until (Run>=fLineLen) or (fLine[Run] in [#0, #10, #13]);
 end;
 
@@ -4719,7 +4862,14 @@ begin
         fStringLen := 2; // length of "(*"
         Dec(Run);
         StartPascalCodeFoldBlock(cfbtAnsiComment);
+
+        FCustomCommentTokenMarkup := FCustomTokenMarkupAnsi;
+        if not (FIsInNextToEOL or IsScanning) then
+          GetCustomSymbolToken(tkAnsiComment, 2, FCustomTokenMarkup);
+
         Inc(Run, 2);
+        if FCustomTokenMarkup <> nil then
+          exit;
         if not (fLine[Run] in [#0, #10, #13]) then begin
           if FUsePasDoc and (fLine[Run] = '@') and CheckPasDoc(True) then
             exit;
@@ -4830,8 +4980,6 @@ begin
 end;
 
 procedure TSynPasSyn.EqualSignProc;
-var
-  tfb: TPascalCodeFoldBlockType;
 begin
   inc(Run);
   fTokenID := tkSymbol;
@@ -4913,6 +5061,9 @@ end;
 procedure TSynPasSyn.SlashProc;
 begin
   if fLine[Run+1] = '/' then begin
+    FCustomCommentTokenMarkup := FCustomTokenMarkupSlash;
+    FIsInSlash := True;
+
     fTokenID := tkComment;
     if FAtLineStart then begin
       fRange := fRange + [rsSlash];
@@ -4920,19 +5071,16 @@ begin
       if not(TopPascalCodeFoldBlockType = cfbtSlashComment) then
         StartPascalCodeFoldBlock(cfbtSlashComment);
     end;
+
+    if (not (FIsInNextToEOL or IsScanning)) and
+       GetCustomSymbolToken(tkSlashComment, 2, FCustomTokenMarkup)
+    then begin
       inc(Run, 2);
-    FIsInSlash := True;
-    while not(fLine[Run] in [#0, #10, #13]) do
-      if FUsePasDoc and (fLine[Run] = '@') then begin
-        if fLine[Run+1] = '@' then
-          inc(Run, 2)
-        else
-        if CheckPasDoc(True) then
       exit;
-        Inc(Run);
+    end;
-      end
+    inc(Run, 2);
-      else
+
-        Inc(Run);
+    SlashCommentProc;
   end else begin
     Inc(Run);
     fTokenID := tkSymbol;
@@ -4941,27 +5089,41 @@ begin
 end;
 
 procedure TSynPasSyn.SlashContinueProc;
+var
+  AtSlashOpen: Boolean;
 begin
-  if FIsInSlash and (fLine[Run] = '@') then begin
+  if FIsInSlash and (not (FIsInNextToEOL or IsScanning)) then begin
+    FCustomCommentTokenMarkup := FCustomTokenMarkupSlash;
+    fTokenID := tkComment;
+
+    if (fLine[Run] = '@') then begin
       if CheckPasDoc then
         exit;
     end;
+    if (IsLetterChar[fline[Run]]) and
+       ( (Run = 0) or
+         not((IsLetterChar[fline[Run-1]] or IsUnderScoreOrNumberChar[fline[Run-1]]))
+       )
+    then begin
+      if GetCustomTokenAndNext(tkSlashComment, FCustomTokenMarkup) then
+        exit;
+    end;
+  end;
 
-  if FIsInSlash or ((fLine[Run] = '/') and (fLine[Run + 1] = '/')) then begin
+  AtSlashOpen := (fLine[Run] = '/') and (fLine[Run + 1] = '/') and not FIsInSlash;
+  if FIsInSlash or AtSlashOpen then begin
     FIsInSlash := True;
     // Continue fold block
     fTokenID := tkComment;
-    while not(fLine[Run] in [#0, #10, #13]) do
+
-      if FUsePasDoc and (fLine[Run] = '@') then begin
+    if (not (FIsInNextToEOL or IsScanning)) and AtSlashOpen and
-        if fLine[Run+1] = '@' then
+       GetCustomSymbolToken(tkSlashComment, 2, FCustomTokenMarkup)
-          inc(Run, 2)
+    then begin
-        else
+      inc(Run, 2);
-        if CheckPasDoc(True) then
       exit;
-        Inc(Run);
+    end;
-      end
+
-      else
+    SlashCommentProc;
-        Inc(Run);
     exit;
   end;
 
@@ -4982,6 +5144,37 @@ begin
     Next;
 end;
 
+procedure TSynPasSyn.SlashCommentProc;
+var
+  IsInWord, WasInWord: Boolean;
+begin
+  IsInWord := False;
+  WasInWord := (FIsInNextToEOL or IsScanning); // don't run checks
+
+  while not(fLine[Run] in [#0, #10, #13]) do begin
+    if FUsePasDoc and (fLine[Run] = '@') then begin
+      if fLine[Run+1] = '@' then
+        inc(Run, 2)
+      else
+      if CheckPasDoc(True) then
+        exit;
+      Inc(Run);
+    end
+    else
+    if (not WasInWord) and IsLetterChar[fline[Run]] then begin
+      if GetCustomTokenAndNext(tkSlashComment, FCustomTokenMarkup, True) then
+        exit;
+    end
+    else
+      Inc(Run);
+
+    if not (FIsInNextToEOL or IsScanning) then begin
+      WasInWord := IsInWord;
+      IsInWord := (IsLetterChar[fline[Run]] or IsUnderScoreOrNumberChar[fline[Run]]);
+    end;
+  end;
+end;
+
 procedure TSynPasSyn.SpaceProc;
 begin
   inc(Run);
@@ -5002,18 +5195,82 @@ begin
 end;
 
 procedure TSynPasSyn.StringProc;
+var
+  IsInWord, WasInWord, ct: Boolean;
 begin
   fTokenID := tkString;
+
+  if FInString then begin
+    if not (FIsInNextToEOL or IsScanning) then begin
+      if (fLine[Run] = '''') and (fLine[Run+1] = '''') and
+         GetCustomSymbolToken(tkString, 2, FCustomTokenMarkup)
+      then begin
+        inc(Run, 2);
+        exit;
+      end;
+
+      if (IsLetterChar[fline[Run]]) and
+         ( (Run = 0) or
+           not((IsLetterChar[fline[Run-1]] or IsUnderScoreOrNumberChar[fline[Run-1]]))
+         )
+      then begin
+        if GetCustomTokenAndNext(tkString, FCustomTokenMarkup) then
+          exit;
+      end;
+    end;
+  end
+  else begin
+    FInString := True;
+    if not (FIsInNextToEOL or IsScanning) and
+      GetCustomSymbolToken(tkString, 1, FCustomTokenMarkup)
+    then begin
       Inc(Run);
+      exit;
+    end;
+    Inc(Run);
+  end;
+
+  IsInWord := False;
+  WasInWord := (FIsInNextToEOL or IsScanning); // don't run checks
   while (not (fLine[Run] in [#0, #10, #13])) do begin
     if fLine[Run] = '''' then begin
+      if (fLine[Run+1] = '''') then begin
+        // escaped
+        if (not (FIsInNextToEOL or IsScanning)) and
+           GetCustomSymbolToken(tkString, 2, FCustomTokenMarkup, Run <> fTokenPos)
+        then begin
+          if (Run = fTokenPos) then
+            inc(Run, 2);
+          exit
+        end;
+        Inc(Run);
+      end
+      else begin
+        // string end
+        if not (FIsInNextToEOL or IsScanning) then begin
+          ct := GetCustomSymbolToken(tkString, 1, FCustomTokenMarkup, Run <> fTokenPos);
+          if ct and (Run <> fTokenPos) then
+            exit;
+        end;
         Inc(Run);
-      if (fLine[Run] <> '''') then
         break;
       end;
-    Inc(Run);
+    end
+    else
+    if (not WasInWord) and IsLetterChar[fline[Run]] then begin
+      if GetCustomTokenAndNext(tkString, FCustomTokenMarkup, True) then
+        exit;
     end;
 
+    Inc(Run);
+
+    if not (FIsInNextToEOL or IsScanning) then begin
+      WasInWord := IsInWord;
+      IsInWord := (IsLetterChar[fline[Run]] or IsUnderScoreOrNumberChar[fline[Run]]);
+    end;
+  end;
+  FInString := False;
+
   // modifiers like "alias" take a string as argument
   if (PasCodeFoldRange.BracketNestLevel = 0) then begin
     if (fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsInProcHeader]) and
@@ -5085,26 +5342,67 @@ begin
             ;
 end;
 
-procedure TSynPasSyn.CheckForAdditionalAttributes;
+function TSynPasSyn.GetCustomSymbolToken(ATokenID: TtkTokenKindEx; ALen: integer; out
+  ACustomMarkup: TSynHighlighterAttributesModifier; APeekOnly: boolean): boolean;
 var
-  i, h: integer;
+  TempMarkup: TSynHighlighterAttributesModifier;
-  CustTkList: TStringList;
-  tfb: TPascalCodeFoldBlockType;
 begin
-  h := FTokenHashKey and 255;
+  ACustomMarkup := nil;
-  if FTokenID in FCustomTokenInfo[h].MatchTokenKinds then begin
+  Result := GetCustomToken(ATokenID, 0, @fLine[Run], ALen, TempMarkup);
-    CustTkList := nil;
+  if Result and (not APeekOnly) then
-    for i := 0 to Length(FCustomTokenInfo[h].Lists) - 1 do
+    ACustomMarkup := TempMarkup;
-      if FCustomTokenInfo[h].Lists[i].TokenKind = FTokenID then begin
+end;
-        CustTkList := FCustomTokenInfo[h].Lists[i].List;
+
+function TSynPasSyn.GetCustomTokenAndNext(ATokenID: TtkTokenKindEx; out
+  ACustomMarkup: TSynHighlighterAttributesModifier; APeekOnly: boolean): boolean;
+var
+  h: Integer;
+  TempTokenMarkup: TSynHighlighterAttributesModifier;
+begin
+  ACustomMarkup := nil;
+  fToIdent := Run;
+  h := KeyHash;
+  Result := fStringLen > 0;
+  if not Result then
+    exit;
+  Result := GetCustomToken(ATokenID, byte(h and 255), @fLine[Run], fStringLen, TempTokenMarkup);
+  if Result and (not APeekOnly) then begin
+    ACustomMarkup := TempTokenMarkup;
+    Run := Run + fStringLen;
+  end;
+end;
+
+function TSynPasSyn.GetCustomToken(ATokenID: TtkTokenKindEx; AnHash: byte; ATokenStart: PChar;
+  ATokenLen: integer; out ACustomMarkup: TSynHighlighterAttributesModifier): boolean;
+var
+  CustTkList: TStringList;
+  i, j: integer;
+  s: string;
+begin
+  Result := False;
+  ACustomMarkup := nil;
+  if ATokenID in FCustomTokenInfo[AnHash].MatchTokenKinds then begin
+    for i := 0 to Length(FCustomTokenInfo[AnHash].Lists) - 1 do
+      if FCustomTokenInfo[AnHash].Lists[i].TokenKind = ATokenID then begin
+        CustTkList := FCustomTokenInfo[AnHash].Lists[i].List;
+        if CustTkList <> nil then begin
+          SetString(s, ATokenStart, ATokenLen);
+          j := CustTkList.IndexOf(UpperCase(s));
+          Result := j >= 0;
+          if Result then
+            ACustomMarkup := TSynPasSynCustomToken(CustTkList.Objects[j]).Markup;
+        end;
         break;
       end;
-    if CustTkList <> nil then begin
-      i := CustTkList.IndexOf(UpperCase(GetToken));
-      if i >= 0 then
-        FCustomTokenMarkup := TSynPasSynCustomToken(CustTkList.Objects[i]).Markup;
-    end;
   end;
+end;
+
+procedure TSynPasSyn.CheckForAdditionalAttributes;
+var
+  tfb: TPascalCodeFoldBlockType;
+begin
+  if not (FTokenID in [tkString, tkComment]) then
+    GetCustomToken(FTokenID, byte(FTokenHashKey and 255), @fLine[fTokenPos], Run - fTokenPos, FCustomTokenMarkup);
 
   case FTokenState of
     tsAtProcName: begin
@@ -5280,13 +5578,16 @@ begin
         BorProc
       else if rsDirective in fRange then
         DirectiveProc
-      else if rsSlash in fRange then
+      else if (rsSlash in fRange) or FIsInSlash then
         SlashContinueProc
+      else if FInString then
+        StringProc
       else begin
         FNextTokenState := tsNone;
         OldNestLevel := PasCodeFoldRange.BracketNestLevel;
         if (PasCodeFoldRange.BracketNestLevel = 1) then // procedure foo; [attr...]
           FOldRange := FOldRange - [rsWasInProcHeader];
+        FCustomCommentTokenMarkup := nil;
         FTokenExtraAttribs := [];
         FTokenTypeDeclExtraAttrib := eaNone;
         //if rsAtEqual in fRange then
@@ -5549,6 +5850,11 @@ begin
     FCustomTokenMergedMarkup.Merge(FCustomTokenMarkup);
     Result := FCustomTokenMergedMarkup;
   end;
+  if FCustomCommentTokenMarkup <> nil then begin
+    FCustomCommentTokenMergedMarkup.Assign(Result);
+    FCustomCommentTokenMergedMarkup.Merge(FCustomCommentTokenMarkup);
+    Result := FCustomCommentTokenMergedMarkup;
+  end;
 
   if (FTokenID = tkSymbol) and (Run - fTokenPos = 1) and (fLine[fTokenPos] in ['(', ')'])
   then begin
@@ -5605,7 +5911,8 @@ end;
 function TSynPasSyn.GetTokenIsCommentEnd: Boolean;
 begin
   Result := (FTokenID = tkComment) and
-            (FRange * [rsAnsi, rsBor, rsSlash] = []);  // rsIDEDirective
+            (FRange * [rsAnsi, rsBor, rsSlash] = []) and  // rsIDEDirective
+            (not (FIsInSlash and (Run < fLineLen)));
 end;
 
 function TSynPasSyn.GetRange: Pointer;
@@ -7244,7 +7551,7 @@ begin
     FOnChange(Self);
 end;
 
-procedure TSynPasSynCustomToken.SetMatchTokenKinds(AValue: TtkTokenKinds);
+procedure TSynPasSynCustomToken.SetMatchTokenKinds(AValue: TtkTokenKindExs);
 begin
   if FMatchTokenKinds = AValue then Exit;
   FMatchTokenKinds := AValue;

ide/lazarusidestrconsts.pas

@@ -3622,6 +3622,11 @@ resourcestring
   lisCodeToolsOptsNewLine     = 'Newline';
   lisCodeToolsOptsSpace       = 'Space';
   lisCodeToolsOptsSymbol      = 'Symbol';
+  lisCodeToolsOptsString      = 'String';
+  lisCodeToolsOptsComment= 'Comment';
+  lisCodeToolsOptsCommentSlash= 'Slash Comment: //';
+  lisCodeToolsOptsCommentAnsi = 'Ansi Comment: (*';
+  lisCodeToolsOptsCommentBor  = 'Curly Comment: {';
   lisCodeToolsOptsBracket     = 'Bracket';
   lisCodeToolsOptsCaret       = 'Caret (^)';
 

ide/main.pp

@@ -4042,7 +4042,7 @@ begin
           TokenTxt, TokenType, Start, Attri);
         inc(xy.x);
         if Start + Length(TokenTxt) = xy.X then begin
-          IdentFound := TtkTokenKind(TokenType) in [tkAsm, tkComment, tkIdentifier, tkString];
+          IdentFound := (TokenType >= 0) and (TtkTokenKind(TokenType) in [tkAsm, tkComment, tkIdentifier, tkString]);
           StringFound := TtkTokenKind(TokenType) = tkString;
         end;
         cont := True;
@@ -4050,7 +4050,7 @@ begin
       if not (IdentFound or StringFound) then begin
         ASrcEdit.EditorComponent.GetHighlighterAttriAtRowColEx(xy,
           TokenTxt, TokenType, Start, Attri, cont);
-        IdentFound := TtkTokenKind(TokenType) in [tkAsm, tkComment, tkIdentifier, tkString];
+        IdentFound := (TokenType >= 0) and (TtkTokenKind(TokenType) in [tkAsm, tkComment, tkIdentifier, tkString]);
         StringFound := TtkTokenKind(TokenType) = tkString;
       end;
     end;

ide/sourcesyneditor.pas

@@ -379,9 +379,9 @@ type
   TSynHighlighterLazCustomPasAttribute = class(TSynHighlighterAttributesModifier)
   private
     FCustomWords: TStrings;
-    FCustomWordTokenKind: TtkTokenKind;
+    FCustomWordTokenKind: TtkTokenKindEx;
     procedure DoWordsChanged(Sender: TObject);
-    procedure SetCustomWordTokenKind(AValue: TtkTokenKind);
+    procedure SetCustomWordTokenKind(AValue: TtkTokenKindEx);
   protected
     procedure AssignFrom(Src: TLazSynCustomTextAttributes); override;
     procedure DoClear; override;
@@ -390,7 +390,7 @@ type
     destructor Destroy; override;
     property CustomWords: TStrings read FCustomWords;
   published
-    property CustomWordTokenKind: TtkTokenKind read FCustomWordTokenKind write SetCustomWordTokenKind;
+    property CustomWordTokenKind: TtkTokenKindEx read FCustomWordTokenKind write SetCustomWordTokenKind;
   end;
 
   { TIDESynPasSyn }
@@ -2155,7 +2155,7 @@ end;
 
 { TSynHighlighterLazCustomPasAttribute }
 
-procedure TSynHighlighterLazCustomPasAttribute.SetCustomWordTokenKind(AValue: TtkTokenKind);
+procedure TSynHighlighterLazCustomPasAttribute.SetCustomWordTokenKind(AValue: TtkTokenKindEx);
 begin
   if FCustomWordTokenKind = AValue then Exit;
   FCustomWordTokenKind := AValue;

ide/syncolorattribeditor.pas

@@ -258,6 +258,11 @@ begin
     2: FCurHighlightElement.CustomWordTokenKind := tkModifier;
     3: FCurHighlightElement.CustomWordTokenKind := tkNumber;
     4: FCurHighlightElement.CustomWordTokenKind := tkSymbol;
+    5: FCurHighlightElement.CustomWordTokenKind := tkString;
+    6: FCurHighlightElement.CustomWordTokenKind := tkComment;
+    7: FCurHighlightElement.CustomWordTokenKind := tkSlashComment;
+    8: FCurHighlightElement.CustomWordTokenKind := tkAnsiComment;
+    9: FCurHighlightElement.CustomWordTokenKind := tkBorComment;
   end;
 end;
 
@@ -790,6 +795,11 @@ begin
       tkModifier:   dropCustomWordKind.ItemIndex := 2;
       tkNumber:     dropCustomWordKind.ItemIndex := 3;
       tkSymbol:     dropCustomWordKind.ItemIndex := 4;
+      tkString:     dropCustomWordKind.ItemIndex := 5;
+      tkComment:    dropCustomWordKind.ItemIndex := 6;
+      tkSlashComment: dropCustomWordKind.ItemIndex := 7;
+      tkAnsiComment:  dropCustomWordKind.ItemIndex := 8;
+      tkBorComment:   dropCustomWordKind.ItemIndex := 9;
     end;
 
     UpdatingColor := False;
@@ -870,6 +880,11 @@ begin
   dropCustomWordKind.Items.Add(dlgModifier);
   dropCustomWordKind.Items.Add(lisCodeToolsOptsNumber);
   dropCustomWordKind.Items.Add(lisCodeToolsOptsSymbol);
+  dropCustomWordKind.Items.Add(lisCodeToolsOptsString);
+  dropCustomWordKind.Items.Add(lisCodeToolsOptsComment);
+  dropCustomWordKind.Items.Add(lisCodeToolsOptsCommentSlash);
+  dropCustomWordKind.Items.Add(lisCodeToolsOptsCommentAnsi);
+  dropCustomWordKind.Items.Add(lisCodeToolsOptsCommentBor);
   dropCustomWordKind.ItemIndex := 0;
 
   //Constraints.MinHeight := max(Constraints.MinHeight,