1unit LazSynTextArea;
2
3{$mode objfpc}{$H+}
4{$INLINE OFF}
5
6interface
7
8uses
9  Classes, SysUtils,
10  // LCL
11  Graphics, Controls, LCLType, LCLIntf, LCLProc,
12  // LazUtils
13  LazMethodList,
14  // SynEdit
15  SynEditTypes, SynEditMiscProcs, SynEditMiscClasses, LazSynEditText,
16  SynEditMarkup, SynEditHighlighter, SynTextDrawer;
17
18
19type
20  TLazSynDisplayTokenInfoEx = record
21    Tk: TLazSynDisplayTokenInfo;
22    Attr: TSynSelectedColorMergeResult;
23    StartPos: TLazSynDisplayTokenBound;  // Start according to Logical flow. Left for LTR, or Right for RTL
24    EndPos: TLazSynDisplayTokenBound;    // End according to Logical flow.
25    // SreenRect Bounds. Ltr/RTL independent. Start is always left. End Always right
26    PhysicalCharStart: Integer;          // 1 based - Full char bound (Before StartPos.Physical (PaintStart))
27    PhysicalClipStart: Integer;          // 1 based - PaintStart
28    PhysicalCharEnd: Integer;            // 1 based - Full char bound (After EndPos.Physical (PaintEnd))
29    PhysicalClipEnd: Integer;            // 1 based - PaintEnd
30    RtlInfo: TLazSynDisplayRtlInfo;
31    RtlExpandedExtraBytes: Integer;         // tab and space expansion
32    RtlHasTabs: Boolean;
33    RtlHasDoubleWidth: Boolean;
34
35    ExpandedExtraBytes: Integer;         // tab and space expansion
36    HasTabs: Boolean;                    // ExtraWidth may still be 0
37    HasDoubleWidth: Boolean;
38
39    NextPos: TLazSynDisplayTokenBound;   // Next toxen, may be BIDI
40    NextRtlInfo: TLazSynDisplayRtlInfo;
41  end;
42
43  { TLazSynPaintTokenBreaker }
44
45  TLazSynPaintTokenBreaker = class
46  private
47    FBackgroundColor: TColor;
48    FForegroundColor: TColor;
49    FSpaceExtraByteCount: Integer;
50    FTabExtraByteCount: Integer;
51    FFirstCol, FLastCol: integer; // Physical
52
53    FDisplayView: TLazSynDisplayView;
54    FLinesView:  TSynEditStrings;
55    FMarkupManager: TSynEditMarkupManager;
56
57    FCharWidths: TPhysicalCharWidths;
58    FCharWidthsLen: Integer;
59    FCurTxtLineIdx : Integer;
60    FCurLineByteLen: Integer;
61
62    // Fields for GetNextHighlighterTokenFromView
63    // Info about the token (from highlighter)
64    FCurViewToken: TLazSynDisplayTokenInfo;
65    FCurViewCurTokenStartPos: TLazSynDisplayTokenBound; // Start bound of the HL token
66    FCurViewAttr: TSynSelectedColorMergeResult;
67    FWrapEndBound: TLazSynDisplayTokenBound;
68    // Scanner Pos
69    FCurViewScannerPos: TLazSynDisplayTokenBound;  // Start according to Logical flow. Left for LTR, or Right for RTL
70    FCurViewScannerPhysCharPos: Integer;           // 1 based - Full char bound (Before FCurViewScannerPos.Physical (PaintStart))
71    // RTL Run
72    FCurViewinRTL: Boolean;
73    FCurViewRtlPhysStart, FCurViewRtlPhysEnd: integer;
74    FCurViewRtlLogStart,  FCurViewRtlLogEnd: integer;
75    FCurViewRtlExpExtraBytes: Integer;         // tab and space expansion for entire RTL run
76    FCurViewRtlHasTabs: Boolean;
77    FCurViewRtlHasDoubleWidth: Boolean;
78
79    FNextMarkupPhysPos, FNextMarkupLogPos: Integer;
80    FCurMarkupNextStart: TLazSynDisplayTokenBound;
81    FCurMarkupNextRtlInfo: TLazSynDisplayRtlInfo;
82    FCurMarkupState: (cmPreInit, cmLine, cmPastEOL, cmPastWrapEnd);
83    FMarkupTokenAttr: TSynSelectedColorMergeResult;
84    procedure InitCurMarkup;
85  public
86    constructor Create;
87    destructor Destroy; override;
88    procedure Prepare(ADisplayView: TLazSynDisplayView; ALinesView:  TSynEditStrings;
89                      AMarkupManager: TSynEditMarkupManager;
90                      AFirstCol, ALastCol: integer
91                     );
92    procedure SetHighlighterTokensLine(ALine: TLineIdx; out ARealLine: TLineIdx);
93    function  GetNextHighlighterTokenFromView(out ATokenInfo: TLazSynDisplayTokenInfoEx;
94                                              APhysEnd: Integer = -1;
95                                              ALogEnd: Integer = -1
96                                             ): Boolean;
97    function  GetNextHighlighterTokenEx(out ATokenInfo: TLazSynDisplayTokenInfoEx): Boolean;
98    property  CharWidths: TPhysicalCharWidths read FCharWidths;
99    property ForegroundColor: TColor read FForegroundColor write FForegroundColor;
100    property BackgroundColor: TColor read FBackgroundColor write FBackgroundColor;
101    property SpaceExtraByteCount: Integer read FSpaceExtraByteCount write FSpaceExtraByteCount;
102    property TabExtraByteCount: Integer read FTabExtraByteCount write FTabExtraByteCount;
103  end;
104
105  { TLazSynTextArea }
106
107  TLazSynTextArea = class(TLazSynSurface)
108  private
109    FCharsInWindow: Integer;
110    FCharWidth: integer;
111    FLinesInWindow: Integer;
112    fOnStatusChange: TStatusChangeEvent;
113    FTextSizeChangeList: TMethodList;
114    FTextHeight: integer;
115
116    FCanvas: TCanvas;
117    FTextDrawer: TheTextDrawer;
118    FEtoBuf: TEtoBuffer;
119    FTheLinesView: TSynEditStrings;
120    FHighlighter: TSynCustomHighlighter;
121    FMarkupManager: TSynEditMarkupManager;
122    FTokenBreaker: TLazSynPaintTokenBreaker;
123    FPaintLineColor, FPaintLineColor2: TSynSelectedColor;
124    FForegroundColor: TColor;
125    FBackgroundColor: TColor;
126    FRightEdgeColor: TColor;
127
128    FTextBounds: TRect;
129    FPadding: array [TLazSynBorderSide] of Integer;
130    FExtraCharSpacing: integer;
131    FExtraLineSpacing, FCurrentExtraLineSpacing: integer;
132    FVisibleSpecialChars: TSynVisibleSpecialChars;
133    FRightEdgeColumn: integer;
134    FRightEdgeVisible: boolean;
135
136    FTopLine: TLinePos;
137    FLeftChar: Integer;
138
139    function GetExtraCharSpacing: integer;
140    function GetPadding(Side: TLazSynBorderSide): integer;
141    procedure SetExtraCharSpacing(AValue: integer);
142    procedure SetExtraLineSpacing(AValue: integer);
143    procedure SetLeftChar(AValue: Integer);
144    procedure SetPadding(Side: TLazSynBorderSide; AValue: integer);
145    procedure SetTopLine(AValue: TLinePos);
146    procedure DoDrawerFontChanged(Sender: TObject);
147  protected
148    procedure BoundsChanged; override;
149    procedure DoPaint(ACanvas: TCanvas; AClip: TRect); override;
150    procedure PaintTextLines(AClip: TRect; FirstLine, LastLine,
151      FirstCol, LastCol: integer); virtual;
152    property Canvas: TCanvas read FCanvas;
153  public
154    constructor Create(AOwner: TWinControl; ATextDrawer: TheTextDrawer);
155    destructor Destroy; override;
156    procedure Assign(Src: TLazSynSurface); override;
157    procedure InvalidateLines(FirstTextLine, LastTextLine: TLineIdx); override;
158
159    function ScreenColumnToXValue(Col: integer): integer;  // map screen column to screen pixel
160    function RowColumnToPixels(const RowCol: TPoint): TPoint;
161    function PixelsToRowColumn(Pixels: TPoint; aFlags: TSynCoordinateMappingFlags): TPoint; // ignores scmLimitToLines
162
163    procedure FontChanged;
164    procedure AddTextSizeChangeHandler(AHandler: TNotifyEvent);
165    procedure RemoveTextSizeChangeHandler(AHandler: TNotifyEvent);
166
167    // Settings controlled by SynEdit
168    property Padding[Side: TLazSynBorderSide]: integer read GetPadding write SetPadding;
169    property ForegroundColor: TColor read FForegroundColor write FForegroundColor;
170    property BackgroundColor: TColor read FBackgroundColor write FBackgroundColor;
171    property ExtraCharSpacing: integer read GetExtraCharSpacing write SetExtraCharSpacing;
172    property ExtraLineSpacing: integer read FCurrentExtraLineSpacing write SetExtraLineSpacing;
173    property VisibleSpecialChars: TSynVisibleSpecialChars read FVisibleSpecialChars write FVisibleSpecialChars;
174    property RightEdgeColumn: integer  read FRightEdgeColumn write FRightEdgeColumn;
175    property RightEdgeVisible: boolean read FRightEdgeVisible write FRightEdgeVisible;
176    property RightEdgeColor: TColor    read FRightEdgeColor write FRightEdgeColor;
177
178    property TopLine: TLinePos read FTopLine write SetTopLine; // TopView
179    property LeftChar: Integer read FLeftChar write SetLeftChar;
180
181    property TheLinesView:  TSynEditStrings       read FTheLinesView  write FTheLinesView;
182    property Highlighter:   TSynCustomHighlighter read FHighlighter   write FHighlighter;
183    property MarkupManager: TSynEditMarkupManager read FMarkupManager write FMarkupManager;
184    property TextDrawer: TheTextDrawer read FTextDrawer;
185  public
186    property TextBounds: TRect read FTextBounds;
187
188    property LineHeight: integer read FTextHeight;
189    property CharWidth: integer  read FCharWidth;
190    property LinesInWindow: Integer read FLinesInWindow;
191    property CharsInWindow: Integer read FCharsInWindow;
192    property OnStatusChange: TStatusChangeEvent read fOnStatusChange write fOnStatusChange;
193  end;
194
195  { TLazSynSurfaceWithText }
196
197  TLazSynSurfaceWithText = class(TLazSynSurface)
198  private
199    FTextArea: TLazSynTextArea;
200  protected
201    procedure SetTextArea(AValue: TLazSynTextArea); virtual;
202    function GetTextArea: TLazSynTextArea; virtual;
203  public
204    procedure Assign(Src: TLazSynSurface); override;
205    property TextArea: TLazSynTextArea read GetTextArea write SetTextArea;
206  end;
207
208  { TLazSynSurfaceManager }
209
210  TLazSynSurfaceManager = class(TLazSynSurfaceWithText)
211  private
212    FLeftGutterArea: TLazSynSurfaceWithText;
213    FLeftGutterWidth: integer;
214    FRightGutterArea: TLazSynSurfaceWithText;
215    FRightGutterWidth: integer;
216    procedure SetLeftGutterArea(AValue: TLazSynSurfaceWithText);
217    procedure SetLeftGutterWidth(AValue: integer);
218    procedure SetRightGutterArea(AValue: TLazSynSurfaceWithText);
219    procedure SetRightGutterWidth(AValue: integer);
220  protected
221    function GetLeftGutterArea: TLazSynSurfaceWithText; virtual;
222    function GetRightGutterArea: TLazSynSurfaceWithText; virtual;
223    procedure SetTextArea(AValue: TLazSynTextArea); override;
224    function  GetTextArea: TLazSynTextArea; override;
225  protected
226    procedure SetBackgroundColor(AValue: TColor); virtual;
227    procedure SetExtraCharSpacing(AValue: integer); virtual;
228    procedure SetExtraLineSpacing(AValue: integer); virtual;
229    procedure SetForegroundColor(AValue: TColor); virtual;
230    procedure SetPadding(Side: TLazSynBorderSide; AValue: integer); virtual;
231    procedure SetRightEdgeColor(AValue: TColor); virtual;
232    procedure SetRightEdgeColumn(AValue: integer); virtual;
233    procedure SetRightEdgeVisible(AValue: boolean); virtual;
234    procedure SetVisibleSpecialChars(AValue: TSynVisibleSpecialChars); virtual;
235    procedure SetHighlighter(AValue: TSynCustomHighlighter); virtual;
236  protected
237    procedure DoPaint(ACanvas: TCanvas; AClip: TRect); override;
238    procedure DoDisplayViewChanged; override;
239    procedure BoundsChanged; override;
240  public
241    constructor Create(AOwner: TWinControl);
242    procedure InvalidateLines(FirstTextLine, LastTextLine: TLineIdx); override;
243    procedure InvalidateTextLines(FirstTextLine, LastTextLine: TLineIdx); virtual;
244    procedure InvalidateGutterLines(FirstTextLine, LastTextLine: TLineIdx); virtual;
245
246    property LeftGutterArea:  TLazSynSurfaceWithText read GetLeftGutterArea  write SetLeftGutterArea;
247    property RightGutterArea: TLazSynSurfaceWithText read GetRightGutterArea write SetRightGutterArea;
248    property LeftGutterWidth:  integer read FLeftGutterWidth  write SetLeftGutterWidth;
249    property RightGutterWidth: integer read FRightGutterWidth write SetRightGutterWidth;
250  public
251    // Settings forwarded to textarea
252    property Padding[Side: TLazSynBorderSide]: integer write SetPadding;
253    property ForegroundColor: TColor   write SetForegroundColor;
254    property BackgroundColor: TColor   write SetBackgroundColor;
255    property ExtraCharSpacing: integer write SetExtraCharSpacing;
256    property ExtraLineSpacing: integer write SetExtraLineSpacing;
257    property VisibleSpecialChars: TSynVisibleSpecialChars write SetVisibleSpecialChars;
258    property RightEdgeColumn: integer  write SetRightEdgeColumn;
259    property RightEdgeVisible: boolean write SetRightEdgeVisible;
260    property RightEdgeColor: TColor    write SetRightEdgeColor;
261    property Highlighter:   TSynCustomHighlighter write SetHighlighter;
262  end;
263
264
265implementation
266
267{ TLazSynPaintTokenBreaker }
268
269procedure TLazSynPaintTokenBreaker.InitCurMarkup;
270var
271  TmpTokenInfo: TLazSynDisplayTokenInfoEx;
272begin
273  FCurMarkupState := cmLine;
274
275  if GetNextHighlighterTokenFromView(TmpTokenInfo, -1, 1) then begin
276    FCurMarkupNextStart   := TmpTokenInfo.NextPos;
277    FCurMarkupNextRtlInfo := TmpTokenInfo.NextRtlInfo;
278  end else begin
279    // past eol
280    FCurMarkupNextStart          := TmpTokenInfo.StartPos;
281    FCurMarkupNextStart.Logical  := FCurMarkupNextStart.Logical + (FFirstCol - FCurMarkupNextStart.Physical);
282    FCurMarkupNextStart.Physical := FFirstCol;
283    FCurMarkupNextRtlInfo.IsRtl  := False;
284  end;
285end;
286
287constructor TLazSynPaintTokenBreaker.Create;
288begin
289  FCurViewAttr := TSynSelectedColorMergeResult.Create;
290  FMarkupTokenAttr := TSynSelectedColorMergeResult.Create;
291  FTabExtraByteCount := 0;
292  FSpaceExtraByteCount := 0;
293end;
294
295destructor TLazSynPaintTokenBreaker.Destroy;
296begin
297  FreeAndNil(FCurViewAttr);
298  FreeAndNil(FMarkupTokenAttr);
299  inherited Destroy;
300end;
301
302procedure TLazSynPaintTokenBreaker.Prepare(ADisplayView: TLazSynDisplayView;
303  ALinesView: TSynEditStrings; AMarkupManager: TSynEditMarkupManager; AFirstCol,
304  ALastCol: integer);
305begin
306  FDisplayView   := ADisplayView;
307  FLinesView     := ALinesView;
308  FMarkupManager := AMarkupManager;
309  FFirstCol      := AFirstCol;
310  FLastCol       := ALastCol;
311end;
312
313procedure TLazSynPaintTokenBreaker.SetHighlighterTokensLine(ALine: TLineIdx; out
314  ARealLine: TLineIdx);
315var
316  LogLeftPos: Integer;
317begin
318  FDisplayView.SetHighlighterTokensLine(ALine, ARealLine, LogLeftPos, FCurLineByteLen);
319  FCharWidths := FLinesView.GetPhysicalCharWidths(ARealLine);
320  FCharWidthsLen := Length(FCharWidths);
321  FCurLineByteLen := FCurLineByteLen + LogLeftPos - 1;
322
323  FCurViewToken.TokenLength     := 0;
324  FCurViewScannerPos.Logical   := LogLeftPos;
325  FCurViewScannerPos.Physical  := 1;
326  FCurViewScannerPos.Offset    := 0;
327  FCurViewScannerPhysCharPos  := 1;
328  FCurViewinRTL := False;
329
330  FNextMarkupPhysPos := -1;
331  FNextMarkupLogPos  := -1;
332  FCurMarkupState      := cmPreInit;
333  FCurTxtLineIdx     := ARealLine;
334end;
335
336function TLazSynPaintTokenBreaker.GetNextHighlighterTokenEx(out
337  ATokenInfo: TLazSynDisplayTokenInfoEx): Boolean;
338const
339  Space = '  ';
340begin
341  if FCurMarkupState = cmPreInit then
342    InitCurMarkup;
343
344  if (FCurLineByteLen < FCharWidthsLen) and (FCurViewScannerPos.Logical > FCurLineByteLen)
345  then begin
346    if FCurMarkupState <> cmPastWrapEnd then begin
347      assert(FCurViewScannerPos.Logical = FCurLineByteLen + 1, 'TLazSynPaintTokenBreaker.GetNextHighlighterTokenEx: FCurViewScannerPos.Logical = FCurLineByteLen + 1');
348      FCurMarkupState := cmPastWrapEnd;
349      FWrapEndBound := FCurViewScannerPos;
350    end;
351  end;
352
353  if (FCurMarkupState = cmPastWrapEnd) then begin
354    FNextMarkupPhysPos := MaxInt;
355    FNextMarkupLogPos := MaxInt;
356  end
357  else
358  if (FNextMarkupPhysPos < 0) or
359     (FCurMarkupNextRtlInfo.IsRtl       and (FNextMarkupPhysPos >= FCurMarkupNextStart.Physical)) or
360     ((not FCurMarkupNextRtlInfo.IsRtl) and (FNextMarkupPhysPos <= FCurMarkupNextStart.Physical)) or
361     (FNextMarkupLogPos < 0) or (FNextMarkupLogPos <= FCurMarkupNextStart.Logical)
362  then begin
363    FMarkupManager.GetNextMarkupColAfterRowCol(FCurTxtLineIdx+1,
364      FCurMarkupNextStart, FCurMarkupNextRtlInfo, FNextMarkupPhysPos, FNextMarkupLogPos);
365
366    if FNextMarkupPhysPos < 1 then
367      if FCurMarkupNextRtlInfo.IsRtl
368      then FNextMarkupPhysPos := 1
369      else FNextMarkupPhysPos := MaxInt;
370    if FNextMarkupLogPos < 1 then
371      FNextMarkupLogPos := MaxInt;
372  end;
373
374  if (FCurMarkupState <> cmPastWrapEnd) and (FCurLineByteLen < FCharWidthsLen) and
375     (FNextMarkupLogPos > FCurLineByteLen + 1)
376  then
377    FNextMarkupLogPos := FCurLineByteLen + 1; // stop at WrapEnd / EOL // tokens should have a bound there anyway
378
379  ATokenInfo.Attr := nil;
380  if FCurMarkupState in [cmPastEOL, cmPastWrapEnd]
381  then Result := False
382  else Result := GetNextHighlighterTokenFromView(ATokenInfo, FNextMarkupPhysPos, FNextMarkupLogPos);
383
384  if not Result then begin
385    // the first run StartPos is set by GetNextHighlighterTokenFromView
386    if FCurMarkupState in [cmPastEOL, cmPastWrapEnd] then begin
387      ATokenInfo.StartPos   := FCurMarkupNextStart
388    end
389    else
390    if FFirstCol > ATokenInfo.StartPos.Physical then begin
391      ATokenInfo.StartPos.Logical := ATokenInfo.StartPos.Logical + (FFirstCol - ATokenInfo.StartPos.Physical);
392      ATokenInfo.StartPos.Physical := FFirstCol;
393    end;
394
395    if (FCurMarkupState <> cmPastWrapEnd) then
396      FCurMarkupState := cmPastEOL;
397
398    Result := (ATokenInfo.StartPos.Physical < FLastCol);
399    if not Result then
400      exit;
401    assert((FNextMarkupPhysPos <= 0) or (FNextMarkupPhysPos > ATokenInfo.StartPos.Physical), 'FNextMarkupPhysPos > ATokenInfo.StartPos.Physical');
402
403    ATokenInfo.Tk.TokenStart      := @Space[1];
404    ATokenInfo.Tk.TokenLength     := 1;
405
406    if FNextMarkupPhysPos > 0
407    then ATokenInfo.EndPos.Physical    := Min(FNextMarkupPhysPos, FLastCol)
408    else ATokenInfo.EndPos.Physical    := FLastCol;
409    ATokenInfo.EndPos.Offset      := 0;
410    ATokenInfo.EndPos.Logical     := ATokenInfo.StartPos.Logical + (ATokenInfo.EndPos.Physical - ATokenInfo.StartPos.Physical);
411
412    if (FNextMarkupLogPos > 0) and (FNextMarkupLogPos < ATokenInfo.EndPos.Logical) then begin
413      ATokenInfo.EndPos.Physical := ATokenInfo.EndPos.Physical - (ATokenInfo.EndPos.Logical - FNextMarkupLogPos);
414      ATokenInfo.EndPos.Logical  := FNextMarkupLogPos;
415    end;
416    assert(ATokenInfo.EndPos.Physical > ATokenInfo.StartPos.Physical, 'ATokenInfo.EndPos.Physical > ATokenInfo.StartPos.Physical');
417    assert(ATokenInfo.EndPos.Logical > ATokenInfo.StartPos.Logical, 'ATokenInfo.EndPos.Logical > ATokenInfo.StartPos.Logical');
418
419    FCurMarkupNextStart := ATokenInfo.EndPos;
420    if FCurMarkupNextRtlInfo.IsRtl then begin
421      FNextMarkupPhysPos := -1;
422      FNextMarkupLogPos  := -1;
423    end;
424    FCurMarkupNextRtlInfo.IsRtl := False;
425
426    ATokenInfo.PhysicalCharStart  := ATokenInfo.StartPos.Physical;
427    ATokenInfo.PhysicalClipStart  := ATokenInfo.StartPos.Physical;
428    ATokenInfo.PhysicalCharEnd    := ATokenInfo.EndPos.Physical;
429    ATokenInfo.PhysicalClipEnd    := ATokenInfo.EndPos.Physical;
430    ATokenInfo.RtlInfo.IsRtl      := False;
431    FMarkupTokenAttr.Clear;
432    if ATokenInfo.Attr <> nil then begin
433      FMarkupTokenAttr.Assign(ATokenInfo.Attr);
434    end
435    else begin
436      FMarkupTokenAttr.Foreground := FForegroundColor;
437      FMarkupTokenAttr.Background := FBackgroundColor;
438    end;
439
440    ATokenInfo.ExpandedExtraBytes := 0;
441    ATokenInfo.HasTabs            := False;
442    ATokenInfo.HasDoubleWidth     := False; // TODO: True, but needs charwidth for painter
443  end
444  else begin
445    if ATokenInfo.NextRtlInfo.IsRtl <> FCurMarkupNextRtlInfo.IsRtl then begin
446      FNextMarkupPhysPos := -1;
447      FNextMarkupLogPos  := -1;
448    end;
449    FCurMarkupNextStart   := ATokenInfo.NextPos;
450    FCurMarkupNextRtlInfo := ATokenInfo.NextRtlInfo;
451
452    FMarkupTokenAttr.Assign(ATokenInfo.Attr);
453    FMarkupTokenAttr.CurrentStartX := ATokenInfo.StartPos; // current sub-token
454    FMarkupTokenAttr.CurrentEndX   := ATokenInfo.EndPos;
455  end;
456
457  if FCurMarkupState = cmPastWrapEnd then
458    fMarkupManager.MergeMarkupAttributeAtWrapEnd(FCurTxtLineIdx + 1,
459      FWrapEndBound, FMarkupTokenAttr)
460  else
461    fMarkupManager.MergeMarkupAttributeAtRowCol(FCurTxtLineIdx + 1,
462      ATokenInfo.StartPos, ATokenInfo.EndPos, ATokenInfo.RtlInfo, FMarkupTokenAttr);
463  FMarkupTokenAttr.ProcessMergeInfo;
464
465
466  ATokenInfo.Attr := FMarkupTokenAttr;
467  // Deal with equal colors
468  // TODO: Map to RGB first
469  if (FMarkupTokenAttr.Background = FMarkupTokenAttr.Foreground) then begin // or if diff(gb,fg) < x
470    if FMarkupTokenAttr.Background = BackgroundColor then
471      FMarkupTokenAttr.Foreground := not(FMarkupTokenAttr.Background) and $00ffffff // or maybe ForegroundColor ?
472    else
473      FMarkupTokenAttr.Foreground := BackgroundColor;
474  end;
475
476  // Todo merge attribute
477
478end;
479
480function TLazSynPaintTokenBreaker.GetNextHighlighterTokenFromView(out
481  ATokenInfo: TLazSynDisplayTokenInfoEx; APhysEnd: Integer; ALogEnd: Integer): Boolean;
482
483  procedure InitSynAttr(var ATarget: TSynSelectedColorMergeResult; const ASource: TLazSynCustomTextAttributes;
484    const AnAttrStartX: TLazSynDisplayTokenBound);
485  const
486    NoEnd: TLazSynDisplayTokenBound = (Physical: -1; Logical: -1; Offset: 0);
487  begin
488    ATarget.Clear;
489    if Assigned(ASource) then begin
490      ATarget.Assign(ASource);
491      if ATarget.Foreground = clNone then
492        ATarget.Foreground := ForegroundColor;
493      if ATarget.Background = clNone then
494        ATarget.Background := BackgroundColor;
495    end else
496    begin
497      ATarget.Foreground := ForegroundColor;
498      ATarget.Background := BackgroundColor;
499      ATarget.Style :=  []; // Font.Style; // currently always cleared
500    end;
501//    ATarget.MergeFinalStyle := True;
502    ATarget.StyleMask  := [];
503    ATarget.StartX := AnAttrStartX;
504    ATarget.EndX   := NoEnd;
505  end;
506
507  function MaybeFetchToken: Boolean; inline;
508  begin
509    Result := FCurViewToken.TokenLength > 0;
510    if Result or (FCurViewToken.TokenLength < 0) then exit;
511    FCurViewCurTokenStartPos := FCurViewScannerPos;
512    while FCurViewToken.TokenLength = 0 do begin // Todo: is SyncroEd-test a zero size token is returned
513      Result := FDisplayView.GetNextHighlighterToken(FCurViewToken);
514      if not Result then
515        FCurViewToken.TokenAttr := nil;
516      Result := Result and (FCurViewToken.TokenStart <> nil); // False for end of line token
517      if not Result then begin
518        FCurViewToken.TokenLength := -1;
519        exit;
520      end;
521      // Todo: concatenate with next token, if possible (only, if reaching token end)
522    end;
523  end;
524
525  function GetCharWidthData(AIdx: Integer): TPhysicalCharWidth; inline;
526  begin
527    if (AIdx >= FCharWidthsLen) or (AIdx >= FCurLineByteLen)
528    then Result := 1
529    else Result := FCharWidths[AIdx];
530  end;
531
532  Procedure AdjustCurTokenLogStart(ANewLogStart: Integer); inline;
533  // ANewLogStart = 1 based
534  var
535    j: integer;
536  begin
537    j := (ANewLogStart - FCurViewScannerPos.Logical);
538    FCurViewToken.TokenLength := FCurViewToken.TokenLength - j;
539    FCurViewToken.TokenStart  := FCurViewToken.TokenStart + j;
540    FCurViewScannerPos.Logical   := ANewLogStart;
541  end;
542
543  procedure SkipLtrBeforeFirstCol(var ALogicIdx: integer; ALogicEnd: Integer); inline;
544  var
545    j: Integer;
546    pcw: TPhysicalCharWidth;
547  begin
548    if  (FCurViewScannerPhysCharPos >= FFirstCol) then
549      exit;
550
551    pcw := GetCharWidthData(ALogicIdx);
552    if (pcw and PCWFlagRTL <> 0) then exit;
553
554    j := (pcw and PCWMask);
555    while (ALogicIdx < ALogicEnd) and (FCurViewScannerPhysCharPos + j <= FFirstCol) and
556          (pcw and PCWFlagRTL = 0)
557    do begin
558      inc(FCurViewScannerPhysCharPos, j);
559      repeat
560        inc(ALogicIdx);
561      until (ALogicIdx >= ALogicEnd) or
562            (ALogicIdx >= FCharWidthsLen) or ((FCharWidths[ALogicIdx] and PCWMask) <> 0);
563
564      pcw := GetCharWidthData(ALogicIdx);
565      j := pcw and PCWMask;
566    end;
567
568    if ALogicIdx <> FCurViewScannerPos.Logical - 1 then begin
569      AdjustCurTokenLogStart(ALogicIdx + 1);
570      assert(FCurViewToken.TokenLength >= 0, 'FCurViewToken.TokenLength > 0');
571    end;
572
573    if FCurViewScannerPhysCharPos > FCurViewScannerPos.Physical then
574      FCurViewScannerPos.Physical := FCurViewScannerPhysCharPos;
575    if (FCurViewScannerPos.Physical < FFirstCol) and
576       (FCurViewScannerPos.Physical + j > FFirstCol)
577    then
578      FCurViewScannerPos.Physical := FFirstCol;
579  end;
580
581  procedure SkipRtlOffScreen(var ALogicIdx: integer; ALogicEnd: Integer); inline;
582  var
583    j: Integer;
584    pcw: TPhysicalCharWidth;
585  begin
586    if  (FCurViewScannerPhysCharPos <= FFirstCol) then begin
587// TODO: end, if FCurViewRtlPhysEnd >= FLastCol;
588      if ALogicIdx + FCurViewToken.TokenLength < FCurViewRtlLogEnd then begin
589        if FCurViewToken.TokenLength > 0 then begin
590          ALogicIdx := ALogicIdx + FCurViewToken.TokenLength;
591          FCurViewScannerPos.Logical := FCurViewScannerPos.Logical + FCurViewToken.TokenLength;
592          FCurViewToken.TokenLength := 0;
593        end;
594      end
595      else begin
596        j :=  FCurViewRtlLogEnd - ALogicIdx;
597        FCurViewScannerPos.Logical   := FCurViewScannerPos.Logical + j;
598        FCurViewToken.TokenStart  := FCurViewToken.TokenStart + j;
599        FCurViewToken.TokenLength := FCurViewToken.TokenLength - j;
600        ALogicIdx := ALogicIdx + j;
601        FCurViewScannerPhysCharPos      := FCurViewRtlPhysEnd;
602        FCurViewScannerPos.Physical := FCurViewRtlPhysEnd;
603        assert(FCurViewScannerPos.Logical - 1 = FCurViewRtlLogEnd, 'SkipRtlOffScreen: FCurViewScannerPos.Logical = FCurViewRtlLogEnd');
604      end;
605      exit;
606    end;
607
608    if  (FCurViewScannerPhysCharPos <= FLastCol) then
609      exit;
610
611    pcw := GetCharWidthData(ALogicIdx);
612    if (pcw and PCWFlagRTL = 0) then exit;
613
614    j := (pcw and PCWMask);
615    while (ALogicIdx < ALogicEnd) and (FCurViewScannerPhysCharPos - j >= FLastCol) and
616          (pcw and PCWFlagRTL <> 0)
617    do begin
618      dec(FCurViewScannerPhysCharPos, j);
619      repeat
620        inc(ALogicIdx);
621      until (ALogicIdx >= ALogicEnd) or
622              (ALogicIdx >= FCharWidthsLen) or ((FCharWidths[ALogicIdx] and PCWMask) <> 0);
623
624      pcw := GetCharWidthData(ALogicIdx);
625      j := pcw and PCWMask;
626    end;
627
628    if ALogicIdx <> FCurViewScannerPos.Logical - 1 then begin
629      AdjustCurTokenLogStart(ALogicIdx + 1);
630      assert(FCurViewToken.TokenLength >= 0, 'FCurViewToken.TokenLength > 0');
631    end;
632    if FCurViewScannerPos.Physical > FLastCol then
633      FCurViewScannerPos.Physical := FLastCol;
634  end;
635
636  procedure ChangeToRtl(ALogicIdx, ALogicEnd: Integer);
637  var
638    RtlRunPhysWidth, TabExtra, i, j: Integer;
639    pcw: TPhysicalCharWidth;
640    HasTabs, HasDouble: Boolean;
641    c: Char;
642  begin
643    FCurViewRtlLogStart := ALogicIdx;
644    pcw := GetCharWidthData(ALogicIdx);
645
646    RtlRunPhysWidth := 0;
647    i         := 0;
648    HasDouble := False;
649    HasTabs   := False;
650    TabExtra  := 0; // Extra bytes needed for expanded Tab/Space(utf8 visible space/dot)
651    j := (pcw and PCWMask);
652    // must go over token bounds
653    //while (ALogicIdx < ALogicEnd) and (pcw and PCWFlagRTL <> 0) do begin
654    while (ALogicIdx < FCharWidthsLen) and (ALogicIdx < FCurLineByteLen) and (pcw and PCWFlagRTL <> 0) do begin
655      inc(RtlRunPhysWidth, j);
656
657      if (j <> 0) and (FCurViewToken.TokenStart <> nil) then begin
658        c := (FCurViewToken.TokenStart + i)^;
659        if c = #9  then begin
660          HasTabs := True;
661          inc(TabExtra, j-1 + FTabExtraByteCount);
662        end
663        else
664        if j > 1 then
665          HasDouble := True;
666        if c = ' ' then
667          inc(TabExtra, FSpaceExtraByteCount);
668      end;
669
670      repeat
671        inc(ALogicIdx);
672        inc(i);
673      until (ALogicIdx >= FCurLineByteLen) or
674            (ALogicIdx >= FCharWidthsLen) or ((FCharWidths[ALogicIdx] and PCWMask) <> 0);
675
676      pcw := GetCharWidthData(ALogicIdx);
677      j := pcw and PCWMask;
678    end;
679
680    FCurViewinRTL               := True;
681    FCurViewRTLLogEnd           := ALogicIdx;
682    FCurViewRtlPhysStart        := FCurViewScannerPhysCharPos;
683    FCurViewRtlPhysEnd          := FCurViewScannerPhysCharPos + RtlRunPhysWidth;
684    FCurViewScannerPhysCharPos  := FCurViewRtlPhysEnd;
685    FCurViewScannerPos.Physical := FCurViewRtlPhysEnd;
686    FCurViewRtlExpExtraBytes    := TabExtra;
687    FCurViewRtlHasTabs          := HasTabs;
688    FCurViewRtlHasDoubleWidth   := HasDouble;
689  end;
690
691  function MaybeChangeToRtl(ALogicIdx, ALogicEnd: Integer): boolean; inline;
692  begin
693    Result := (GetCharWidthData(ALogicIdx) and PCWFlagRTL) <> 0;
694    if Result then
695      ChangeToRtl(ALogicIdx, ALogicEnd);
696  end;
697
698  procedure ChangeToLtr(ALogicIdx, ALogicEnd: Integer);
699  begin
700    FCurViewinRTL := False;
701    FCurViewScannerPhysCharPos      := FCurViewRtlPhysEnd;
702    FCurViewScannerPos.Physical := FCurViewRtlPhysEnd;
703  end;
704
705  function MaybeChangeToLtr(ALogicIdx, ALogicEnd: Integer): boolean; inline;
706  begin
707    Result := (GetCharWidthData(ALogicIdx) and PCWFlagRTL) = 0;
708    if Result then
709      ChangeToLtr(ALogicIdx, ALogicEnd);
710  end;
711
712var
713  i, j: Integer;
714  pcw: TPhysicalCharWidth;
715  c: Char;
716  LogicIdx, LogicEnd, PhysPos: Integer;
717  PrevLogicIdx, PrevPhysPos: Integer;
718  PhysTokenStop: Integer;
719  TabExtra: Integer;
720  HasTabs, HasDouble: Boolean;
721begin
722  ATokenInfo.Attr := nil;
723  while True do begin
724    Result := MaybeFetchToken;    // Get token from View/Highlighter
725    if not Result then begin
726      ATokenInfo.StartPos      := FCurViewScannerPos;
727      ATokenInfo.RtlInfo.IsRtl := False;
728      ATokenInfo.NextRtlInfo.IsRtl := False;
729      if FCurViewToken.TokenAttr <> nil then begin
730        InitSynAttr(FCurViewAttr, FCurViewToken.TokenAttr, FCurViewCurTokenStartPos);
731        ATokenInfo.Attr := FCurViewAttr;
732      end
733      else
734        ATokenInfo.Attr := nil;
735      exit;
736    end;
737
738    LogicIdx := FCurViewScannerPos.Logical - 1;
739    LogicEnd := LogicIdx + FCurViewToken.TokenLength;
740    //assert(GetCharWidthData(LogicIdx)<>0, 'GetNextHighlighterTokenFromView: Token starts with char');
741
742    case FCurViewinRTL of
743      False: // Left To Right
744        begin
745          SkipLtrBeforeFirstCol(LogicIdx, LogicEnd);    // Skip out of screen
746          if FCurViewToken.TokenLength = 0 then
747            continue;  // Get NEXT token
748
749          if MaybeChangeToRtl(LogicIdx, LogicEnd) then
750            continue;
751
752          if APhysEnd > 0
753          then PhysTokenStop := Min(FLastCol, APhysEnd)
754          else PhysTokenStop := FLastCol;
755          // TODO: APhysEnd should always allow some data. Compare with FLastCol? Assert for APhysEnd
756          Result := PhysTokenStop > FCurViewScannerPos.Physical;
757          if not Result then begin
758            ATokenInfo.StartPos           := FCurViewScannerPos;
759            exit;
760          end;
761
762          // Find end according to PhysTokenStop
763          PhysPos      := FCurViewScannerPhysCharPos;
764          PrevLogicIdx := LogicIdx;
765          PrevPhysPos  := PhysPos;
766          HasDouble := False;
767          HasTabs := False;
768          TabExtra      := 0; // Extra bytes needed for expanded Tab/Space(utf8 visible space/dot)
769          i := 0;
770
771          if (ALogEnd > 0) and (LogicEnd >= ALogEnd) then
772            LogicEnd := ALogEnd - 1;
773
774          pcw := GetCharWidthData(LogicIdx);
775          while (LogicIdx < LogicEnd) and (PhysPos < PhysTokenStop) and
776                (pcw and PCWFlagRTL = 0)
777          do begin
778            j := pcw and PCWMask;
779
780            PrevLogicIdx := LogicIdx;
781            PrevPhysPos  := PhysPos;
782            inc(PhysPos, j);
783            if j <> 0 then begin
784              c := (FCurViewToken.TokenStart + i)^;
785              if c = #9  then begin
786                HasTabs := True;
787                inc(TabExtra, j-1 + FTabExtraByteCount);
788              end
789              else
790              if j > 1 then
791                HasDouble := True;
792              if c = ' ' then
793                inc(TabExtra, FSpaceExtraByteCount);
794            end;
795
796            repeat
797              inc(LogicIdx);
798              inc(i);
799            until (LogicIdx >= FCharWidthsLen) or
800                  (LogicIdx >= LogicEnd) or ((FCharWidths[LogicIdx] and PCWMask) <> 0);
801            pcw := GetCharWidthData(LogicIdx);
802          end;
803          Assert((PhysPos > FCurViewScannerPhysCharPos) or (ALogEnd > 0), 'PhysPos > FCurViewScannerPhysCharPos');
804
805          ATokenInfo.Tk                 := FCurViewToken;
806          ATokenInfo.Tk.TokenLength     := LogicIdx + 1 - FCurViewScannerPos.Logical;
807
808          ATokenInfo.StartPos           := FCurViewScannerPos;
809          ATokenInfo.StartPos.Offset    := ATokenInfo.StartPos.Physical - FCurViewScannerPhysCharPos; // >= 0
810
811          ATokenInfo.EndPos.Logical     := LogicIdx + 1;
812          ATokenInfo.EndPos.Physical    := Min(PhysPos, PhysTokenStop);
813          ATokenInfo.EndPos.Offset      := ATokenInfo.EndPos.Physical - PhysPos; // Zero or Negative. Paint ends before Logical
814
815          ATokenInfo.PhysicalCharStart  := FCurViewScannerPhysCharPos;
816          ATokenInfo.PhysicalClipStart  := ATokenInfo.StartPos.Physical;
817          ATokenInfo.PhysicalCharEnd    := PhysPos;
818          ATokenInfo.PhysicalClipEnd    := ATokenInfo.EndPos.Physical;
819          ATokenInfo.RtlInfo.IsRtl      := False;
820          //ATokenInfo.RtlInfo.PhysLeft   := FCurViewRtlPhysStart;
821          //ATokenInfo.RtlInfo.PhysRight  := FCurViewRtlPhysEnd;
822          //ATokenInfo.RtlInfo.LogFirst   := FCurViewRtlLogStart + 1;
823          //ATokenInfo.RtlInfo.LogLast    := FCurViewRtlLogEnd + 1;
824          //ATokenInfo.RtlExpandedExtraBytes := FCurViewRtlExpExtraBytes;
825          //ATokenInfo.RtlHasDoubleWidth  := FCurViewRtlHasDoubleWidth;
826          ATokenInfo.Attr               := FCurViewAttr;
827
828          ATokenInfo.ExpandedExtraBytes := TabExtra;
829          ATokenInfo.HasTabs            := HasTabs;
830          ATokenInfo.HasDoubleWidth     := HasDouble;
831          assert(ATokenInfo.StartPos.Offset >= 0, 'FCurViewScannerPos.Offset >= 0');
832          assert(ATokenInfo.EndPos.Offset   <= 0, 'FCurViewToken.EndPos.Offset <= 0');
833
834          if PhysPos > PhysTokenStop then begin      // Last char goes over paint boundary
835            LogicIdx := PrevLogicIdx;
836            PhysPos  := PrevPhysPos;
837          end
838          else
839            PhysTokenStop := PhysPos;
840          AdjustCurTokenLogStart(LogicIdx + 1);
841          FCurViewScannerPhysCharPos   := PhysPos;
842          if PhysTokenStop > FCurViewScannerPos.Physical  then
843            FCurViewScannerPos.Physical := PhysTokenStop;
844
845          assert(FCurViewToken.TokenLength >= 0, 'FCurViewToken.TokenLength >= 0');
846
847          InitSynAttr(FCurViewAttr, FCurViewToken.TokenAttr, FCurViewCurTokenStartPos);
848          if FCurViewToken.TokenLength = 0 then
849            ATokenInfo.Attr.EndX := ATokenInfo.EndPos; // PhysPos-1;
850
851          MaybeFetchToken;
852          if MaybeChangeToRtl(LogicIdx, LogicEnd) then begin // get NextTokenPhysStart
853            SkipRtlOffScreen(LogicIdx, LogicEnd);
854            while FCurViewToken.TokenLength = 0 do
855              if MaybeFetchToken then
856                SkipRtlOffScreen(LogicIdx, LogicEnd);
857          end;
858
859          ATokenInfo.NextPos.Physical      := FCurViewScannerPos.Physical;
860          ATokenInfo.NextPos.Logical       := FCurViewScannerPos.Logical;
861          ATokenInfo.NextPos.Offset        := FCurViewScannerPos.Physical - FCurViewScannerPhysCharPos;
862          ATokenInfo.NextRtlInfo.IsRtl     := FCurViewinRTL;
863          ATokenInfo.NextRtlInfo.PhysLeft  := FCurViewRtlPhysStart;
864          ATokenInfo.NextRtlInfo.PhysRight := FCurViewRtlPhysEnd;
865          ATokenInfo.NextRtlInfo.LogFirst  := FCurViewRtlLogStart + 1;
866          ATokenInfo.NextRtlInfo.LogLast   := FCurViewRtlLogEnd + 1;
867
868          break;
869        end; // case FCurViewinRTL = False;
870      True: // Right To Left
871        begin
872          SkipRtlOffScreen(LogicIdx, LogicEnd);
873          if FCurViewToken.TokenLength = 0 then
874            continue;  // Get NEXT token
875
876          if MaybeChangeToLtr(LogicIdx, LogicEnd) then
877            continue;
878
879          if APhysEnd >= FCurViewRtlPhysEnd
880          then PhysTokenStop := FFirstCol
881          else PhysTokenStop := Max(FFirstCol, APhysEnd);
882          // TODO: APhysEnd should always allow some data. Assert for APhysEnd
883          // FFirstCol must be less PPS. Otherwise it would have gone LTR
884//          Result := PhysTokenStop < FCurViewScannerPos.Physical;
885//          if not Result then exit;
886
887          // Find end according to PhysTokenStop
888          PhysPos      := FCurViewScannerPhysCharPos;
889          PrevLogicIdx := LogicIdx;
890          PrevPhysPos  := PhysPos;
891          HasDouble := False;
892          HasTabs := False;
893          TabExtra      := 0; // Extra bytes needed for expanded Tab/Space(utf8 visible space/dot)
894          i := 0;
895
896          if (ALogEnd > 0) and (LogicEnd >= ALogEnd) then
897            LogicEnd := ALogEnd - 1;
898
899          pcw := GetCharWidthData(LogicIdx);
900          while (LogicIdx < LogicEnd) and (PhysPos > PhysTokenStop) and
901                (pcw and PCWFlagRTL <> 0)
902          do begin
903            j := pcw and PCWMask;
904
905            PrevLogicIdx := LogicIdx;
906            PrevPhysPos  := PhysPos;
907            dec(PhysPos, j);
908            if j <> 0 then begin
909              c := (FCurViewToken.TokenStart + i)^;
910              if c = #9  then begin
911                HasTabs := True;
912                inc(TabExtra, j-1 + FTabExtraByteCount);
913              end
914              else
915              if j > 1 then
916                HasDouble := True;
917              if c = ' ' then
918                inc(TabExtra, FSpaceExtraByteCount);
919            end;
920
921            repeat
922              inc(LogicIdx);
923              inc(i);
924            until (LogicIdx >= FCharWidthsLen) or
925                  (LogicIdx >= LogicEnd) or ((FCharWidths[LogicIdx] and PCWMask) <> 0);
926            pcw := GetCharWidthData(LogicIdx);
927          end;
928          Assert((PhysPos < FCurViewScannerPhysCharPos) or (ALogEnd > 0), 'PhysPos > FCurViewScannerPhysCharPos');
929
930          ATokenInfo.Tk                 := FCurViewToken;
931          ATokenInfo.Tk.TokenLength     := LogicIdx + 1 - FCurViewScannerPos.Logical;
932
933          ATokenInfo.StartPos           := FCurViewScannerPos;
934          //ATokenInfo.StartPos.Logical   := LogicIdx + 1;
935          //ATokenInfo.StartPos.Physical  := ATokenInfo.StartPos.Physical;
936          ATokenInfo.StartPos.Offset    := FCurViewScannerPhysCharPos - ATokenInfo.StartPos.Physical; //  >= 0
937
938          ATokenInfo.EndPos.Logical     := LogicIdx + 1;
939          ATokenInfo.EndPos.Physical    := Max(PhysPos, PhysTokenStop);
940          ATokenInfo.EndPos.Offset      := PhysPos - ATokenInfo.EndPos.Physical; //  <= 0
941
942          ATokenInfo.PhysicalCharStart  := PhysPos;
943          ATokenInfo.PhysicalClipStart  := ATokenInfo.EndPos.Physical;
944          ATokenInfo.PhysicalCharEnd    := FCurViewScannerPhysCharPos;
945          ATokenInfo.PhysicalClipEnd    := ATokenInfo.StartPos.Physical;
946          ATokenInfo.RtlInfo.IsRtl      := True;
947          ATokenInfo.RtlInfo.PhysLeft   := FCurViewRtlPhysStart;
948          ATokenInfo.RtlInfo.PhysRight  := FCurViewRtlPhysEnd;
949          ATokenInfo.RtlInfo.LogFirst   := FCurViewRtlLogStart + 1;
950          ATokenInfo.RtlInfo.LogLast    := FCurViewRtlLogEnd + 1;
951          ATokenInfo.RtlExpandedExtraBytes := FCurViewRtlExpExtraBytes;
952          ATokenInfo.RtlHasTabs         := FCurViewRtlHasTabs;
953          ATokenInfo.RtlHasDoubleWidth  := FCurViewRtlHasDoubleWidth;
954          ATokenInfo.Attr               := FCurViewAttr;
955
956          ATokenInfo.ExpandedExtraBytes := TabExtra;
957          ATokenInfo.HasTabs            := HasTabs;
958          ATokenInfo.HasDoubleWidth     := HasDouble;
959          assert(ATokenInfo.StartPos.Offset >= 0, 'FCurViewScannerPos.Offset >= 0');
960          assert(ATokenInfo.EndPos.Offset   <= 0, 'FCurViewToken.EndPos.Offset <= 0');
961
962          if (PhysPos < PhysTokenStop) and (PhysTokenStop > FFirstCol) then begin      // Last char goes over paint boundary
963            LogicIdx := PrevLogicIdx;
964            PhysPos  := PrevPhysPos;
965          end
966          else
967            PhysTokenStop := Max(PhysPos, PhysTokenStop);
968
969          AdjustCurTokenLogStart(LogicIdx + 1);
970          FCurViewScannerPhysCharPos   := PhysPos;
971          if PhysTokenStop < FCurViewScannerPos.Physical then
972            FCurViewScannerPos.Physical := PhysTokenStop;
973
974          assert(FCurViewToken.TokenLength >= 0, 'FCurViewToken.TokenLength >= 0');
975
976          InitSynAttr(FCurViewAttr, FCurViewToken.TokenAttr, FCurViewCurTokenStartPos);
977          if FCurViewToken.TokenLength = 0 then
978            ATokenInfo.Attr.EndX := ATokenInfo.EndPos; // PhysPos-1;
979
980          MaybeFetchToken;
981          SkipRtlOffScreen(LogicIdx, LogicEnd);
982          while FCurViewToken.TokenLength = 0 do
983            if MaybeFetchToken then
984              SkipRtlOffScreen(LogicIdx, LogicEnd);
985          MaybeChangeToLtr(LogicIdx, LogicEnd);  // get NextTokenPhysStart
986
987          // If the next token is RTL, then NextPos is the next EndPos
988          ATokenInfo.NextPos.Physical      := FCurViewScannerPos.Physical;
989          ATokenInfo.NextPos.Logical       := FCurViewScannerPos.Logical;
990          ATokenInfo.NextPos.Offset        := FCurViewScannerPhysCharPos - FCurViewScannerPos.Physical;
991          ATokenInfo.NextRtlInfo.IsRtl     := FCurViewinRTL;
992          ATokenInfo.NextRtlInfo.PhysLeft  := FCurViewRtlPhysStart;
993          ATokenInfo.NextRtlInfo.PhysRight := FCurViewRtlPhysEnd;
994          ATokenInfo.NextRtlInfo.LogFirst  := FCurViewRtlLogStart + 1;
995          ATokenInfo.NextRtlInfo.LogLast   := FCurViewRtlLogEnd + 1;
996
997          break;
998        end; // case FCurViewinRTL = True;
999    end;
1000
1001
1002  end; // while True
1003end;
1004
1005{ TLazSynSurfaceWithText }
1006
1007procedure TLazSynSurfaceWithText.SetTextArea(AValue: TLazSynTextArea);
1008begin
1009  FTextArea := AValue;
1010end;
1011
1012function TLazSynSurfaceWithText.GetTextArea: TLazSynTextArea;
1013begin
1014  Result := FTextArea;
1015end;
1016
1017procedure TLazSynSurfaceWithText.Assign(Src: TLazSynSurface);
1018begin
1019  inherited Assign(Src);
1020  FTextArea := TLazSynSurfaceWithText(Src).FTextArea;
1021end;
1022
1023{ TLazSynSurfaceManager }
1024
1025procedure TLazSynSurfaceManager.SetLeftGutterWidth(AValue: integer);
1026begin
1027  if FLeftGutterWidth = AValue then Exit;
1028  FLeftGutterWidth := AValue;
1029  BoundsChanged;
1030end;
1031
1032procedure TLazSynSurfaceManager.SetPadding(Side: TLazSynBorderSide; AValue: integer);
1033begin
1034  FTextArea.Padding[Side] := AValue;
1035end;
1036
1037procedure TLazSynSurfaceManager.SetRightEdgeColor(AValue: TColor);
1038begin
1039  FTextArea.RightEdgeColor := AValue;
1040end;
1041
1042procedure TLazSynSurfaceManager.SetRightEdgeColumn(AValue: integer);
1043begin
1044  FTextArea.RightEdgeColumn := AValue;
1045end;
1046
1047procedure TLazSynSurfaceManager.SetRightEdgeVisible(AValue: boolean);
1048begin
1049  FTextArea.RightEdgeVisible := AValue;
1050end;
1051
1052procedure TLazSynSurfaceManager.SetLeftGutterArea(AValue: TLazSynSurfaceWithText);
1053begin
1054  if FLeftGutterArea = AValue then Exit;
1055  FLeftGutterArea := AValue;
1056  FLeftGutterArea.DisplayView := DisplayView;
1057  FLeftGutterArea.TextArea := FTextArea;
1058end;
1059
1060function TLazSynSurfaceManager.GetLeftGutterArea: TLazSynSurfaceWithText;
1061begin
1062  Result := FLeftGutterArea;
1063end;
1064
1065function TLazSynSurfaceManager.GetRightGutterArea: TLazSynSurfaceWithText;
1066begin
1067  Result := FRightGutterArea;
1068end;
1069
1070function TLazSynSurfaceManager.GetTextArea: TLazSynTextArea;
1071begin
1072  Result := FTextArea;
1073end;
1074
1075procedure TLazSynSurfaceManager.SetBackgroundColor(AValue: TColor);
1076begin
1077  FTextArea.BackgroundColor := AValue;
1078end;
1079
1080procedure TLazSynSurfaceManager.SetExtraCharSpacing(AValue: integer);
1081begin
1082  FTextArea.ExtraCharSpacing := AValue;
1083end;
1084
1085procedure TLazSynSurfaceManager.SetExtraLineSpacing(AValue: integer);
1086begin
1087  FTextArea.ExtraLineSpacing := AValue;
1088end;
1089
1090procedure TLazSynSurfaceManager.SetForegroundColor(AValue: TColor);
1091begin
1092  FTextArea.ForegroundColor := AValue;
1093end;
1094
1095procedure TLazSynSurfaceManager.SetRightGutterArea(AValue: TLazSynSurfaceWithText);
1096begin
1097  if FRightGutterArea = AValue then Exit;
1098  FRightGutterArea := AValue;
1099  FRightGutterArea.DisplayView := DisplayView;
1100  FLeftGutterArea.TextArea := FTextArea;
1101end;
1102
1103procedure TLazSynSurfaceManager.SetRightGutterWidth(AValue: integer);
1104begin
1105  if FRightGutterWidth = AValue then Exit;
1106  FRightGutterWidth := AValue;
1107  BoundsChanged;
1108end;
1109
1110procedure TLazSynSurfaceManager.SetTextArea(AValue: TLazSynTextArea);
1111begin
1112  if FTextArea = AValue then Exit;
1113  FTextArea := AValue;
1114  FTextArea.DisplayView := DisplayView;
1115  if FLeftGutterArea <> nil then
1116    FLeftGutterArea.TextArea := FTextArea;
1117  if FRightGutterArea <> nil then
1118    FRightGutterArea.TextArea := FTextArea;
1119end;
1120
1121procedure TLazSynSurfaceManager.SetVisibleSpecialChars(AValue: TSynVisibleSpecialChars);
1122begin
1123  FTextArea.VisibleSpecialChars := AValue;
1124end;
1125
1126procedure TLazSynSurfaceManager.SetHighlighter(AValue: TSynCustomHighlighter);
1127begin
1128  FTextArea.Highlighter := AValue;
1129end;
1130
1131procedure TLazSynSurfaceManager.DoPaint(ACanvas: TCanvas; AClip: TRect);
1132begin
1133  FLeftGutterArea.Paint(ACanvas, AClip);
1134  FTextArea.Paint(ACanvas, AClip);
1135  FRightGutterArea.Paint(ACanvas, AClip);
1136end;
1137
1138procedure TLazSynSurfaceManager.DoDisplayViewChanged;
1139begin
1140  FLeftGutterArea.DisplayView  := DisplayView;
1141  FRightGutterArea.DisplayView := DisplayView;
1142  FTextArea.DisplayView        := DisplayView;
1143end;
1144
1145procedure TLazSynSurfaceManager.BoundsChanged;
1146var
1147  l, r: Integer;
1148begin
1149  r := Max(Left, Right - RightGutterWidth);
1150  l := Min(r, Left + LeftGutterWidth);
1151  FLeftGutterArea.SetBounds(Top, Left, Bottom, l);
1152  FTextArea.SetBounds(Top, l, Bottom, r);
1153  FRightGutterArea.SetBounds(Top, r, Bottom, Right);
1154end;
1155
1156constructor TLazSynSurfaceManager.Create(AOwner: TWinControl);
1157begin
1158  inherited Create(AOwner);
1159  FLeftGutterWidth := 0;
1160  FRightGutterWidth := 0;
1161end;
1162
1163procedure TLazSynSurfaceManager.InvalidateLines(FirstTextLine, LastTextLine: TLineIdx);
1164var
1165  rcInval: TRect;
1166  ViewedRange: TLineRange;
1167begin
1168  rcInval := Bounds;
1169  if (FirstTextLine >= 0) then begin
1170    ViewedRange := DisplayView.TextToViewIndex(FirstTextLine);
1171    rcInval.Top := Max(TextArea.TextBounds.Top,
1172                       TextArea.TextBounds.Top + (ViewedRange.Top
1173                          - TextArea.TopLine + 1) * TextArea.LineHeight);
1174  end;
1175  if (LastTextLine >= 0) then begin
1176    if LastTextLine <> FirstTextLine then
1177      ViewedRange := DisplayView.TextToViewIndex(LastTextLine);
1178    rcInval.Bottom := Min(TextArea.TextBounds.Bottom,
1179                          TextArea.TextBounds.Top + (ViewedRange.Bottom
1180                             - TextArea.TopLine + 2)  * TextArea.LineHeight);
1181  end;
1182
1183  {$IFDEF VerboseSynEditInvalidate}
1184  DebugLn(['TCustomSynEdit.InvalidateGutterLines ',DbgSName(self), ' FirstLine=',FirstTextLine, ' LastLine=',LastTextLine, ' rect=',dbgs(rcInval)]);
1185  {$ENDIF}
1186  if (rcInval.Top < rcInval.Bottom) and (rcInval.Left < rcInval.Right) then
1187    InvalidateRect(Handle, @rcInval, FALSE);
1188end;
1189
1190procedure TLazSynSurfaceManager.InvalidateTextLines(FirstTextLine, LastTextLine: TLineIdx);
1191begin
1192  FTextArea.InvalidateLines(FirstTextLine, LastTextLine);
1193end;
1194
1195procedure TLazSynSurfaceManager.InvalidateGutterLines(FirstTextLine, LastTextLine: TLineIdx);
1196begin
1197  FLeftGutterArea.InvalidateLines(FirstTextLine, LastTextLine);
1198  FRightGutterArea.InvalidateLines(FirstTextLine, LastTextLine);
1199end;
1200
1201{ TLazSynTextArea }
1202
1203function TLazSynTextArea.GetPadding(Side: TLazSynBorderSide): integer;
1204begin
1205  Result := FPadding[Side];
1206end;
1207
1208function TLazSynTextArea.GetExtraCharSpacing: integer;
1209begin
1210  Result := Max(FExtraCharSpacing, -CharWidth+1);
1211end;
1212
1213procedure TLazSynTextArea.SetExtraCharSpacing(AValue: integer);
1214begin
1215  if FExtraCharSpacing = AValue then Exit;
1216  FExtraCharSpacing := AValue;
1217  FontChanged;
1218end;
1219
1220procedure TLazSynTextArea.SetExtraLineSpacing(AValue: integer);
1221begin
1222  if FExtraLineSpacing = AValue then Exit;
1223  FExtraLineSpacing := AValue;
1224  FCurrentExtraLineSpacing := Max(AValue, -FTextDrawer.CharHeight+1);
1225  FTextHeight := FTextDrawer.CharHeight + FCurrentExtraLineSpacing;
1226  FontChanged;
1227end;
1228
1229procedure TLazSynTextArea.SetLeftChar(AValue: Integer);
1230begin
1231  if FLeftChar = AValue then Exit;
1232  FLeftChar := AValue;
1233end;
1234
1235procedure TLazSynTextArea.SetPadding(Side: TLazSynBorderSide; AValue: integer);
1236begin
1237  FPadding[Side] := AValue;
1238  case Side of
1239    bsLeft:   FTextBounds.Left   := Left + FPadding[bsLeft];
1240    bsTop:    FTextBounds.Top    := Top + FPadding[bsTop];
1241    bsRight:  FTextBounds.Right  := Right - FPadding[bsRight];
1242    bsBottom: FTextBounds.Bottom := Bottom - FPadding[bsBottom];
1243  end;
1244  FontChanged;
1245end;
1246
1247procedure TLazSynTextArea.SetTopLine(AValue: TLinePos);
1248begin
1249  if AValue < 1 then AValue := 1;
1250  if FTopLine = AValue then Exit;
1251  FTopLine := AValue;
1252end;
1253
1254procedure TLazSynTextArea.DoDrawerFontChanged(Sender: TObject);
1255begin
1256  FontChanged;
1257end;
1258
1259procedure TLazSynTextArea.BoundsChanged;
1260begin
1261  FTextBounds.Left   := Left + FPadding[bsLeft];
1262  FTextBounds.Top    := Top + FPadding[bsTop];
1263  FTextBounds.Right  := Right - FPadding[bsRight];
1264  FTextBounds.Bottom := Bottom - FPadding[bsBottom];
1265  FontChanged;
1266end;
1267
1268function TLazSynTextArea.ScreenColumnToXValue(Col: integer): integer;
1269begin
1270  Result := FTextBounds.Left + (Col - LeftChar) * fCharWidth;
1271end;
1272
1273function TLazSynTextArea.RowColumnToPixels(const RowCol: TPoint): TPoint;
1274begin
1275  // Inludes LeftChar, but not Topline
1276  Result.X := FTextBounds.Left + (RowCol.X - LeftChar) * CharWidth;
1277  Result.Y := FTextBounds.Top + RowCol.Y * LineHeight;
1278end;
1279
1280function TLazSynTextArea.PixelsToRowColumn(Pixels: TPoint;
1281  aFlags: TSynCoordinateMappingFlags): TPoint;
1282begin
1283  // Inludes LeftChar, but not Topline
1284  if (Pixels.X >= FTextBounds.Left) and (Pixels.X < FTextBounds.Right) then begin
1285    if not (scmForceLeftSidePos in aFlags) then
1286      Pixels.X := Pixels.X +  (CharWidth div 2);  // nearest side of char
1287    Result.X := (Pixels.X - FTextBounds.Left) div CharWidth
1288                + LeftChar;
1289  end
1290  else
1291    Result.X := 0;
1292  Result.Y := (Pixels.Y - FTextBounds.Top) div LineHeight;
1293
1294  if (not(scmIncludePartVisible in aFlags)) and (Result.Y >= LinesInWindow) then begin
1295    // don't return a partially visible last line
1296    Result.Y := LinesInWindow - 1;
1297  end;
1298  if Result.X < 0 then Result.X := 0;
1299  if Result.Y < 0 then Result.Y := 0;
1300end;
1301
1302constructor TLazSynTextArea.Create(AOwner: TWinControl; ATextDrawer: TheTextDrawer);
1303var
1304  i: TLazSynBorderSide;
1305begin
1306  inherited Create(AOwner);
1307  FTextSizeChangeList := TMethodList.Create;
1308  FTokenBreaker := TLazSynPaintTokenBreaker.Create;
1309  FTextDrawer := ATextDrawer;
1310  FTextDrawer.RegisterOnFontChangeHandler(@DoDrawerFontChanged);
1311  FPaintLineColor := TSynSelectedColor.Create;
1312  FPaintLineColor2 := TSynSelectedColor.Create;
1313  for i := low(TLazSynBorderSide) to high(TLazSynBorderSide) do
1314    FPadding[i] := 0;
1315  FTopLine := 1;
1316  FLeftChar := 1;
1317  FRightEdgeColumn  := 80;
1318  FRightEdgeVisible := True;
1319  FRightEdgeColor   := clSilver;
1320  FontChanged;
1321end;
1322
1323destructor TLazSynTextArea.Destroy;
1324begin
1325  FreeAndNil(FTokenBreaker);
1326  FTextDrawer.UnRegisterOnFontChangeHandler(@DoDrawerFontChanged);
1327  FreeAndNil(FPaintLineColor);
1328  FreeAndNil(FPaintLineColor2);
1329  FreeAndNil(FTextSizeChangeList);
1330  inherited Destroy;
1331end;
1332
1333procedure TLazSynTextArea.Assign(Src: TLazSynSurface);
1334var
1335  i: TLazSynBorderSide;
1336begin
1337  inherited Assign(Src);
1338
1339  FTextDrawer    := TLazSynTextArea(Src).FTextDrawer;
1340  FTheLinesView  := TLazSynTextArea(Src).FTheLinesView;
1341  DisplayView   := TLazSynTextArea(Src).DisplayView;
1342  FHighlighter   := TLazSynTextArea(Src).FHighlighter;
1343  FMarkupManager := TLazSynTextArea(Src).FMarkupManager;
1344  FForegroundColor := TLazSynTextArea(Src).FForegroundColor;
1345  FBackgroundColor := TLazSynTextArea(Src).FBackgroundColor;
1346  FRightEdgeColor  := TLazSynTextArea(Src).FRightEdgeColor;
1347
1348  FExtraCharSpacing := TLazSynTextArea(Src).FExtraCharSpacing;
1349  FExtraLineSpacing := TLazSynTextArea(Src).FExtraLineSpacing;
1350  FCurrentExtraLineSpacing := TLazSynTextArea(Src).FCurrentExtraLineSpacing;
1351  FVisibleSpecialChars := TLazSynTextArea(Src).FVisibleSpecialChars;
1352  FRightEdgeColumn := TLazSynTextArea(Src).FRightEdgeColumn;
1353  FRightEdgeVisible := TLazSynTextArea(Src).FRightEdgeVisible;
1354
1355  for i := low(TLazSynBorderSide) to high(TLazSynBorderSide) do
1356    FPadding[i] := TLazSynTextArea(Src).FPadding[i];
1357
1358  FTopLine := TLazSynTextArea(Src).FTopLine;
1359  FLeftChar := TLazSynTextArea(Src).FLeftChar;
1360
1361  BoundsChanged;
1362end;
1363
1364procedure TLazSynTextArea.InvalidateLines(FirstTextLine, LastTextLine: TLineIdx);
1365var
1366  rcInval: TRect;
1367  ViewedRange: TLineRange;
1368begin
1369  rcInval := Bounds;
1370  if (FirstTextLine >= 0) then begin
1371    ViewedRange := DisplayView.TextToViewIndex(FirstTextLine);
1372    rcInval.Top := Max(TextBounds.Top,
1373                       TextBounds.Top + (ViewedRange.Top - TopLine + 1) * LineHeight);
1374  end;
1375  if (LastTextLine >= 0) then begin
1376    if LastTextLine <> FirstTextLine then
1377      ViewedRange := DisplayView.TextToViewIndex(LastTextLine);
1378    rcInval.Bottom := Min(TextBounds.Bottom,
1379                          TextBounds.Top + (ViewedRange.Bottom - TopLine + 2)  * LineHeight);
1380  end;
1381
1382  {$IFDEF VerboseSynEditInvalidate}
1383  DebugLn(['TCustomSynEdit.InvalidateTextLines ',DbgSName(self), ' FirstLine=',FirstTextLine, ' LastLine=',LastTextLine, ' rect=',dbgs(rcInval)]);
1384  {$ENDIF}
1385  if (rcInval.Top < rcInval.Bottom) and (rcInval.Left < rcInval.Right) then
1386    InvalidateRect(Handle, @rcInval, FALSE);
1387end;
1388
1389procedure TLazSynTextArea.FontChanged;
1390var
1391  OldChars, OldLines: Integer;
1392  Chg: TSynStatusChanges;
1393begin
1394  // ToDo: wait for handle creation
1395  // Report FLinesInWindow=-1 if no handle
1396  FCharWidth := FTextDrawer.CharWidth;  // includes extra
1397  FTextHeight := FTextDrawer.CharHeight + ExtraLineSpacing;
1398
1399  OldChars := FCharsInWindow;
1400  OldLines := FLinesInWindow;
1401  FCharsInWindow :=  0;
1402  FLinesInWindow :=  0;
1403  if FCharWidth > 0 then
1404    FCharsInWindow := Max(0, (FTextBounds.Right - FTextBounds.Left) div FCharWidth);
1405  if FTextHeight > 0 then
1406    FLinesInWindow := Max(0, (FTextBounds.Bottom - FTextBounds.Top) div FTextHeight);
1407
1408  if assigned(fOnStatusChange) then begin
1409    Chg := [];
1410    if OldChars <> FCharsInWindow then
1411      Chg := Chg + [scCharsInWindow];
1412    if OldLines <> FLinesInWindow then
1413      Chg := Chg + [scLinesInWindow];
1414    if (Chg <> []) then
1415      fOnStatusChange(Self, Chg);
1416  end;
1417  FTextSizeChangeList.CallNotifyEvents(Self);
1418end;
1419
1420procedure TLazSynTextArea.AddTextSizeChangeHandler(AHandler: TNotifyEvent);
1421begin
1422  FTextSizeChangeList.Add(TMethod(AHandler));
1423end;
1424
1425procedure TLazSynTextArea.RemoveTextSizeChangeHandler(AHandler: TNotifyEvent);
1426begin
1427  FTextSizeChangeList.Remove(TMethod(AHandler));
1428end;
1429
1430procedure TLazSynTextArea.DoPaint(ACanvas: TCanvas; AClip: TRect);
1431var
1432  PadRect, PadRect2: TRect;
1433  ScreenRow1, ScreenRow2, TextColumn1, TextColumn2: integer;
1434  dc: HDC;
1435begin
1436
1437  // paint padding
1438  FCanvas := ACanvas;
1439  dc := ACanvas.Handle;
1440  SetBkColor(dc, ColorToRGB(BackgroundColor));
1441
1442  if (AClip.Top < FTextBounds.Top) then begin
1443    PadRect2 := Bounds;
1444    PadRect2.Bottom := FTextBounds.Top;
1445    IntersectRect(PadRect{%H-}, AClip, PadRect2);
1446    InternalFillRect(dc, PadRect);
1447  end;
1448  if (AClip.Bottom > FTextBounds.Bottom) then begin
1449    PadRect2 := Bounds;
1450    PadRect2.Top := FTextBounds.Bottom;
1451    IntersectRect(PadRect, AClip, PadRect2);
1452    InternalFillRect(dc, PadRect);
1453  end;
1454  if (AClip.Left < FTextBounds.Left) then begin
1455    PadRect2 := Bounds;
1456    PadRect2.Right := FTextBounds.Left;
1457    IntersectRect(PadRect, AClip, PadRect2);
1458    InternalFillRect(dc, PadRect);
1459  end;
1460  if (AClip.Right > FTextBounds.Right) then begin
1461    PadRect2 := Bounds;
1462    PadRect2.Left := FTextBounds.Right;
1463    IntersectRect(PadRect, AClip, PadRect2);
1464    InternalFillRect(dc, PadRect);
1465  end;
1466
1467  if (AClip.Left   >= FTextBounds.Right) or
1468     (AClip.Right  <= FTextBounds.Left) or
1469     (AClip.Top    >= FTextBounds.Bottom) or
1470     (AClip.Bottom <= FTextBounds.Top)
1471  then
1472    exit;
1473
1474  TextColumn1 := LeftChar;
1475  if (AClip.Left > FTextBounds.Left) then
1476    Inc(TextColumn1, (AClip.Left - FTextBounds.Left) div CharWidth);
1477  TextColumn2 := LeftChar +
1478    ( Min(AClip.Right, FTextBounds.Right) - FTextBounds.Left + CharWidth - 1) div CharWidth;
1479  // lines
1480  ScreenRow1 := Max((AClip.Top - FTextBounds.Top) div fTextHeight, 0);
1481  ScreenRow2 := Min((AClip.Bottom-1 - FTextBounds.Top) div fTextHeight, LinesInWindow + 1);
1482
1483  AClip.Left   := Max(AClip.Left, FTextBounds.Left); // Todo: This is also checked in paintLines (together with right side)
1484  AClip.Right  := Min(AClip.Right, FTextBounds.Right);
1485  //AClip.Top    := Max(AClip.Top, FTextBounds.Top);
1486  //AClip.Bottom := Min(AClip.Bottom, FTextBounds.Bottom);
1487
1488  SetBkMode(dc, TRANSPARENT);
1489  PaintTextLines(AClip, ScreenRow1, ScreenRow2, TextColumn1, TextColumn2);
1490
1491  FCanvas := nil;
1492end;
1493
1494procedure TLazSynTextArea.PaintTextLines(AClip: TRect; FirstLine, LastLine,
1495  FirstCol, LastCol: integer);
1496// FirstLine, LastLine are based 0
1497// FirstCol, LastCol are screen based 1 without scrolling (physical position).
1498//  i.e. the real screen position is fTextOffset+Pred(FirstCol)*CharWidth
1499var
1500  bDoRightEdge: boolean; // right edge
1501  nRightEdge: integer;
1502  colEditorBG: TColor;
1503    // painting the background and the text
1504  rcLine, rcToken: TRect;
1505  EraseLeft, DrawLeft: Integer;  // LeftSide for EraseBackground, Text
1506  CurLine: integer;         // Screen-line index for the loop
1507  CurTextIndex: Integer;    // Current Index in text
1508  dc: HDC;
1509  CharWidths: TPhysicalCharWidths;
1510
1511  var
1512    LineBuffer: PChar;
1513    LineBufferLen: Integer;
1514    LineBufferRtlLogPos: Integer;
1515
1516  procedure DrawHiLightMarkupToken(ATokenInfo: TLazSynDisplayTokenInfoEx);
1517  var
1518    HasFrame: Boolean;
1519    s: TLazSynBorderSide;
1520    Attr: TSynSelectedColorMergeResult;
1521    TxtFlags: Integer;
1522    tok: TRect;
1523    c, i, j, k, e, Len, CWLen: Integer;
1524    pl, pt: PChar;
1525    TxtLeft: Integer;
1526    NeedExpansion, NeedTransform: Boolean;
1527  begin
1528    Attr := ATokenInfo.Attr;
1529    FTextDrawer.SetForeColor(Attr.Foreground);
1530    FTextDrawer.SetBackColor(Attr.Background);
1531    FTextDrawer.SetStyle    (Attr.Style);
1532    HasFrame := False;
1533    for s := low(TLazSynBorderSide) to high(TLazSynBorderSide) do begin
1534      HasFrame := HasFrame or (Attr.FrameSideColors[s] <> clNone);
1535      FTextDrawer.FrameColor[s] := Attr.FrameSideColors[s];
1536      FTextDrawer.FrameStyle[s] := Attr.FrameSideStyles[s];
1537    end;
1538
1539    rcToken.Right := ScreenColumnToXValue(ATokenInfo.PhysicalClipEnd);
1540    if rcToken.Right > AClip.Right then begin
1541      rcToken.Right := AClip.Right;
1542      FTextDrawer.FrameColor[bsRight] := clNone; // right side of char is not painted
1543    end;
1544
1545    //if (rcToken.Right <= rcToken.Left) then exit;
1546    rcToken.Left := ScreenColumnToXValue(ATokenInfo.PhysicalClipStart); // because for the first token, this can be middle of a char, and lead to wrong frame
1547
1548    (* rcToken.Bottom may be less that crLine.Bottom. If a Divider was drawn, then RcToken will not contain it *)
1549    TxtFlags := ETO_OPAQUE;
1550
1551    (* If token includes RightEdge, draw background, and edge first *)
1552    if bDoRightEdge and (nRightEdge<rcToken.Right) and (nRightEdge>=rcToken.Left)
1553    then begin
1554      TxtFlags := 0;
1555      if rcToken.Left < nRightEdge then begin
1556        // draw background left of edge (use rcToken, so we do not delete the divider-draw-line)
1557        tok := rcToken;
1558        tok.Right := nRightEdge;
1559        FTextDrawer.FillRect(tok);
1560      end;
1561      if rcToken.Right > nRightEdge then begin
1562        // draw background right of edge (use rcLine, full height)
1563        tok := rcToken;
1564        tok.Left   := nRightEdge;
1565        tok.Bottom := rcLine.Bottom;
1566        FTextDrawer.FillRect(tok);
1567      end;
1568      // draw edge (use rcLine / rcToken may be reduced)
1569      LCLIntf.MoveToEx(dc, nRightEdge, rcLine.Top, nil);
1570      LCLIntf.LineTo  (dc, nRightEdge, rcLine.Bottom + 1);
1571    end
1572    else
1573    if HasFrame then begin
1574      (* Draw background for frame *)
1575      TxtFlags := 0;
1576      tok := rcToken;
1577      if rcToken.Right > nRightEdge + 1 then
1578        tok.Bottom := rcLine.Bottom;
1579      FTextDrawer.FillRect(tok);
1580    end;
1581
1582    if HasFrame then begin
1583      // draw frame
1584      tok := rcToken;
1585      if rcToken.Right > nRightEdge + 1 then
1586        tok.Bottom := rcLine.Bottom;
1587      FTextDrawer.DrawFrame(tok);
1588    end;
1589
1590    if ATokenInfo.RtlInfo.IsRtl then begin
1591      // Always draw the entire RTL run, to keep weak chars in context.
1592      // Alternatively, could use ETO_RTLREADING
1593      j :=  (ATokenInfo.StartPos.Logical - ATokenInfo.RtlInfo.LogFirst); // bytes in rtl-run, before TokenStart
1594      i :=  (ATokenInfo.RtlInfo.LogLast - ATokenInfo.EndPos.Logical);    // bytes in rtl-run, after TokenEnd
1595      ATokenInfo.Tk.TokenStart  := ATokenInfo.Tk.TokenStart - j;
1596      ATokenInfo.Tk.TokenLength := ATokenInfo.Tk.TokenLength + j + i;
1597
1598      j :=  (ATokenInfo.EndPos.Physical - ATokenInfo.RtlInfo.PhysLeft);
1599      i :=  (ATokenInfo.RtlInfo.PhysRight - ATokenInfo.StartPos.Physical);
1600      ATokenInfo.PhysicalCharStart := ATokenInfo.PhysicalCharStart - j;
1601      ATokenInfo.PhysicalCharEnd   := ATokenInfo.PhysicalCharEnd + i;
1602
1603      ATokenInfo.StartPos.Logical   := ATokenInfo.RtlInfo.LogFirst;
1604      ATokenInfo.ExpandedExtraBytes := ATokenInfo.RtlExpandedExtraBytes;
1605      ATokenInfo.HasTabs            := ATokenInfo.RtlHasTabs;
1606      ATokenInfo.HasDoubleWidth     := ATokenInfo.RtlHasDoubleWidth;
1607    end;
1608
1609    NeedExpansion := (ATokenInfo.ExpandedExtraBytes > 0) or (ATokenInfo.HasTabs);
1610    NeedTransform := FTextDrawer.NeedsEto or ATokenInfo.HasDoubleWidth or NeedExpansion
1611                     {$IFDEF Windows} or ATokenInfo.RtlInfo.IsRtl {$ENDIF}
1612                     ;
1613    Len := ATokenInfo.Tk.TokenLength;
1614    if (not ATokenInfo.RtlInfo.IsRtl) or (LineBufferRtlLogPos <> ATokenInfo.RtlInfo.LogFirst) then
1615      FEtoBuf := nil;
1616
1617    If NeedTransform and ATokenInfo.RtlInfo.IsRtl and (LineBufferRtlLogPos = ATokenInfo.RtlInfo.LogFirst)
1618    then begin
1619      // allready done
1620      if NeedExpansion then begin
1621        ATokenInfo.Tk.TokenStart  := LineBuffer;
1622        ATokenInfo.Tk.TokenLength := Len + ATokenInfo.ExpandedExtraBytes;
1623      end;
1624    end
1625    else
1626    If NeedTransform then begin
1627      LineBufferRtlLogPos := ATokenInfo.RtlInfo.LogFirst;
1628      pt := ATokenInfo.Tk.TokenStart;
1629      // prepare LineBuffer
1630      if NeedExpansion then begin
1631        if (LineBufferLen < Len + ATokenInfo.ExpandedExtraBytes + 1) then begin
1632          LineBufferLen := Len + ATokenInfo.ExpandedExtraBytes + 1 + 128;
1633          ReAllocMem(LineBuffer, LineBufferLen);
1634        end;
1635        pl := LineBuffer;
1636      end;
1637
1638      // Prepare FETOBuf
1639      if FTextDrawer.NeedsEto or ATokenInfo.HasDoubleWidth
1640         {$IFDEF Windows} or ATokenInfo.RtlInfo.IsRtl {$ENDIF}  // RTL may have script with ligature
1641      then begin
1642        FEtoBuf := FTextDrawer.Eto;
1643        FEtoBuf.SetMinLength(Len + ATokenInfo.ExpandedExtraBytes + 1);
1644        c := FTextDrawer.GetCharWidth;
1645      end
1646      else
1647        c := 0;
1648        e := 0;
1649
1650      CWLen := Length(CharWidths);
1651
1652      // Copy to LineBuffer (and maybe FetoBuf
1653      if NeedExpansion then begin
1654        j := ATokenInfo.StartPos.Logical - 1;
1655        for i := 0 to Len - 1 do begin
1656          if j < CWLen
1657          then k := (CharWidths[j] and PCWMask)
1658          else k := 1;
1659          // combining chars will get 0 widths
1660          if (pt^ in [#0..#127, #192..#255]) and (FetoBuf <> nil) then begin
1661            FEtoBuf.EtoData[e] := k * c;
1662            inc(e);
1663          end;
1664
1665          case pt^ of
1666            #9: begin
1667                dec(e);
1668                if (vscTabAtFirst in FVisibleSpecialChars) and (j < CWLen) then begin
1669                  pl^ := #194; inc(pl);
1670                  pl^ := #187; inc(pl);
1671                  dec(k);
1672                  if FetoBuf <> nil then FEtoBuf.EtoData[e] := c;
1673                  inc(e);
1674                end;
1675                while k > 0 do begin
1676                  pl^ := ' '; inc(pl);
1677                  dec(k);
1678                  if FetoBuf <> nil then FEtoBuf.EtoData[e] := c;
1679                  inc(e);
1680                end;
1681                if (vscTabAtLast in FVisibleSpecialChars) and ((pl-1)^=' ') and (j < CWLen) then begin
1682                  (pl-1)^ := #194;
1683                  pl^ := #187; inc(pl);
1684                  if FetoBuf <> nil then FEtoBuf.EtoData[e] := c;
1685                  inc(e);
1686                end;
1687              end;
1688            ' ': begin
1689                if (vscSpace in FVisibleSpecialChars) and (j < CWLen) then begin
1690                  pl^ := #194; inc(pl);
1691                  pl^ := #183; inc(pl);
1692                end
1693                else begin
1694                  pl^ := pt^;
1695                  inc(pl);
1696                end;
1697              end;
1698            else begin
1699                pl^ := pt^;
1700                inc(pl);
1701              end;
1702          end;
1703          inc(pt);
1704          inc(j);
1705        end;
1706        pl^ := #0;
1707
1708      // Finish linebuffer
1709      ATokenInfo.Tk.TokenStart  := LineBuffer;
1710      ATokenInfo.Tk.TokenLength := Len + ATokenInfo.ExpandedExtraBytes;
1711      // TODO skip expanded half tab
1712
1713      end
1714      else
1715      // FETOBuf only
1716      begin
1717        for j := ATokenInfo.StartPos.Logical - 1 to ATokenInfo.StartPos.Logical - 1 + Len do begin
1718          if pt^ in [#0..#127, #192..#255] then begin
1719            // combining chars will get 0 widths
1720            if j < CWLen
1721            then k := (CharWidths[j] and PCWMask)
1722            else k := 1;
1723            FEtoBuf.EtoData[e] := k * c;
1724            inc(e);
1725          end;
1726          inc(pt);
1727        end;
1728      end;
1729    end;
1730
1731    if (ATokenInfo.PhysicalCharStart <> ATokenInfo.PhysicalClipStart) or
1732       (ATokenInfo.PhysicalCharEnd <> ATokenInfo.PhysicalClipEnd)
1733    then
1734      TxtFlags := TxtFlags + ETO_CLIPPED;
1735
1736    tok := rcToken;
1737    if rcToken.Right > nRightEdge + 1 then
1738      tok.Bottom := rcLine.Bottom;
1739    TxtLeft := ScreenColumnToXValue(ATokenInfo.PhysicalCharStart); // because for the first token, this can be middle of a char, and lead to wrong frame
1740    fTextDrawer.NewTextOut(TxtLeft, rcToken.Top, TxtFlags, tok,
1741      ATokenInfo.Tk.TokenStart, ATokenInfo.Tk.TokenLength, FEtoBuf);
1742
1743
1744    rcToken.Left := rcToken.Right;
1745  end;
1746
1747  procedure PaintLines;
1748  var
1749    ypos: Integer;
1750    DividerInfo: TSynDividerDrawConfigSetting;
1751    TV, cl: Integer;
1752    TokenInfoEx: TLazSynDisplayTokenInfoEx;
1753    MaxLine: Integer;
1754  begin
1755    // Initialize rcLine for drawing. Note that Top and Bottom are updated
1756    // inside the loop. Get only the starting point for this.
1757    rcLine := AClip;
1758    rcLine.Bottom := TextBounds.Top + FirstLine * fTextHeight;
1759
1760    TV := TopLine - 1;
1761
1762    // Now loop through all the lines. The indices are valid for Lines.
1763    MaxLine := DisplayView.GetLinesCount-1;
1764
1765    CurLine := FirstLine-1;
1766    while CurLine<LastLine do begin
1767      inc(CurLine);
1768      if TV + CurLine > MaxLine then break;
1769      // Update the rcLine rect to this line.
1770      rcLine.Top := rcLine.Bottom;
1771      Inc(rcLine.Bottom, fTextHeight);
1772      // Paint the lines depending on the assigned highlighter.
1773      rcToken := rcLine;
1774      // Delete the whole Line
1775      fTextDrawer.BackColor := colEditorBG;
1776      SetBkColor(dc, ColorToRGB(colEditorBG));
1777      rcLine.Left := EraseLeft;
1778      InternalFillRect(dc, rcLine);
1779      rcLine.Left := DrawLeft;
1780      LineBufferRtlLogPos := -1;
1781
1782      FTokenBreaker.SetHighlighterTokensLine(TV + CurLine, CurTextIndex);
1783      CharWidths := FTokenBreaker.CharWidths;
1784      fMarkupManager.PrepareMarkupForRow(CurTextIndex+1);
1785
1786      DividerInfo := DisplayView.GetDrawDividerInfo;  // May call HL.SetRange
1787      if (DividerInfo.Color <> clNone) and (nRightEdge >= FTextBounds.Left) then
1788      begin
1789        ypos := rcToken.Bottom - 1;
1790        cl := DividerInfo.Color;
1791        if cl = clDefault then
1792          cl := RightEdgeColor;
1793        fTextDrawer.DrawLine(nRightEdge, ypos, FTextBounds.Left - 1, ypos, cl);
1794        dec(rcToken.Bottom);
1795      end;
1796
1797      while FTokenBreaker.GetNextHighlighterTokenEx(TokenInfoEx) do begin
1798        DrawHiLightMarkupToken(TokenInfoEx);
1799      end;
1800
1801      fMarkupManager.FinishMarkupForRow(CurTextIndex+1);
1802    end;
1803    CurLine := -1;
1804    AClip.Top := rcLine.Bottom;
1805  end;
1806
1807{ end local procedures }
1808
1809begin
1810  fMarkupManager.BeginMarkup;
1811  FTokenBreaker.Prepare(DisplayView, FTheLinesView, FMarkupManager, FirstCol, LastCol);
1812  FTokenBreaker.ForegroundColor := ForegroundColor;
1813  FTokenBreaker.BackgroundColor := BackgroundColor;
1814  FTokenBreaker.SpaceExtraByteCount := 0;
1815  FTokenBreaker.TabExtraByteCount := 0;
1816  if (vscSpace in FVisibleSpecialChars) then
1817    FTokenBreaker.SpaceExtraByteCount := 1;
1818  if (vscTabAtFirst in FVisibleSpecialChars) then
1819    FTokenBreaker.TabExtraByteCount := FTokenBreaker.TabExtraByteCount + 1;
1820  if (vscTabAtLast in FVisibleSpecialChars) then
1821    FTokenBreaker.TabExtraByteCount := FTokenBreaker.TabExtraByteCount + 1;
1822  //if (AClip.Right < TextLeftPixelOffset(False)) then exit;
1823  //if (AClip.Left > ClientWidth - TextRightPixelOffset) then exit;
1824
1825  //DebugLn(['TCustomSynEdit.PaintTextLines ',dbgs(AClip)]);
1826  CurLine:=-1;
1827  //DebugLn('TCustomSynEdit.PaintTextLines ',DbgSName(Self),' TopLine=',dbgs(TopLine),' AClip=',dbgs(AClip));
1828  colEditorBG := BackgroundColor;
1829  // If the right edge is visible and in the invalid area, prepare to paint it.
1830  // Do this first to realize the pen when getting the dc variable.
1831  bDoRightEdge := False;
1832  if FRightEdgeVisible then begin // column value
1833    nRightEdge := FTextBounds.Left + (RightEdgeColumn - LeftChar + 1) * CharWidth; // pixel value
1834    if (nRightEdge >= AClip.Left) and (nRightEdge <= AClip.Right) then
1835      bDoRightEdge := True;
1836    if nRightEdge > AClip.Right then
1837      nRightEdge := AClip.Right; // for divider draw lines (don't draw into right gutter)
1838  end
1839  else
1840    nRightEdge := AClip.Right;
1841
1842  Canvas.Pen.Color := RightEdgeColor; // used for code folding too
1843  Canvas.Pen.Width := 1;
1844  // Do everything else with API calls. This (maybe) realizes the new pen color.
1845  dc := Canvas.Handle;
1846  SetBkMode(dc, TRANSPARENT);
1847
1848  // Adjust the invalid area to not include the gutter (nor the 2 ixel offset to the guttter).
1849  EraseLeft := AClip.Left;
1850  if (AClip.Left < FTextBounds.Left) then
1851    AClip.Left := FTextBounds.Left ;
1852  DrawLeft := AClip.Left;
1853
1854  if (LastLine >= FirstLine) then begin
1855    // Paint the visible text lines. To make this easier, compute first the
1856    // necessary information about the selected area: is there any visible
1857    // selected area, and what are its lines / columns?
1858    // Moved to two local procedures to make it easier to read.
1859
1860    LineBufferLen := 0;
1861    LineBuffer := nil;
1862    if Assigned(fHighlighter) then begin
1863      fHighlighter.CurrentLines := FTheLinesView;
1864    end;
1865
1866    DisplayView.InitHighlighterTokens(FHighlighter);
1867    fTextDrawer.Style := []; //Font.Style;
1868    fTextDrawer.BeginDrawing(dc);
1869    try
1870      PaintLines;
1871    finally
1872      fTextDrawer.EndDrawing;
1873      DisplayView.FinishHighlighterTokens;
1874      ReAllocMem(LineBuffer, 0);
1875    end;
1876  end;
1877
1878  if (AClip.Top < AClip.Bottom) then begin
1879    // Delete the remaining area
1880    SetBkColor(dc, ColorToRGB(colEditorBG));
1881    AClip.Left := EraseLeft;
1882    InternalFillRect(dc, AClip);
1883    AClip.Left := DrawLeft;
1884
1885    // Draw the right edge if necessary.
1886    if bDoRightEdge then begin
1887      LCLIntf.MoveToEx(dc, nRightEdge, AClip.Top, nil);
1888      LCLIntf.LineTo(dc, nRightEdge, AClip.Bottom + 1);
1889    end;
1890  end;
1891
1892  fMarkupManager.EndMarkup;
1893end;
1894
1895end.
1896
1897