SynEdit: generic method for plugins to override mouse cursor

git-svn-id: trunk@53024 -

components/synedit/synedit.pp

@@ -455,7 +455,7 @@ type
   protected
     procedure CMWantSpecialKey(var Message: TLMessage); message CM_WANTSPECIALKEY;
   private
-    FTextCursor, FOffTextCursor: TCursor;
+    FTextCursor, FOffTextCursor, FOverrideCursor: TCursor;
     FBlockIndent: integer;
     FBlockTabIndent: integer;
     FCaret: TSynEditCaret;
@@ -477,8 +477,7 @@ type
     fFontDummy: TFont;
     FLastSetFontSize: Integer;
     fInserting: Boolean;
-    fLastMouseCaret: TPoint;  // Char; physical (screen)
+    FLastMouseLocation: TSynMouseLocationInfo;
-    FLastMousePoint: TPoint;  // Pixel
     FChangedLinesStart: integer; // 1 based, 0 means invalid
     FChangedLinesEnd: integer; // 1 based, 0 means invalid, -1 means rest of screen
     FChangedLinesDiff: integer; // count changed +/-
@@ -555,6 +554,7 @@ type
     FHookedKeyTranslationList: TSynHookedKeyTranslationList;
     FUndoRedoItemHandlerList: TSynUndoRedoItemHandlerList;
     FMouseDownEventList: TLazSynMouseDownEventList;
+    FQueryMouseCursorList: TObject;
     FKeyDownEventList: TLazSynKeyDownEventList;
     FKeyUpEventList: TLazSynKeyDownEventList;
     FKeyPressEventList: TLazSynKeyPressEventList;
@@ -870,7 +870,7 @@ type
     function DoOnReplaceText(const ASearch, AReplace: string;
       Line, Column: integer): TSynReplaceAction; virtual;
     procedure DoOnStatusChange(Changes: TSynStatusChanges); virtual;
-    property LastMouseCaret: TPoint read FLastMouseCaret write SetLastMouseCaret; // TODO: deprecate? see MouseMove
+    property LastMouseCaret: TPoint read FLastMouseLocation.LastMouseCaret write SetLastMouseCaret; // TODO: deprecate? see MouseMove
     function GetSelEnd: integer;                                                 //L505
     function GetSelStart: integer;
     procedure SetSelEnd(const Value: integer);
@@ -1048,6 +1048,9 @@ type
     procedure RegisterBeforeMouseDownHandler(AHandlerProc: TMouseEvent);
     procedure UnregisterBeforeMouseDownHandler(AHandlerProc: TMouseEvent);
 
+    procedure RegisterQueryMouseCursorHandler(AHandlerProc: TSynQueryMouseCursorEvent);
+    procedure UnregisterQueryMouseCursorHandler(AHandlerProc: TSynQueryMouseCursorEvent);
+
     procedure RegisterBeforeKeyDownHandler(AHandlerProc: TKeyEvent);
     procedure UnregisterBeforeKeyDownHandler(AHandlerProc: TKeyEvent);
     procedure RegisterBeforeKeyUpHandler(AHandlerProc: TKeyEvent);
@@ -1131,6 +1134,9 @@ type
     property SelectionMode: TSynSelectionMode read GetSelectionMode write SetSelectionMode default smNormal;
     property SelectedColor: TSynSelectedColor read GetSelectedColor write SetSelectedColor;
 
+    // Cursor
+    procedure UpdateCursorOverride;
+
     // Colors
     property MarkupManager: TSynEditMarkupManager read fMarkupManager;
     property Color default clWhite;
@@ -1366,6 +1372,16 @@ type
       dx, dy: Integer; const rcScroll, rcClip: TRect);
   end;
 
+  { TSynQueryMouseCursorList }
+
+  TSynQueryMouseCursorList = Class(TSynMethodList)
+  public
+    procedure Add(AHandler: TSynQueryMouseCursorEvent);
+    procedure Remove(AHandler: TSynQueryMouseCursorEvent);
+    procedure CallScrollEventHandlers(Sender: TObject;
+      const AMouseLocation: TSynMouseLocationInfo; var AnCursor: TCursor);
+  end;
+
   { TSynEditUndoCaret }
 
   TSynEditUndoCaret = class(TSynEditUndoItem)
@@ -2110,6 +2126,7 @@ begin
   Width := 200;
   FTextCursor := crIBeam;
   FOffTextCursor := crDefault;
+  FOverrideCursor := crDefault;
   inherited Cursor := FTextCursor;
   fPlugins := TList.Create;
   FHookedKeyTranslationList := TSynHookedKeyTranslationList.Create;
@@ -2158,8 +2175,8 @@ begin
   fFontDummy.Pitch := SynDefaultFontPitch;
   fFontDummy.Quality := SynDefaultFontQuality;
   FLastSetFontSize := fFontDummy.Height;
-  fLastMouseCaret := Point(-1,-1);
+  FLastMouseLocation.LastMouseCaret := Point(-1,-1);
-  FLastMousePoint := Point(-1,-1);
+  FLastMouseLocation.LastMousePoint := Point(-1,-1);
   fBlockIndent := 2;
 
   FTextArea := TLazSynTextArea.Create(Self, FTextDrawer);
@@ -2525,6 +2542,7 @@ begin
   FreeAndNil(FKeyUpEventList);
   FreeAndNil(FMouseDownEventList);
   FreeAndNil(FKeyPressEventList);
+  FreeAndNil(FQueryMouseCursorList);
   FreeAndNil(FUtf8KeyPressEventList);
   inherited Destroy;
 end;
@@ -3592,7 +3610,7 @@ begin
   if (sfRightGutterClick in fStateFlags) then
     FRightGutter.MouseMove(Shift, X, Y);
 
-  FLastMousePoint := Point(X,Y);
+  FLastMouseLocation.LastMousePoint := Point(X,Y);
   LastMouseCaret := PixelsToRowColumn(Point(X,Y)); // TODO: Used for ctrl-Link => Use LastMousePoint, and calculate only, if modifier is down
   UpdateCursor;
 
@@ -4223,6 +4241,15 @@ begin
   FScreenCaret.SetCaretTypeSize(AType, AWidth, AHeight, AXOffs, AYOffs);
 end;
 
+procedure TCustomSynEdit.UpdateCursorOverride;
+var
+  c: TCursor;
+begin
+  c := crDefault;
+  TSynQueryMouseCursorList(FQueryMouseCursorList).CallScrollEventHandlers(Self, FLastMouseLocation, c);
+  FOverrideCursor := c;
+end;
+
 procedure TCustomSynEdit.PasteFromClipboard;
 var
   ClipHelper: TSynClipboardStream;
@@ -5426,14 +5453,13 @@ begin
     exit;
   end;
 
-  if (FLastMousePoint.X >= FTextArea.Bounds.Left) and (FLastMousePoint.X <  FTextArea.Bounds.Right) and
+  if (FOverrideCursor <> crDefault) then
-     (FLastMousePoint.Y >= FTextArea.Bounds.Top) and (FLastMousePoint.Y < FTextArea.Bounds.Bottom)
+    inherited Cursor := FOverrideCursor
-  then begin
+  else
-    if Assigned(FMarkupCtrlMouse) and (FMarkupCtrlMouse.Cursor <> crDefault) then
+  if (FLastMouseLocation.LastMousePoint.X >= FTextArea.Bounds.Left) and (FLastMouseLocation.LastMousePoint.X <  FTextArea.Bounds.Right) and
-      inherited Cursor := FMarkupCtrlMouse.Cursor
+     (FLastMouseLocation.LastMousePoint.Y >= FTextArea.Bounds.Top) and (FLastMouseLocation.LastMousePoint.Y < FTextArea.Bounds.Bottom)
-    else
+  then
-      inherited Cursor := FTextCursor;
+    inherited Cursor := FTextCursor
-  end
   else
     inherited Cursor := FOffTextCursor;
 end;
@@ -6381,8 +6407,8 @@ end;
 
 procedure TCustomSynEdit.SetLastMouseCaret(const AValue: TPoint);
 begin
-  if (FLastMouseCaret.X=AValue.X) and (FLastMouseCaret.Y=AValue.Y) then exit;
+  if (FLastMouseLocation.LastMouseCaret.X=AValue.X) and (FLastMouseLocation.LastMouseCaret.Y=AValue.Y) then exit;
-  FLastMouseCaret:=AValue;
+  FLastMouseLocation.LastMouseCaret:=AValue;
   if assigned(fMarkupCtrlMouse) then
     fMarkupCtrlMouse.LastMouseCaret := AValue;
   UpdateCursor;
@@ -9206,6 +9232,19 @@ begin
     FMouseDownEventList.Remove(TMethod(AHandlerProc));
 end;
 
+procedure TCustomSynEdit.RegisterQueryMouseCursorHandler(AHandlerProc: TSynQueryMouseCursorEvent);
+begin
+  if FQueryMouseCursorList = nil then
+    FQueryMouseCursorList := TSynQueryMouseCursorList.Create;
+  TSynQueryMouseCursorList(FQueryMouseCursorList).Add(AHandlerProc);
+end;
+
+procedure TCustomSynEdit.UnregisterQueryMouseCursorHandler(AHandlerProc: TSynQueryMouseCursorEvent);
+begin
+  if FQueryMouseCursorList <> nil then
+    TSynQueryMouseCursorList(FQueryMouseCursorList).Remove(AHandlerProc);
+end;
+
 procedure TCustomSynEdit.RegisterBeforeKeyDownHandler(AHandlerProc: TKeyEvent);
 begin
   if FKeyDownEventList = nil then
@@ -9725,6 +9764,31 @@ begin
     TSynScrollEventProc(FItems[i].FHandler)(Sender, AnEvent, dx, dy, rcScroll, rcClip);
 end;
 
+{ TSynQueryMouseCursorList }
+
+procedure TSynQueryMouseCursorList.Add(AHandler: TSynQueryMouseCursorEvent);
+begin
+  inherited Add(TMethod(AHandler));
+end;
+
+procedure TSynQueryMouseCursorList.Remove(AHandler: TSynQueryMouseCursorEvent);
+begin
+  inherited Remove(TMethod(AHandler));
+end;
+
+procedure TSynQueryMouseCursorList.CallScrollEventHandlers(Sender: TObject;
+  const AMouseLocation: TSynMouseLocationInfo; var AnCursor: TCursor);
+var
+  i, p: Integer;
+  c: TObject;
+begin
+  p := 0;
+  c := nil;
+  i:=Count;
+  while NextDownIndex(i) do
+    TSynQueryMouseCursorEvent(Items[i])(Sender, AMouseLocation, AnCursor, p, c);
+end;
+
 { TSynEditMarkListInternal }
 
 function TSynEditMarkListInternal.GetLinesView: TSynEditStrings;

components/synedit/syneditmarkupctrlmouselink.pp

@@ -27,7 +27,7 @@ interface
 
 uses
   Classes, SysUtils, Graphics, SynEditMarkup, SynEditMiscClasses,
-  SynEditMouseCmds, LazSynEditText, Controls, LCLProc;
+  SynEditMouseCmds, LazSynEditText, SynEditTypes, Controls, LCLProc;
 
 type
 
@@ -45,10 +45,13 @@ type
     FLastMouseCaret: TPoint;
     FLastMouseCaretLogical: TPoint;
     function GetIsMouseOverLink: Boolean;
+    procedure SetCursor(AValue: TCursor);
     procedure SetLastMouseCaret(const AValue: TPoint);
     Procedure LinesChanged(Sender: TSynEditStrings; AIndex, ANewCount, AOldCount : Integer);
     function  IsCtrlMouseShiftState(AShift: TShiftState; OnlyShowLink: Boolean): Boolean;
     procedure InternalUpdateCtrlMouse;
+    procedure UpdateSynCursor(Sender: TObject; const AMouseLocation: TSynMouseLocationInfo;
+    var AnCursor: TCursor; var APriority: Integer; var AChangedBy: TObject);
   protected
     procedure SetLines(const AValue : TSynEditStrings); override;
     procedure DoMarkupChanged(AMarkup: TSynSelectedColor); override;
@@ -79,6 +82,9 @@ type
 implementation
 uses SynEdit;
 
+const
+  LINK_CURSOR_PRIORITY = 1;
+
 { TSynEditMarkupCtrlMouseLink }
 
 procedure TSynEditMarkupCtrlMouseLink.SetLastMouseCaret(const AValue: TPoint);
@@ -106,6 +112,13 @@ begin
   Result := FCtrlLinkable and (FCtrlMouseLine >= 0);
 end;
 
+procedure TSynEditMarkupCtrlMouseLink.SetCursor(AValue: TCursor);
+begin
+  if FCursor = AValue then Exit;
+  FCursor := AValue;
+  TCustomSynEdit(SynEdit).UpdateCursorOverride;
+end;
+
 procedure TSynEditMarkupCtrlMouseLink.LinesChanged(Sender: TSynEditStrings; AIndex, ANewCount,
   AOldCount: Integer);
 begin
@@ -137,7 +150,7 @@ procedure TSynEditMarkupCtrlMouseLink.InternalUpdateCtrlMouse;
   begin
     if FCtrlMouseLine >= 0 then
       InvalidateSynLines(FCtrlMouseLine, FCtrlMouseLine);
-    FCursor := crDefault;
+    SetCursor(crDefault);
     CtrlMouseLine:=-1;
     FCtrlLinkable := False;
   end;
@@ -162,13 +175,23 @@ begin
     CtrlMouseX2 := NewX2;
     InvalidateSynLines(FCtrlMouseLine, FCtrlMouseLine);
     if FCtrlLinkable then
-      FCursor := crHandPoint
+      SetCursor(crHandPoint)
     else
       doNotShowLink;
   end else
     doNotShowLink;
 end;
 
+procedure TSynEditMarkupCtrlMouseLink.UpdateSynCursor(Sender: TObject;
+  const AMouseLocation: TSynMouseLocationInfo; var AnCursor: TCursor; var APriority: Integer;
+  var AChangedBy: TObject);
+begin
+  if (Cursor = crDefault) or (APriority > LINK_CURSOR_PRIORITY) then exit;
+  AnCursor := Cursor;
+  APriority := LINK_CURSOR_PRIORITY;
+  AChangedBy := Self;
+end;
+
 function TSynEditMarkupCtrlMouseLink.IsCtrlMouseShiftState(AShift: TShiftState;
   OnlyShowLink: Boolean): Boolean;
 var
@@ -224,10 +247,13 @@ begin
   MarkupInfo.StyleMask := [];
   MarkupInfo.Foreground := clBlue; {TODO:  invert blue to bg .... see below}
   MarkupInfo.Background := clNone;
+
+  TCustomSynEdit(SynEdit).RegisterQueryMouseCursorHandler(@UpdateSynCursor);
 end;
 
 destructor TSynEditMarkupCtrlMouseLink.Destroy;
 begin
+  TCustomSynEdit(SynEdit).UnregisterQueryMouseCursorHandler(@UpdateSynCursor);
   if Lines <> nil then begin;
     Lines.RemoveModifiedHandler(senrLinesModified, @LinesChanged);
   end;

components/synedit/synedittypes.pp

@@ -41,7 +41,7 @@ unit SynEditTypes;
 
 interface
 uses
-  SysUtils, types;
+  SysUtils, types, Controls;
 
 const
   TSynSpecialChars = [#128..#255]; // MG: special chars. Meaning depends on system encoding/codepage.
@@ -116,7 +116,15 @@ type
     dx, dy: Integer; const rcScroll, rcClip: TRect
   ) of object;
 
-  TSynVisibleSpecialChar = (vscSpace, vscTabAtFirst, vscTabAtLast);
+  TSynMouseLocationInfo = record
+    LastMouseCaret: TPoint;  // Char; physical (screen)
+    LastMousePoint: TPoint;  // Pixel
+  end;
+
+  TSynQueryMouseCursorEvent = procedure(Sender: TObject; const AMouseLocation: TSynMouseLocationInfo;
+    var AnCursor: TCursor; var APriority: Integer; var AChangedBy: TObject) of object;
+
+TSynVisibleSpecialChar = (vscSpace, vscTabAtFirst, vscTabAtLast);
   TSynVisibleSpecialChars = set of TSynVisibleSpecialChar;
 
   TSynLineStyle = (