From 900e58ed4f410693a56897c64baf32f4c5e2a74d Mon Sep 17 00:00:00 2001 From: Martin Date: Tue, 18 Mar 2025 19:59:44 +0100 Subject: [PATCH] Ide, TodoListLaz: Add IdeIntf for color scheme / Add "todo comment" markup for SourceEditor Issue #41420 --- .../ideintf/editorsyntaxhighlighterdef.pas | 47 +- components/synedit/synedithighlighter.pp | 20 +- components/synedit/synhighlighterpas.pp | 29 +- components/todolist/todolistlaz.lpk | 8 + components/todolist/todolistlaz.pas | 3 +- components/todolist/todosynmarkup.pas | 547 ++++++++++++++++++ ide/editoroptions.pp | 214 ++++++- ide/frames/editor_color_options.pas | 4 +- ide/sourcemarks.pas | 3 +- ide/syncolorattribeditor.pas | 2 + 10 files changed, 856 insertions(+), 21 deletions(-) create mode 100644 components/todolist/todosynmarkup.pas diff --git a/components/ideintf/editorsyntaxhighlighterdef.pas b/components/ideintf/editorsyntaxhighlighterdef.pas index 7b67ed8d09..1a275a344b 100644 --- a/components/ideintf/editorsyntaxhighlighterdef.pas +++ b/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 diff --git a/components/synedit/synedithighlighter.pp b/components/synedit/synedithighlighter.pp index 34d3acf3a8..3b8e24b9a6 100644 --- a/components/synedit/synedithighlighter.pp +++ b/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); diff --git a/components/synedit/synhighlighterpas.pp b/components/synedit/synhighlighterpas.pp index ffdf365def..bc4b498029 100644 --- a/components/synedit/synhighlighterpas.pp +++ b/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 diff --git a/components/todolist/todolistlaz.lpk b/components/todolist/todolistlaz.lpk index 696034b328..dbad5659e9 100644 --- a/components/todolist/todolistlaz.lpk +++ b/components/todolist/todolistlaz.lpk @@ -44,12 +44,20 @@ + + + + + + + + diff --git a/components/todolist/todolistlaz.pas b/components/todolist/todolistlaz.pas index 0ed0c3f972..75fd20c112 100644 --- a/components/todolist/todolistlaz.pas +++ b/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 diff --git a/components/todolist/todosynmarkup.pas b/components/todolist/todosynmarkup.pas new file mode 100644 index 0000000000..36b058032b --- /dev/null +++ b/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. + diff --git a/ide/editoroptions.pp b/ide/editoroptions.pp index a4afa61238..7dfaf230a9 100644 --- a/ide/editoroptions.pp +++ b/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; 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. diff --git a/ide/frames/editor_color_options.pas b/ide/frames/editor_color_options.pas index a5a00741dd..e8f07bf5e8 100644 --- a/ide/frames/editor_color_options.pas +++ b/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 diff --git a/ide/sourcemarks.pas b/ide/sourcemarks.pas index 99ad560650..d42b193185 100644 --- a/ide/sourcemarks.pas +++ b/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; diff --git a/ide/syncolorattribeditor.pas b/ide/syncolorattribeditor.pas index 439cab60d9..f78f569bc2 100644 --- a/ide/syncolorattribeditor.pas +++ b/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