SynEdit: Caret Color

git-svn-id: trunk@58647 -

components/synedit/synedit.pp

@@ -594,7 +594,6 @@ type
     FOnClickLink: TMouseEvent;
     FOnMouseLink: TSynMouseLinkEvent;
     FPendingFoldState: String;
-    FScreenCaretPainterClass: TSynEditScreenCaretPainterClass;
 
     procedure UpdateScreenCaret;
     procedure AquirePrimarySelection;
@@ -766,6 +765,7 @@ type
     procedure InternalBeginUndoBlock(aList: TSynEditUndoList = nil); // includes paintlock
     procedure InternalEndUndoBlock(aList: TSynEditUndoList = nil);
   protected
+    FScreenCaretPainterClass: TSynEditScreenCaretPainterClass deprecated 'need refactor';
     {$IFDEF EnableDoubleBuf}
     BufferBitmap: TBitmap; // the double buffer
     SavedCanvas: TCanvas; // the normal TCustomControl canvas during paint
@@ -2052,7 +2052,7 @@ begin
   FCaret.AddChangeHandler(@CaretChanged);
   FInternalCaret := TSynEditCaret.Create;
   FInternalCaret.MaxLeftChar := @CurrentMaxLineLen;
-  FScreenCaretPainterClass := TSynEditScreenCaretPainterSystem;
+  FScreenCaretPainterClass{%H-} := TSynEditScreenCaretPainterSystem;
 
   // Create the lines/views
   FTrimmedLinesView := TSynEditStringTrimmingList.Create(fLines, fCaret);
@@ -4987,7 +4987,7 @@ begin
   {$ENDIF}
   LastMouseCaret:=Point(-1,-1);
   // Todo: Under Windows, keeping the Caret only works, if no other component creates a caret
-  FScreenCaretPainterClass := TSynEditScreenCaretPainterClass(ScreenCaret.Painter.ClassType);
+  FScreenCaretPainterClass{%H-} := TSynEditScreenCaretPainterClass(ScreenCaret.Painter.ClassType);
   UpdateScreenCaret;
   if FHideSelection and SelAvail then
     Invalidate;
@@ -5007,8 +5007,8 @@ begin
   DebugLn(['[TCustomSynEdit.WMSetFocus] A ',DbgSName(Self), ' time=', dbgs(Now*86640)]);
   {$ENDIF}
   FScreenCaret.DestroyCaret; // Ensure recreation. On Windows only one caret exists, and it must be moved to the focused editor
-  if ScreenCaret.Painter.ClassType <> FScreenCaretPainterClass then
+  if ScreenCaret.Painter.ClassType <> FScreenCaretPainterClass{%H-} then
-    ScreenCaret.ChangePainter(FScreenCaretPainterClass);
+    ScreenCaret.ChangePainter(FScreenCaretPainterClass{%H-});
   if ScreenCaret.Painter.ClassType <> TSynEditScreenCaretPainterSystem then // system painter does not use timer
     FScreenCaret.PaintTimer.ResetInterval;
   FScreenCaret.Visible := not(eoNoCaret in FOptions) and IsVisible;

ide/editoroptions.pp

@@ -123,6 +123,7 @@ const
     '',  // ahaRightMargin
     '',  // ahaSpecialVisibleChars
     '',  // ahaTopInfoHint
+    '', // ahaCaretColor
     '', '', '',  // ahaIfDefBlockInactive, ahaIfDefBlockActive, ahaIfDefBlockTmpActive
     '', '', '',  // ahaIfDefNodeInactive, ahaIfDefNodeActive, ahaIfDefNodeTmpActive
     '', '', '', '', // ahaIdentComplWindow, ahaIdentComplWindowBorder, ahaIdentComplWindowSelection, ahaIdentComplWindowHighlight
@@ -163,6 +164,7 @@ const
     { ahaRightMargin}          agnGutter,
     { ahaSpecialVisibleChars } agnText,
     { ahaTopInfoHint }         agnLine,
+    { ahaCaretColor }          agnText,
     { ahaIfDefBlockInactive }  agnIfDef,
     { ahaIfDefBlockActive }    agnIfDef,
     { ahaIfDefBlockTmpActive } agnIfDef,
@@ -220,6 +222,7 @@ const
     { ahaRightMargin}         [hafForeColor],
     { ahaSpecialVisibleChars }[hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior, hafFrameStyle, hafFrameEdges, hafStyle, hafStyleMask],
     { ahaTopInfoHint }        [hafBackColor, hafForeColor, hafFrameColor, hafAlpha, hafPrior, hafFrameStyle, hafFrameEdges, hafStyle, hafStyleMask],
+    { ahaCaretColor }         [hafBackColor, hafForeColor],
     { 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],
@@ -2523,6 +2526,7 @@ begin
   AdditionalHighlightAttributes[ahaRightMargin]         := dlgRightMargin;
   AdditionalHighlightAttributes[ahaSpecialVisibleChars] := dlgAddHiSpecialVisibleChars;
   AdditionalHighlightAttributes[ahaTopInfoHint]         := dlgTopInfoHint;
+  AdditionalHighlightAttributes[ahaCaretColor]          := dlgCaretColor;
   AdditionalHighlightAttributes[ahaIfDefBlockInactive]  := dlgIfDefBlockInactive;
   AdditionalHighlightAttributes[ahaIfDefBlockActive]    := dlgIfDefBlockActive;
   AdditionalHighlightAttributes[ahaIfDefBlockTmpActive] := dlgIfDefBlockTmpActive;
@@ -6593,7 +6597,7 @@ procedure TColorSchemeLanguage.ApplyTo(ASynEdit: TSynEdit);
       Result := Result.GetSchemeGlobal;
   end;
 var
-  Attri, att: TColorSchemeAttribute;
+  Attri: TColorSchemeAttribute;
   i, c, j: Integer;
   IDESynEdit: TIDESynEditor;
   aha: TAdditionalHilightAttribute;
@@ -6632,8 +6636,14 @@ begin
     SetMarkupColor(ahaFoldedCodeLine,    aSynEdit.FoldedCodeLineColor);
     SetMarkupColor(ahaHiddenCodeLine,    aSynEdit.HiddenCodeLineColor);
     SetMarkupColor(ahaLineHighlight,     aSynEdit.LineHighlightColor);
-    if ASynEdit is TIDESynEditor then
+    if ASynEdit is TIDESynEditor then begin
       SetMarkupColor(ahaTopInfoHint,  TIDESynEditor(aSynEdit).TopInfoMarkup);
+      Attri := GetUsedAttr(ahaCaretColor);
+      if Attri <> nil then begin
+        TIDESynEditor(aSynEdit).CaretColor := Attri.Foreground;
+        TIDESynEditor(aSynEdit).MultiCaret.Color := Attri.Background;
+      end;
+    end;
     SetMarkupColorByClass(ahaHighlightWord, TSynEditMarkupHighlightAllCaret);
     SetMarkupColorByClass(ahaWordGroup,     TSynEditMarkupWordGroup);
     SetMarkupColorByClass(ahaSpecialVisibleChars, TSynEditMarkupSpecialChar);
@@ -6728,18 +6738,17 @@ begin
       j := 0;
       c := 0;
       for aha := ahaOutlineLevel1Color to ahaOutlineLevel10Color do begin
-        att := AttributeByEnum[aha];
+        Attri := GetUsedAttr(aha);
-        if Att.IsEnabled or
+        if Attri = nil then Continue;
+        if (Attri.IsEnabled) or
            (FFormatVersion >= 12)
         then begin
           SetMarkupColor(aha, TSynEditMarkupFoldColors(aSynEdit.Markup[i]).Color[j]);
 
-        if att.IsUsingSchemeGlobals then
+          TSynEditMarkupFoldColors(aSynEdit.Markup[i]).LineColor[j].Color := Attri.MarkupFoldLineColor;
-          att := att.GetSchemeGlobal;
+          TSynEditMarkupFoldColors(aSynEdit.Markup[i]).LineColor[j].Style := Attri.MarkupFoldLineStyle;
-          TSynEditMarkupFoldColors(aSynEdit.Markup[i]).LineColor[j].Color := att.MarkupFoldLineColor;
+          TSynEditMarkupFoldColors(aSynEdit.Markup[i]).LineColor[j].Alpha := Attri.MarkupFoldLineAlpha;
-          TSynEditMarkupFoldColors(aSynEdit.Markup[i]).LineColor[j].Style := att.MarkupFoldLineStyle;
+          TSynEditMarkupFoldColors(aSynEdit.Markup[i]).LineColor[j].Priority := Attri.FramePriority;
-          TSynEditMarkupFoldColors(aSynEdit.Markup[i]).LineColor[j].Alpha := att.MarkupFoldLineAlpha;
-          TSynEditMarkupFoldColors(aSynEdit.Markup[i]).LineColor[j].Priority := att.FramePriority;
           inc(j);
           c := j;
         end;

ide/frames/editor_color_options.pas

@@ -264,7 +264,7 @@ begin
 
   // Draw preview box - Background
   c := clNone;
-  if (hafBackColor in  Attri.Features) then
+  if (hafBackColor in  Attri.Features) and not (AttriIdx = ord(ahaCaretColor)) then
     c := Attri.Background;
   // Fallback Background-color for gutter
   if ((c = clNone) or (c = clDefault)) and
@@ -282,7 +282,7 @@ begin
   TheTree.Canvas.FillRect(NodeRect.Left+2, NodeRect.Top+2, NodeRect.Left+FullAbcWidth-2, NodeRect.Bottom-2);
 
   // Special draw Modified line gutter
-  if AttriIdx = ord(ahaModifiedLine) then begin
+  if (AttriIdx = ord(ahaModifiedLine)) then begin
     TextY := NodeRect.Bottom - NodeRect.Top - 4;
     TheTree.Canvas.Brush.Color := Attri.Foreground;
     TheTree.Canvas.FillRect(NodeRect.Left+2, NodeRect.Top+2, NodeRect.Left+5, NodeRect.Bottom-2);
@@ -291,9 +291,11 @@ begin
     exit;
   end;
 
-  // Special draw oultine color
+  // Special draw oultine color // Caret color
-  if Attri.Group = agnOutlineColors then begin
+  if (Attri.Group = agnOutlineColors) or (AttriIdx = ord(ahaCaretColor)) then begin
     c := Attri.MarkupFoldLineColor;
+    if (AttriIdx = ord(ahaCaretColor)) then
+      c := Attri.Foreground;
     if c <> clNone then begin
       TheTree.Canvas.Pen.Color := c;
       TheTree.Canvas.MoveTo(NodeRect.Left+2, NodeRect.Top+2);
@@ -305,7 +307,8 @@ begin
     FullAbcWidth := FullAbcWidth - 6;
     TheTree.Canvas.Brush.Color := Attri.Background;
     TheTree.Canvas.FillRect(NodeRect.Left+2, NodeRect.Top+2, NodeRect.Left+FullAbcWidth-2, NodeRect.Bottom-2);
-//    exit;
+    if (AttriIdx = ord(ahaCaretColor)) then
+      exit;
   end;
 
   // Draw preview Frame

ide/lazarusidestrconsts.pas

@@ -1941,6 +1941,8 @@ resourcestring
   dlgUnsavedLineColor = 'Unsaved line';
   dlgSavedLineColor = 'Saved line';
   dlgGutterCollapsedColor = 'Collapsed';
+  dlgCaretForeColor = 'Color (NotXor)';
+  dlgCaretBackColor = 'Multi/2nd (NotXor)';
   dlgElementAttributes = 'Element Attributes';
   dlgEdBold = 'Bold';
   dlgEdItal = 'Italic';
@@ -2132,6 +2134,7 @@ resourcestring
   dlgAddHiAttrOutlineLevel10Color = 'Level 10';
   dlgAddHiSpecialVisibleChars     = 'Visualized Special Chars';
   dlgTopInfoHint                  = 'Current Class/Proc Hint';
+  dlgCaretColor                   = 'Caret';
   dlgIfDefBlockInactive           = 'Inactive $IFDEF code';
   dlgIfDefBlockActive             = 'Active $IFDEF code';
   dlgIfDefBlockTmpActive          = 'Included mixed state $IFDEF code';

ide/sourcemarks.pas

@@ -63,7 +63,7 @@ type
      ahaTemplateEditOther, ahaSyncroEditCur,      ahaSyncroEditSync,
      ahaSyncroEditOther,   ahaSyncroEditArea,     ahaGutterSeparator,
      ahaGutter,            ahaRightMargin,        ahaSpecialVisibleChars,
-     ahaTopInfoHint,
+     ahaTopInfoHint,       ahaCaretColor,
      ahaIfDefBlockInactive, ahaIfDefBlockActive, ahaIfDefBlockTmpActive,
      ahaIfDefNodeInactive, ahaIfDefNodeActive, ahaIfDefNodeTmpActive,
      ahaIdentComplWindow, ahaIdentComplWindowBorder, ahaIdentComplWindowSelection, ahaIdentComplWindowHighlight,

ide/sourcesyneditor.pas

@@ -238,6 +238,7 @@ type
 
   TIDESynEditor = class(TSynEdit)
   private
+    FCaretColor: TColor;
     FCaretStamp: Int64;
     FMarkupIdentComplWindow: TSynMarkupIdentComplWindow;
     FShowTopInfo: boolean;
@@ -266,6 +267,7 @@ type
     function GetOnMultiCaretBeforeCommand: TSynMultiCaretBeforeCommand;
     procedure GetTopInfoMarkupForLine(Sender: TObject; {%H-}Line: integer; var Special: boolean;
       aMarkup: TSynSelectedColor);
+    procedure SetCaretColor(AValue: TColor);
     procedure SetHighlightUserWordCount(AValue: Integer);
     procedure SetOnMultiCaretBeforeCommand(AValue: TSynMultiCaretBeforeCommand);
     procedure SetShowTopInfo(AValue: boolean);
@@ -309,6 +311,7 @@ type
     property  IsInMultiCaretRepeatExecution: Boolean read GetIsInMultiCaretRepeatExecution;
     property  OnMultiCaretBeforeCommand: TSynMultiCaretBeforeCommand read GetOnMultiCaretBeforeCommand write SetOnMultiCaretBeforeCommand;
     property CaretStamp: Int64 read FCaretStamp;
+    property CaretColor: TColor read FCaretColor write SetCaretColor;
   end;
 
   TIDESynHighlighterPasRangeList = class(TSynHighlighterPasRangeList)
@@ -1563,6 +1566,27 @@ begin
   aMarkup.Assign(FTopInfoMarkup);
 end;
 
+procedure TIDESynEditor.SetCaretColor(AValue: TColor);
+begin
+  if FCaretColor = AValue then Exit;
+  FCaretColor := AValue;
+  if (AValue = clDefault) or (AValue = clNone) then begin
+    FScreenCaretPainterClass{%H-} := TSynEditScreenCaretPainterSystem;
+    if ScreenCaret.Painter.ClassType <> TSynEditScreenCaretPainterSystem then begin
+      MultiCaret.ActiveMode := mcmNoCarets; // clear all carets, before changing the caret class
+      ScreenCaret.ChangePainter(TSynEditScreenCaretPainterSystem);
+  end;
+  end
+  else begin
+    FScreenCaretPainterClass{%H-} := TSynEditScreenCaretPainterInternal;
+    if ScreenCaret.Painter.ClassType <> TSynEditScreenCaretPainterInternal then begin
+      MultiCaret.ActiveMode := mcmNoCarets; // clear all carets, before changing the caret class
+      ScreenCaret.ChangePainter(TSynEditScreenCaretPainterInternal);
+    end;
+    TSynEditScreenCaretPainterInternal(ScreenCaret.Painter).Color := AValue;
+  end;
+end;
+
 procedure TIDESynEditor.SetHighlightUserWordCount(AValue: Integer);
 var
   m: TSourceSynEditMarkupHighlightAllMulti;
@@ -1714,6 +1738,7 @@ var
   MarkupFoldColors: TSynEditMarkupFoldColors;
 begin
   inherited Create(AOwner);
+  FCaretColor := clNone;
   FUserWordsList := TFPList.Create;
   FTemplateEdit:=TSynPluginTemplateEdit.Create(Self);
   FSyncroEdit := TSynPluginSyncroEdit.Create(Self);

ide/syncolorattribeditor.pas

@@ -502,6 +502,7 @@ begin
   try
     // Adjust color captions
     ForeGroundUseDefaultCheckBox.Caption := dlgForecolor;
+    BackGroundUseDefaultCheckBox.Caption := dlgBackColor;
     FrameColorUseDefaultCheckBox.Caption := dlgFrameColor;
     if FCurrentColorScheme <> nil then begin
       if (FCurrentColorScheme.AttributeByEnum[ahaModifiedLine] <> nil) and
@@ -514,6 +515,12 @@ begin
          (FCurHighlightElement.StoredName = FCurrentColorScheme.AttributeByEnum[ahaCodeFoldingTree].StoredName)
       then begin
         FrameColorUseDefaultCheckBox.Caption := dlgGutterCollapsedColor;
+      end else
+      if (FCurrentColorScheme.AttributeByEnum[ahaCaretColor] <> nil) and
+         (FCurHighlightElement.StoredName = FCurrentColorScheme.AttributeByEnum[ahaCaretColor].StoredName)
+      then begin
+        ForeGroundUseDefaultCheckBox.Caption := dlgCaretForeColor;
+        BackGroundUseDefaultCheckBox.Caption := dlgCaretBackColor;
       end;
     end;