Ide, TodoListLaz: Add IdeIntf for color scheme / Add "todo comment" markup for SourceEditor Issue #41420

components/ideintf/editorsyntaxhighlighterdef.pas

@@ -44,7 +44,7 @@ const
   IdeHighlighterUnknownId      = TIdeSyntaxHighlighterID(-2); // Name not in list
   IdeHighlighterNotSpecifiedId = TIdeSyntaxHighlighterID(-1); // No Name given
   IdeHighlighterNoneID         = TIdeSyntaxHighlighterID(0);
-  IdeHighlighterStartId = TIdeSyntaxHighlighterID(1); // first regulor Highlighter in IdeSyntaxHighlighters (lowest index)
+  IdeHighlighterStartId = TIdeSyntaxHighlighterID(1); // first regular Highlighter in IdeSyntaxHighlighters (lowest index)
 
   LazSyntaxHighlighterNames: array[TLazSyntaxHighlighter] of String =
   ( 'None',
@@ -73,8 +73,53 @@ const
 function GetSyntaxHighlighterCaption(h: TLazSyntaxHighlighter): string;     deprecated 'Use IdeSyntaxHighlighters (to be removed in 4.99)';
 function StrToLazSyntaxHighlighter(const s: String): TLazSyntaxHighlighter; deprecated 'Use IdeSyntaxHighlighters (to be removed in 4.99)';
 
+
+type
+  TColorSchemeAttributeFeature =
+    ( hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior,
+      hafStyle, hafStyleMask,
+      hafFrameStyle, hafFrameEdges,
+      hafMarkupFoldColor, // for the MarkupFoldColor module
+      hafCustomWords
+    );
+  TColorSchemeAttributeFeatures = set of TColorSchemeAttributeFeature;
+
+  IColorSchemeAttribute = interface ['{2572547D-217A-4A83-A910-0D808ECF3317}']
+    procedure ApplyTo(aDest: TObject);
+  end;
+
+  IColorSchemeLanguage = interface ['{40A0F5E1-ADD5-4E0E-BD14-583E244C4ACC}']
+    function GetName: String;
+    function AttributeCount: Integer;
+    function GetAttributeIntf(AnIndex: integer): IColorSchemeAttribute;  //TSynHighlighterAttributesModifier
+    function GetAttributeIntf(const AStoredName: string): IColorSchemeAttribute;  //TSynHighlighterAttributesModifier
+  end;
+
+  IColorScheme = interface ['{121AB166-7458-4AD8-8122-C9AD4A259521}']
+    function GetName: String;
+    function Count: integer;
+    function GetLanguage(AnIndex: Integer): IColorSchemeLanguage;
+    function GetLanguageForHighlighter(AnHiglighter: TObject): IColorSchemeLanguage;
+    function GetLanguageForHighlighter(AnHighlighterId: TIdeSyntaxHighlighterID): IColorSchemeLanguage;
+  end;
+
+  IColorSchemeList = interface ['{BA72F07B-77F5-4C36-AE9C-907980ADDEE3}']
+    function Count: integer;
+    function GetScheme(AnIndex: Integer): IColorScheme;
+    function GetScheme(AName: String): IColorScheme;
+    function GetCurrentSchemeForHighlighter(AnHiglighter: TObject): IColorScheme;
+    function GetCurrentSchemeForHighlighter(AnHighlighterId: TIdeSyntaxHighlighterID): IColorScheme;
+
+    procedure RegisterChangedHandler(AnHandler: TNotifyEvent);
+    procedure UnregisterChangedHandler(AnHandler: TNotifyEvent);
+
+    function RegisterAttributeGroup(AName: PString): integer; // pointer to resource string
+    procedure AddAttribute(AnAttrGroup: integer; AnHighlighterId: TIdeSyntaxHighlighterID; AStoredName: String; AName: PString;  AFeatures: TColorSchemeAttributeFeatures; ADefaults: TObject = nil);
+  end;
+
 var
   IdeSyntaxHighlighters: TIdeSyntaxHighlighterList;
+  IdeColorSchemeList: IColorSchemeList;
 
 implementation
 

components/synedit/synedithighlighter.pp

@@ -38,7 +38,7 @@ uses
   // LazUtils
   LazUTF8, LazMethodList,
   // SynEdit
-  SynEditTypes, SynEditTextBase;
+  SynEditTypes, SynEditTextBase, SynEditMiscProcs;
 
 type
   { TSynHighlighterRangeList }
@@ -417,6 +417,7 @@ type
     function IsKeyword(const AKeyword: string): boolean; virtual;               // DJLP 2000-08-09
     procedure Next; virtual; abstract;
     procedure NextToEol;
+    function  NextToLogX(ALogX: IntPos): boolean;
 
     property DrawDivider[Index: integer]: TSynDividerDrawConfigSetting
       read GetDrawDivider;
@@ -1593,6 +1594,23 @@ begin
   FIsInNextToEOL := False;
 end;
 
+function TSynCustomHighlighter.NextToLogX(ALogX: IntPos): boolean;
+var
+  Start: Integer;
+begin
+  Result := False;
+  while not GetEol do begin
+    Start := ToPos(GetTokenPos);
+    if Start > ALogX then
+      exit;
+    if ALogX < Start + GetTokenLen then begin
+      Result := True;
+      exit;
+    end;
+    Next;
+  end;
+end;
+
 procedure TSynCustomHighlighter.ContinueNextLine;
 begin
   inc(FLineIndex);

components/synedit/synhighlighterpas.pp

@@ -925,6 +925,9 @@ type
     function GetTokenKind: integer; override;
     function GetTokenPos: Integer; override;
     function GetTokenLen: Integer; override;
+    function GetTokenIsComment: Boolean;
+    function GetTokenIsCommentStart(AnIgnoreMultiLineSlash: Boolean = False): Boolean;
+    function GetTokenIsCommentEnd: Boolean;
     function IsKeyword(const AKeyword: string): boolean; override;
     procedure Next; override;
 
@@ -5197,6 +5200,7 @@ begin
     #10: LFProc;
     #13: CRProc;
     else
+      FOldRange := fRange;
       if rsAnsi in fRange then
         AnsiProc
       else if fRange * [rsBor, rsIDEDirective] <> [] then
@@ -5207,7 +5211,6 @@ begin
         SlashContinueProc
       else begin
         FNextTokenState := tsNone;
-        FOldRange := fRange;
         OldNestLevel := PasCodeFoldRange.BracketNestLevel;
         if (PasCodeFoldRange.BracketNestLevel = 1) then // procedure foo; [attr...]
           FOldRange := FOldRange - [rsWasInProcHeader];
@@ -5469,6 +5472,30 @@ begin
   Result := Run-fTokenPos;
 end;
 
+function TSynPasSyn.GetTokenIsComment: Boolean;
+begin
+  Result := (FTokenID = tkComment) or
+            ( (fLineLen = 0) and
+              (FRange * [rsAnsi, rsBor] <> [])  //rsIDEDirective
+            );
+end;
+
+function TSynPasSyn.GetTokenIsCommentStart(AnIgnoreMultiLineSlash: Boolean): Boolean;
+begin
+  if AnIgnoreMultiLineSlash then
+    Result := (FTokenID = tkComment) and (fLineLen > 0) and
+              (FOldRange * [rsAnsi, rsBor] = [])  // rsIDEDirective
+  else
+    Result := (FTokenID = tkComment) and (fLineLen > 0) and
+              (FOldRange * [rsAnsi, rsBor, rsSlash] = []);
+end;
+
+function TSynPasSyn.GetTokenIsCommentEnd: Boolean;
+begin
+  Result := (FTokenID = tkComment) and
+            (FRange * [rsAnsi, rsBor, rsSlash] = []);  // rsIDEDirective
+end;
+
 function TSynPasSyn.GetRange: Pointer;
 begin
   // For speed reasons, we work with fRange instead of CodeFoldRange.RangeType

components/todolist/todolistlaz.lpk

@@ -44,12 +44,20 @@
         <Filename Value="todoliststrconsts.pas"/>
         <UnitName Value="ToDoListStrConsts"/>
       </Item>
+      <Item>
+        <Filename Value="todosynmarkup.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="todosynmarkup"/>
+      </Item>
     </Files>
     <i18n>
       <EnableI18N Value="True"/>
       <OutDir Value="languages"/>
     </i18n>
     <RequiredPkgs>
+      <Item>
+        <PackageName Value="SynEdit"/>
+      </Item>
       <Item>
         <PackageName Value="IDEIntf"/>
       </Item>

components/todolist/todolistlaz.pas

@@ -8,13 +8,14 @@ unit ToDoListLaz;
 interface
 
 uses
-  ToDoDlg, ToDoList, ToDoListCore, ToDoListStrConsts, LazarusPackageIntf;
+  ToDoDlg, ToDoList, ToDoListCore, ToDoListStrConsts, TodoSynMarkup, LazarusPackageIntf;
 
 implementation
 
 procedure Register;
 begin
   RegisterUnit('ToDoDlg', @ToDoDlg.Register);
+  RegisterUnit('TodoSynMarkup', @TodoSynMarkup.Register);
 end;
 
 initialization

components/todolist/todosynmarkup.pas

@@ -0,0 +1,547 @@
+unit TodoSynMarkup;
+
+{$mode objfpc}{$H+}
+{$inline off}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Graphics,
+  LazLoggerBase,
+  // IdeIntf
+  SrcEditorIntf, EditorSyntaxHighlighterDef,
+  // LazEdit
+  LazEditMiscProcs,
+  // SynEdit
+  SynEditMarkup, SynHighlighterPas, SynEditMiscProcs, SynEdit, SynEditMiscClasses, SynEditTypes,
+  SynEditHighlighter;
+
+type
+
+  { TSynEditTodoMarkup }
+
+  TSynEditTodoMarkup = class(TSynEditMarkup)
+  private type
+    TCommentKind = (ckTodo, ckDone, ckNote);
+    TFoundTodo = record
+      StartPos: TLogPoint;
+      EndPos: TLogPoint;
+      Kind: TCommentKind;
+    end;
+  private
+    FPasHl: TSynPasSyn;
+    FLineLen: integer;
+    FFoundPos: array of TFoundTodo;
+    FSkipStartLine, FSkipEndLine: integer;
+    FNxtIdx, FMrkIdx: integer;
+  public
+    procedure BeginMarkup; override;
+    procedure PrepareMarkupForRow(aRow: Integer); override;
+    procedure GetNextMarkupColAfterRowCol(const aRow: Integer;
+      const aStartCol: TLazSynDisplayTokenBound; const AnRtlInfo: TLazSynDisplayRtlInfo; out
+      ANextPhys, ANextLog: Integer); override;
+    function GetMarkupAttributeAtRowCol(const aRow: Integer;
+      const aStartCol: TLazSynDisplayTokenBound; const AnRtlInfo: TLazSynDisplayRtlInfo
+      ): TSynSelectedColor; override;
+    function GetMarkupAttributeAtWrapEnd(const aRow: Integer;
+      const aWrapCol: TLazSynDisplayTokenBound): TSynSelectedColor; override;
+  end;
+
+procedure Register;
+
+implementation
+
+type
+
+  { TTodoEditorHandler }
+
+  TTodoEditorHandler = class
+    procedure DoEditorCreated(Sender: TObject);
+    procedure DoColorsChanged(Sender: TObject);
+  end;
+
+resourcestring
+  AttribGroupName = 'Todo comments';
+  AttribNameTodo  = 'Todo comment';
+  AttribNameDone  = 'Done comment';
+  AttribNameNote  = 'Note comment';
+
+var
+  AttribGroupIdx: Integer;
+  CommentAttribTodo, CommentAttribDone, CommentAttribNote: TSynSelectedColor;
+
+procedure Register;
+begin
+  SourceEditorManagerIntf.RegisterChangeEvent(semEditorCreate, @TTodoEditorHandler(nil).DoEditorCreated);
+  SourceEditorManagerIntf.RegisterChangeEvent(semEditorCloned, @TTodoEditorHandler(nil).DoEditorCreated);
+  TTodoEditorHandler(nil).DoColorsChanged(nil);
+end;
+
+procedure RegisterAttribs;
+var
+  pas: TIdeSyntaxHighlighterID;
+begin
+  CommentAttribTodo := TSynSelectedColor.Create('', '');
+  CommentAttribDone := TSynSelectedColor.Create('', '');
+  CommentAttribNote := TSynSelectedColor.Create('', '');
+  CommentAttribTodo.Clear;
+  CommentAttribDone.Clear;
+  CommentAttribNote.Clear;
+
+  IdeColorSchemeList.RegisterChangedHandler(@TTodoEditorHandler(nil).DoColorsChanged);
+
+  // Register colors before the IDE loads them
+
+  pas := IdeSyntaxHighlighters.GetIdForLazSyntaxHighlighter(lshFreePascal);
+  AttribGroupIdx := IdeColorSchemeList.RegisterAttributeGroup(@AttribGroupName);
+
+  IdeColorSchemeList.AddAttribute(AttribGroupIdx, pas, 'LazTodoListCommentTodo', @AttribNameTodo, [hafBackColor..hafFrameEdges]);
+  IdeColorSchemeList.AddAttribute(AttribGroupIdx, pas, 'LazTodoListCommentDone', @AttribNameDone, [hafBackColor..hafFrameEdges]);
+  IdeColorSchemeList.AddAttribute(AttribGroupIdx, pas, 'LazTodoListCommentNote', @AttribNameNote, [hafBackColor..hafFrameEdges]);
+end;
+
+procedure FreeAttribs;
+begin
+  CommentAttribTodo.Free;
+  CommentAttribDone.Free;
+  CommentAttribNote.Free;
+end;
+
+{ TTodoEditorHandler }
+
+procedure TTodoEditorHandler.DoEditorCreated(Sender: TObject);
+var
+  Syn: TSynEdit;
+begin
+  Syn := TSourceEditorInterface(Sender).EditorControl as TSynEdit;
+  Syn.MarkupManager.AddMarkUp(TSynEditTodoMarkup.Create(Syn));
+end;
+
+procedure TTodoEditorHandler.DoColorsChanged(Sender: TObject);
+var
+  pas: TIdeSyntaxHighlighterID;
+  cs: IColorScheme;
+  csl: IColorSchemeLanguage;
+  attr: IColorSchemeAttribute;
+begin
+  pas := IdeSyntaxHighlighters.GetIdForLazSyntaxHighlighter(lshFreePascal);
+  cs := IdeColorSchemeList.GetCurrentSchemeForHighlighter(pas);
+  csl := cs.GetLanguageForHighlighter(pas);
+  attr := csl.GetAttributeIntf('LazTodoListCommentTodo');
+  attr.ApplyTo(CommentAttribTodo);
+  attr := csl.GetAttributeIntf('LazTodoListCommentDone');
+  attr.ApplyTo(CommentAttribDone);
+  attr := csl.GetAttributeIntf('LazTodoListCommentNote');
+  attr.ApplyTo(CommentAttribNote);
+end;
+
+{ TSynEditTodoMarkup }
+
+procedure TSynEditTodoMarkup.BeginMarkup;
+begin
+  FFoundPos := nil;
+  FSkipStartLine := -1;
+  inherited BeginMarkup;
+
+  FPasHl := TSynPasSyn(TSynEdit(SynEdit).Highlighter);
+  if (FPasHl <> nil) and not(TSynCustomHighlighter(FPasHl) is TSynPasSyn) then
+    FPasHl := nil;
+
+  if not (CommentAttribTodo.IsEnabled or
+          CommentAttribDone.IsEnabled or
+          CommentAttribNote.IsEnabled)
+  then
+    FPasHl := nil;
+end;
+
+procedure TSynEditTodoMarkup.PrepareMarkupForRow(aRow: Integer);
+var
+  LineText: String;
+  p: PChar;
+  pe: Pointer;
+
+  function GetLine(ALineNum: integer): boolean; inline;
+  begin
+    Result := False;
+    if ALineNum >= SynEdit.Lines.Count then
+      exit;
+    Result := True;
+    LineText := SynEdit.Lines[ToIdx(ALineNum)];
+    p := PChar(LineText);
+    pe := p + Length(LineText);
+  end;
+  function AdvanceToNextLine(var ALineNum: integer): boolean; inline;
+  begin
+    repeat
+      inc(ALineNum);
+      Result := GetLine(ALineNum);
+    until (not Result) or (LineText <> '');
+  end;
+
+  function StartsWithContinuedComment(ALineNum: integer): boolean; inline;
+  begin
+    FPasHl.StartAtLineIndex(ToIdx(ALineNum));
+    Result := FPasHl.GetTokenIsComment and
+              not FPasHl.GetTokenIsCommentStart(True);
+  end;
+
+  function GetStartOfComment(var ALineNum: integer; out ALogX: integer): boolean; inline;
+  var
+    IsComment, IsNewCommentStart: Boolean;
+  begin
+    ALogX := 1;
+    FPasHl.StartAtLineIndex(ToIdx(ALineNum));
+    Result := FPasHl.GetTokenIsComment;
+    if (not Result) or
+       (FPasHl.GetTokenIsCommentStart(True))
+    then
+      exit;
+
+    while ALineNum > 1 do begin
+      dec(ALineNum);
+      if ALineNum = FSkipEndLine then
+        exit(False);
+
+      FPasHl.StartAtLineIndex(ToIdx(ALineNum));
+
+      IsComment := FPasHl.GetTokenIsComment;
+      // if not a comment, then pretend its a new start => used for "result"
+      IsNewCommentStart := (not IsComment) or FPasHl.GetTokenIsCommentStart(True);
+      if IsComment and (not IsNewCommentStart) and FPasHl.GetEol then
+        continue;
+
+      Result := IsNewCommentStart;
+      while not FPasHl.GetEol do begin
+        if not IsComment then begin
+          ALogX := ToPos(FPasHl.GetTokenPos);
+          Result := True;
+        end;
+        FPasHl.Next;
+        IsComment := FPasHl.GetTokenIsComment;
+      end;
+
+      if Result then
+        exit;
+    end;
+    Result := False;
+  end;
+
+var
+  curRow: integer;
+  StartPos: TPoint;
+
+  procedure MaybeSetSkipRows;
+  begin
+    if curRow > aRow then begin
+      FSkipStartLine := StartPos.Y + 1;
+      FSkipEndLine := curRow - 1;
+    end;
+  end;
+
+var
+  fnd, firstRun, HasHash: Boolean;
+  LogX, TkEnd: integer;
+  Kind: TCommentKind;
+  pos: TPoint;
+  i: SizeInt;
+begin
+  if FPasHl = nil then
+    exit;
+
+  FNxtIdx := 0;
+  FMrkIdx := 0;
+  FLineLen := Length(SynEdit.Lines[ToIdx(aRow)]);
+
+  if (FSkipStartLine >=0) and (FSkipStartLine <= aRow) and (FSkipEndLine >= aRow) then begin
+    FFoundPos := nil;
+    exit;
+  end;
+
+  curRow := aRow;
+  LogX := 1;
+
+  i := Length(FFoundPos) - 1;
+  if (i >= 0) and
+     (FFoundPos[i].StartPos.Y < aRow) and
+     (FFoundPos[i].EndPos.Y >= aRow - 1)
+  then begin
+    if (FFoundPos[i].EndPos.Y >= aRow) then begin
+      if i > 0 then
+        FFoundPos[0] := FFoundPos[i];
+      SetLength(FFoundPos, 1);
+      if FFoundPos[0].EndPos.Y > aRow then
+        exit;
+      LogX := FFoundPos[0].EndPos.X;
+    end
+    else
+    if StartsWithContinuedComment(aRow) then begin
+      if i > 0 then
+        FFoundPos[0] := FFoundPos[i];
+      SetLength(FFoundPos, 1);
+      TkEnd := 1 + FPasHl.GetTokenLen;
+      FFoundPos[0].EndPos.Y := aRow;
+      FFoundPos[0].EndPos.X := TkEnd;
+      LogX := TkEnd;
+    end
+    else
+      FFoundPos := nil;
+  end
+  else
+    FFoundPos := nil;
+
+  if (FFoundPos = nil) and (not GetStartOfComment(curRow, LogX)) then begin
+    curRow := aRow;
+    LogX := 1;
+  end;
+
+  GetLine(curRow);
+  if LineText = '' then
+    exit;
+
+  p := p + LogX - 1;
+
+  fnd := False;
+  firstRun := True;
+  repeat
+    if (not firstRun) and (curRow < aRow) then begin
+      // There was only one continuous comment in front of aRow => skip it;
+      curRow := aRow;
+      GetLine(curRow);
+    end;
+    firstRun := False;
+
+    (* *** find potential comment start *** *)
+    while p < pe do begin
+      case p^ of
+        '{': break;
+        '(': if p[1] = '*' then break;
+        '/': if p[1] = '/' then break;
+      end;
+      inc(p);
+    end;
+    if p >= pe then
+      exit;
+
+    StartPos.x := p - PChar(LineText) + 1;
+    StartPos.y := curRow;
+    case p^ of
+      '(', '/': inc(p, 2);
+      else      inc(p);
+    end;
+
+    (* ***  skip whitespace *** *)
+    repeat
+      p := p + CountLeadWhiteSpace(p);
+      if p >= pe then begin
+        if not AdvanceToNextLine(curRow) then begin
+          MaybeSetSkipRows;
+          exit;
+        end;
+        continue; // continue skip whitespace for new line
+      end;
+      break;
+    until false;
+
+    (* ***  skip hash *** *)
+    HasHash := (p+5 < pe) and (p^ = '#'); // hash must be on same line as keyword
+    if HasHash then
+      inc(p);
+
+    (* ***  keyword *** *)
+    if (p+4 <= pe) then begin
+      case p^ of
+        't', 'T': begin
+            Kind := ckTodo;
+            fnd := (p[1] in ['o', 'O']) and (p[2] in ['d', 'D']) and (p[3] in ['o', 'O']);
+          end;
+        'd', 'D': begin
+            Kind := ckDone;
+            fnd := (p[1] in ['o', 'O']) and (p[2] in ['n', 'N']) and (p[3] in ['e', 'E']);
+          end;
+        'n', 'N': begin
+            Kind := ckNote;
+            fnd := (p[1] in ['o', 'O']) and (p[2] in ['t', 'T']) and (p[3] in ['e', 'E']);
+          end;
+      end;
+    end;
+    if not fnd then begin
+      MaybeSetSkipRows;
+      Continue;
+    end;
+
+    fnd := False; // for next round, in case of several todo on one line
+    inc(p, 4);
+    if not ( (p = pe) or (p^ in [#9, #10, #13, ' ',':'])) then begin
+      MaybeSetSkipRows;
+      continue;
+    end;
+
+    (* ***  Check arguments / parse *** *)
+    if not HasHash then begin
+      while p^ <> ':' do begin
+        while p^ in [#9, ' ', '0'..'9'] do
+          inc(p);
+
+        if p >= pe then begin
+          if not AdvanceToNextLine(curRow) then begin
+            MaybeSetSkipRows;
+            break;
+          end;
+          continue; // continue search for colon
+        end;
+
+        if (p^ = '-') and (p[1] in ['o', 'O', 'c', 'C']) then begin
+          if p[2] = '''' then begin
+            inc(p, 3);
+            while (p^ <> '''') do begin
+              inc(p);
+              if p >= pe then begin
+                if not AdvanceToNextLine(curRow) then begin
+                  MaybeSetSkipRows;
+                  break;
+                end;
+                continue; // continue search for quote
+              end;
+            end;
+            inc(p);
+          end
+          else
+          begin
+            inc(p, 2);
+            while (p < pe) and not(p^ in [#9, ' ', ':']) do
+              inc(p);
+          end;
+          continue; // continue search for colon
+        end;
+
+        break; // not allowed char
+      end;
+      if p^ <> ':' then begin
+        MaybeSetSkipRows;
+        continue;
+      end;
+    end;
+
+    (* ***  found *** *)
+    assert(StartPos.Y <= aRow, 'TSynEditTodoMarkup.PrepareMarkupForRow: StartPos.Y <= aRow');
+
+    if (StartPos.Y = aRow) then begin
+      FPasHl.StartAtLineIndex(ToIdx(StartPos.Y));
+      FPasHl.NextToLogX(StartPos.X);
+      if (ToPos(FPasHl.GetTokenPos) <> StartPos.x) or (not FPasHl.GetTokenIsCommentStart(True)) then begin
+        MaybeSetSkipRows;
+        Continue;
+      end;
+    end;
+
+    if curRow < aRow then begin
+      curRow := aRow;
+      GetLine(curRow);
+    end;
+    pos.Y := curRow;
+    pos.x := 1;
+    if StartPos.Y = curRow then
+      pos.X := StartPos.x;
+
+    if (StartPos.Y <> aRow) or
+       (StartPos.Y <> pos.Y) or (StartPos.X > pos.X)
+    then
+      FPasHl.StartAtLineIndex(ToIdx(pos.Y));
+    FPasHl.NextToLogX(pos.X);
+    TkEnd := ToPos(FPasHl.GetTokenPos) + FPasHl.GetTokenLen;
+
+    i := Length(FFoundPos);
+    SetLength(FFoundPos, i + 1);
+    FFoundPos[i].StartPos := StartPos;
+    FFoundPos[i].EndPos.y := curRow;
+    FFoundPos[i].EndPos.x := TkEnd;
+    FFoundPos[i].Kind     := Kind;
+
+    p := PChar(LineText) + TkEnd - 1;
+  until (p >= pe) or (curRow > aRow);
+
+end;
+
+procedure TSynEditTodoMarkup.GetNextMarkupColAfterRowCol(const aRow: Integer;
+  const aStartCol: TLazSynDisplayTokenBound; const AnRtlInfo: TLazSynDisplayRtlInfo; out
+  ANextPhys, ANextLog: Integer);
+begin
+  ANextLog := -1;
+  ANextPhys := -1;
+  if (Length(FFoundPos) > 0) and (aStartCol.Logical < FLineLen + 1) then
+    ANextLog := FLineLen + 1;
+  while (FNxtIdx < Length(FFoundPos)) do begin
+    if (FFoundPos[FNxtIdx].StartPos.X > aStartCol.Logical) then begin
+      ANextLog := FFoundPos[FNxtIdx].StartPos.X;
+      exit;
+    end
+    else
+    if (FFoundPos[FNxtIdx].EndPos.X > aStartCol.Logical) and
+       (FFoundPos[FNxtIdx].EndPos.y = aRow)
+    then begin
+      ANextLog := FFoundPos[FNxtIdx].EndPos.X;
+      exit;
+    end;
+    inc(FNxtIdx);
+  end;
+end;
+
+function TSynEditTodoMarkup.GetMarkupAttributeAtRowCol(const aRow: Integer;
+  const aStartCol: TLazSynDisplayTokenBound; const AnRtlInfo: TLazSynDisplayRtlInfo
+  ): TSynSelectedColor;
+begin
+  Result := nil;
+  if aStartCol.Logical > FLineLen then
+    exit;
+  while (Result = nil) and (FMrkIdx < Length(FFoundPos)) do begin
+    if (FFoundPos[FMrkIdx].StartPos.X > aStartCol.Logical) and
+       (FFoundPos[FMrkIdx].StartPos.Y = aRow)
+    then
+      exit;
+    if (FFoundPos[FMrkIdx].EndPos.X > aStartCol.Logical) or
+       (FFoundPos[FMrkIdx].EndPos.y > aRow)
+    then begin
+      case FFoundPos[FMrkIdx].Kind of
+        ckTodo: Result := CommentAttribTodo;
+        ckDone: Result := CommentAttribDone;
+        else    Result := CommentAttribNote;
+      end;
+      exit;
+    end;
+
+    inc(FMrkIdx);
+  end;
+end;
+
+function TSynEditTodoMarkup.GetMarkupAttributeAtWrapEnd(const aRow: Integer;
+  const aWrapCol: TLazSynDisplayTokenBound): TSynSelectedColor;
+begin
+  Result := nil;
+  if aWrapCol.Logical > FLineLen then
+    exit;
+  while (Result = nil) and (FMrkIdx < Length(FFoundPos)) do begin
+    if (FFoundPos[FMrkIdx].StartPos.X > aWrapCol.Logical) and
+       (FFoundPos[FMrkIdx].StartPos.Y = aRow)
+    then
+      exit;
+    if (FFoundPos[FMrkIdx].EndPos.X > aWrapCol.Logical) or
+       (FFoundPos[FMrkIdx].EndPos.y > aRow)
+    then begin
+      case FFoundPos[FMrkIdx].Kind of
+        ckTodo: Result := CommentAttribTodo;
+        ckDone: Result := CommentAttribDone;
+        else    Result := CommentAttribNote;
+      end;
+      exit;
+    end;
+
+    inc(FMrkIdx);
+  end;
+end;
+
+initialization
+  RegisterAttribs;
+finalization
+  FreeAttribs;
+end.
+

ide/editoroptions.pp

@@ -42,7 +42,7 @@ uses
   // RTL, FCL
   Classes, SysUtils, typinfo, fgl, Math, resource,
   // LCL
-  Graphics, LResources, Forms, Dialogs, ComCtrls, LCLType, Controls,
+  Graphics, LResources, Forms, Dialogs, ComCtrls, LCLType, Controls, LCLProc,
   // LazUtils
   FileUtil, LazFileUtils, LazUTF8, LazClasses, Laz2_XMLCfg, LazStringUtils, LazLoggerBase,
   // Synedit
@@ -96,15 +96,6 @@ type
   TLazSynPluginSyncroEditForm = class(TForm)       end;
   TLazSynPluginSyncroEditFormOff = class(TForm)    end;
 
-  TColorSchemeAttributeFeature =
-    ( hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior,
-      hafStyle, hafStyleMask,
-      hafFrameStyle, hafFrameEdges,
-      hafMarkupFoldColor, // for the MarkupFoldColor module
-      hafCustomWords
-    );
-  TColorSchemeAttributeFeatures = set of TColorSchemeAttributeFeature;
-
 const
   SynEditPreviewIncludeOptions = [eoNoCaret, eoNoSelection];
   SynEditPreviewExcludeOptions = [eoDragDropEditing, eoDropFiles,
@@ -331,10 +322,11 @@ type
 
   { TColorSchemeAttribute }
 
-  TColorSchemeAttribute = class(TSynHighlighterLazCustomPasAttribute)
+  TColorSchemeAttribute = class(TSynHighlighterLazCustomPasAttribute, IColorSchemeAttribute)
   private
     FFeatures: TColorSchemeAttributeFeatures;
     FGroup: TAhaGroupName;
+    FRegisteredGroup: integer;
     FMarkupFoldLineAlpha: Byte;
     FMarkupFoldLineColor: TColor;
     FMarkupFoldLineStyle: TSynLineStyle;
@@ -342,10 +334,13 @@ type
     FAlreadyGotSchemeGlobal: Boolean;
     FSchemeGlobalCache: TColorSchemeAttribute;
     FUseSchemeGlobals: Boolean;
+    function GetGroupName: String;
     function GetIsUsingSchemeGlobals: Boolean;
     procedure SetMarkupFoldLineAlpha(AValue: Byte);
     procedure SetMarkupFoldLineColor(AValue: TColor);
     procedure SetMarkupFoldLineStyle(AValue: TSynLineStyle);
+    // IColorSchemeAttribute
+    procedure ApplyTo(aDest: TObject);
   protected
     procedure Init; override;
   public
@@ -363,6 +358,7 @@ type
     procedure SaveToXml(aXMLConfig: TRttiXMLConfig; const aPath: String;
                         Defaults: TColorSchemeAttribute);
     property Group: TAhaGroupName read FGroup write FGroup;
+    property GroupName: String read GetGroupName;
     property IsUsingSchemeGlobals: Boolean read GetIsUsingSchemeGlobals;
     property Features: TColorSchemeAttributeFeatures read FFeatures write FFeatures;
   published
@@ -375,7 +371,7 @@ type
 
   { TColorSchemeLanguage }
 
-  TColorSchemeLanguage = class(TObject)
+  TColorSchemeLanguage = class(TObject, IColorSchemeLanguage)
   private
     FDefaultAttribute: TColorSchemeAttribute;
     FAttributes: TQuickStringlist; // TColorSchemeAttribute
@@ -391,6 +387,9 @@ type
     function GetName: String;
     function DoesSupportGroup(AGroup: TAhaGroupName): boolean;
     function GetSupportsFileExt: Boolean;
+    // IColorSchemeLanguage
+    function GetAttributeIntf(AnIndex: integer): IColorSchemeAttribute;
+    function GetAttributeIntf(const AStoredName: string): IColorSchemeAttribute;
   public
     constructor Create(AGroup: TColorScheme; AIdeHighlighterID: TIdeSyntaxHighlighterID;
       IsSchemeDefault: Boolean);
@@ -426,39 +425,58 @@ type
 
   { TColorScheme }
 
-  TColorScheme = class(TObject)
+  TColorScheme = class(TObject, IColorScheme)
   private type
     TColorSchemesMap = specialize TFPGMapObject<string, TColorSchemeLanguage>;
   private
     FName: String;
     FColorSchemes: TColorSchemesMap; //Array of TColorSchemeLanguage;
     FDefaultColors: TColorSchemeLanguage;
+    function GetColorScheme(Index: integer): TColorSchemeLanguage;
     function GetColorSchemeBySynHl(Index: TSynCustomHighlighter): TColorSchemeLanguage;
+    // IColorScheme
+    function GetName: String;
+    function GetLanguage(AnIndex: Integer): IColorSchemeLanguage;
+    function GetLanguageForHighlighter(AnHiglighter: TObject {TSynCustomHighlighter}): IColorSchemeLanguage;
+    function GetLanguageForHighlighter(AnHighlighterId: TIdeSyntaxHighlighterID): IColorSchemeLanguage;
   public
     constructor Create(const AName: String);
     constructor CreateFromXml(aXMLConfig: TRttiXMLConfig; const AName, aPath: String);
     destructor  Destroy; override;
     procedure Assign(Src: TColorScheme); reintroduce;
+    function Count: integer;
     function GetStoredValuesForScheme: TColorScheme; // The IDE default colors from the resources
     procedure LoadFromXml(aXMLConfig: TRttiXMLConfig; const aPath: String;
                           Defaults: TColorScheme; const aOldPath: String = '');
     procedure SaveToXml(aXMLConfig: TRttiXMLConfig; const aPath: String; Defaults: TColorScheme);
     property  Name: string read FName;
     property  DefaultColors: TColorSchemeLanguage read FDefaultColors;
+    property  ColorScheme[Index: integer]: TColorSchemeLanguage read GetColorScheme;
     property  ColorSchemeBySynHl[Index: TSynCustomHighlighter]: TColorSchemeLanguage read GetColorSchemeBySynHl;
   end;
 
   { TColorSchemeFactory }
 
-  TColorSchemeFactory = class(TObject)
+  TColorSchemeFactory = class(TObject, IColorSchemeList)
   private
     FMappings: TQuickStringlist; // TColorScheme
     function GetColorSchemeGroup(const Index: String): TColorScheme;
     function GetColorSchemeGroupAtPos(Index: Integer): TColorScheme;
+    // IColorSchemeList
+    function GetScheme(AnIndex: Integer): IColorScheme;
+    function GetScheme(AName: String): IColorScheme;
+    function GetCurrentSchemeForHighlighter(AnHiglighter: TObject {TSynCustomHighlighter}): IColorScheme;
+    function GetCurrentSchemeForHighlighter(AnHighlighterId: TIdeSyntaxHighlighterID): IColorScheme;
+    procedure RegisterChangedHandler(AnHandler: TNotifyEvent);
+    procedure UnregisterChangedHandler(AnHandler: TNotifyEvent);
+    function RegisterAttributeGroup(AName: PString): integer; // pointer to resource string
+    procedure InternalAddAttribute(AnAttrGroup: integer; AnHighlighterId: TIdeSyntaxHighlighterID; AStoredName: String; AName: PString;  AFeatures: TColorSchemeAttributeFeatures; ADefaults: TObject = nil);
+    procedure AddAttribute(AnAttrGroup: integer; AnHighlighterId: TIdeSyntaxHighlighterID; AStoredName: String; AName: PString;  AFeatures: TColorSchemeAttributeFeatures; ADefaults: TObject = nil);
   public
     constructor Create;
     destructor  Destroy; override;
     procedure Clear;
+    function Count: integer;
     procedure Assign(Src: TColorSchemeFactory); reintroduce;
     procedure LoadFromXml(aXMLConfig: TRttiXMLConfig; const aPath: String;
       Defaults: TColorSchemeFactory; const aOldPath: String = '');
@@ -1880,6 +1898,7 @@ type
     fMultiWinEditAccessOrder: TEditorOptionsEditAccessOrderList;
     // Default values for RttiXmlConfig using published properties.
     FDefaultValues: TEditorOptionsDefaults;
+
     function GetHighlighterList: TEditOptLangList;
     procedure Init;
     function GetCodeTemplateFileNameExpand: String;
@@ -1890,6 +1909,7 @@ type
     class function GetGroupCaption: string; override;
     class function GetInstance: TAbstractIDEOptions; override;
     procedure DoAfterWrite(Restore: boolean); override;
+    procedure DoAfterRead; override;
   public
     constructor Create;
     destructor Destroy; override;
@@ -2058,6 +2078,8 @@ const
 
 var
   DefaultColorSchemeName: String;
+  EdOptsChangedHandlers: TMethodList;
+  RegisteredAttribGroupNames: array of PString;
 
 function FontHeightToSize(Height: Integer): Integer;
 var
@@ -5614,6 +5636,15 @@ begin
   if not Restore then
     Save;
   inherited;
+  if EdOptsChangedHandlers <> nil then
+    EdOptsChangedHandlers.CallNotifyEvents(nil);
+end;
+
+procedure TEditorOptions.DoAfterRead;
+begin
+  inherited DoAfterRead;
+  if EdOptsChangedHandlers <> nil then
+    EdOptsChangedHandlers.CallNotifyEvents(nil);
 end;
 
 constructor TEditorOptions.Create;
@@ -7073,6 +7104,11 @@ begin
   Changed;
 end;
 
+procedure TColorSchemeAttribute.ApplyTo(aDest: TObject);
+begin
+  ApplyTo(aDest as TSynHighlighterAttributes, nil);
+end;
+
 procedure TColorSchemeAttribute.Init;
 begin
   inherited Init;
@@ -7087,6 +7123,14 @@ begin
   Result := FUseSchemeGlobals and (GetSchemeGlobal <> nil);
 end;
 
+function TColorSchemeAttribute.GetGroupName: String;
+begin
+  if FGroup = agnRegistered then
+    Result := RegisteredAttribGroupNames[FRegisteredGroup]^
+  else
+    Result := AdditionalHighlightGroupNames[Group];
+end;
+
 function TColorSchemeAttribute.GetSchemeGlobal: TColorSchemeAttribute;
 begin
   if FAlreadyGotSchemeGlobal then
@@ -7369,6 +7413,16 @@ begin
   Result := (FHighlighter = nil) or not(FHighlighter is TNonSrcIDEHighlighter);
 end;
 
+function TColorSchemeLanguage.GetAttributeIntf(AnIndex: integer): IColorSchemeAttribute;
+begin
+  Result := GetAttributeAtPos(AnIndex);
+end;
+
+function TColorSchemeLanguage.GetAttributeIntf(const AStoredName: string): IColorSchemeAttribute;
+begin
+  Result := GetAttribute(AStoredName);
+end;
+
 function TColorSchemeLanguage.GetStoredValuesForLanguage: TColorSchemeLanguage;
 var
   cs: TColorScheme;
@@ -7944,6 +7998,32 @@ begin
     Result := FColorSchemes[Index.LanguageName];
 end;
 
+function TColorScheme.GetName: String;
+begin
+  Result := FName;
+end;
+
+function TColorScheme.GetLanguage(AnIndex: Integer): IColorSchemeLanguage;
+begin
+  Result := FColorSchemes.Data[AnIndex];
+end;
+
+function TColorScheme.GetLanguageForHighlighter(AnHighlighterId: TIdeSyntaxHighlighterID
+  ): IColorSchemeLanguage;
+begin
+  Result := ColorSchemeBySynHl[HighlighterList.SharedSynInstances[AnHighlighterId]];
+end;
+
+function TColorScheme.GetLanguageForHighlighter(AnHiglighter: TObject): IColorSchemeLanguage;
+begin
+  Result := ColorSchemeBySynHl[AnHiglighter as TSynCustomHighlighter];
+end;
+
+function TColorScheme.GetColorScheme(Index: integer): TColorSchemeLanguage;
+begin
+  Result := FColorSchemes.Data[Index];
+end;
+
 function TColorScheme.GetStoredValuesForScheme: TColorScheme;
 begin
   Result:=ColorSchemeFactory.ColorSchemeGroup[Name];
@@ -8002,6 +8082,11 @@ begin
   end;
 end;
 
+function TColorScheme.Count: integer;
+begin
+  Result := FColorSchemes.Count;
+end;
+
 procedure TColorScheme.LoadFromXml(aXMLConfig: TRttiXMLConfig;
   const aPath: String; Defaults: TColorScheme; const aOldPath: String);
 var
@@ -8070,6 +8155,98 @@ begin
   Result := TColorScheme(FMappings.Objects[Index]);
 end;
 
+function TColorSchemeFactory.GetScheme(AnIndex: Integer): IColorScheme;
+begin
+  Result := nil;
+  if EditorOpts <> nil then
+    Result := EditorOpts.UserColorSchemeGroup.ColorSchemeGroupAtPos[AnIndex];
+end;
+
+function TColorSchemeFactory.GetScheme(AName: String): IColorScheme;
+begin
+  Result := nil;
+  if EditorOpts <> nil then
+    Result := EditorOpts.UserColorSchemeGroup.ColorSchemeGroup[AName];
+end;
+
+function TColorSchemeFactory.GetCurrentSchemeForHighlighter(AnHiglighter: TObject): IColorScheme;
+begin
+  Result := nil;
+  if EditorOpts <> nil then
+    Result := EditorOpts.UserColorSchemeGroup.GetColorSchemeGroup(EditorOpts.ReadColorScheme((AnHiglighter as TSynCustomHighlighter).LanguageName));
+end;
+
+function TColorSchemeFactory.GetCurrentSchemeForHighlighter(AnHighlighterId: TIdeSyntaxHighlighterID
+  ): IColorScheme;
+begin
+  Result := nil;
+  if EditorOpts <> nil then
+    Result := EditorOpts.UserColorSchemeGroup.GetColorSchemeGroup(EditorOpts.ReadColorScheme(HighlighterList.Names[AnHighlighterId]));
+end;
+
+procedure TColorSchemeFactory.RegisterChangedHandler(AnHandler: TNotifyEvent);
+begin
+  if EdOptsChangedHandlers = nil then
+    EdOptsChangedHandlers := TMethodList.Create;
+  EdOptsChangedHandlers.Add(TMethod(AnHandler));
+end;
+
+procedure TColorSchemeFactory.UnregisterChangedHandler(AnHandler: TNotifyEvent);
+begin
+  if EdOptsChangedHandlers <> nil then
+    EdOptsChangedHandlers.Remove(TMethod(AnHandler));
+end;
+
+function TColorSchemeFactory.RegisterAttributeGroup(AName: PString): integer;
+begin
+  Result := Length(RegisteredAttribGroupNames);
+  SetLength(RegisteredAttribGroupNames, Result + 1);
+  RegisteredAttribGroupNames[Result] := AName;
+end;
+
+procedure TColorSchemeFactory.InternalAddAttribute(AnAttrGroup: integer;
+  AnHighlighterId: TIdeSyntaxHighlighterID; AStoredName: String; AName: PString;
+  AFeatures: TColorSchemeAttributeFeatures; ADefaults: TObject);
+var
+  h: TSynCustomHighlighter;
+  i: Integer;
+  cs: TColorScheme;
+  csl: TColorSchemeLanguage;
+  csa: TColorSchemeAttribute;
+begin
+  h := HighlighterList.SharedSynInstances[AnHighlighterId];
+  if h = nil then
+    exit;
+
+  for i := 0 to FMappings.Count - 1 do begin
+    cs := ColorSchemeGroupAtPos[i];
+    csl := cs.ColorSchemeBySynHl[h];
+    if csl = nil then
+      continue;
+
+    csa := TColorSchemeAttribute.Create(csl, AName, AStoredName);
+    csa.Clear;
+    if ADefaults <> nil then
+      csa.AssignColors(ADefaults as TSynHighlighterAttributes);
+    csa.InternalSaveDefaultValues;
+
+    csa.FGroup := agnRegistered;
+    csa.FRegisteredGroup := AnAttrGroup;
+    csa.FFeatures := AFeatures;
+
+    csl.FAttributes.AddObject(AStoredName, csa);
+  end;
+end;
+
+procedure TColorSchemeFactory.AddAttribute(AnAttrGroup: integer;
+  AnHighlighterId: TIdeSyntaxHighlighterID; AStoredName: String; AName: PString;
+  AFeatures: TColorSchemeAttributeFeatures; ADefaults: TObject);
+begin
+  InternalAddAttribute(AnAttrGroup, AnHighlighterId, AStoredName, AName, AFeatures, ADefaults);
+  if EditorOpts <> nil then
+    EditorOpts.UserColorSchemeGroup.InternalAddAttribute(AnAttrGroup, AnHighlighterId, AStoredName, AName, AFeatures, ADefaults);
+end;
+
 constructor TColorSchemeFactory.Create;
 begin
   inherited Create;
@@ -8096,6 +8273,11 @@ begin
   end;
 end;
 
+function TColorSchemeFactory.Count: integer;
+begin
+  Result := FMappings.Count;
+end;
+
 procedure TColorSchemeFactory.Assign(Src: TColorSchemeFactory);
 var
   lMapping: TColorScheme;
@@ -8254,9 +8436,13 @@ end;
 initialization
   RegisterIDEOptionsGroup(GroupEditor, TEditorOptions);
   IdeSyntaxHighlighters := HighlighterList;
+  IdeColorSchemeList := ColorSchemeFactory;
 
 finalization
+  IdeColorSchemeList := nil;
   ColorSchemeFactory.Free;
   HighlighterList.Free;
+  RegisteredAttribGroupNames := nil;
+  EdOptsChangedHandlers.Free;
 
 end.

ide/frames/editor_color_options.pas

@@ -1183,7 +1183,7 @@ begin
   else
     ColorElementTree.Items.Add(nil, AdditionalHighlightGroupNames[agnDefault]);
   for j := low(TAhaGroupName) to high(TAhaGroupName) do
-    if not(j in [agnDefault, agnLanguage]) then
+    if not(j in [agnDefault, agnLanguage, agnRegistered]) then
       ColorElementTree.Items.Add(nil, AdditionalHighlightGroupNames[j]).Visible := False;
 
   // Fill Attributes in
@@ -1216,7 +1216,7 @@ begin
         else
           begin
             AttriIdx := GetEnumValue(TypeInfo(TAdditionalHilightAttribute), Attr.StoredName);
-            ParentName := AdditionalHighlightGroupNames[Attr.Group];
+            ParentName := Attr.GroupName;
             ParentNode := ColorElementTree.Items.FindTopLvlNode(ParentName);
             if (AttriIdx >= ord(ahaIdentComplWindowEntryVar)) and (AttriIdx <= ord(ahaIdentComplWindowEntryUnknown))
             then begin

ide/sourcemarks.pas

@@ -81,7 +81,8 @@ type
   TAhaGroupName = (
     agnDefault, agnLanguage, agnText, agnLine, agnGutter, agnWrap,
     agnTemplateMode, agnSyncronMode,
-    agnIfDef, agnIdentComplWindow, agnOutlineColors
+    agnIfDef, agnIdentComplWindow, agnOutlineColors,
+    agnRegistered
   );
 
   TSourceEditorBase = class;

ide/syncolorattribeditor.pas

@@ -9,6 +9,8 @@ uses
   // LCL
   LCLIntf, Forms, StdCtrls, ExtCtrls, Graphics, GraphUtil,
   ColorBox, Dialogs, Menus, Spin,
+  // IdeIntf
+  EditorSyntaxHighlighterDef,
   // SynEdit
   SynEditTypes, SynTextDrawer, SynHighlighterPas,
   // IdeConfig