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