1{-------------------------------------------------------------------------------
2The contents of this file are subject to the Mozilla Public License
3Version 1.1 (the "License"); you may not use this file except in compliance
4with the License. You may obtain a copy of the License at
5http://www.mozilla.org/MPL/
6
7Software distributed under the License is distributed on an "AS IS" basis,
8WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
9the specific language governing rights and limitations under the License.
10
11Alternatively, the contents of this file may be used under the terms of the
12GNU General Public License Version 2 or later (the "GPL"), in which case
13the provisions of the GPL are applicable instead of those above.
14If you wish to allow use of your version of this file only under the terms
15of the GPL and not to allow others to use your version of this file
16under the MPL, indicate your decision by deleting the provisions above and
17replace them with the notice and other provisions required by the GPL.
18If you do not delete the provisions above, a recipient may use your version
19of this file under either the MPL or the GPL.
20
21-------------------------------------------------------------------------------}
22unit SynEditMarkupCtrlMouseLink;
23
24{$mode objfpc}{$H+}
25
26interface
27
28uses
29  Classes, SysUtils, Graphics, SynEditMarkup, SynEditMiscClasses,
30  SynEditMouseCmds, LazSynEditText, SynEditTypes, Controls, LCLProc;
31
32type
33
34  { TSynEditMarkupCtrlMouseLink }
35
36  TSynEditMarkupCtrlMouseLink = class(TSynEditMarkup)
37  private
38    FCtrlMouseLine: Integer;
39    FCtrlMouseX1: Integer;
40    FCtrlMouseX2: Integer;
41    FCtrlLinkable: Boolean;
42    FCursor: TCursor;
43
44    FLastControlIsPressed: boolean;
45    FLastMouseCaret: TPoint;
46    FLastMouseCaretLogical: TPoint;
47    function GetIsMouseOverLink: Boolean;
48    procedure SetCursor(AValue: TCursor);
49    procedure SetLastMouseCaret(const AValue: TPoint);
50    Procedure LinesChanged(Sender: TSynEditStrings; AIndex, ANewCount, AOldCount : Integer);
51    function  IsCtrlMouseShiftState(AShift: TShiftState; OnlyShowLink: Boolean): Boolean;
52    procedure InternalUpdateCtrlMouse;
53    procedure UpdateSynCursor(Sender: TObject; const AMouseLocation: TSynMouseLocationInfo;
54    var AnCursor: TCursor; var APriority: Integer; var AChangedBy: TObject);
55  protected
56    procedure SetLines(const AValue : TSynEditStringsLinked); override;
57    procedure DoMarkupChanged(AMarkup: TSynSelectedColor); override;
58    procedure DoEnabledChanged(Sender: TObject); override;
59  public
60    procedure UpdateCtrlState(aShift: TShiftState);
61    procedure UpdateCtrlMouse;
62    property LastMouseCaret: TPoint read FLastMouseCaret write SetLastMouseCaret;
63  public
64    constructor Create(ASynEdit: TSynEditBase);
65    destructor Destroy; override;
66
67    function GetMarkupAttributeAtRowCol(const aRow: Integer;
68                                        const aStartCol: TLazSynDisplayTokenBound;
69                                        const AnRtlInfo: TLazSynDisplayRtlInfo): TSynSelectedColor; override;
70    procedure GetNextMarkupColAfterRowCol(const aRow: Integer;
71                                         const aStartCol: TLazSynDisplayTokenBound;
72                                         const AnRtlInfo: TLazSynDisplayRtlInfo;
73                                         out   ANextPhys, ANextLog: Integer); override;
74
75    property CtrlMouseLine : Integer read FCtrlMouseLine write FCtrlMouseLine;
76    property CtrlMouseX1 : Integer read FCtrlMouseX1 write FCtrlMouseX1;
77    property CtrlMouseX2 : Integer read FCtrlMouseX2 write FCtrlMouseX2;
78    property IsMouseOverLink: Boolean read GetIsMouseOverLink;
79    property Cursor: TCursor read FCursor;
80  end;
81
82implementation
83
84const
85  LINK_CURSOR_PRIORITY = 1;
86
87{ TSynEditMarkupCtrlMouseLink }
88
89procedure TSynEditMarkupCtrlMouseLink.SetLastMouseCaret(const AValue: TPoint);
90begin
91  if (FLastMouseCaret.X = AValue.X) and (FLastMouseCaret.Y = AValue.Y) then exit;
92  FLastMouseCaret := AValue;
93  if LastMouseCaret.y > 0
94  then FLastMouseCaretLogical := Lines.PhysicalToLogicalPos(LastMouseCaret)
95  else FLastMouseCaretLogical := LastMouseCaret;
96  UpdateCtrlMouse;
97end;
98
99function TSynEditMarkupCtrlMouseLink.GetIsMouseOverLink: Boolean;
100var
101  NewCtrlIsPressed: Boolean;
102begin
103  // Normal checks only take Ctrl-State for ShowLink into account (since the cursor needs updates)
104  // Here we need to check for Hiden-Links too
105  NewCtrlIsPressed := IsCtrlMouseShiftState(GetKeyShiftState, False);
106  if FLastControlIsPressed <> NewCtrlIsPressed then begin
107    FLastControlIsPressed := NewCtrlIsPressed;
108    InternalUpdateCtrlMouse;
109  end;
110
111  Result := FCtrlLinkable and (FCtrlMouseLine >= 0);
112end;
113
114procedure TSynEditMarkupCtrlMouseLink.SetCursor(AValue: TCursor);
115begin
116  if FCursor = AValue then Exit;
117  FCursor := AValue;
118  SynEdit.UpdateCursorOverride;
119end;
120
121procedure TSynEditMarkupCtrlMouseLink.LinesChanged(Sender: TSynEditStrings; AIndex, ANewCount,
122  AOldCount: Integer);
123begin
124  If LastMouseCaret.Y < 0 then exit;
125  LastMouseCaret := Point(-1, -1);
126  UpdateCtrlMouse;
127end;
128
129procedure TSynEditMarkupCtrlMouseLink.UpdateCtrlState(aShift: TShiftState);
130var
131  NewCtrlIsPressed: Boolean;
132begin
133  NewCtrlIsPressed := IsCtrlMouseShiftState(aShift, True);
134  if FLastControlIsPressed <> NewCtrlIsPressed then begin
135    FLastControlIsPressed := NewCtrlIsPressed;
136    InternalUpdateCtrlMouse;
137  end;
138end;
139
140procedure TSynEditMarkupCtrlMouseLink.UpdateCtrlMouse;
141begin
142  FLastControlIsPressed := IsCtrlMouseShiftState(GetKeyShiftState, True);
143  InternalUpdateCtrlMouse;
144end;
145
146procedure TSynEditMarkupCtrlMouseLink.InternalUpdateCtrlMouse;
147
148  procedure doNotShowLink;
149  begin
150    if FCtrlMouseLine >= 0 then
151      InvalidateSynLines(FCtrlMouseLine, FCtrlMouseLine);
152    SetCursor(crDefault);
153    CtrlMouseLine:=-1;
154    FCtrlLinkable := False;
155  end;
156
157var
158  NewY, NewX1, NewX2: Integer;
159begin
160  if FLastControlIsPressed and (LastMouseCaret.X>0) and (LastMouseCaret.Y>0) then begin
161    // show link
162    NewY := LastMouseCaret.Y;
163    SynEdit.GetWordBoundsAtRowCol(FLastMouseCaretLogical,NewX1,NewX2);
164    if (NewY = CtrlMouseLine) and
165       (NewX1 = CtrlMouseX1) and
166       (NewX2 = CtrlMouseX2)
167    then
168      exit;
169    if (FCtrlMouseLine >= 0) and (FCtrlMouseLine <> NewY) then
170      InvalidateSynLines(FCtrlMouseLine, FCtrlMouseLine);
171    FCtrlLinkable := SynEdit.IsLinkable(NewY, NewX1, NewX2);
172    CtrlMouseLine := fLastMouseCaret.Y;
173    CtrlMouseX1 := NewX1;
174    CtrlMouseX2 := NewX2;
175    InvalidateSynLines(FCtrlMouseLine, FCtrlMouseLine);
176    if FCtrlLinkable then
177      SetCursor(crHandPoint)
178    else
179      doNotShowLink;
180  end else
181    doNotShowLink;
182end;
183
184procedure TSynEditMarkupCtrlMouseLink.UpdateSynCursor(Sender: TObject;
185  const AMouseLocation: TSynMouseLocationInfo; var AnCursor: TCursor; var APriority: Integer;
186  var AChangedBy: TObject);
187begin
188  if (Cursor = crDefault) or (APriority > LINK_CURSOR_PRIORITY) then exit;
189  AnCursor := Cursor;
190  APriority := LINK_CURSOR_PRIORITY;
191  AChangedBy := Self;
192end;
193
194function TSynEditMarkupCtrlMouseLink.IsCtrlMouseShiftState(AShift: TShiftState;
195  OnlyShowLink: Boolean): Boolean;
196var
197  act: TSynEditMouseAction;
198  i: Integer;
199begin
200  Result := False;
201
202  if not (emUseMouseActions in SynEdit.MouseOptions) then begin
203    Result := (emShowCtrlMouseLinks in SynEdit.MouseOptions) and
204              (AShift * ([ssShift, ssCtrl, ssAlt] + [SYNEDIT_LINK_MODIFIER]) = [SYNEDIT_LINK_MODIFIER]);
205    exit;
206  end;
207
208  // todo: check FMouseSelActions if over selection?
209  for i := 0 to SynEdit.MouseActions.Count - 1 do begin
210    act := SynEdit.MouseActions.Items[i];
211    if (act.Command = emcMouseLink) and
212       ( (act.Option = emcoMouseLinkShow) or (not OnlyShowLink) ) and
213       act.IsMatchingShiftState(AShift)
214    then
215      exit(True);
216  end;
217
218  for i := 0 to SynEdit.MouseTextActions.Count - 1 do begin
219    act := SynEdit.MouseTextActions.Items[i];
220    if (act.Command = emcMouseLink) and
221       ( (act.Option = emcoMouseLinkShow) or (not OnlyShowLink) ) and
222       act.IsMatchingShiftState(AShift)
223    then
224      exit(True);
225  end;
226
227  if not SynEdit.SelAvail then exit;
228
229  for i := 0 to SynEdit.MouseSelActions.Count - 1 do begin
230    act := SynEdit.MouseSelActions.Items[i];
231    if (act.Command = emcMouseLink) and
232       ( (act.Option = emcoMouseLinkShow) or (not OnlyShowLink) ) and
233       act.IsMatchingShiftState(AShift)
234    then
235      exit(True);
236  end;
237end;
238
239constructor TSynEditMarkupCtrlMouseLink.Create(ASynEdit: TSynEditBase);
240begin
241  inherited Create(ASynEdit);
242  FLastControlIsPressed := false;
243  FCtrlMouseLine:=-1;
244  FCtrlLinkable := False;
245  MarkupInfo.Style := [];
246  MarkupInfo.StyleMask := [];
247  MarkupInfo.Foreground := clBlue; {TODO:  invert blue to bg .... see below}
248  MarkupInfo.Background := clNone;
249
250  SynEdit.RegisterQueryMouseCursorHandler(@UpdateSynCursor);
251end;
252
253destructor TSynEditMarkupCtrlMouseLink.Destroy;
254begin
255  SynEdit.UnregisterQueryMouseCursorHandler(@UpdateSynCursor);
256  if Lines <> nil then begin;
257    Lines.RemoveModifiedHandler(senrLinesModified, @LinesChanged);
258  end;
259  inherited Destroy;
260end;
261
262procedure TSynEditMarkupCtrlMouseLink.SetLines(
263  const AValue: TSynEditStringsLinked);
264begin
265  inherited SetLines(AValue);
266  if Lines <> nil then begin;
267    Lines.AddModifiedHandler(senrLinesModified, @LinesChanged);
268  end;
269end;
270
271procedure TSynEditMarkupCtrlMouseLink.DoMarkupChanged(AMarkup: TSynSelectedColor
272  );
273begin
274  inherited DoMarkupChanged(AMarkup);
275  if FCtrlMouseLine >= 0 then
276    InvalidateSynLines(FCtrlMouseLine, FCtrlMouseLine);
277end;
278
279procedure TSynEditMarkupCtrlMouseLink.DoEnabledChanged(Sender: TObject);
280begin
281  inherited DoEnabledChanged(Sender);
282  if FCtrlMouseLine >= 0 then
283    InvalidateSynLines(FCtrlMouseLine, FCtrlMouseLine);
284end;
285
286function TSynEditMarkupCtrlMouseLink.GetMarkupAttributeAtRowCol(const aRow: Integer;
287  const aStartCol: TLazSynDisplayTokenBound; const AnRtlInfo: TLazSynDisplayRtlInfo): TSynSelectedColor;
288begin
289  Result := nil;
290  if (not FCtrlLinkable) or (aRow <> FCtrlMouseLine) or
291     ((aStartCol.Logical < CtrlMouseX1) or (aStartCol.Logical >= CtrlMouseX2))
292  then exit;
293  Result := MarkupInfo;
294  MarkupInfo.SetFrameBoundsLog(CtrlMouseX1, CtrlMouseX2);
295end;
296
297procedure TSynEditMarkupCtrlMouseLink.GetNextMarkupColAfterRowCol(const aRow: Integer;
298  const aStartCol: TLazSynDisplayTokenBound; const AnRtlInfo: TLazSynDisplayRtlInfo; out ANextPhys,
299  ANextLog: Integer);
300begin
301  ANextLog := -1;
302  ANextPhys := -1;
303  if FCtrlMouseLine <> aRow
304  then exit;
305
306  if aStartCol.Logical < CtrlMouseX1
307  then ANextLog := CtrlMouseX1;
308  if (aStartCol.Logical < CtrlMouseX2) and (aStartCol.Logical >= CtrlMouseX1)
309  then ANextLog := CtrlMouseX2;
310end;
311
312end.
313
314