IDE, SynEdit: Add custom ident/keywords to Pascal Highlighter

components/synedit/synedithighlighter.pp

@@ -169,6 +169,7 @@ type
 
     procedure AssignFrom(Src: TLazSynCustomTextAttributes); override;
     procedure DoChange; override;
+    procedure Init; virtual;
     property ConstName: string read FConstName write FConstName; // internal accessor
   public
     constructor Create;
@@ -1290,9 +1291,15 @@ begin
     fOnChange(Self);
 end;
 
+procedure TSynHighlighterAttributes.Init;
+begin
+  //
+end;
+
 constructor TSynHighlighterAttributes.Create;
 begin
   inherited Create;
+  Init;
   InternalSaveDefaultValues;
 end;
 

components/synedit/synhighlighterpas.pp

@@ -47,11 +47,12 @@ advanced features found in Object Pascal in Delphi 4.
 unit SynHighlighterPas;
 
 {$I synedit.inc}
+{$ModeSwitch advancedrecords}
 
 interface
 
 uses
-  SysUtils, Classes, Registry, Graphics, SynEditHighlighterFoldBase,
+  SysUtils, Classes, fgl, Registry, Graphics, SynEditHighlighterFoldBase,
   SynEditMiscProcs, SynEditTypes, SynEditHighlighter, SynEditTextBase,
   SynEditStrConst, SynEditMiscClasses, LazLoggerBase;
 
@@ -63,6 +64,7 @@ type
   TtkTokenKind = (tkAsm, tkComment, tkIdentifier, tkKey, tkModifier, tkNull, tkNumber,
     tkSpace, tkString, tkSymbol, tkDirective, tkIDEDirective,
     tkUnknown);
+  TtkTokenKinds= set of TtkTokenKind;
 
   TRangeState = (
     rsAnsiMultiDQ,  // Multi line double quoted string
@@ -306,6 +308,30 @@ const
 
 type
 
+  { TSynPasSynCustomToken }
+
+  TSynPasSynCustomToken = class
+  private
+    FOnChange: TNotifyEvent;
+    FOnMarkupChange: TNotifyEvent;
+    procedure DoMarkupChaged(Sender: TObject);
+    procedure DoTokensChanged(Sender: TObject);
+  private
+    FMarkup: TSynHighlighterAttributesModifier;
+    FMatchTokenKinds: TtkTokenKinds;
+    FTokens: TStrings;
+
+    procedure SetMatchTokenKinds(AValue: TtkTokenKinds);
+    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 Tokens: TStrings read FTokens;
+    property Markup: TSynHighlighterAttributesModifier read FMarkup;
+  end;
+
  TSynPasRangeInfo = record
     EndLevelIfDef: Smallint;
     MinLevelIfDef: Smallint;
@@ -364,7 +390,29 @@ type
   { TSynPasSyn }
 
   TSynPasSyn = class(TSynCustomFoldHighlighter)
+  private type
+
+    { TSynPasSynCustomTokenInfo }
+
+    TSynPasSynCustomTokenInfo = record
+      MatchTokenKinds: TtkTokenKinds;
+      Word: String;
+      Token: TSynPasSynCustomToken;
+      class operator = (a, b: TSynPasSynCustomTokenInfo): boolean;
+    end;
+    PSynPasSynCustomTokenInfo = ^TSynPasSynCustomTokenInfo;
+    PPSynPasSynCustomTokenInfo = ^PSynPasSynCustomTokenInfo;
+    TSynPasSynCustomTokenInfoList = specialize TFPGList<TSynPasSynCustomTokenInfo>;
   private
+    FSynCustomTokens: array of TSynPasSynCustomToken;
+    FNeedCustomTokenBuild: boolean;
+    FCustomTokenInfo: array [byte] of record
+      MatchTokenKinds: TtkTokenKinds;
+      List: TSynPasSynCustomTokenInfoList;
+    end;
+    FCustomTokenMarkup: TSynHighlighterAttributesModifier;
+    FCustomTokenMergedMarkup: TSynSelectedColorMergeResult;
+
     fAsmStart: Boolean;
     FExtendedKeywordsMode: Boolean;
     FNestedComments: boolean;
@@ -396,6 +444,7 @@ type
     fIdentFuncTable: array[0..220] of TIdentFuncTableFunc;
     fTokenPos: Integer;// start of current token in fLine
     FTokenID: TtkTokenKind;
+    FTokenHashKey: Integer;
     FTokenFlags: set of (tfProcName);
     FTokenIsCaseLabel: Boolean;
     fStringAttri: TSynHighlighterAttributes;
@@ -418,6 +467,11 @@ type
     // Divider
     FDividerDrawConfig: Array [TSynPasDividerDrawLocation] of TSynDividerDrawConfig;
 
+    procedure DoCustomTokenChanged(Sender: TObject);
+    procedure RebuildCustomTokenInfo;
+    function  GetCustomTokenCount: integer;
+    procedure SetCustomTokenCount(AValue: integer);
+    function  GetCustomTokens(AnIndex: integer): TSynPasSynCustomToken;
     function GetPasCodeFoldRange: TSynPasSynRange;
     procedure PasDocAttrChanged(Sender: TObject);
     procedure SetCompilerMode(const AValue: TPascalCompilerMode);
@@ -669,6 +723,8 @@ type
     function FoldLineLength(ALineIndex, FoldIndex: Integer): integer; override; // accesses FoldNodeInfo
     function FoldEndLine(ALineIndex, FoldIndex: Integer): integer; override;    // accesses FoldNodeInfo
 
+    property CustomTokenCount: integer read GetCustomTokenCount write SetCustomTokenCount;
+    property CustomTokens[AnIndex: integer]: TSynPasSynCustomToken read GetCustomTokens;
   published
     property AsmAttri: TSynHighlighterAttributes read fAsmAttri write fAsmAttri;
     property CommentAttri: TSynHighlighterAttributes read fCommentAttri
@@ -1109,6 +1165,75 @@ begin
   Result := TSynPasSynRange(CodeFoldRange);
 end;
 
+function TSynPasSyn.GetCustomTokenCount: integer;
+begin
+  Result := Length(FSynCustomTokens);
+end;
+
+procedure TSynPasSyn.DoCustomTokenChanged(Sender: TObject);
+begin
+  FNeedCustomTokenBuild := True;
+end;
+
+procedure TSynPasSyn.RebuildCustomTokenInfo;
+var
+  i, j, h: Integer;
+  ti: TSynPasSynCustomTokenInfo;
+  t: String;
+begin
+  FNeedCustomTokenBuild := False;
+  for i := 0 to 255 do begin
+    FreeAndNil(FCustomTokenInfo[i].List);
+    FCustomTokenInfo[i].MatchTokenKinds := [];
+  end;
+  for i := 0 to Length(FSynCustomTokens) - 1 do begin
+    for j := 0 to FSynCustomTokens[i].FTokens.Count - 1 do begin
+      if FSynCustomTokens[i].MatchTokenKinds = [] then
+        continue;
+      t := FSynCustomTokens[i].FTokens[j];
+      if t = '' then
+        continue;
+      fLine    := PChar(t);
+      fLineLen := Length(t);
+      fToIdent := 0;
+      h := KeyHash and 255;
+
+      if FCustomTokenInfo[h].List = nil then
+        FCustomTokenInfo[h].List := TSynPasSynCustomTokenInfoList.Create;
+
+      ti.MatchTokenKinds := FSynCustomTokens[i].MatchTokenKinds;
+      ti.Word := UpperCase(t);
+      ti.Token := FSynCustomTokens[i];
+      FCustomTokenInfo[h].MatchTokenKinds := FCustomTokenInfo[h].MatchTokenKinds + FSynCustomTokens[i].MatchTokenKinds;
+      FCustomTokenInfo[h].List.Add(ti);
+    end;
+  end;
+end;
+
+procedure TSynPasSyn.SetCustomTokenCount(AValue: integer);
+var
+  l: SizeInt;
+  i: Integer;
+begin
+  l := Length(FSynCustomTokens);
+  if AValue = l then
+    exit;
+
+  for i := AValue to l - 1 do
+    FSynCustomTokens[i].Free;
+  SetLength(FSynCustomTokens, AValue);
+  for i := l to AValue - 1 do begin
+    FSynCustomTokens[i] := TSynPasSynCustomToken.Create;
+    FSynCustomTokens[i].OnMarkupChange := @DefHighlightChange;
+    FSynCustomTokens[i].OnChange := @DoCustomTokenChanged;
+  end;
+end;
+
+function TSynPasSyn.GetCustomTokens(AnIndex: integer): TSynPasSynCustomToken;
+begin
+  Result := FSynCustomTokens[AnIndex];
+end;
+
 procedure TSynPasSyn.PasDocAttrChanged(Sender: TObject);
 begin
   FUsePasDoc := fPasDocKeyWordAttri.IsEnabled or
@@ -3157,13 +3282,11 @@ begin
 end;
 
 function TSynPasSyn.IdentKind(p: integer): TtkTokenKind;
-var
-  HashKey: Integer;
 begin
   fToIdent := p;
-  HashKey := KeyHash;
+  FTokenHashKey := KeyHash;
-  if HashKey <= High(fIdentFuncTable) then
+  if FTokenHashKey <= High(fIdentFuncTable) then
-    Result := fIdentFuncTable[HashKey]()
+    Result := fIdentFuncTable[FTokenHashKey]()
   else
     Result := tkIdentifier;
 end;
@@ -3270,6 +3393,8 @@ begin
   FCurPasDocAttri := TSynSelectedColorMergeResult.Create(@SYNS_AttrCaseLabel, SYNS_XML_AttrCaseLabel);
   FPasDocWordList := TStringList.Create;
 
+  FCustomTokenMergedMarkup := TSynSelectedColorMergeResult.Create;
+
   CompilerMode:=pcmDelphi;
   SetAttributesOnChange(@DefHighlightChange);
   fPasDocKeyWordAttri.OnChange := @PasDocAttrChanged;
@@ -3285,13 +3410,19 @@ begin
 end; { Create }
 
 destructor TSynPasSyn.Destroy;
+var
+  i: Integer;
 begin
   DestroyDividerDrawConfig;
   FreeAndNil(FCurCaseLabelAttri);
   FreeAndNil(FCurIDEDirectiveAttri);
   FreeAndNil(FCurProcedureHeaderNameAttr);
   FreeAndNil(FCurPasDocAttri);
+  FreeAndNil(FCustomTokenMergedMarkup);
   FreeAndNil(FPasDocWordList);
+  CustomTokenCount := 0;
+  for i := 0 to 255 do
+    FCustomTokenInfo[i].List.Free;
   inherited Destroy;
 end;
 
@@ -3311,6 +3442,9 @@ end;
 procedure TSynPasSyn.SetLine(const NewValue: string; LineNumber:Integer);
 begin
   //DebugLn(['TSynPasSyn.SetLine START LineNumber=',LineNumber,' Line="',NewValue,'"']);
+  if FNeedCustomTokenBuild then
+    RebuildCustomTokenInfo;
+
   fLineStr := NewValue;
   fLineLen:=length(fLineStr);
   fLine:=PChar(Pointer(fLineStr));
@@ -4243,7 +4377,10 @@ end;
 procedure TSynPasSyn.Next;
 var
   IsAtCaseLabel: Boolean;
-  OldNestLevel: Integer;
+  OldNestLevel, i: Integer;
+  CustTk: TSynPasSynCustomTokenInfoList;
+  CustTkList: PPSynPasSynCustomTokenInfo;
+  UpperTk: String;
 begin
   fAsmStart := False;
   FIsPasDocKey := False;
@@ -4251,6 +4388,7 @@ begin
   FIsPasUnknown := False;
   FTokenIsCaseLabel := False;
   fTokenPos := Run;
+  FCustomTokenMarkup := nil;
   if Run>=fLineLen then begin
     NullProc;
     exit;
@@ -4284,8 +4422,28 @@ begin
 
         IsAtCaseLabel := rsAtCaseLabel in fRange;
 
+        FTokenHashKey := 0;
         fProcTable[fLine[Run]];
 
+        if FTokenID in FCustomTokenInfo[FTokenHashKey and 255].MatchTokenKinds then begin
+          CustTk := FCustomTokenInfo[FTokenHashKey and 255].List;
+          if CustTk <> nil then begin
+            UpperTk := '';
+            CustTkList := CustTk.List;
+            for i := 0 to CustTk.Count - 1 do begin
+              if (FTokenID in CustTkList^^.MatchTokenKinds) then begin
+                if UpperTk = '' then
+                  UpperTk := UpperCase(GetToken);
+                if (UpperTk = CustTkList^^.Word) then begin
+                  FCustomTokenMarkup := CustTkList^^.Token.FMarkup;
+                  break;
+                end
+              end;
+              inc(CustTkList);
+            end;
+          end;
+        end;
+
         if (FTokenID = tkIdentifier) and (FTokenState = tsAtProcName) then begin
           if rsInProcHeader in fRange then
             FTokenFlags := FTokenFlags + [tfProcName];
@@ -4455,6 +4613,12 @@ begin
     FCurProcedureHeaderNameAttr.Merge(FProcedureHeaderNameAttr);
     Result := FCurProcedureHeaderNameAttr;
   end;
+
+  if FCustomTokenMarkup <> nil then begin
+    FCustomTokenMergedMarkup.Assign(Result);
+    FCustomTokenMergedMarkup.Merge(FCustomTokenMarkup);
+    Result := FCustomTokenMergedMarkup;
+  end;
 end;
 
 function TSynPasSyn.GetTokenKind: integer;
@@ -5774,6 +5938,15 @@ begin
   FD4syntax := Value;
 end;
 
+{ TSynPasSyn.TSynPasSynCustomTokenInfo }
+
+class operator TSynPasSyn.TSynPasSynCustomTokenInfo. = (a, b: TSynPasSynCustomTokenInfo): boolean;
+begin
+  Result := (a.MatchTokenKinds = b.MatchTokenKinds) and
+            (a.Token = b.Token) and
+            (a.Word = b.Word);
+end;
+
 { TSynFreePascalSyn }
 
 constructor TSynFreePascalSyn.Create(AOwner: TComponent);
@@ -5859,6 +6032,43 @@ begin
   dec(FPasFoldFixLevel);
 end;
 
+{ TSynPasSynCustomToken }
+
+procedure TSynPasSynCustomToken.DoTokensChanged(Sender: TObject);
+begin
+  if FOnChange <> nil then
+    FOnChange(Self);
+end;
+
+procedure TSynPasSynCustomToken.SetMatchTokenKinds(AValue: TtkTokenKinds);
+begin
+  if FMatchTokenKinds = AValue then Exit;
+  FMatchTokenKinds := AValue;
+  DoTokensChanged(Self);
+end;
+
+procedure TSynPasSynCustomToken.DoMarkupChaged(Sender: TObject);
+begin
+  if FOnMarkupChange <> nil then
+    FOnMarkupChange(Self);
+end;
+
+constructor TSynPasSynCustomToken.Create;
+begin
+    FMarkup := TSynHighlighterAttributesModifier.Create;
+    FMarkup.OnChange := @DoMarkupChaged;
+    FTokens := TStringList.Create;
+    TStringList(FTokens).OnChange := @DoTokensChanged;
+    FMatchTokenKinds := [];
+end;
+
+destructor TSynPasSynCustomToken.Destroy;
+begin
+  inherited Destroy;
+  FMarkup.Free;
+  FTokens.Free;
+end;
+
 { TSynHighlighterPasRangeList }
 
 function TSynHighlighterPasRangeList.GetTSynPasRangeInfo(Index: Integer): TSynPasRangeInfo;

ide/editoroptions.pp

@@ -100,7 +100,8 @@ type
     ( hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior,
       hafStyle, hafStyleMask,
       hafFrameStyle, hafFrameEdges,
-      hafMarkupFoldColor // for the MarkupFoldColor module
+      hafMarkupFoldColor, // for the MarkupFoldColor module
+      hafCustomWords
     );
   TColorSchemeAttributeFeatures = set of TColorSchemeAttributeFeature;
 
@@ -283,7 +284,7 @@ type
 
   { TColorSchemeAttribute }
 
-  TColorSchemeAttribute = class(TSynHighlighterAttributesModifier)
+  TColorSchemeAttribute = class(TSynHighlighterLazCustumPasAttribute)
   private
     FFeatures: TColorSchemeAttributeFeatures;
     FGroup: TAhaGroupName;
@@ -6985,6 +6986,10 @@ begin
       TSynHighlighterAttributesModifier(aDest).ForeAlpha := Src.ForeAlpha;
       TSynHighlighterAttributesModifier(aDest).BackAlpha := Src.BackAlpha;
       TSynHighlighterAttributesModifier(aDest).FrameAlpha := Src.FrameAlpha;
+      if aDest is TSynHighlighterLazCustumPasAttribute then begin
+        TSynHighlighterLazCustumPasAttribute(aDest).CustomWords.Assign(CustomWords);
+        TSynHighlighterLazCustumPasAttribute(aDest).CustomWordTokenKind := CustomWordTokenKind;
+      end;
     end;
 
     if hafPrior in Src.Features then begin
@@ -7026,6 +7031,8 @@ begin
   inherited Assign(Src);
   FFeatures := [hafBackColor, hafForeColor, hafFrameColor,
                 hafStyle, hafFrameStyle, hafFrameEdges, hafPrior];
+  if Src is TSynHighlighterLazCustumPasAttribute then
+    FFeatures := FFeatures + [hafCustomWords];
   if Src is TSynHighlighterAttributesModifier then
     FFeatures := FFeatures + [hafAlpha, hafStyleMask];
 
@@ -7103,8 +7110,10 @@ begin
   Assert(Version > 4, 'TColorSchemeAttribute.LoadFromXml: Version ('+IntToStr(Version)+' < 5.');
   if StoredName = '' then exit;
   Path := aPath + StrToValidXMLName(StoredName) + '/';
-  if aXMLConfig.HasPath(Path, False) then
+  if aXMLConfig.HasPath(Path, False) then begin
-    aXMLConfig.ReadObject(Path, Self, Defaults)
+    aXMLConfig.ReadObject(Path, Self, Defaults);
+    CustomWords.Text := aXMLConfig.GetValue(Path+'CustomWords', '');
+  end
   else begin
     if (Defaults <> Self) and (Defaults <> nil) then begin
       // do not copy (Stored)Name or Features ...
@@ -7122,14 +7131,16 @@ begin
       BoldPriority      := Defaults.BoldPriority;
       ItalicPriority    := Defaults.ItalicPriority;
       UnderlinePriority := Defaults.UnderlinePriority;
+      CustomWords.Text  := Defaults.CustomWords.Text;
     end;
   end;
 end;
 
-procedure TColorSchemeAttribute.SaveToXml(aXMLConfig: TRttiXMLConfig;
+procedure TColorSchemeAttribute.SaveToXml(aXMLConfig: TRttiXMLConfig; const aPath: String;
-  const aPath: String; Defaults: TColorSchemeAttribute);
+  Defaults: TColorSchemeAttribute);
 var
   AttriName: String;
+  Path: String;
 begin
   if StoredName = '' then
     exit;
@@ -7138,7 +7149,9 @@ begin
   if AttriName <> '' then
     aXMLConfig.DeletePath(aPath + StrToValidXMLName(AttriName));
 
-  aXMLConfig.WriteObject(aPath + StrToValidXMLName(StoredName) + '/', Self, Defaults);
+  Path := aPath + StrToValidXMLName(StoredName) + '/';
+  aXMLConfig.WriteObject(Path, Self, Defaults);
+  aXMLConfig.SetDeleteValue(Path + 'CustomWords', CustomWords.Text, '');
 end;
 
 { TColorSchemeLanguage }
@@ -7258,6 +7271,9 @@ begin
       csa.Assign(hla);
       csa.Group := agnLanguage;
       if (FHighlighter <> nil) and (FHighlighter is TNonSrcIDEHighlighter) then
+        if hla is TSynHighlighterLazCustumPasAttribute then
+          csa.Features := [hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior, hafStyle, hafStyleMask, hafCustomWords]
+        else
         if hla is TSynHighlighterAttributesModifier then
           csa.Features := [hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior, hafStyle, hafStyleMask]
         else

ide/frames/editor_color_options.pas

@@ -1176,11 +1176,18 @@ begin
         agnDefault, //  continue; // default is currently not shown
         agnLanguage:
           begin
-            if FIsEditingDefaults then
-              ParentName := AdditionalHighlightGroupNames[agnDefault]
-            else
-              ParentName := FCurrentHighlighter.LanguageName;
             ParentNode := ColorElementTree.Items.GetFirstNode;
+            if FIsEditingDefaults then begin
+              ParentName := AdditionalHighlightGroupNames[agnDefault];
+            end
+            else
+            if hafCustomWords in Attr.Features then begin
+              ParentName := FCurrentHighlighter.LanguageName + ' (Custom)';
+              ParentNode := ColorElementTree.Items.FindTopLvlNode(ParentName);
+            end
+            else begin
+              ParentName := FCurrentHighlighter.LanguageName;
+            end;
           end;
         else
           begin

ide/lazarusidestrconsts.pas

@@ -6291,6 +6291,9 @@ resourcestring
   optDispGutterNoCurrentLineColor = 'No current line color';
   optDispGutterUseCurrentLineColor = 'Use current line color';
   optDispGutterUseCurrentLineNumberColor = 'Use current line number color';
+  dlgMatchWords = 'Match words';
+  dlgKeyWord = 'KeyWord';
+  dlgModifier = 'Modifier';
 
 implementation
 

ide/sourcesyneditor.pas

@@ -331,10 +331,32 @@ type
     FInitializationLine, FFinalizationLine: Integer;
   end;
 
+  { TSynHighlighterLazCustumPasAttribute }
+
+  TSynHighlighterLazCustumPasAttribute = class(TSynHighlighterAttributesModifier)
+  private
+    FCustomWords: TStrings;
+    FCustomWordTokenKind: TtkTokenKind;
+    procedure DoWordsChanged(Sender: TObject);
+    procedure SetCustomWordTokenKind(AValue: TtkTokenKind);
+  protected
+    procedure AssignFrom(Src: TLazSynCustomTextAttributes); override;
+    procedure DoClear; override;
+    procedure Init; override;
+  public
+    destructor Destroy; override;
+    property CustomWords: TStrings read FCustomWords;
+  published
+    property CustomWordTokenKind: TtkTokenKind read FCustomWordTokenKind write SetCustomWordTokenKind;
+  end;
+
   { TIDESynPasSyn }
 
   TIDESynPasSyn = class(TSynPasSyn)
   private
+    FCustomAttribs: array[0..9] of TSynHighlighterLazCustumPasAttribute;
+
+    procedure DoBuildCustomPasAttr(Sender: TObject);
     function GetFinalizationLine: Integer;
     function GetImplementationLine: Integer;
     function GetInitializationLine: Integer;
@@ -345,6 +367,10 @@ type
       IncreaseLevel: Boolean = true; ForceDisabled: Boolean = False
       ): TSynCustomCodeFoldBlock; override;
   public
+    constructor Create(AOwner: TComponent); override;
+    //procedure DefHighlightChange(Sender: TObject);
+
+
     procedure SetLine({$IFDEF FPC}const {$ENDIF}NewValue: string;
       LineNumber: Integer); override;
     property InterfaceLine: Integer read GetInterfaceLine;
@@ -1925,11 +1951,86 @@ begin
   Ime.InvalidateLinesMethod := @InvalidateLines;
   ImeHandler := Ime;
 end;
-
 {$ENDIF}
 
+{ TSynHighlighterLazCustumPasAttribute }
+
+procedure TSynHighlighterLazCustumPasAttribute.SetCustomWordTokenKind(AValue: TtkTokenKind);
+begin
+  if FCustomWordTokenKind = AValue then Exit;
+  FCustomWordTokenKind := AValue;
+  Changed;
+end;
+
+procedure TSynHighlighterLazCustumPasAttribute.DoWordsChanged(Sender: TObject);
+begin
+  Changed;
+end;
+
+procedure TSynHighlighterLazCustumPasAttribute.AssignFrom(Src: TLazSynCustomTextAttributes);
+begin
+  inherited AssignFrom(Src);
+  if Src is TSynHighlighterLazCustumPasAttribute then begin
+    FCustomWords.Assign(TSynHighlighterLazCustumPasAttribute(Src).FCustomWords);
+    FCustomWordTokenKind := TSynHighlighterLazCustumPasAttribute(Src).FCustomWordTokenKind;
+  end
+  else begin
+    FCustomWords.Clear;
+    FCustomWordTokenKind := tkIdentifier;
+  end;
+end;
+
+procedure TSynHighlighterLazCustumPasAttribute.DoClear;
+begin
+  inherited DoClear;
+  if FCustomWords <> nil then
+    FCustomWords.Clear;
+  FCustomWordTokenKind := tkIdentifier;
+end;
+
+procedure TSynHighlighterLazCustumPasAttribute.Init;
+begin
+  FCustomWords := TStringList.Create;
+  FCustomWordTokenKind := tkIdentifier;
+  TStringList(FCustomWords).OnChange := @DoWordsChanged;
+  inherited Init;
+end;
+
+destructor TSynHighlighterLazCustumPasAttribute.Destroy;
+begin
+  inherited Destroy;
+  FCustomWords.Destroy;
+end;
+
 { TIDESynPasSyn }
 
+procedure TIDESynPasSyn.DoBuildCustomPasAttr(Sender: TObject);
+var
+  c, i: Integer;
+begin
+  c := 0;
+  for i := 0 to 9 do
+    if FCustomAttribs[i].IsEnabled and
+       (trim(FCustomAttribs[i].CustomWords.Text) <> '')
+    then
+      inc(c);
+
+  CustomTokenCount := c;
+  c := 0;
+  for i := 0 to 9 do
+    if FCustomAttribs[i].IsEnabled and
+       (trim(FCustomAttribs[i].CustomWords.Text) <> '')
+    then begin
+      CustomTokens[c].Markup.Assign(FCustomAttribs[i]);
+      CustomTokens[c].MatchTokenKinds := [FCustomAttribs[i].CustomWordTokenKind];
+      CustomTokens[c].Tokens.Assign(FCustomAttribs[i].CustomWords);
+      inc(c);
+    end;
+
+
+  DefHighlightChange(Sender);
+end;
+
 function TIDESynPasSyn.GetFinalizationLine: Integer;
 begin
   Result := TIDESynHighlighterPasRangeList(CurrentRanges).FFinalizationLine;
@@ -1977,6 +2078,19 @@ begin
   Result := inherited;
 end;
 
+constructor TIDESynPasSyn.Create(AOwner: TComponent);
+var
+  i: Integer;
+begin
+  inherited Create(AOwner);
+
+  for i := 0 to 9 do begin
+    FCustomAttribs[i] := TSynHighlighterLazCustumPasAttribute.Create('Custom '+IntToStr(i), 'CustomToken_'+IntToStr(i));
+    AddAttribute(FCustomAttribs[i]);
+    FCustomAttribs[i].OnChange := @DoBuildCustomPasAttr;
+  end;
+end;
+
 procedure TIDESynPasSyn.SetLine(const NewValue: string; LineNumber: Integer);
 begin
   if assigned(CurrentRanges) then begin

ide/syncolorattribeditor.pas

@@ -10,7 +10,7 @@ uses
   LCLIntf, Forms, StdCtrls, ExtCtrls, Graphics, GraphUtil,
   ColorBox, Dialogs, Menus, Spin,
   // SynEdit
-  SynEditTypes, SynTextDrawer,
+  SynEditTypes, SynTextDrawer, SynHighlighterPas,
   // IdeConfig
   EnvironmentOpts,
   // IDE
@@ -25,9 +25,20 @@ type
     BackPriorSpin: TSpinEdit;
     BackGroundColorBox: TColorBox;
     BackGroundLabel: TLabel;
-    ColumnPosBevel: TPanel;
+    dropCustomWordKind: TComboBox;
     ForePriorLabel: TLabel;
     ForePriorSpin: TSpinEdit;
+    lbFiller1: TLabel;
+    lbCustomWords: TLabel;
+    lbFiller10: TLabel;
+    lbFiller2: TLabel;
+    lbFiller3: TLabel;
+    lbFiller4: TLabel;
+    lbFiller5: TLabel;
+    lbFiller6: TLabel;
+    lbFiller7: TLabel;
+    lbFiller8: TLabel;
+    lbFiller9: TLabel;
     lblInfo: TLabel;
     MarkupFoldStyleBox: TComboBox;
     MarkupFoldAlphaSpin: TSpinEdit;
@@ -45,6 +56,34 @@ type
     ForeAlphaLabel: TLabel;
     BackAlphaLabel: TLabel;
     FrameAlphaLabel: TLabel;
+    edCustomWord: TMemo;
+    Panel1: TPanel;
+    Panel10: TPanel;
+    Panel11: TPanel;
+    Panel12: TPanel;
+    Panel13: TPanel;
+    Panel14: TPanel;
+    Panel15: TPanel;
+    Panel16: TPanel;
+    Panel17: TPanel;
+    Panel18: TPanel;
+    Panel19: TPanel;
+    Panel2: TPanel;
+    Panel20: TPanel;
+    Panel21: TPanel;
+    Panel22: TPanel;
+    pnlWords: TPanel;
+    Panel3: TPanel;
+    Panel4: TPanel;
+    Panel5: TPanel;
+    Panel6: TPanel;
+    Panel7: TPanel;
+    Panel8: TPanel;
+    Panel9: TPanel;
+    pnlFrameHost2: TPanel;
+    pnlFrameHost1: TPanel;
+    pnlForegroundName: TPanel;
+    pnlBackgroundName: TPanel;
     pnlUnderline: TPanel;
     pnlBold: TPanel;
     pnlItalic: TPanel;
@@ -68,6 +107,8 @@ type
     TextUnderlineRadioPanel: TPanel;
     ForeGroundLabel: TLabel;
     ForeGroundUseDefaultCheckBox: TCheckBox;
+    procedure dropCustomWordKindChange(Sender: TObject);
+    procedure edCustomWordChange(Sender: TObject);
     procedure GeneralAlphaSpinOnChange(Sender: TObject);
     procedure GeneralAlphaSpinOnEnter(Sender: TObject);
     procedure GeneralColorBoxOnChange(Sender: TObject);
@@ -199,6 +240,25 @@ begin
   DoChanged;
 end;
 
+procedure TSynColorAttrEditor.edCustomWordChange(Sender: TObject);
+begin
+  if (FCurHighlightElement = nil) then
+    exit;
+
+  FCurHighlightElement.CustomWords.Text := trim(edCustomWord.Text);
+end;
+
+procedure TSynColorAttrEditor.dropCustomWordKindChange(Sender: TObject);
+begin
+  case dropCustomWordKind.ItemIndex of
+    0: FCurHighlightElement.CustomWordTokenKind := tkIdentifier;
+    1: FCurHighlightElement.CustomWordTokenKind := tkKey;
+    2: FCurHighlightElement.CustomWordTokenKind := tkModifier;
+    3: FCurHighlightElement.CustomWordTokenKind := tkNumber;
+    4: FCurHighlightElement.CustomWordTokenKind := tkSymbol;
+  end;
+end;
+
 procedure TSynColorAttrEditor.GeneralAlphaSpinOnEnter(Sender: TObject);
 begin
   UpdatingColor := True;
@@ -278,29 +338,19 @@ end;
 
 procedure TSynColorAttrEditor.DoResized;
 var
-  S: TSpinEdit;
+  EdCustWidth: Integer;
 begin
-  S := FramePriorSpin;
+  EdCustWidth := 0;
-  if not S.Visible then
+  if edCustomWord.Visible then
-    S := FrameAlphaSpin;
+    EdCustWidth := edCustomWord.Width;
-  if Width > S.Left + S.Width + FrameStyleBox.Width + FrameEdgesBox.Width + 15 then
+
-  begin
+  if Width > Panel1.Width + EdCustWidth - pnlFrameHost1.Width + Max(pnlFrameHost1.Width, pnlFrameHost2.Width) + 15 then begin
-    //FrameEdgesBox.AnchorSide[akTop].Control := S;
+    FrameEdgesBox.Parent := pnlFrameHost1;
-    FrameEdgesBox.AnchorSide[akTop].Side := asrTop;
+    FrameStyleBox.Parent := pnlFrameHost1;
-    FrameEdgesBox.AnchorSide[akLeft].Control := S;
-    FrameEdgesBox.AnchorSide[akLeft].Side := asrBottom;
-    FrameEdgesBox.BorderSpacing.Top := 0;
-    FrameEdgesBox.BorderSpacing.Left := 6;
-    MarkupFoldColorBox.AnchorSide[akTop].Control := FrameColorBox;
   end
   else begin
-    //FrameEdgesBox.AnchorSide[akTop].Control := FrameColorBox;
+    FrameEdgesBox.Parent := pnlFrameHost2;
-    FrameEdgesBox.AnchorSide[akTop].Side := asrBottom;
+    FrameStyleBox.Parent := pnlFrameHost2;
-    FrameEdgesBox.AnchorSide[akLeft].Control := FrameColorBox;
-    FrameEdgesBox.AnchorSide[akLeft].Side := asrTop;
-    FrameEdgesBox.BorderSpacing.Top := 3;
-    FrameEdgesBox.BorderSpacing.Left := 0;
-    MarkupFoldColorBox.AnchorSide[akTop].Control := FrameEdgesBox;
   end;
 end;
 
@@ -432,37 +482,14 @@ end;
 
 procedure TSynColorAttrEditor.pnlElementAttributesResize(Sender: TObject);
 var
-  MinAnchor: TControl;
+  EdCustWidth: Integer;
-  MinWidth: Integer;
-  S: TSpinEdit;
-
-  procedure CheckControl(Other: TControl);
-  var w,h: Integer;
-  begin
-    if not Other.Visible then exit;
-    h:=0;
-    w:=0;
-    Other.GetPreferredSize(w,h);
-    if w <= MinWidth then exit;
-    MinAnchor := Other;
-    MinWidth := w;
-  end;
 begin
-  MinWidth := -1;
+  EdCustWidth := 0;
-  MinAnchor := ForeGroundLabel;
+  if edCustomWord.Visible then
-  CheckControl(ForeGroundLabel);
+    EdCustWidth := edCustomWord.Width;
-  CheckControl(BackGroundLabel);
-  CheckControl(ForeGroundUseDefaultCheckBox);
-  CheckControl(BackGroundUseDefaultCheckBox);
-  CheckControl(FrameColorUseDefaultCheckBox);
-  CheckControl(MarkupFoldColorUseDefaultCheckBox);
 
-  ColumnPosBevel.AnchorSide[akLeft].Control := MinAnchor;
+  //Constraints.MinHeight := lblInfo.Top + lblInfo.Height;
-  Constraints.MinHeight := lblInfo.Top + lblInfo.Height;
+  Constraints.MinWidth := Panel1.Width + EdCustWidth - pnlFrameHost1.Width + 15;
-  S := BackPriorSpin;
-  if not S.Visible then
-    S := BackAlphaSpin;
-  Constraints.MinWidth := S.Left + S.Width;
 end;
 
 procedure TSynColorAttrEditor.TextStyleRadioOnChange(Sender: TObject);
@@ -743,12 +770,26 @@ begin
       TextUnderlineCheckBox.Checked := fsUnderline in FCurHighlightElement.Style;
     end;
 
-    lblInfo.Visible := False;
+    lblInfo.Caption := '';
     if IsAhaElement(FCurHighlightElement, ahaCaretColor) then begin
       lblInfo.Caption := dlgCaretColorInfo;
       lblInfo.Visible := True;
     end;
 
+    // custom words
+    lbCustomWords.Visible      := hafCustomWords in FCurHighlightElement.Features;
+    edCustomWord.Visible       := hafCustomWords in FCurHighlightElement.Features;
+    dropCustomWordKind.Visible := hafCustomWords in FCurHighlightElement.Features;
+    edCustomWord.Text := FCurHighlightElement.CustomWords.Text;
+
+    case FCurHighlightElement.CustomWordTokenKind of
+      tkIdentifier: dropCustomWordKind.ItemIndex := 0;
+      tkKey:        dropCustomWordKind.ItemIndex := 1;
+      tkModifier:   dropCustomWordKind.ItemIndex := 2;
+      tkNumber:     dropCustomWordKind.ItemIndex := 3;
+      tkSymbol:     dropCustomWordKind.ItemIndex := 4;
+    end;
+
     UpdatingColor := False;
   finally
     EnableAlign;
@@ -792,7 +833,6 @@ end;
 procedure TSynColorAttrEditor.Setup;
 begin
   UpdatingColor := False;
-  ColumnPosBevel.Height := 1;
   ForeGroundLabel.Caption := dlgForecolor;
   BackGroundLabel.Caption := dlgBackColor;
   ForeGroundUseDefaultCheckBox.Caption := dlgForecolor;
@@ -822,11 +862,19 @@ begin
   TextUnderlineRadioOff.Caption := dlgEdOff;
   TextUnderlineRadioInvert.Caption := dlgEdInvert;
 
-  Constraints.MinHeight := max(Constraints.MinHeight,
+  lbCustomWords.Caption := dlgMatchWords;
-                               pnlUnderline.Top + pnlUnderline.Height +
+  dropCustomWordKind.Items.Add(lisCodeToolsOptsIdentifier);
-                               Max(pnlUnderline.BorderSpacing.Around,
+  dropCustomWordKind.Items.Add(dlgKeyWord);
-                                   pnlUnderline.BorderSpacing.Bottom)
+  dropCustomWordKind.Items.Add(dlgModifier);
-                              );
+  dropCustomWordKind.Items.Add(lisCodeToolsOptsNumber);
+  dropCustomWordKind.Items.Add(lisCodeToolsOptsSymbol);
+  dropCustomWordKind.ItemIndex := 0;
+
+  //Constraints.MinHeight := max(Constraints.MinHeight,
+  //                             pnlUnderline.Top + pnlUnderline.Height +
+  //                             Max(pnlUnderline.BorderSpacing.Around,
+  //                                 pnlUnderline.BorderSpacing.Bottom)
+  //                            );
 end;
 
 end.