From e323ffce4bec2c4cb12c054625c0c1bc76131cdf Mon Sep 17 00:00:00 2001 From: Martin Date: Sun, 3 Mar 2024 16:42:09 +0100 Subject: [PATCH] IDE, SynEdit: Add option to highlight current line in gutter --- components/synedit/syngutter.pp | 41 +++-- components/synedit/syngutterbase.pp | 173 ++++++++++++++++++--- components/synedit/syngutterchanges.pas | 7 +- components/synedit/synguttercodefolding.pp | 8 +- components/synedit/syngutterlinenumber.pp | 37 +++-- components/synedit/synguttermarks.pp | 8 +- ide/editoroptions.pp | 45 +++++- ide/frames/editor_color_options.pas | 30 +++- ide/frames/editor_display_options.lfm | 31 +++- ide/frames/editor_display_options.pas | 23 +++ ide/lazarusidestrconsts.pas | 5 + ide/sourcemarks.pas | 1 + 12 files changed, 334 insertions(+), 75 deletions(-) diff --git a/components/synedit/syngutter.pp b/components/synedit/syngutter.pp index 25bcc150d1..2a7eea4fc1 100644 --- a/components/synedit/syngutter.pp +++ b/components/synedit/syngutter.pp @@ -58,6 +58,7 @@ type published property AutoSize; property Color; + property CurrentLineColor; property Cursor: TCursor read FCursor write FCursor default crDefault; property LeftOffset; property RightOffset; @@ -89,6 +90,7 @@ type property LineOffset: Integer read FLineOffset write SetLineOffset default 0; property LineOnRight: Boolean read FLineOnRight write SetLineOnRight default True; property MarkupInfo; + property MarkupInfoCurrentLine; end; { TSynEditMouseActionsGutter } @@ -257,25 +259,47 @@ end; procedure TSynGutter.Paint(Canvas: TCanvas; Surface:TLazSynGutterArea; AClip: TRect; FirstLine, LastLine: integer); var - i: integer; - rcLine: TRect; + aCaretRow: LongInt; + i, t: integer; + rcLine, rcClip: TRect; dc: HDC; begin + aCaretRow := ToIdx(SynEdit.TextXYToScreenXY(SynEdit.CaretXY).Y); + if (aCaretRow < FirstLine) or (aCaretRow > LastLine) then + aCaretRow := -1; + FCaretRow := aCaretRow; + Canvas.Brush.Color := Color; dc := Canvas.Handle; LCLIntf.SetBkColor(dc, TColorRef(Canvas.Brush.Color)); + rcClip := AClip; + t := Surface.TextBounds.Top; // Clear all TextDrawer.BeginDrawing(dc); TextDrawer.SetBackColor(Color); TextDrawer.SetForeColor(SynEdit.Font.Color); TextDrawer.SetFrameColor(clNone); - with AClip do - TextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, AClip, nil, 0); + if aCaretRow >= 0 then + rcClip.Bottom := t + aCaretRow * SynEdit.LineHeight; + with rcClip do + TextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, rcClip, nil, 0); + if aCaretRow >= 0 then begin + rcClip.top := rcClip.Bottom + SynEdit.LineHeight; + rcClip.Bottom := AClip.Bottom; + with rcClip do + TextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, rcClip, nil, 0); + + rcClip.Bottom := rcClip.Top; + rcClip.top := rcClip.Top - SynEdit.LineHeight; + TextDrawer.SetBackColor(MarkupInfoCurLineMerged.Background); + with rcClip do + TextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, rcClip, nil, 0); + end; TextDrawer.EndDrawing; AClip.Left := Surface.Left + LeftOffset; - AClip.Top := Surface.TextBounds.Top + FirstLine * SynEdit.LineHeight; + AClip.Top := t + FirstLine * SynEdit.LineHeight; rcLine := AClip; rcLine.Right := rcLine.Left; @@ -435,12 +459,7 @@ end; procedure TSynGutterSeparator.Paint(Canvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer); begin - if MarkupInfo.Background <> clNone then - Canvas.Brush.Color := MarkupInfo.Background - else - Canvas.Brush.Color := Gutter.Color; - Canvas.Brush.Style := bsSolid; - Canvas.FillRect(AClip); + PaintBackground(Canvas, AClip); if FLineOnRight then begin AClip.Right := Min(AClip.Right, Left + LeftOffset + Width - FLineOffset); diff --git a/components/synedit/syngutterbase.pp b/components/synedit/syngutterbase.pp index b197f805ac..4d55a88341 100644 --- a/components/synedit/syngutterbase.pp +++ b/components/synedit/syngutterbase.pp @@ -12,7 +12,7 @@ uses LazMethodList, // SynEdit SynEditMarks, SynEditMiscClasses, SynTextDrawer, SynEditMouseCmds, - LazSynTextArea; + LazSynTextArea, SynEditHighlighter; type @@ -34,7 +34,10 @@ type FSide: TSynGutterSide; FSynEdit: TSynEditBase; FTextDrawer: TheTextDrawer; - FColor: TColor; + FColor: TSynSelectedColor; + FCurrentLineColor: TSynHighlighterAttributesModifier; + FMarkupInfoCurLineMerged: TSynSelectedColorMergeResult; + FLeft, FWidth, FHeight, FTop: Integer; FVisible: boolean; FAutoSize: boolean; @@ -49,9 +52,13 @@ type FOnResizeHandler: TMethodList; FOnChangeHandler: TMethodList; + procedure DoColorChanged(Sender: TObject); + procedure UpdateInternalColors; + function GetColor: TColor; function GetMouseActions: TSynEditMouseActions; procedure SetAutoSize(const AValue: boolean); procedure SetColor(const Value: TColor); + procedure SetCurrentLineColor(AValue: TSynHighlighterAttributesModifier); procedure SetGutterParts(const AValue: TSynGutterPartListBase); procedure SetLeftOffset(const AValue: integer); procedure SetMouseActions(const AValue: TSynEditMouseActions); @@ -59,6 +66,7 @@ type procedure SetVisible(const AValue: boolean); procedure SetWidth(Value: integer); protected + FCaretRow: integer; procedure SetChildBounds; procedure DoChange(Sender: TObject); procedure DoResize(Sender: TObject); @@ -73,6 +81,9 @@ type procedure Clear; function GetOwner: TPersistent; override; property GutterArea: TLazSynSurfaceWithText read FGutterArea write FGutterArea; + + property MarkupInfoCurLineMerged: TSynSelectedColorMergeResult read FMarkupInfoCurLineMerged; + property CaretRow: integer read FCaretRow; // vaild only during paint public constructor Create(AOwner : TSynEditBase; ASide: TSynGutterSide; ATextDrawer: TheTextDrawer); destructor Destroy; override; @@ -106,7 +117,8 @@ type // properties available for the GutterPartClasses property SynEdit: TSynEditBase read FSynEdit; property TextDrawer: TheTextDrawer read FTextDrawer; - property Color: TColor read FColor write SetColor default clBtnFace; + property Color: TColor read GetColor write SetColor default clBtnFace; + property CurrentLineColor: TSynHighlighterAttributesModifier read FCurrentLineColor write SetCurrentLineColor; property MouseActions: TSynEditMouseActions read GetMouseActions write SetMouseActions; end; @@ -158,17 +170,22 @@ type FVisible: Boolean; FSynEdit: TSynEditBase; FGutter: TSynGutterBase; - FMarkupInfo: TSynSelectedColor; + FMarkupInfo, FMarkupInfoInternal: TSynSelectedColor; + FMarkupInfoCurrentLine: TSynHighlighterAttributesModifier; + FMarkupInfoCurLineMerged: TSynSelectedColorMergeResult; FCursor: TCursor; FOnChange: TNotifyEvent; FOnGutterClick: TGutterClickEvent; FMouseActions: TSynEditMouseInternalActions; + procedure DoColorChanged(Sender: TObject); + function GetCaretRow: integer; inline; function GetFullWidth: integer; function GetGutterArea: TLazSynSurfaceWithText; function GetGutterParts: TSynGutterPartListBase; function GetMouseActions: TSynEditMouseActions; procedure SetLeftOffset(AValue: integer); procedure SetMarkupInfo(const AValue: TSynSelectedColor); + procedure SetMarkupInfoCurrentLine(AValue: TSynHighlighterAttributesModifier); procedure SetMouseActions(const AValue: TSynEditMouseActions); procedure SetRightOffset(AValue: integer); protected @@ -181,6 +198,8 @@ type procedure SetAutoSize(const AValue : boolean); virtual; procedure SetVisible(const AValue : boolean); virtual; procedure GutterVisibilityChanged; virtual; + procedure UpdateInternalColors; + procedure PaintBackground(Canvas: TCanvas; AClip: TRect); procedure SetWidth(const AValue : integer); virtual; procedure Init; override; procedure VisibilityOrSize(aCallDoChange: Boolean = False); @@ -190,6 +209,9 @@ type property Gutter: TSynGutterBase read FGutter; property SynEdit:TSynEditBase read FSynEdit; property GutterArea: TLazSynSurfaceWithText read GetGutterArea; + property MarkupInfoInternal: TSynSelectedColor read FMarkupInfoInternal; + property MarkupInfoCurLineMerged: TSynSelectedColorMergeResult read FMarkupInfoCurLineMerged; + property CaretRow: integer read GetCaretRow; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -217,6 +239,7 @@ type property OnChange: TNotifyEvent read FOnChange write FOnChange; property Cursor: TCursor read FCursor write FCursor default crDefault; property MarkupInfo: TSynSelectedColor read FMarkupInfo write SetMarkupInfo; + property MarkupInfoCurrentLine: TSynHighlighterAttributesModifier read FMarkupInfoCurrentLine write SetMarkupInfoCurrentLine; published property AutoSize: boolean read FAutoSize write SetAutoSize default True; property Width: integer read FWidth write SetWidth default 10; @@ -242,6 +265,13 @@ begin FOnResizeHandler := TMethodList.Create; FOnChangeHandler := TMethodList.Create; + FColor := TSynSelectedColor.Create; + FColor.OnChange := @DoColorChanged; + + FCurrentLineColor := TSynHighlighterAttributesModifier.Create; + FCurrentLineColor.OnChange := @DoColorChanged; + FMarkupInfoCurLineMerged := TSynSelectedColorMergeResult.Create; + inherited Create; FSide := ASide; FSynEdit := AOwner; @@ -255,7 +285,7 @@ begin FWidth := -1; FLeftOffset := 0; FRightOffset := 0; - FColor := clBtnFace; + Color := clBtnFace; FVisible := True; AutoSize := True; end; @@ -268,6 +298,9 @@ begin FreeAndNil(FMouseActions); FreeAndNil(FOnChangeHandler); FreeAndNil(FOnResizeHandler); + FreeAndNil(FMarkupInfoCurLineMerged); + FreeAndNil(FCurrentLineColor); + FreeAndNil(FColor); inherited Destroy; end; @@ -278,7 +311,8 @@ begin IncChangeLock; try FGutterPartList.Assign(TSynGutterBase(Source).FGutterPartList); - Color := TSynGutterBase(Source).FColor; + Color := TSynGutterBase(Source).Color; + CurrentLineColor := TSynGutterBase(Source).FCurrentLineColor; Visible := TSynGutterBase(Source).FVisible; AutoSize := TSynGutterBase(Source).FAutoSize; Width := TSynGutterBase(Source).FWidth; @@ -366,12 +400,19 @@ begin end; procedure TSynGutterBase.SetColor(const Value: TColor); +var + i: Integer; begin - if FColor <> Value then - begin - FColor := Value; - DoChange(Self); - end; + if FColor.Background = Value then + exit; + FColor.Background := Value; +end; + +procedure TSynGutterBase.SetCurrentLineColor(AValue: TSynHighlighterAttributesModifier); +var + i: Integer; +begin + FCurrentLineColor.Assign(AValue); end; procedure TSynGutterBase.SetAutoSize(const AValue: boolean); @@ -387,6 +428,29 @@ begin Result := FMouseActions.UserActions; end; +function TSynGutterBase.GetColor: TColor; +begin + Result := FColor.Background; +end; + +procedure TSynGutterBase.DoColorChanged(Sender: TObject); +begin + UpdateInternalColors; + DoChange(Self); +end; + +procedure TSynGutterBase.UpdateInternalColors; +var + i: Integer; +begin + FMarkupInfoCurLineMerged.Clear; + FMarkupInfoCurLineMerged.Assign(FColor); + FMarkupInfoCurLineMerged.Merge(FCurrentLineColor); + FMarkupInfoCurLineMerged.ProcessMergeInfo; + for i := 0 to PartCount - 1 do + Parts[i].UpdateInternalColors; +end; + procedure TSynGutterBase.SetGutterParts(const AValue: TSynGutterPartListBase); begin FGutterPartList.Assign(AValue); @@ -606,11 +670,28 @@ begin Result := FWidth + FLeftOffset + FRightOffset; end; +procedure TSynGutterPartBase.DoColorChanged(Sender: TObject); +begin + UpdateInternalColors; + DoChange(Self); +end; + +function TSynGutterPartBase.GetCaretRow: integer; +begin + Result := Gutter.CaretRow; +end; + procedure TSynGutterPartBase.SetMarkupInfo(const AValue: TSynSelectedColor); begin FMarkupInfo.Assign(AValue); end; +procedure TSynGutterPartBase.SetMarkupInfoCurrentLine(AValue: TSynHighlighterAttributesModifier); +begin + if FMarkupInfoCurrentLine = AValue then Exit; + FMarkupInfoCurrentLine.Assign(AValue); +end; + procedure TSynGutterPartBase.SetMouseActions(const AValue: TSynEditMouseActions); begin FMouseActions.UserActions := AValue; @@ -678,6 +759,44 @@ begin // end; +procedure TSynGutterPartBase.UpdateInternalColors; +begin + if Gutter = nil then + exit; + FMarkupInfoInternal.Assign(FMarkupInfo); + if FMarkupInfoInternal.Background = clNone then + FMarkupInfoInternal.Background := Gutter.Color; + if FMarkupInfoInternal.Foreground = clNone then + FMarkupInfoInternal.Foreground := SynEdit.Font.Color; + + FMarkupInfoCurLineMerged.Clear; + FMarkupInfoCurLineMerged.Assign(FMarkupInfoInternal); + FMarkupInfoCurLineMerged.Merge(Gutter.FCurrentLineColor); + FMarkupInfoCurLineMerged.Merge(MarkupInfoCurrentLine); + FMarkupInfoCurLineMerged.ProcessMergeInfo; +end; + +procedure TSynGutterPartBase.PaintBackground(Canvas: TCanvas; AClip: TRect); +var + t: Integer; +begin + if MarkupInfo.Background <> clNone then + begin + Canvas.Brush.Color := MarkupInfo.Background; + LCLIntf.SetBkColor(Canvas.Handle, TColorRef(Canvas.Brush.Color)); + Canvas.FillRect(AClip); + end; + if (MarkupInfoCurLineMerged.Background <> clNone) and (CaretRow >= 0) then + begin + t := GutterArea.Top; + aClip.Top := t + CaretRow * SynEdit.LineHeight; + AClip.Bottom := AClip.Top + SynEdit.LineHeight; + Canvas.Brush.Color := MarkupInfoCurLineMerged.Background; + LCLIntf.SetBkColor(Canvas.Handle, TColorRef(Canvas.Brush.Color)); + Canvas.FillRect(AClip); + end; +end; + procedure TSynGutterPartBase.SetWidth(const AValue : integer); begin if (FWidth=AValue) or ((FAutoSize) and not(csLoading in ComponentState)) then exit; @@ -709,7 +828,14 @@ begin FMarkupInfo.Background := clBtnFace; FMarkupInfo.Foreground := clNone; FMarkupInfo.FrameColor := clNone; - FMarkupInfo.OnChange := @DoChange; + + FMarkupInfoCurrentLine := TSynHighlighterAttributesModifier.Create; + FMarkupInfoCurrentLine.Background := clNone; + FMarkupInfoCurrentLine.Foreground := clNone; + FMarkupInfoCurrentLine.FrameColor := clNone; + + FMarkupInfoInternal := TSynSelectedColor.Create; + FMarkupInfoCurLineMerged := TSynSelectedColorMergeResult.Create; FMouseActions := CreateMouseActions; @@ -718,6 +844,10 @@ begin FLeftOffset := 0; FRightOffset := 0; Inherited Create(AOwner); // Todo: Lock the DoChange from RegisterItem, and call DoChange at the end (after/in autosize) + + FMarkupInfo.OnChange := @DoColorChanged; + FMarkupInfoCurrentLine.OnChange := @DoColorChanged; + UpdateInternalColors; end; procedure TSynGutterPartBase.Init; @@ -752,7 +882,10 @@ destructor TSynGutterPartBase.Destroy; begin inherited Destroy; FreeAndNil(FMouseActions); + FreeAndNil(FMarkupInfoCurLineMerged); FreeAndNil(FMarkupInfo); + FreeAndNil(FMarkupInfoInternal); + FreeAndNil(FMarkupInfoCurrentLine); end; procedure TSynGutterPartBase.Assign(Source : TPersistent); @@ -766,6 +899,8 @@ begin FWidth := Src.FWidth; FAutoSize := Src.FAutoSize; MarkupInfo.Assign(Src.MarkupInfo); + MarkupInfoCurrentLine.Assign(Src.MarkupInfoCurrentLine); + UpdateInternalColors; DoChange(Self); // Todo, maybe on Resize? end else @@ -779,7 +914,9 @@ var begin if not Visible then exit; - if MarkupInfo.Background = clNone then + if (MarkupInfo.Background = clNone) and + ( (MarkupInfoCurLineMerged.Background = clNone) or (CaretRow < 0)) + then begin Paint(Canvas, AClip, FirstLine, LastLine); exit; @@ -789,20 +926,14 @@ begin OffsRect := AClip; OffsRect.Left := FLeft; OffsRect.Right := FLeft + FLeftOffset; - - Canvas.Brush.Color := MarkupInfo.Background; - LCLIntf.SetBkColor(Canvas.Handle, TColorRef(Canvas.Brush.Color)); - Canvas.FillRect(OffsRect); + PaintBackground(Canvas, OffsRect); end; if FRightOffset > 0 then begin OffsRect := AClip; OffsRect.Right := FLeft + FullWidth; OffsRect.Left := OffsRect.Right - FRightOffset; - - Canvas.Brush.Color := MarkupInfo.Background; - LCLIntf.SetBkColor(Canvas.Handle, TColorRef(Canvas.Brush.Color)); - Canvas.FillRect(OffsRect); + PaintBackground(Canvas, OffsRect); end; AClip.Left := AClip.Left + FLeftOffset; diff --git a/components/synedit/syngutterchanges.pas b/components/synedit/syngutterchanges.pas index 944616ac76..c583f4616b 100644 --- a/components/synedit/syngutterchanges.pas +++ b/components/synedit/syngutterchanges.pas @@ -26,6 +26,7 @@ type published property ModifiedColor: TColor read GetModifiedColor write SetModifiedColor; property SavedColor: TColor read GetSavedColor write SetSavedColor; + property MarkupInfoCurrentLine; end; implementation @@ -84,11 +85,7 @@ begin c := SynEdit.Lines.Count; t := ToIdx(GutterArea.TextArea.TopLine); - if MarkupInfo.Background <> clNone then - begin - Canvas.Brush.Color := MarkupInfo.Background; - Canvas.FillRect(AClip); - end; + PaintBackground(Canvas, AClip); Canvas.Pen.Width := Width; Canvas.Pen.EndCap:= pecFlat; diff --git a/components/synedit/synguttercodefolding.pp b/components/synedit/synguttercodefolding.pp index 085d66272d..dfa481a1b5 100644 --- a/components/synedit/synguttercodefolding.pp +++ b/components/synedit/synguttercodefolding.pp @@ -114,6 +114,7 @@ type procedure ResetMouseActions; override; // set mouse-actions according to current Options / may clear them published property MarkupInfo; + property MarkupInfoCurrentLine; property MouseActionsExpanded: TSynEditMouseActions read GetMouseActionsExpanded write SetMouseActionsExpanded; property MouseActionsCollapsed: TSynEditMouseActions @@ -737,12 +738,7 @@ begin LineOffset := 2; HalfBoxSize := Min(Width, LineHeight - cNodeOffset*2) div 2; - if MarkupInfo.Background <> clNone then - begin - Canvas.Brush.Color := MarkupInfo.Background; - LCLIntf.SetBkColor(Canvas.Handle, TColorRef(Canvas.Brush.Color)); - Canvas.FillRect(AClip); - end; + PaintBackground(Canvas, AClip); with Canvas do begin diff --git a/components/synedit/syngutterlinenumber.pp b/components/synedit/syngutterlinenumber.pp index 41dd0778a7..62ae64c7ad 100644 --- a/components/synedit/syngutterlinenumber.pp +++ b/components/synedit/syngutterlinenumber.pp @@ -59,6 +59,7 @@ type override; published property MarkupInfo; + property MarkupInfoCurrentLine; property DigitCount: integer read FDigitCount write SetDigitCount; property ShowOnlyLineNumbersMultiplesOf: integer read FShowOnlyLineNumbersMultiplesOf write SetShowOnlyLineNumbersMultiplesOf; @@ -248,24 +249,13 @@ begin // Changed to use fTextDrawer.BeginDrawing and fTextDrawer.EndDrawing only // when absolutely necessary. Note: Never change brush / pen / font of the // canvas inside of this block (only through methods of fTextDrawer)! - if MarkupInfo.Background <> clNone then - Canvas.Brush.Color := MarkupInfo.Background - else - Canvas.Brush.Color := Gutter.Color; dc := Canvas.Handle; - LCLIntf.SetBkColor(dc, TColorRef(Canvas.Brush.Color)); FTextDrawer.BeginDrawing(dc); try - if MarkupInfo.Background <> clNone then - FTextDrawer.SetBackColor(MarkupInfo.Background) - else - FTextDrawer.SetBackColor(Gutter.Color); - if MarkupInfo.Foreground <> clNone then - fTextDrawer.SetForeColor(MarkupInfo.Foreground) - else - fTextDrawer.SetForeColor(SynEdit.Font.Color); - fTextDrawer.SetFrameColor(MarkupInfo.FrameColor); - fTextDrawer.Style := MarkupInfo.Style; + FTextDrawer.SetBackColor(MarkupInfoInternal.Background); + fTextDrawer.SetForeColor(MarkupInfoInternal.Foreground); + fTextDrawer.SetFrameColor(MarkupInfoInternal.FrameColor); + fTextDrawer.Style := MarkupInfoInternal.Style; // prepare the rect initially rcLine := AClip; rcLine.Bottom := AClip.Top; @@ -294,6 +284,19 @@ begin if i <> LineInfo.LineRange.Top then s := ''; // erase the background and draw the line number string in one go + if i - t = CaretRow then begin + FTextDrawer.SetBackColor(MarkupInfoCurLineMerged.Background); + fTextDrawer.SetForeColor(MarkupInfoCurLineMerged.Foreground); + fTextDrawer.SetFrameColor(MarkupInfoCurLineMerged.FrameColor); + fTextDrawer.Style := MarkupInfoCurLineMerged.Style; + end + else + if i - t = CaretRow+1 then begin + FTextDrawer.SetBackColor(MarkupInfoInternal.Background); + fTextDrawer.SetForeColor(MarkupInfoInternal.Foreground); + fTextDrawer.SetFrameColor(MarkupInfoInternal.FrameColor); + fTextDrawer.Style := MarkupInfoInternal.Style; + end; fTextDrawer.ExtTextOut(rcLine.Left, rcLine.Top, ETO_OPAQUE or ETO_CLIPPED, rcLine, PChar(Pointer(S)),Length(S)); end; @@ -301,6 +304,10 @@ begin // now erase the remaining area if any if AClip.Bottom > rcLine.Bottom then begin + FTextDrawer.SetBackColor(MarkupInfoInternal.Background); + fTextDrawer.SetForeColor(MarkupInfoInternal.Foreground); + fTextDrawer.SetFrameColor(MarkupInfoInternal.FrameColor); + fTextDrawer.Style := MarkupInfoInternal.Style; rcLine.Top := rcLine.Bottom; rcLine.Bottom := AClip.Bottom; with rcLine do diff --git a/components/synedit/synguttermarks.pp b/components/synedit/synguttermarks.pp index fb0776a477..026aff9c15 100644 --- a/components/synedit/synguttermarks.pp +++ b/components/synedit/synguttermarks.pp @@ -42,6 +42,8 @@ type property DebugMarksImageIndex: Integer read FDebugMarksImageIndex write FDebugMarksImageIndex; property ColumnWidth: Integer read FColumnWidth; // initialized in Paint property ColumnCount: Integer read FColumnCount; + published + property MarkupInfoCurrentLine; end; implementation @@ -225,11 +227,7 @@ var rcLine: TRect; begin if not Visible then exit; - if MarkupInfo.Background <> clNone then - Canvas.Brush.Color := MarkupInfo.Background - else - Canvas.Brush.Color := Gutter.Color; - LCLIntf.SetBkColor(Canvas.Handle, TColorRef(Canvas.Brush.Color)); + PaintBackground(Canvas, AClip); if assigned(FBookMarkOpt) and assigned(FBookMarkOpt.BookmarkImages) then FColumnWidth := GetImgListRes(Canvas, FBookMarkOpt.BookmarkImages).Width diff --git a/ide/editoroptions.pp b/ide/editoroptions.pp index 1d6d2f0343..13b6999dbb 100644 --- a/ide/editoroptions.pp +++ b/ide/editoroptions.pp @@ -40,7 +40,7 @@ interface uses // RTL, FCL - Classes, SysUtils, typinfo, fgl, resource, + Classes, SysUtils, typinfo, fgl, Math, resource, // LCL Graphics, LResources, Forms, Dialogs, ComCtrls, LCLType, Controls, // LazUtils @@ -132,6 +132,7 @@ const '', // ahaSpecialVisibleChars '', // ahaTopInfoHint '', '', // ahaCaretColor, ahaOverviewGutter + '', '', // ahaGutterCurrentLine, ahaGutterNumberCurrentLine '', '', '', // ahaIfDefBlockInactive, ahaIfDefBlockActive, ahaIfDefBlockTmpActive '', '', '', // ahaIfDefNodeInactive, ahaIfDefNodeActive, ahaIfDefNodeTmpActive '', '', '', '', '', // ahaIdentComplWindow, ahaIdentComplWindowBorder, ahaIdentComplRecent, ahaIdentComplWindowSelection, ahaIdentComplWindowHighlight @@ -174,6 +175,8 @@ const { ahaTopInfoHint } agnLine, { ahaCaretColor } agnText, { ahaOverviewGutter } agnGutter, + { ahaGutterCurrentLine } agnGutter, + { ahaGutterNumberCurrentLine } agnGutter, { ahaIfDefBlockInactive } agnIfDef, { ahaIfDefBlockActive } agnIfDef, { ahaIfDefBlockTmpActive } agnIfDef, @@ -234,6 +237,8 @@ const { ahaTopInfoHint } [hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior, hafFrameStyle, hafFrameEdges, hafStyle, hafStyleMask], { ahaCaretColor } [hafBackColor, hafForeColor], { ahaOverviewGutter } [hafBackColor, hafForeColor, hafFrameColor], + { ahaGutterCurrentLine } [hafBackColor], + { ahaGutterNumberCurrentLine } [hafBackColor, hafForeColor, hafFrameColor, hafStyle], { ahaIfDefBlockInactive } [hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior, hafFrameStyle, hafFrameEdges, hafStyle, hafStyleMask], { ahaIfDefBlockActive } [hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior, hafFrameStyle, hafFrameEdges, hafStyle, hafStyleMask], { ahaIfDefBlockTmpActive }[hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior, hafFrameStyle, hafFrameEdges, hafStyle, hafStyleMask], @@ -1467,6 +1472,8 @@ type TEditorOptsScrollPastEolMode = (optScrollFixed, optScrollPage, optScrollNone); + TEditorSynGutterOptsLineColor = (glcOff, glcOn, glcLineNum); + { TEditorSynGutterOptions } TEditorSynGutterOptions = class(TPersistent) @@ -1476,6 +1483,7 @@ type FIndex: integer; FOffsetLeft: integer; FOffsetRight: integer; + FShowLineColor: TEditorSynGutterOptsLineColor; FVisible: boolean; FWidth: integer; protected @@ -1485,6 +1493,7 @@ type destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure ApplyTo(AGutterPart: TSynGutterPartBase); + procedure ApplyLineColorTo(AGutterPart: TSynGutterPartBase; Attri, NumAttri: TColorSchemeAttribute); procedure ApplyIndexTo(AGutterPart: TSynGutterPartBase); property Defaults: TEditorSynGutterOptions read FDefaults; @@ -1495,6 +1504,7 @@ type property Width: integer read FWidth write FWidth; property OffsetLeft: integer read FOffsetLeft write FOffsetLeft; property OffsetRight: integer read FOffsetRight write FOffsetRight; + property ShowLineColor: TEditorSynGutterOptsLineColor read FShowLineColor write FShowLineColor; end; { TEditorSynGutterOptionsList } @@ -2217,6 +2227,7 @@ begin FGClass := AGClass; FIndex := AIdx; FVisible := True; + FShowLineColor := glcOn; if FGClass = TSynGutterMarks then begin FWidth := 2; @@ -2224,6 +2235,15 @@ begin else if FGClass = TSynGutterLineNumber then begin FWidth := 2; + FShowLineColor := glcLineNum; + end + else + if FGClass = TSynGutterCodeFolding then begin + FShowLineColor := glcOff; + end + else + if FGClass = TSynGutterLineOverview then begin + FShowLineColor := glcOff; end; end; @@ -2249,6 +2269,7 @@ begin FOffsetRight := TEditorSynGutterOptions(Source).FOffsetRight; FVisible := TEditorSynGutterOptions(Source).FVisible; FWidth := TEditorSynGutterOptions(Source).FWidth; + FShowLineColor := TEditorSynGutterOptions(Source).FShowLineColor; end; end; @@ -2286,6 +2307,17 @@ begin AGutterPart.RightOffset := FOffsetRight; end; +procedure TEditorSynGutterOptions.ApplyLineColorTo(AGutterPart: TSynGutterPartBase; Attri, + NumAttri: TColorSchemeAttribute); +begin + if AGutterPart = nil then exit; + case FShowLineColor of + glcOff: ; + glcOn: if Attri <> nil then Attri.ApplyTo(AGutterPart.MarkupInfoCurrentLine); + glcLineNum: if NumAttri <> nil then NumAttri.ApplyTo(AGutterPart.MarkupInfoCurrentLine); + end; +end; + procedure TEditorSynGutterOptions.ApplyIndexTo(AGutterPart: TSynGutterPartBase); begin if AGutterPart <> nil then @@ -2948,6 +2980,8 @@ begin AdditionalHighlightAttributes[ahaTopInfoHint] := dlgTopInfoHint; AdditionalHighlightAttributes[ahaCaretColor] := dlgCaretColor; AdditionalHighlightAttributes[ahaOverviewGutter] := dlgOverviewGutterColor; + AdditionalHighlightAttributes[ahaGutterCurrentLine] := dlgGutterCurrentLineOther; + AdditionalHighlightAttributes[ahaGutterNumberCurrentLine] := dlgGutterCurrentLineNumber; AdditionalHighlightAttributes[ahaIfDefBlockInactive] := dlgIfDefBlockInactive; AdditionalHighlightAttributes[ahaIfDefBlockActive] := dlgIfDefBlockActive; AdditionalHighlightAttributes[ahaIfDefBlockTmpActive] := dlgIfDefBlockTmpActive; @@ -6472,6 +6506,8 @@ procedure TEditorOptions.SetMarkupColors(aSynEd: TSynEdit); var Scheme: TColorSchemeLanguage; TmpHl: TIDESynTextSyn; + Attri, AttriNum: TColorSchemeAttribute; + i: Integer; begin // Find current color scheme for default colors if (aSynEd.Highlighter = nil) then begin @@ -6490,6 +6526,13 @@ begin // get current colorscheme: Scheme := GetColorSchemeLanguage(aSynEd.Highlighter); if Assigned(Scheme) then Scheme.ApplyTo(aSynEd); + + Attri := Scheme.AttributeByEnum[ahaGutterCurrentLine]; + AttriNum := Scheme.AttributeByEnum[ahaGutterNumberCurrentLine]; + for i := 0 to GutterPartList.Count - 1 do + GutterPartList[i].ApplyLineColorTo(aSynEd.Gutter.Parts.ByClass[GutterPartList[i].GClass, 0], Attri, AttriNum); + for i := 0 to GutterRightPartList.Count - 1 do + GutterRightPartList[i].ApplyLineColorTo(aSynEd.Gutter.Parts.ByClass[GutterRightPartList[i].GClass, 0], Attri, AttriNum); end; procedure TEditorOptions.ApplyFontSettingsTo(ASynEdit: TSynEdit); diff --git a/ide/frames/editor_color_options.pas b/ide/frames/editor_color_options.pas index 8dfe28b915..c362ff8eba 100644 --- a/ide/frames/editor_color_options.pas +++ b/ide/frames/editor_color_options.pas @@ -42,7 +42,8 @@ uses // IdeConfig IDEProcs, LazConf, // IDE - EditorOptions, editor_general_options, LazarusIDEStrConsts, SourceMarks; + EditorOptions, editor_general_options, + LazarusIDEStrConsts, SourceMarks; type @@ -168,7 +169,6 @@ type procedure SetCurrentScheme(SynInstance: TSrcIDEHighlighter; const ColorScheme: String); procedure ApplyCurrentScheme; - procedure UpdateCurrentScheme; procedure StatusChange(Sender: TObject; {%H-}Changes: TSynStatusChanges); procedure SpecialLineMarkup(Sender: TObject; Line: Integer; @@ -192,6 +192,7 @@ type procedure ReadSettings(AOptions: TAbstractIDEOptions); override; procedure WriteSettings(AOptions: TAbstractIDEOptions); override; procedure SelectAhaColor(aha: TAdditionalHilightAttribute); + procedure UpdateCurrentScheme; class function SupportedOptionsClass: TAbstractIDEOptionsClass; override; property UnsavedColorSchemeSettings: TColorSchemeFactory read FTempColorSchemeSettings; property UnsavedColorSchemeDefaultNames: TStringList read FColorSchemes; @@ -199,6 +200,8 @@ type implementation +uses editor_display_options; + {$R *.lfm} const @@ -1354,19 +1357,40 @@ end; procedure TEditorColorOptionsFrame.UpdateCurrentScheme; var - a: Integer; + a, i: Integer; + col: TEditorDisplayOptionsFrame; + Attri, AttriNum: TColorSchemeAttribute; begin // there is always a colorscheme selected, except during initialization with GeneralPage do begin if FCurrentColorScheme = nil then exit; + for a := Low(PreviewEdits) to High(PreviewEdits) do PreviewEdits[a].BeginUpdate; try if not FIsEditingDefaults then FCurrentColorScheme.ApplyTo(FCurrentHighlighter); + for a := Low(PreviewEdits) to High(PreviewEdits) do begin FCurrentColorScheme.ApplyTo(PreviewEdits[a]); + + Attri := FCurrentColorScheme.AttributeByEnum[ahaGutterCurrentLine]; + AttriNum := FCurrentColorScheme.AttributeByEnum[ahaGutterNumberCurrentLine]; + col := TEditorDisplayOptionsFrame(FDialog.FindEditor(TEditorDisplayOptionsFrame)); + if (col <> nil) then begin + for i := 0 to col.CurGutterPartList.Count - 1 do + col.CurGutterPartList[i].ApplyLineColorTo(PreviewEdits[a].Gutter.Parts.ByClass[col.CurGutterPartList[i].GClass, 0], Attri, AttriNum); + for i := 0 to col.CurGutterRightPartList.Count - 1 do + col.CurGutterRightPartList[i].ApplyLineColorTo(PreviewEdits[a].Gutter.Parts.ByClass[col.CurGutterRightPartList[i].GClass, 0], Attri, AttriNum); + end + else begin + for i := 0 to EditorOpts.GutterPartList.Count - 1 do + EditorOpts.GutterPartList[i].ApplyLineColorTo(PreviewEdits[a].Gutter.Parts.ByClass[EditorOpts.GutterPartList[i].GClass, 0], Attri, AttriNum); + for i := 0 to EditorOpts.GutterRightPartList.Count - 1 do + EditorOpts.GutterRightPartList[i].ApplyLineColorTo(PreviewEdits[a].Gutter.Parts.ByClass[EditorOpts.GutterRightPartList[i].GClass, 0], Attri, AttriNum); + end; + PreviewEdits[a].Invalidate; end; finally diff --git a/ide/frames/editor_display_options.lfm b/ide/frames/editor_display_options.lfm index c3f32f479b..7d399493f9 100644 --- a/ide/frames/editor_display_options.lfm +++ b/ide/frames/editor_display_options.lfm @@ -12,13 +12,13 @@ object EditorDisplayOptionsFrame: TEditorDisplayOptionsFrame object MarginAndGutterGroupBox: TGroupBox AnchorSideRight.Side = asrBottom Left = 0 - Height = 249 + Height = 250 Top = 0 Width = 588 Align = alTop AutoSize = True Caption = 'MarginAndGutterGroupBox' - ClientHeight = 229 + ClientHeight = 230 ClientWidth = 584 TabOrder = 0 object RightMarginLabel: TLabel @@ -40,7 +40,7 @@ object EditorDisplayOptionsFrame: TEditorDisplayOptionsFrame AnchorSideTop.Side = asrCenter Left = 325 Height = 15 - Top = 182 + Top = 211 Width = 121 BorderSpacing.Left = 6 BorderSpacing.Top = 6 @@ -112,11 +112,11 @@ object EditorDisplayOptionsFrame: TEditorDisplayOptionsFrame end object ShowOnlyLineNumbersMultiplesOfSpinEdit: TSpinEdit AnchorSideLeft.Control = RightMarginComboBox - AnchorSideTop.Control = spinGutterPartLeftOffs + AnchorSideTop.Control = cbCurLineMarkup AnchorSideTop.Side = asrBottom Left = 265 Height = 23 - Top = 178 + Top = 207 Width = 54 BorderSpacing.Top = 6 MaxValue = 65536 @@ -277,12 +277,27 @@ object EditorDisplayOptionsFrame: TEditorDisplayOptionsFrame TabOrder = 9 OnClick = rgGutterSiteClick end + object cbCurLineMarkup: TComboBox + AnchorSideLeft.Control = RightMarginComboBox + AnchorSideTop.Control = spinGutterPartLeftOffs + AnchorSideTop.Side = asrBottom + Left = 265 + Height = 23 + Top = 178 + Width = 200 + BorderSpacing.Top = 6 + BorderSpacing.Bottom = 6 + ItemHeight = 15 + TabOrder = 11 + Text = 'cbCurLineMarkup' + OnChange = spinGutterPartWidthChange + end end object EditorFontGroupBox: TGroupBox AnchorSideRight.Side = asrBottom Left = 0 Height = 113 - Top = 255 + Top = 256 Width = 588 Align = alTop AutoSize = True @@ -432,8 +447,8 @@ object EditorDisplayOptionsFrame: TEditorDisplayOptionsFrame AnchorSideRight.Side = asrBottom AnchorSideBottom.Side = asrBottom Left = 0 - Height = 81 - Top = 374 + Height = 80 + Top = 375 Width = 588 Align = alClient BorderSpacing.Top = 6 diff --git a/ide/frames/editor_display_options.pas b/ide/frames/editor_display_options.pas index 5c00270af7..673e3226bb 100644 --- a/ide/frames/editor_display_options.pas +++ b/ide/frames/editor_display_options.pas @@ -42,6 +42,7 @@ type { TEditorDisplayOptionsFrame } TEditorDisplayOptionsFrame = class(TAbstractIDEOptionsEditor) + cbCurLineMarkup: TComboBox; GutterPartVisible: TCheckBox; chkTopInfoView: TCheckBox; DisableAntialiasingCheckBox: TCheckBox; @@ -170,6 +171,7 @@ end; procedure TEditorDisplayOptionsFrame.UpdatePreviews; var i, j: Integer; + col: TEditorColorOptionsFrame; begin with GeneralPage do for i := Low(PreviewEdits) to High(PreviewEdits) do @@ -183,6 +185,9 @@ begin FCurGutterRightPartList[j].ApplyIndexTo(PreviewEdits[i].RightGutter.Parts.ByClass[FCurGutterRightPartList[j].GClass, 0]); end; end; + col := TEditorColorOptionsFrame(FDialog.FindEditor(TEditorColorOptionsFrame)); + if col <> nil then + col.UpdateCurrentScheme; end; procedure TEditorDisplayOptionsFrame.EditorFontButtonClick(Sender: TObject); @@ -354,6 +359,12 @@ begin spinGutterPartWidth.Value := FCurrentGutterPart.Width; spinGutterPartLeftOffs.Value := FCurrentGutterPart.OffsetLeft; spinGutterPartRightOffs.Value := FCurrentGutterPart.OffsetRight; + case FCurrentGutterPart.ShowLineColor of + glcOff: cbCurLineMarkup.ItemIndex := 0; + glcOn: cbCurLineMarkup.ItemIndex := 1; + glcLineNum: cbCurLineMarkup.ItemIndex := 2; + end; + FGutterParsUpdating := False; btnGutterUp.Enabled := lbGutterParts.ItemIndex > 0; @@ -362,6 +373,10 @@ begin ShowOnlyLineNumbersMultiplesOfSpinEdit.Enabled := (FCurrentGutterPart <> nil) and (FCurrentGutterPart.GClass = TSynGutterLineNumber); ShowOnlyLineNumbersMultiplesOfLabel.Enabled := ShowOnlyLineNumbersMultiplesOfSpinEdit.Enabled; + + cbCurLineMarkup.Enabled := (FCurrentGutterPart <> nil) and + (FCurrentGutterPart.GClass <> TSynGutterLineNumber) and + (FCurrentGutterPart.GClass <> TSynGutterLineOverview); end; procedure TEditorDisplayOptionsFrame.btnGutterUpClick(Sender: TObject); @@ -474,6 +489,11 @@ begin FCurrentGutterPart.Width := spinGutterPartWidth.Value; FCurrentGutterPart.OffsetLeft := spinGutterPartLeftOffs.Value; FCurrentGutterPart.OffsetRight := spinGutterPartRightOffs.Value; + case cbCurLineMarkup.ItemIndex of + 0: FCurrentGutterPart.ShowLineColor := glcOff; + 1: FCurrentGutterPart.ShowLineColor := glcOn; + 2: FCurrentGutterPart.ShowLineColor := glcLineNum; + end; UpdatePreviews; end; @@ -533,6 +553,9 @@ begin lblGutterPartWidth.Caption := lisGutterPartWidth; lblGutterPartMargin.Caption := lisGutterPartMargin; + cbCurLineMarkup.Items.Add(optDispGutterNoCurrentLineColor); + cbCurLineMarkup.Items.Add(optDispGutterUseCurrentLineColor); + cbCurLineMarkup.Items.Add(optDispGutterUseCurrentLineNumberColor); with GeneralPage do AddPreviewEdit(DisplayPreview); diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 7c049bed42..1ca6eee99e 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -2164,6 +2164,8 @@ resourcestring dlgTopInfoHint = 'Current Class/Proc Hint'; dlgCaretColor = 'Caret (Text-Cursor)'; dlgOverviewGutterColor = 'Overview Gutter'; + dlgGutterCurrentLineOther = 'Current Line (other)'; + dlgGutterCurrentLineNumber = 'Current Line (number)'; dlgIfDefBlockInactive = 'Inactive $IFDEF code'; dlgIfDefBlockActive = 'Active $IFDEF code'; dlgIfDefBlockTmpActive = 'Included mixed state $IFDEF code'; @@ -6450,6 +6452,9 @@ resourcestring optDispGutterChanges = 'Changes'; optDispGutterSeparator = 'Separator'; optDispGutterFolding = 'Folding'; + optDispGutterNoCurrentLineColor = 'No current line color'; + optDispGutterUseCurrentLineColor = 'Use current line color'; + optDispGutterUseCurrentLineNumberColor = 'Use current line number color'; implementation diff --git a/ide/sourcemarks.pas b/ide/sourcemarks.pas index 400ac816de..b45ac35a83 100644 --- a/ide/sourcemarks.pas +++ b/ide/sourcemarks.pas @@ -64,6 +64,7 @@ type ahaSyncroEditOther, ahaSyncroEditArea, ahaGutterSeparator, ahaGutter, ahaRightMargin, ahaSpecialVisibleChars, ahaTopInfoHint, ahaCaretColor, ahaOverviewGutter, + ahaGutterCurrentLine, ahaGutterNumberCurrentLine, ahaIfDefBlockInactive, ahaIfDefBlockActive, ahaIfDefBlockTmpActive, ahaIfDefNodeInactive, ahaIfDefNodeActive, ahaIfDefNodeTmpActive, ahaIdentComplWindow, ahaIdentComplWindowBorder, ahaIdentComplRecent, ahaIdentComplWindowSelection, ahaIdentComplWindowHighlight,