1{-------------------------------------------------------------------------------
2The contents of this file are subject to the Mozilla Public License
3Version 1.1 (the "License"); you may not use this file except in compliance
4with the License. You may obtain a copy of the License at
5http://www.mozilla.org/MPL/
6
7Software distributed under the License is distributed on an "AS IS" basis,
8WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
9the specific language governing rights and limitations under the License.
10
11The Original Code is: SynEditMiscClasses.pas, released 2000-04-07.
12The Original Code is based on the mwSupportClasses.pas file from the
13mwEdit component suite by Martin Waldenburg and other developers, the Initial
14Author of this file is Michael Hieke.
15All Rights Reserved.
16
17Contributors to the SynEdit and mwEdit projects are listed in the
18Contributors.txt file.
19
20Alternatively, the contents of this file may be used under the terms of the
21GNU General Public License Version 2 or later (the "GPL"), in which case
22the provisions of the GPL are applicable instead of those above.
23If you wish to allow use of your version of this file only under the terms
24of the GPL and not to allow others to use your version of this file
25under the MPL, indicate your decision by deleting the provisions above and
26replace them with the notice and other provisions required by the GPL.
27If you do not delete the provisions above, a recipient may use your version
28of this file under either the MPL or the GPL.
29
30$Id$
31
32You may retrieve the latest version of this file at the SynEdit home page,
33located at http://SynEdit.SourceForge.net
34
35Known Issues:
36-------------------------------------------------------------------------------}
37
38unit SynEditMiscClasses;
39
40{$I synedit.inc}
41{$INLINE off}
42
43interface
44
45uses
46  Classes, SysUtils,
47  // LazUtils
48  LazMethodList, LazUtilities, LazLoggerBase,
49  // LCL
50  LCLIntf, LCLType, Graphics, Controls, Clipbrd, ImgList,
51  // SynEdit
52  SynEditHighlighter, SynEditMiscProcs, SynEditTypes, LazSynEditText, SynEditPointClasses, SynEditMouseCmds,
53  SynEditTextBase;
54
55const
56  SYNEDIT_DEFAULT_MOUSE_OPTIONS = [];
57
58  // MouseAction related options MUST NOT be included here
59  SYNEDIT_DEFAULT_OPTIONS = [
60    eoAutoIndent,
61    eoScrollPastEol,
62    eoSmartTabs,
63    eoTabsToSpaces,
64    eoTrimTrailingSpaces,
65    eoGroupUndo,
66    eoBracketHighlight
67  ];
68
69  SYNEDIT_DEFAULT_OPTIONS2 = [
70    eoFoldedCopyPaste,
71    eoOverwriteBlock,
72    eoAcceptDragDropEditing
73  ];
74
75  // Those will be prevented from being set => so evtl they may be removed
76  SYNEDIT_UNIMPLEMENTED_OPTIONS = [
77    eoAutoSizeMaxScrollWidth,  //TODO Automatically resizes the MaxScrollWidth property when inserting text
78    eoDisableScrollArrows,     //TODO Disables the scroll bar arrow buttons when you can't scroll in that direction any more
79    eoDropFiles,               //TODO Allows the editor accept file drops
80    eoHideShowScrollbars,      //TODO if enabled, then the scrollbars will only show when necessary.  If you have ScrollPastEOL, then it the horizontal bar will always be there (it uses MaxLength instead)
81    eoSmartTabDelete,          //TODO similar to Smart Tabs, but when you delete characters
82    ////eoSpecialLineDefaultFg,    //TODO disables the foreground text color override when using the OnSpecialLineColor event
83    eoAutoIndentOnPaste,       // Indent text inserted from clipboard
84    eoSpacesToTabs             // Converts space characters to tabs and spaces
85  ];
86
87type
88
89  TSynUndoRedoItemEvent = function (Caller: TObject; Item: TSynEditUndoItem): Boolean of object;
90
91  { TSynWordBreaker }
92
93  TSynWordBreaker = class
94  private
95    FIdentChars: TSynIdentChars;
96    FWhiteChars: TSynIdentChars;
97    FWordBreakChars: TSynIdentChars;
98    FWordChars: TSynIdentChars;
99    procedure SetIdentChars(const AValue: TSynIdentChars);
100    procedure SetWhiteChars(const AValue: TSynIdentChars);
101    procedure SetWordBreakChars(const AValue: TSynIdentChars);
102  public
103    constructor Create;
104    procedure Reset;
105
106    // aX is the position between the chars (as in CaretX)
107    // 1 is in front of the first char
108    function IsInWord     (aLine: String; aX: Integer
109                           ): Boolean;  // Includes at word boundary
110    function IsAtWordStart(aLine: String; aX: Integer): Boolean;
111    function IsAtWordEnd  (aLine: String; aX: Integer): Boolean;
112    function NextWordStart(aLine: String; aX: Integer;
113                           aIncludeCurrent: Boolean = False): Integer;
114    function NextWordEnd  (aLine: String; aX: Integer;
115                           aIncludeCurrent: Boolean = False): Integer;
116    function PrevWordStart(aLine: String; aX: Integer;
117                           aIncludeCurrent: Boolean = False): Integer;
118    function PrevWordEnd  (aLine: String; aX: Integer;
119                           aIncludeCurrent: Boolean = False): Integer;
120
121    function NextBoundary (aLine: String; aX: Integer;
122                           aIncludeCurrent: Boolean = False): Integer;
123    function PrevBoundary (aLine: String; aX: Integer;
124                           aIncludeCurrent: Boolean = False): Integer;
125
126    property IdentChars: TSynIdentChars read FIdentChars write SetIdentChars;
127    property WordChars: TSynIdentChars read FWordChars;
128    property WordBreakChars: TSynIdentChars read FWordBreakChars write SetWordBreakChars;
129    property WhiteChars: TSynIdentChars read FWhiteChars write SetWhiteChars;
130  end;
131
132  TLazSynSurface = class;
133  TSynSelectedColor = class;
134  TSynBookMarkOpt = class;
135
136  { TSynEditBase }
137
138  TSynEditBase = class(TCustomControl)
139  private
140    FMouseOptions: TSynEditorMouseOptions;
141    fReadOnly: Boolean;
142    fHideSelection: boolean;
143    fBookMarkOpt: TSynBookMarkOpt;
144    fExtraCharSpacing: integer;
145    fExtraLineSpacing: integer;
146    procedure BookMarkOptionsChanged(Sender: TObject);
147    procedure SetHideSelection(Value: boolean);
148  protected
149    FWordBreaker: TSynWordBreaker;
150    FBlockSelection: TSynEditSelection;
151    FScreenCaret: TSynEditScreenCaret;
152    FOptions: TSynEditorOptions;
153    FOptions2: TSynEditorOptions2;
154    procedure DoTopViewChanged(Sender: TObject); virtual; abstract;
155    function GetMarkupMgr: TObject; virtual; abstract;
156    function GetLines: TStrings; virtual; abstract;
157    function GetCanRedo: boolean; virtual; abstract;
158    function GetCanUndo: boolean; virtual; abstract;
159    function GetCaretObj: TSynEditCaret; virtual; abstract;
160    function GetModified: Boolean; virtual; abstract;
161    function GetReadOnly: boolean; virtual;
162    function GetIsBackwardSel: Boolean;
163    function GetHighlighterObj: TObject; virtual; abstract;
164    function GetMarksObj: TObject; virtual; abstract;
165    function GetSelText: string;
166    function GetSelAvail: Boolean;
167    function GetSelectedColor: TSynSelectedColor; virtual; abstract;
168    function GetTextViewsManager: TSynTextViewsManager; virtual; abstract;
169    procedure SetLines(Value: TStrings); virtual; abstract;
170    function GetViewedTextBuffer: TSynEditStringsLinked; virtual; abstract;
171    function GetFoldedTextBuffer: TObject; virtual; abstract;
172    function GetTextBuffer: TSynEditStrings; virtual; abstract;
173    function GetPaintArea: TLazSynSurface; virtual; abstract; // TLazSynSurfaceManager
174    procedure SetModified(Value: boolean); virtual; abstract;
175    procedure SetMouseOptions(AValue: TSynEditorMouseOptions); virtual;
176    procedure SetReadOnly(Value: boolean); virtual;
177    procedure StatusChanged(AChanges: TSynStatusChanges); virtual; abstract;
178    procedure SetOptions(AOptions: TSynEditorOptions); virtual; abstract;
179    procedure SetOptions2(AOptions2: TSynEditorOptions2); virtual; abstract;
180    procedure SetSelectedColor(const aSelectedColor: TSynSelectedColor); virtual; abstract;
181
182    function GetCharsInWindow: Integer; virtual; abstract;
183    function GetCharWidth: integer; virtual; abstract;
184    function GetLeftChar: Integer; virtual; abstract;
185    function GetLineHeight: integer; virtual; abstract;
186    function GetLinesInWindow: Integer; virtual; abstract;
187    function GetTopLine: Integer; virtual; abstract;
188    procedure SetLeftChar(Value: Integer); virtual; abstract;
189    procedure SetTopLine(Value: Integer); virtual; abstract;
190
191    function GetBlockBegin: TPoint; virtual; abstract;
192    function GetBlockEnd: TPoint; virtual; abstract;
193    function GetSelEnd: Integer; virtual; abstract;
194    function GetSelStart: Integer; virtual; abstract;
195    procedure SetBlockBegin(Value: TPoint); virtual; abstract;
196    procedure SetBlockEnd(Value: TPoint); virtual; abstract;
197    procedure SetSelEnd(const Value: Integer); virtual; abstract;
198    procedure SetSelStart(const Value: Integer); virtual; abstract;
199    procedure SetSelTextExternal(const Value: string); virtual; abstract;
200
201    function GetMouseActions: TSynEditMouseActions; virtual; abstract;
202    function GetMouseSelActions: TSynEditMouseActions; virtual; abstract;
203    function GetMouseTextActions: TSynEditMouseActions; virtual; abstract;
204    procedure SetMouseActions(const AValue: TSynEditMouseActions); virtual; abstract;
205    procedure SetMouseSelActions(const AValue: TSynEditMouseActions); virtual; abstract;
206    procedure SetMouseTextActions(AValue: TSynEditMouseActions); virtual; abstract;
207
208    procedure SetExtraCharSpacing(const AValue: integer); virtual;
209    procedure SetExtraLineSpacing(const AValue: integer); virtual;
210
211    function GetCaretX : Integer; virtual; abstract;
212    function GetCaretY : Integer; virtual; abstract;
213    function GetCaretXY: TPoint; virtual; abstract;
214    procedure SetCaretX(const Value: Integer); virtual; abstract;
215    procedure SetCaretY(const Value: Integer); virtual; abstract;
216    procedure SetCaretXY(Value: TPoint); virtual; abstract;
217    function GetLogicalCaretXY: TPoint; virtual; abstract;
218    procedure SetLogicalCaretXY(const NewLogCaretXY: TPoint); virtual; abstract;
219
220    property MarkupMgr: TObject read GetMarkupMgr;
221    property FoldedTextBuffer: TObject read GetFoldedTextBuffer;                // TSynEditFoldedView
222    property ViewedTextBuffer: TSynEditStringsLinked read GetViewedTextBuffer;        // As viewed internally (with uncommited spaces / TODO: expanded tabs, folds). This may change, use with care
223    property TextBuffer: TSynEditStrings read GetTextBuffer;                    // (TSynEditStringList) No uncommited (trailing/trimmable) spaces
224    property WordBreaker: TSynWordBreaker read FWordBreaker;
225  public
226    constructor Create(AOwner: TComponent); override;
227    destructor Destroy; override;
228
229    function FindGutterFromGutterPartList(const APartList: TObject): TObject; virtual; abstract;
230  public
231    // Caret
232    function CaretXPix: Integer; virtual; abstract;
233    function CaretYPix: Integer; virtual; abstract;
234
235    function ScreenRowToRow(ScreenRow: integer; LimitToLines: Boolean = True): integer; virtual; abstract; deprecated 'use ScreenXYToTextXY';
236    function RowToScreenRow(PhysicalRow: integer): integer; virtual; abstract; deprecated 'use TextXYToScreenXY';
237    (* ScreenXY:
238       First visible (scrolled in) screen line is 1
239       First column is 1 => column does not take scrolling into account
240    *)
241    function ScreenXYToTextXY(AScreenXY: TPhysPoint; LimitToLines: Boolean = True): TPhysPoint; virtual; abstract;
242    function TextXYToScreenXY(APhysTextXY: TPhysPoint): TPhysPoint; virtual; abstract;
243
244    procedure GetWordBoundsAtRowCol(const XY: TPoint; out StartX, EndX: integer); virtual; abstract;
245    function GetWordAtRowCol(XY: TPoint): string; virtual; abstract;
246
247    // Cursor
248    procedure UpdateCursorOverride; virtual; abstract;
249  public
250    // Undo Redo
251    procedure BeginUndoBlock{$IFDEF SynUndoDebugBeginEnd}(ACaller: String = ''){$ENDIF}; virtual; abstract;
252    procedure BeginUpdate(WithUndoBlock: Boolean = True); virtual; abstract;
253    procedure EndUndoBlock{$IFDEF SynUndoDebugBeginEnd}(ACaller: String = ''){$ENDIF}; virtual; abstract;
254    procedure EndUpdate; virtual; abstract;
255
256    procedure ClearUndo; virtual; abstract;
257    procedure Redo; virtual; abstract;
258    procedure Undo; virtual; abstract;
259    property CanRedo: boolean read GetCanRedo;
260    property CanUndo: boolean read GetCanUndo;
261  public
262    // matching brackets
263    procedure FindMatchingBracket; virtual; abstract;
264    function FindMatchingBracket(PhysStartBracket: TPoint;
265                                 StartIncludeNeighborChars, MoveCaret,
266                                 SelectBrackets, OnlyVisible: Boolean
267                                ): TPoint; virtual; abstract; // Returns Physical
268    function FindMatchingBracketLogical(LogicalStartBracket: TPoint;
269                                        StartIncludeNeighborChars, MoveCaret,
270                                        SelectBrackets, OnlyVisible: Boolean
271                                       ): TPoint; virtual; abstract; // Returns Logical
272  public
273    // handlers
274    procedure RegisterCommandHandler(AHandlerProc: THookedCommandEvent;
275      AHandlerData: pointer; AFlags: THookedCommandFlags = [hcfPreExec, hcfPostExec]); virtual; abstract;
276    procedure UnregisterCommandHandler(AHandlerProc: THookedCommandEvent); virtual; abstract;
277
278    procedure RegisterMouseActionSearchHandler(AHandlerProc: TSynEditMouseActionSearchProc); virtual; abstract;
279    procedure UnregisterMouseActionSearchHandler(AHandlerProc: TSynEditMouseActionSearchProc); virtual; abstract;
280    procedure RegisterMouseActionExecHandler(AHandlerProc: TSynEditMouseActionExecProc); virtual; abstract;
281    procedure UnregisterMouseActionExecHandler(AHandlerProc: TSynEditMouseActionExecProc); virtual; abstract;
282
283    procedure RegisterKeyTranslationHandler(AHandlerProc: THookedKeyTranslationEvent); virtual; abstract;
284    procedure UnRegisterKeyTranslationHandler(AHandlerProc: THookedKeyTranslationEvent); virtual; abstract;
285
286    procedure RegisterUndoRedoItemHandler(AHandlerProc: TSynUndoRedoItemEvent); virtual; abstract;
287    procedure UnRegisterUndoRedoItemHandler(AHandlerProc: TSynUndoRedoItemEvent); virtual; abstract;
288
289    procedure RegisterStatusChangedHandler(AStatusChangeProc: TStatusChangeEvent; AChanges: TSynStatusChanges); virtual; abstract;
290    procedure UnRegisterStatusChangedHandler(AStatusChangeProc: TStatusChangeEvent); virtual; abstract;
291
292    procedure RegisterBeforeMouseDownHandler(AHandlerProc: TMouseEvent); virtual; abstract;
293    procedure UnregisterBeforeMouseDownHandler(AHandlerProc: TMouseEvent); virtual; abstract;
294
295    procedure RegisterQueryMouseCursorHandler(AHandlerProc: TSynQueryMouseCursorEvent); virtual; abstract;
296    procedure UnregisterQueryMouseCursorHandler(AHandlerProc: TSynQueryMouseCursorEvent); virtual; abstract;
297
298    procedure RegisterBeforeKeyDownHandler(AHandlerProc: TKeyEvent); virtual; abstract;
299    procedure UnregisterBeforeKeyDownHandler(AHandlerProc: TKeyEvent); virtual; abstract;
300    procedure RegisterBeforeKeyUpHandler(AHandlerProc: TKeyEvent); virtual; abstract;
301    procedure UnregisterBeforeKeyUpHandler(AHandlerProc: TKeyEvent); virtual; abstract;
302    procedure RegisterBeforeKeyPressHandler(AHandlerProc: TKeyPressEvent); virtual; abstract;
303    procedure UnregisterBeforeKeyPressHandler(AHandlerProc: TKeyPressEvent); virtual; abstract;
304    procedure RegisterBeforeUtf8KeyPressHandler(AHandlerProc: TUTF8KeyPressEvent); virtual; abstract;
305    procedure UnregisterBeforeUtf8KeyPressHandler(AHandlerProc: TUTF8KeyPressEvent); virtual; abstract;
306
307    procedure RegisterPaintEventHandler(APaintEventProc: TSynPaintEventProc; AnEvents: TSynPaintEvents); virtual; abstract;
308    procedure UnRegisterPaintEventHandler(APaintEventProc: TSynPaintEventProc); virtual; abstract;
309    procedure RegisterScrollEventHandler(AScrollEventProc: TSynScrollEventProc; AnEvents: TSynScrollEvents); virtual; abstract;
310    procedure UnRegisterScrollEventHandler(AScrollEventProc: TSynScrollEventProc); virtual; abstract;
311
312  public
313    function IsLinkable(Y, X1, X2: Integer): Boolean; virtual; abstract;
314    // invalidate lines
315    procedure InvalidateGutter; virtual; abstract;
316    procedure InvalidateLine(Line: integer); virtual; abstract;
317    procedure InvalidateGutterLines(FirstLine, LastLine: integer); virtual; abstract; // Currently invalidates full line => that may change
318    procedure InvalidateLines(FirstLine, LastLine: integer); virtual; abstract;
319
320    // text / lines
321    function GetLineState(ALine: Integer): TSynLineState; virtual; abstract;
322  public
323    // Byte to Char
324    function LogicalToPhysicalPos(const p: TPoint): TPoint; virtual; abstract;
325    function LogicalToPhysicalCol(const Line: String; Index, LogicalPos
326                              : integer): integer; virtual; abstract;
327    // Char to Byte
328    function PhysicalToLogicalPos(const p: TPoint): TPoint; virtual; abstract;
329    function PhysicalToLogicalCol(const Line: string;
330                                  Index, PhysicalPos: integer): integer; virtual; abstract;
331    function PhysicalLineLength(Line: String; Index: integer): integer; virtual; abstract;
332  public
333    property BookMarkOptions: TSynBookMarkOpt read fBookMarkOpt write fBookMarkOpt; // ToDo: check "write fBookMarkOpt"
334    property ExtraCharSpacing: integer read fExtraCharSpacing write SetExtraCharSpacing default 0;
335    property ExtraLineSpacing: integer read fExtraLineSpacing write SetExtraLineSpacing default 0;
336    property Lines: TStrings read GetLines write SetLines;
337    // See SYNEDIT_UNIMPLEMENTED_OPTIONS for deprecated Values
338    property Options: TSynEditorOptions read FOptions write SetOptions default SYNEDIT_DEFAULT_OPTIONS;
339    property Options2: TSynEditorOptions2 read FOptions2 write SetOptions2 default SYNEDIT_DEFAULT_OPTIONS2;
340    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default FALSE;
341    property Modified: Boolean read GetModified write SetModified;
342
343    property CaretX: Integer read GetCaretX write SetCaretX;
344    property CaretY: Integer read GetCaretY write SetCaretY;
345    property CaretXY: TPoint read GetCaretXY write SetCaretXY;// screen position
346    property LogicalCaretXY: TPoint read GetLogicalCaretXY write SetLogicalCaretXY;
347
348    property CharsInWindow: Integer read GetCharsInWindow;
349    property CharWidth: integer read GetCharWidth;
350    property LeftChar: Integer read GetLeftChar write SetLeftChar;
351    property LineHeight: integer read GetLineHeight;
352    property LinesInWindow: Integer read GetLinesInWindow;
353    property TopLine: Integer read GetTopLine write SetTopLine;
354
355    property BlockBegin: TPoint read GetBlockBegin write SetBlockBegin;         // Set Blockbegin. For none persistent also sets Blockend. Setting Caret may undo this and should be done before setting block
356    property BlockEnd: TPoint read GetBlockEnd write SetBlockEnd;
357    property SelStart: Integer read GetSelStart write SetSelStart;              // 1-based byte pos of first selected char
358    property SelEnd: Integer read GetSelEnd write SetSelEnd;                    // 1-based byte pos of first char after selction end
359    property IsBackwardSel: Boolean read GetIsBackwardSel;
360    property SelText: string read GetSelText write SetSelTextExternal;
361
362    property MouseActions: TSynEditMouseActions read GetMouseActions write SetMouseActions;
363    // Mouseactions, if mouse is over selection => fallback to normal
364    property MouseSelActions: TSynEditMouseActions read GetMouseSelActions write SetMouseSelActions;
365    property MouseTextActions: TSynEditMouseActions read GetMouseTextActions write SetMouseTextActions;
366    property MouseOptions: TSynEditorMouseOptions read FMouseOptions write SetMouseOptions
367      default SYNEDIT_DEFAULT_MOUSE_OPTIONS;
368
369    property TextViewsManager: TSynTextViewsManager read GetTextViewsManager; experimental; // Only use to Add/remove views
370
371    property SelectedColor: TSynSelectedColor read GetSelectedColor write SetSelectedColor;
372    property SelAvail: Boolean read GetSelAvail;
373    property HideSelection: boolean read fHideSelection write SetHideSelection default false;
374
375    property Highlighter: TObject read GetHighlighterObj;
376    property Marks: TObject read GetMarksObj;
377  end;
378
379  { TSynEditFriend }
380  // TODO: Redesign
381
382  TSynEditFriend = class(TComponent)
383  private
384    FFriendEdit: TSynEditBase;
385    function GetCaretObj: TSynEditCaret;
386    function GetFoldedTextBuffer: TObject;
387    function GetIsRedoing: Boolean;
388    function GetIsUndoing: Boolean;
389    function GetMarkupMgr: TObject;
390    function GetPaintArea: TLazSynSurface; // TLazSynSurfaceManager
391    function GetScreenCaret: TSynEditScreenCaret;
392    function GetSelectionObj: TSynEditSelection;
393    function GetTextBuffer: TSynEditStrings;
394    function GetViewedTextBuffer: TSynEditStringsLinked;
395    function GetWordBreaker: TSynWordBreaker;
396  protected
397    property FriendEdit: TSynEditBase read FFriendEdit write FFriendEdit;
398    property FoldedTextBuffer: TObject read GetFoldedTextBuffer;                // TSynEditFoldedView
399    property ViewedTextBuffer: TSynEditStringsLinked read GetViewedTextBuffer;        // As viewed internally (with uncommited spaces / TODO: expanded tabs, folds). This may change, use with care
400    property TextBuffer: TSynEditStrings read GetTextBuffer;                    // (TSynEditStringList)
401    property CaretObj: TSynEditCaret read GetCaretObj;
402    property ScreenCaret: TSynEditScreenCaret read GetScreenCaret; // TODO: should not be exposed
403    property SelectionObj: TSynEditSelection read GetSelectionObj;
404    property PaintArea: TLazSynSurface read GetPaintArea; // TLazSynSurfaceManager
405    property MarkupMgr: TObject read GetMarkupMgr;
406    property IsUndoing: Boolean read GetIsUndoing;
407    property IsRedoing: Boolean read GetIsRedoing;
408    property WordBreaker: TSynWordBreaker read GetWordBreaker;
409  end;
410
411
412  TSynObjectListItem = class;
413
414  { TSynObjectList }
415
416  TSynObjectList = class(TComponent)
417  private
418    FList: TList;
419    FOnChange: TNotifyEvent;
420    FOwner: TComponent;
421    FSorted: Boolean;
422    function GetBasePart(Index: Integer): TSynObjectListItem;
423    procedure PutBasePart(Index: Integer; const AValue: TSynObjectListItem);
424    procedure SetSorted(const AValue: Boolean);
425  protected
426    function GetChildOwner: TComponent; override;
427    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
428    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
429    procedure RegisterItem(AnItem: TSynObjectListItem); virtual;
430    procedure DoChange(Sender: TObject); virtual;
431    property List: TList read FList;
432  public
433    constructor Create(AOwner: TComponent); override;
434    destructor  Destroy; override;
435    procedure Assign(Source: TPersistent); override;
436    Function  Add(AnItem: TSynObjectListItem): Integer;
437    Procedure Delete(Index: Integer);
438    Procedure Clear;
439    Function  Count: Integer;
440    Function  IndexOf(AnItem: TSynObjectListItem): Integer;
441    Procedure Move(AOld, ANew: Integer);
442    procedure Sort;
443    property Sorted: Boolean read FSorted write SetSorted;
444    property Owner: TComponent read FOwner;
445    property BaseItems[Index: Integer]: TSynObjectListItem
446      read GetBasePart write PutBasePart; default;
447    property OnChange: TNotifyEvent read FOnChange write FOnChange;
448  end;
449
450  { TSynObjectListItem }
451
452  TSynObjectListItem = class(TSynEditFriend)
453  private
454    FOwner: TSynObjectList;
455    function GetIndex: Integer;
456    procedure SetIndex(const AValue: Integer);
457  protected
458    function Compare(Other: TSynObjectListItem): Integer; virtual;
459    function GetDisplayName: String; virtual;
460    property Owner: TSynObjectList read FOwner;
461    // Use Init to setup things that are needed before Owner.RegisterItem (bur require Owner to be set)
462    procedure Init; virtual;
463  public
464    constructor Create(AOwner: TComponent); override;
465    destructor  Destroy; override;
466    property Index: Integer read GetIndex write SetIndex;
467    property DisplayName: String read GetDisplayName;
468    function GetParentComponent: TComponent; override; // for child order in stream reading
469  end;
470
471  TSynObjectListItemClass = class of TSynObjectListItem;
472
473  TLazSynDisplayTokenBound = record
474    Physical: Integer;      // 1 based - May be in middle of char
475    Logical: Integer;       // 1 based
476    Offset: Integer;        // default 0. MultiWidth (e.g. Tab), if token starts in the middle of char
477  end;
478
479  { TSynSelectedColor }
480
481  TSynSelectedColor = class(TSynHighlighterAttributesModifier)
482  private
483    // 0 or -1 start/end before/after line // 1 first char
484    FStartX, FEndX: TLazSynDisplayTokenBound;
485  protected
486    procedure DoClear; override;
487    procedure AssignFrom(Src: TLazSynCustomTextAttributes); override;
488    procedure Init; override;
489  public
490    // boundaries of the frame
491    procedure SetFrameBoundsPhys(AStart, AEnd: Integer);
492    procedure SetFrameBoundsLog(AStart, AEnd: Integer; AStartOffs: Integer = 0; AEndOffs: Integer = 0);
493    property StartX: TLazSynDisplayTokenBound read FStartX write FStartX;
494    property EndX: TLazSynDisplayTokenBound read FEndX write FEndX;
495  public
496    function GetModifiedStyle(aStyle: TFontStyles): TFontStyles; // deprecated;
497    procedure ModifyColors(var AForeground, ABackground, AFrameColor: TColor;
498      var AStyle: TFontStyles; var AFrameStyle: TSynLineStyle); deprecated;
499  end;
500
501  TSynSelectedColorAlphaEntry = record
502    Color: TColor;
503    Alpha: Integer;
504    Priority: Integer
505  end;
506
507  TSynSelectedColorMergeInfo = record
508    BaseColor: TColor;
509    BasePriority: Integer;
510    AlphaCount: Integer;
511    AlphaStack: Array of TSynSelectedColorAlphaEntry;
512  end;
513
514  TSynSelectedColorEnum = (
515    sscBack, sscFore, sscFrameLeft, sscFrameRight, sscFrameTop, sscFrameBottom
516  );
517
518  { TSynSelectedColorMergeResult }
519
520  TSynSelectedColorMergeResult = class(TSynSelectedColor)
521  private
522    // TSynSelectedColor.Style and StyleMask describe how to modify a style,
523    // but PaintLines creates an instance that contains an actual style (without mask)
524    MergeFinalStyle: Boolean; // always true
525    FMergeInfoInitialized: Boolean;
526
527    FCurrentEndX: TLazSynDisplayTokenBound;
528    FCurrentStartX: TLazSynDisplayTokenBound;
529    FFrameSidesInitialized: Boolean;
530    FFrameSideColors: array[TLazSynBorderSide] of TColor;
531    FFrameSideStyles: array[TLazSynBorderSide] of TSynLineStyle;
532    FFrameSidePriority: array[TLazSynBorderSide] of Integer;
533    FFrameSideOrigin: array[TLazSynBorderSide] of TSynFrameEdges;
534
535    FMergeInfos: array [TSynSelectedColorEnum] of TSynSelectedColorMergeInfo;
536
537    function IsMatching(ABound1, ABound2: TLazSynDisplayTokenBound): Boolean;
538    function GetFrameSideColors(Side: TLazSynBorderSide): TColor;
539    function GetFrameSideOrigin(Side: TLazSynBorderSide): TSynFrameEdges;
540    function GetFrameSidePriority(Side: TLazSynBorderSide): integer;
541    function GetFrameSideStyles(Side: TLazSynBorderSide): TSynLineStyle;
542    procedure SetCurrentEndX(AValue: TLazSynDisplayTokenBound);
543    procedure SetCurrentStartX(AValue: TLazSynDisplayTokenBound);
544  protected
545    procedure AssignFrom(Src: TLazSynCustomTextAttributes); override;
546    procedure DoClear; override;
547    procedure Init; override;
548
549    procedure MaybeInitFrameSides;
550    procedure MergeToInfo(var AnInfo: TSynSelectedColorMergeInfo;
551      AColor: TColor; APriority, AnAlpha: Integer);
552    function  CalculateInfo(var AnInfo: TSynSelectedColorMergeInfo;
553              ANoneColor: TColor; IsFrame: Boolean = False): TColor;
554    property FrameSidePriority[Side: TLazSynBorderSide]: integer read GetFrameSidePriority;
555    property FrameSideOrigin[Side: TLazSynBorderSide]: TSynFrameEdges read GetFrameSideOrigin;
556  public
557    destructor Destroy; override;
558
559    property FrameSideColors[Side: TLazSynBorderSide]: TColor read GetFrameSideColors;
560    property FrameSideStyles[Side: TLazSynBorderSide]: TSynLineStyle read GetFrameSideStyles;
561    // boundaries for current paint
562    property CurrentStartX: TLazSynDisplayTokenBound read FCurrentStartX write SetCurrentStartX;
563    property CurrentEndX: TLazSynDisplayTokenBound read FCurrentEndX write SetCurrentEndX;
564  public
565    procedure InitMergeInfo;    // (called automatically) Set all MergeInfo to the start values. After this was called, ay Changes to the color properties are ignored
566    procedure ProcessMergeInfo; // copy the merge result, to the actual color properties
567    procedure CleanupMergeInfo; // free the alpha arrays
568    procedure Merge(Other: TSynHighlighterAttributesModifier);
569    procedure Merge(Other: TSynHighlighterAttributesModifier; LeftCol, RightCol: TLazSynDisplayTokenBound);
570    procedure MergeFrames(Other: TSynHighlighterAttributesModifier; LeftCol, RightCol: TLazSynDisplayTokenBound);
571  end;
572
573  { TLazSynSurface }
574
575  TLazSynSurface = class
576  private
577    FBounds: TRect;
578    FBoundsChangeList: TMethodList;
579    FDisplayView: TLazSynDisplayView;
580    FOwner: TWinControl;
581    function GetHandle: HWND;
582    procedure SetDisplayView(AValue: TLazSynDisplayView);
583  protected
584    procedure BoundsChanged; virtual;
585    procedure DoPaint(ACanvas: TCanvas; AClip: TRect); virtual; abstract;
586    procedure DoDisplayViewChanged; virtual;
587    property  Handle: HWND read GetHandle;
588  public
589    constructor Create(AOwner: TWinControl);
590    destructor Destroy; override;
591    procedure Assign(Src: TLazSynSurface); virtual;
592    procedure AddBoundsChangeHandler(AHandler: TNotifyEvent);
593    procedure RemoveBoundsChangeHandler(AHandler: TNotifyEvent);
594
595    procedure Paint(ACanvas: TCanvas; AClip: TRect);
596    procedure InvalidateLines(FirstTextLine, LastTextLine: TLineIdx); virtual;
597    procedure SetBounds(ATop, ALeft, ABottom, ARight: Integer);
598
599    property Left: Integer   read FBounds.Left;
600    property Top: Integer    read FBounds.Top;
601    property Right:Integer   read FBounds.Right;
602    property Bottom: integer read FBounds.Bottom;
603    property Bounds: TRect read FBounds;
604
605    property DisplayView:   TLazSynDisplayView    read FDisplayView   write SetDisplayView;
606  end;
607
608  { TSynBookMarkOpt }
609
610  TSynBookMarkOpt = class(TPersistent)
611  private
612    fBookmarkImages: TCustomImageList;
613    fDrawBookmarksFirst: boolean;                                               //mh 2000-10-12
614    fEnableKeys: Boolean;
615    fGlyphsVisible: Boolean;
616    fLeftMargin: Integer;
617    fOwner: TComponent;
618    fXoffset: integer;
619    fOnChange: TNotifyEvent;
620    procedure SetBookmarkImages(const Value: TCustomImageList);
621    procedure SetDrawBookmarksFirst(Value: boolean);                            //mh 2000-10-12
622    procedure SetGlyphsVisible(Value: Boolean);
623    procedure SetLeftMargin(Value: Integer);
624    procedure SetXOffset(Value: integer);
625  public
626    constructor Create(AOwner: TComponent);
627  published
628    property BookmarkImages: TCustomImageList
629      read fBookmarkImages write SetBookmarkImages;
630    property DrawBookmarksFirst: boolean read fDrawBookmarksFirst               //mh 2000-10-12
631      write SetDrawBookmarksFirst default True;
632    property EnableKeys: Boolean
633      read fEnableKeys write fEnableKeys default True;
634    property GlyphsVisible: Boolean
635      read fGlyphsVisible write SetGlyphsVisible default True;
636    property LeftMargin: Integer read fLeftMargin write SetLeftMargin default 2;
637    property Xoffset: integer read fXoffset write SetXOffset default 12;
638    property OnChange: TNotifyEvent read fOnChange write fOnChange;
639  end;
640
641  { TSynInternalImage }
642
643  TSynInternalImage = class(TObject)
644  public
645    constructor Create(const AName: string; Count: integer);
646    destructor Destroy; override;
647    procedure DrawMark(ACanvas: TCanvas; Number, X, Y, LineHeight: integer);
648  end;
649
650
651  { TSynEditSearchCustom }
652
653  TSynEditSearchCustom = class(TComponent)
654  protected
655    function GetPattern: string; virtual; abstract;
656    procedure SetPattern(const Value: string); virtual; abstract;
657    function GetLength(aIndex: integer): integer; virtual; abstract;
658    function GetResult(aIndex: integer): integer; virtual; abstract;
659    function GetResultCount: integer; virtual; abstract;
660    procedure SetOptions(const Value: TSynSearchOptions); virtual; abstract;
661  public
662    function FindAll(const NewText: string): integer; virtual; abstract;
663    property Pattern: string read GetPattern write SetPattern;
664    property ResultCount: integer read GetResultCount;
665    property Results[aIndex: integer]: integer read GetResult;
666    property Lengths[aIndex: integer]: integer read GetLength;
667    property Options: TSynSearchOptions write SetOptions;
668  end;
669
670  {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
671  TSynClipboardStreamTag = type integer;
672  {$ELSE }
673  TSynClipboardStreamTag = type word;
674  {$ENDIF}
675
676  { TSynClipboardStream }
677
678  TSynClipboardStream = class
679  private
680    FMemStream: TMemoryStream;
681    FText: String;
682    FTextP: PChar;
683    FIsPlainText: Boolean;
684    FColumnModeFlag: Boolean;
685
686    function GetMemory: Pointer;
687    function GetSize: LongInt;
688    function GetSelectionMode: TSynSelectionMode;
689    procedure SetSelectionMode(const AValue: TSynSelectionMode);
690    procedure SetInternalText(const AValue: String);
691    procedure SetText(const AValue: String);
692  public
693    constructor Create;
694    destructor Destroy; override;
695    class function ClipboardFormatId: TClipboardFormat;
696    class function ClipboardFormatMSDEVColumnSelect: TClipboardFormat;
697    class function ClipboardFormatBorlandIDEBlockType: TClipboardFormat;
698
699    function CanReadFromClipboard(AClipboard: TClipboard): Boolean;
700    function ReadFromClipboard(AClipboard: TClipboard): Boolean;
701    function WriteToClipboard(AClipboard: TClipboard): Boolean;
702
703    procedure Clear;
704
705    function HasTag(ATag: TSynClipboardStreamTag): Boolean;
706    function GetTagPointer(ATag: TSynClipboardStreamTag): Pointer;
707    function GetTagLen(ATag: TSynClipboardStreamTag): Integer;
708    // No check for duplicates
709    Procedure AddTag(ATag: TSynClipboardStreamTag; Location: Pointer; Len: Integer);
710    property IsPlainText: Boolean read FIsPlainText;
711
712    // Currently Each method (or each method of a pair) must be assigned only ONCE
713    property TextP: PChar read FTextP;
714    property Text: String write SetText;
715    property InternalText: String write SetInternalText;
716
717    property SelectionMode: TSynSelectionMode read GetSelectionMode write SetSelectionMode;
718
719    property Memory: Pointer read GetMemory;
720    property Size: LongInt read GetSize;
721  end;
722
723  { TSynMethodList }
724
725  TSynMethodList = Class(TMethodList)
726  private
727    function IndexToObjectIndex(const AnObject: TObject; AnIndex: Integer): integer;
728    function GetObjectItems(AnObject: TObject; Index: integer): TMethod;
729    procedure SetObjectItems(AnObject: TObject; Index: integer; const AValue: TMethod);
730  public
731    function CountByObject(const AnObject: TObject): integer;
732    procedure DeleteByObject(const AnObject: TObject; Index: integer);
733    procedure AddCopyFrom(AList: TSynMethodList; AOwner: TObject = nil);
734  public
735    property ItemsByObject[AnObject: TObject; Index: integer]: TMethod
736      read GetObjectItems write SetObjectItems; default;
737  end;
738
739  TSynFilteredMethodListEntry = record
740    FHandler: TMethod;
741    FFilter: LongInt;
742  end;
743
744  { TSynFilteredMethodList }
745
746  TSynFilteredMethodList = Class
747  private
748    FCount: Integer;
749  protected
750    FItems: Array of TSynFilteredMethodListEntry;
751    function IndexOf(AHandler: TMethod): Integer;
752    function IndexOf(AHandler: TMethod; AFilter: LongInt): Integer;
753    function NextDownIndex(var Index: integer): boolean;
754    function NextDownIndexNumFilter(var Index: integer; AFilter: LongInt): boolean;
755    function NextDownIndexBitFilter(var Index: integer; AFilter: LongInt): boolean;
756    procedure Delete(AIndex: Integer);
757  public
758    constructor Create;
759    procedure AddNumFilter(AHandler: TMethod; AFilter: LongInt);                         // Separate entries for same method with diff filter
760    procedure AddBitFilter(AHandler: TMethod; AFilter: LongInt);                    // Filter is bitmask
761    procedure Remove(AHandler: TMethod);
762    procedure Remove(AHandler: TMethod; AFilter: LongInt);
763    procedure CallNotifyEventsNumFilter(Sender: TObject; AFilter: LongInt);
764    procedure CallNotifyEventsBitFilter(Sender: TObject; AFilter: LongInt);         // filter is Bitmask
765    property Count: Integer read FCount;
766  end;
767
768const
769  synClipTagText = TSynClipboardStreamTag(1);
770  synClipTagExtText = TSynClipboardStreamTag(2);
771  synClipTagMode = TSynClipboardStreamTag(3);
772  synClipTagFold = TSynClipboardStreamTag(4);
773
774
775type
776
777  TReplacedChildSite = (rplcLeft, rplcRight);
778
779  { TSynSizedDifferentialAVLNode }
780
781  TSynSizedDifferentialAVLNode = Class
782  private
783    procedure SetLeftSizeSum(AValue: Integer);
784  protected
785    (* AVL Tree structure *)
786    FParent, FLeft, FRight : TSynSizedDifferentialAVLNode;    (* AVL Links *)
787    FBalance : shortint;                                    (* AVL Balance *)
788
789    (* Position:  stores difference to parent value
790    *)
791    FPositionOffset: Integer;
792
793    (* Size:  Each node can have a Size, or similar value.
794              LeftSizeSum is the Sum of all sizes on the Left. This allows one to quickly
795              calculate the sum of all preceding nodes together
796    *)
797    FSize: Integer;
798    FLeftSizeSum: Integer;
799
800    property LeftSizeSum: Integer read FLeftSizeSum write SetLeftSizeSum;
801    {$IFDEF SynDebug}
802    function Debug: String; virtual;
803    {$ENDIF}
804  public
805    function TreeDepth: integer;           (* longest WAY down. Only one node => 1! *)
806
807    procedure SetLeftChild(ANode : TSynSizedDifferentialAVLNode); overload; inline;
808    procedure SetLeftChild(ANode : TSynSizedDifferentialAVLNode;
809                           anAdjustChildPosOffset : Integer); overload; inline;
810    procedure SetLeftChild(ANode : TSynSizedDifferentialAVLNode;
811                           anAdjustChildPosOffset,
812                           aLeftSizeSum : Integer); overload; inline;
813
814    procedure SetRightChild(ANode : TSynSizedDifferentialAVLNode); overload; inline;
815    procedure SetRightChild(ANode : TSynSizedDifferentialAVLNode;
816                            anAdjustChildPosOffset : Integer); overload; inline;
817
818    function ReplaceChild(OldNode, ANode : TSynSizedDifferentialAVLNode) : TReplacedChildSite; overload; inline;
819    function ReplaceChild(OldNode, ANode : TSynSizedDifferentialAVLNode;
820                          anAdjustChildPosOffset : Integer) : TReplacedChildSite; overload; inline;
821
822    procedure AdjustLeftCount(AValue : Integer);
823    procedure AdjustParentLeftCount(AValue : Integer);
824    procedure AdjustPosition(AValue : Integer); // Must not change order with prev/next node
825
826    function Precessor: TSynSizedDifferentialAVLNode;
827    function Successor: TSynSizedDifferentialAVLNode;
828    function Precessor(var aStartPosition, aSizesBeforeSum : Integer): TSynSizedDifferentialAVLNode;
829    function Successor(var aStartPosition, aSizesBeforeSum : Integer): TSynSizedDifferentialAVLNode;
830
831    function GetSizesBeforeSum: Integer;
832    function GetPosition: Integer;
833  end;
834
835  TSynSizedDiffAVLFindMode = (afmNil, afmCreate, afmPrev, afmNext);
836
837  { TSynSizedDifferentialAVLTree }
838
839  TSynSizedDifferentialAVLTree = class
840  protected
841    FRoot: TSynSizedDifferentialAVLNode;
842    FRootOffset : Integer; // Always 0, unless subclassed with nested trees
843
844    // SetRoot, does not obbey fRootOffset => use SetRoot(node, -fRootOffset)
845    procedure SetRoot(ANode : TSynSizedDifferentialAVLNode); virtual; overload;
846    procedure SetRoot(ANode : TSynSizedDifferentialAVLNode; anAdjustChildPosOffset : Integer); virtual; overload;
847
848    procedure DisposeNode(var ANode: TSynSizedDifferentialAVLNode); virtual;
849
850    function  InsertNode(ANode : TSynSizedDifferentialAVLNode) : Integer; // returns FoldedBefore // ANode may not have children
851    procedure RemoveNode(ANode: TSynSizedDifferentialAVLNode); // Does not Free
852    procedure BalanceAfterInsert(ANode: TSynSizedDifferentialAVLNode);
853    procedure BalanceAfterDelete(ANode: TSynSizedDifferentialAVLNode);
854
855    function CreateNode(APosition: Integer): TSynSizedDifferentialAVLNode; virtual;
856  public
857    constructor Create;
858    destructor  Destroy; override;
859    {$IFDEF SynDebug}
860    procedure   Debug;
861    {$ENDIF}
862
863    procedure Clear; virtual;
864    function First: TSynSizedDifferentialAVLNode;
865    function Last: TSynSizedDifferentialAVLNode;
866    function First(out aStartPosition, aSizesBeforeSum : Integer): TSynSizedDifferentialAVLNode;
867    function Last(out aStartPosition, aSizesBeforeSum : Integer): TSynSizedDifferentialAVLNode;
868
869    function FindNodeAtLeftSize(ALeftSum: INteger;
870                                out aStartPosition, aSizesBeforeSum : Integer): TSynSizedDifferentialAVLNode;
871    function FindNodeAtPosition(APosition: INteger; AMode: TSynSizedDiffAVLFindMode;
872                                out aStartPosition, aSizesBeforeSum : Integer): TSynSizedDifferentialAVLNode;
873    procedure AdjustForLinesInserted(AStartLine, ALineCount : Integer);
874    procedure AdjustForLinesDeleted(AStartLine, ALineCount : Integer);
875  end;
876
877
878implementation
879
880{ TSynEditBase }
881
882constructor TSynEditBase.Create(AOwner: TComponent);
883begin
884  inherited Create(AOwner);
885
886  FMouseOptions := SYNEDIT_DEFAULT_MOUSE_OPTIONS;
887  fBookMarkOpt := TSynBookMarkOpt.Create(Self);
888  fBookMarkOpt.OnChange := @BookMarkOptionsChanged;
889end;
890
891procedure TSynEditBase.BookMarkOptionsChanged(Sender: TObject);
892begin
893  InvalidateGutter;
894end;
895
896destructor TSynEditBase.Destroy;
897begin
898  FreeAndNil(fBookMarkOpt);
899
900  inherited Destroy;
901end;
902
903function TSynEditBase.GetReadOnly: boolean;
904begin
905  Result := fReadOnly;
906end;
907
908function TSynEditBase.GetSelAvail: Boolean;
909begin
910  Result := FBlockSelection.SelAvail;
911end;
912
913function TSynEditBase.GetIsBackwardSel: Boolean;
914begin
915  Result := FBlockSelection.SelAvail and FBlockSelection.IsBackwardSel;
916end;
917
918function TSynEditBase.GetSelText: string;
919begin
920  Result := FBlockSelection.SelText;
921end;
922
923procedure TSynEditBase.SetExtraCharSpacing(const AValue: integer);
924begin
925  fExtraCharSpacing := AValue;
926end;
927
928procedure TSynEditBase.SetExtraLineSpacing(const AValue: integer);
929begin
930  fExtraLineSpacing := AValue;
931end;
932
933procedure TSynEditBase.SetHideSelection(Value: boolean);
934begin
935  if fHideSelection <> Value then begin
936    FHideSelection := Value;
937    Invalidate;
938  end;
939end;
940
941procedure TSynEditBase.SetMouseOptions(AValue: TSynEditorMouseOptions);
942begin
943  if FMouseOptions = AValue then Exit;
944  FMouseOptions := AValue;
945end;
946
947procedure TSynEditBase.SetReadOnly(Value: boolean);
948begin
949  if fReadOnly <> Value then begin
950    fReadOnly := Value;
951    StatusChanged([scReadOnly]);
952  end;
953end;
954
955{ TSynEditFriend }
956
957function TSynEditFriend.GetViewedTextBuffer: TSynEditStringsLinked;
958begin
959  Result := FFriendEdit.ViewedTextBuffer;
960end;
961
962function TSynEditFriend.GetWordBreaker: TSynWordBreaker;
963begin
964  Result := FFriendEdit.WordBreaker;
965end;
966
967function TSynEditFriend.GetMarkupMgr: TObject;
968begin
969  Result := FFriendEdit.MarkupMgr;
970end;
971
972function TSynEditFriend.GetPaintArea: TLazSynSurface;
973begin
974  Result := FFriendEdit.GetPaintArea;
975end;
976
977function TSynEditFriend.GetScreenCaret: TSynEditScreenCaret;
978begin
979  Result := FFriendEdit.FScreenCaret;
980end;
981
982function TSynEditFriend.GetSelectionObj: TSynEditSelection;
983begin
984  Result := FFriendEdit.FBlockSelection;
985end;
986
987function TSynEditFriend.GetTextBuffer: TSynEditStrings;
988begin
989  Result := FFriendEdit.TextBuffer;
990end;
991
992function TSynEditFriend.GetIsRedoing: Boolean;
993begin
994  Result := FFriendEdit.ViewedTextBuffer.IsRedoing;
995end;
996
997function TSynEditFriend.GetCaretObj: TSynEditCaret;
998begin
999  Result := FFriendEdit.GetCaretObj;
1000end;
1001
1002function TSynEditFriend.GetFoldedTextBuffer: TObject;
1003begin
1004  Result := FFriendEdit.FoldedTextBuffer;
1005end;
1006
1007function TSynEditFriend.GetIsUndoing: Boolean;
1008begin
1009  Result := FFriendEdit.ViewedTextBuffer.IsUndoing;
1010end;
1011
1012{ TSynSelectedColorMergeResult }
1013
1014function TSynSelectedColorMergeResult.IsMatching(ABound1,
1015  ABound2: TLazSynDisplayTokenBound): Boolean;
1016begin
1017  Result := ( (ABound1.Physical > 0) and
1018              (ABound1.Physical = ABound2.Physical)
1019            ) or
1020            ( (ABound1.Logical > 0) and
1021              (ABound1.Logical = ABound2.Logical) and (ABound1.Offset = ABound2.Offset)
1022            );
1023end;
1024
1025function TSynSelectedColorMergeResult.GetFrameSideColors(Side: TLazSynBorderSide): TColor;
1026begin
1027  if FFrameSidesInitialized then begin
1028    Result := FFrameSideColors[Side];
1029    exit
1030  end;
1031
1032  if (FCurrentStartX.Logical >= 0) or (FCurrentStartX.Physical >= 0) then
1033    case Side of
1034      bsLeft:  if not IsMatching(FCurrentStartX, FStartX) then exit(clNone);
1035      bsRight: if not IsMatching(FCurrentEndX,   FEndX)   then exit(clNone);
1036    end;
1037
1038  if (Side in SynFrameEdgeToSides[FrameEdges])
1039  then Result := FrameColor
1040  else Result := clNone;
1041end;
1042
1043function TSynSelectedColorMergeResult.GetFrameSideOrigin(Side: TLazSynBorderSide): TSynFrameEdges;
1044begin
1045  if FFrameSidesInitialized
1046  then Result := FFrameSideOrigin[Side]
1047  else if FrameColor = clNone
1048  then Result := sfeNone
1049  else Result := FrameEdges;
1050end;
1051
1052function TSynSelectedColorMergeResult.GetFrameSidePriority(Side: TLazSynBorderSide): integer;
1053begin
1054  if FFrameSidesInitialized then begin
1055    Result := FFrameSidePriority[Side];
1056    exit
1057  end;
1058
1059  if (FCurrentStartX.Logical >= 0) or (FCurrentStartX.Physical >= 0) then
1060    case Side of
1061      bsLeft:  if not IsMatching(FCurrentStartX, FStartX) then exit(0);
1062      bsRight: if not IsMatching(FCurrentEndX,   FEndX)   then exit(0);
1063    end;
1064
1065  if (Side in SynFrameEdgeToSides[FrameEdges])
1066  then Result := FramePriority
1067  else Result := 0;
1068end;
1069
1070function TSynSelectedColorMergeResult.GetFrameSideStyles(Side: TLazSynBorderSide): TSynLineStyle;
1071begin
1072  if FFrameSidesInitialized
1073  then Result := FFrameSideStyles[Side]
1074  else
1075  if Side in SynFrameEdgeToSides[FrameEdges]
1076  then Result := FrameStyle
1077  else Result := slsSolid;
1078end;
1079
1080procedure TSynSelectedColorMergeResult.SetCurrentEndX(AValue: TLazSynDisplayTokenBound);
1081begin
1082  //if FCurrentEndX = AValue then Exit;
1083  FCurrentEndX := AValue;
1084  if not IsMatching(FCurrentEndX, FEndX) then begin
1085    FFrameSideColors[bsRight] := clNone;
1086    FMergeInfos[sscFrameRight].BaseColor := clNone;
1087    FMergeInfos[sscFrameRight].AlphaCount := 0;
1088  end;
1089end;
1090
1091procedure TSynSelectedColorMergeResult.SetCurrentStartX(AValue: TLazSynDisplayTokenBound);
1092begin
1093  //if FCurrentStartX = AValue then Exit;
1094  FCurrentStartX := AValue;
1095  if not IsMatching(FCurrentStartX, FStartX) then begin
1096    FFrameSideColors[bsLeft] := clNone;
1097    FMergeInfos[sscFrameLeft].BaseColor := clNone;
1098    FMergeInfos[sscFrameLeft].AlphaCount := 0;
1099  end;
1100end;
1101
1102procedure TSynSelectedColorMergeResult.AssignFrom(Src: TLazSynCustomTextAttributes);
1103var
1104  i: TLazSynBorderSide;
1105  j: TSynSelectedColorEnum;
1106  c: Integer;
1107begin
1108  //DoClear;
1109  FFrameSidesInitialized := False;
1110  FMergeInfoInitialized := False;
1111  for i := low(TLazSynBorderSide) to high(TLazSynBorderSide) do begin
1112    FFrameSideColors[i] := clNone;
1113    FFrameSideStyles[i] := slsSolid;
1114    FFrameSideOrigin[i] := sfeNone;
1115  end;
1116  FCurrentStartX.Physical := -1;
1117  FCurrentEndX.Physical   := -1;
1118  FCurrentStartX.Logical  := -1;
1119  FCurrentEndX.Logical    := -1;
1120  FCurrentStartX.Offset   := 0;
1121  FCurrentEndX.Offset     := 0;
1122
1123  inherited AssignFrom(Src);
1124
1125  if not (Src is TSynSelectedColorMergeResult) then
1126    exit;
1127
1128  FCurrentStartX := TSynSelectedColorMergeResult(Src).FCurrentStartX;
1129  FCurrentEndX   := TSynSelectedColorMergeResult(Src).FCurrentEndX;
1130  FFrameSidesInitialized := TSynSelectedColorMergeResult(Src).FFrameSidesInitialized;
1131
1132  for i := low(TLazSynBorderSide) to high(TLazSynBorderSide) do begin
1133    FFrameSideColors[i] := TSynSelectedColorMergeResult(Src).FFrameSideColors[i];
1134    FFrameSideStyles[i] := TSynSelectedColorMergeResult(Src).FFrameSideStyles[i];
1135    FFrameSideOrigin[i] := TSynSelectedColorMergeResult(Src).FFrameSideOrigin[i];
1136    FFrameSidePriority[i] := TSynSelectedColorMergeResult(Src).FFrameSidePriority[i];
1137  end;
1138
1139  FMergeInfoInitialized := TSynSelectedColorMergeResult(Src).FMergeInfoInitialized;
1140
1141  if FMergeInfoInitialized then begin
1142    for j := low(TSynSelectedColorEnum) to high(TSynSelectedColorEnum) do begin
1143      FMergeInfos[j].BaseColor    := TSynSelectedColorMergeResult(Src).FMergeInfos[j].BaseColor;
1144      FMergeInfos[j].BasePriority := TSynSelectedColorMergeResult(Src).FMergeInfos[j].BasePriority;
1145      c := TSynSelectedColorMergeResult(Src).FMergeInfos[j].AlphaCount;
1146      FMergeInfos[j].AlphaCount   := c;
1147      if Length(FMergeInfos[j].AlphaStack) < c then
1148        SetLength(FMergeInfos[j].AlphaStack, c + 3);
1149      if c > 0 then
1150        move(TSynSelectedColorMergeResult(Src).FMergeInfos[j].AlphaStack[0],
1151             FMergeInfos[j].AlphaStack[0],
1152             c * SizeOf(TSynSelectedColorAlphaEntry) );
1153    end;
1154  end;
1155
1156  Changed; {TODO: only if really changed}
1157end;
1158
1159procedure TSynSelectedColorMergeResult.DoClear;
1160var
1161  i: TLazSynBorderSide;
1162begin
1163  inherited;
1164  FFrameSidesInitialized := False;
1165  for i := low(TLazSynBorderSide) to high(TLazSynBorderSide) do begin
1166    FFrameSideColors[i] := clNone;
1167    FFrameSideStyles[i] := slsSolid;
1168    FFrameSideOrigin[i] := sfeNone;
1169  end;
1170  FCurrentStartX.Physical := -1;
1171  FCurrentEndX.Physical   := -1;
1172  FCurrentStartX.Logical  := -1;
1173  FCurrentEndX.Logical    := -1;
1174  FCurrentStartX.Offset   := 0;
1175  FCurrentEndX.Offset     := 0;
1176  CleanupMergeInfo;
1177end;
1178
1179procedure TSynSelectedColorMergeResult.Init;
1180begin
1181  inherited Init;
1182  MergeFinalStyle := True;
1183  FMergeInfoInitialized := False;
1184end;
1185
1186procedure TSynSelectedColorMergeResult.MaybeInitFrameSides;
1187var
1188  i: TLazSynBorderSide;
1189begin
1190  if FFrameSidesInitialized then
1191    exit;
1192
1193  for i := low(TLazSynBorderSide) to high(TLazSynBorderSide) do begin
1194    FFrameSideColors[i]   := FrameSideColors[i];
1195    FFrameSideStyles[i]   := FrameSideStyles[i];
1196    FFrameSidePriority[i] := FrameSidePriority[i];
1197    FFrameSideOrigin[i]   := FrameSideOrigin[i];
1198  end;
1199  FFrameSidesInitialized := True;
1200end;
1201
1202procedure TSynSelectedColorMergeResult.MergeToInfo(var AnInfo: TSynSelectedColorMergeInfo;
1203  AColor: TColor; APriority, AnAlpha: Integer);
1204begin
1205  if (APriority < AnInfo.BasePriority) or (AColor = clNone) then
1206    exit;
1207
1208  if AnAlpha = 0 then begin // solid
1209    AnInfo.BaseColor := AColor;
1210    AnInfo.BasePriority := APriority;
1211  end
1212  else begin // remember alpha for later
1213    if Length(AnInfo.AlphaStack) <= AnInfo.AlphaCount then
1214      SetLength(AnInfo.AlphaStack, AnInfo.AlphaCount + 5);
1215    AnInfo.AlphaStack[AnInfo.AlphaCount].Color    := AColor;
1216    AnInfo.AlphaStack[AnInfo.AlphaCount].Alpha    := AnAlpha;
1217    AnInfo.AlphaStack[AnInfo.AlphaCount].Priority := APriority;
1218    inc(AnInfo.AlphaCount);
1219  end;
1220end;
1221
1222function TSynSelectedColorMergeResult.CalculateInfo(var AnInfo: TSynSelectedColorMergeInfo;
1223  ANoneColor: TColor; IsFrame: Boolean): TColor;
1224var
1225  i, j, c, p: Integer;
1226  tmp: TSynSelectedColorAlphaEntry;
1227  C1, C2, C3, M1, M2, M3, Alpha: Integer;
1228  Col: TColor;
1229begin
1230  p := AnInfo.BasePriority;
1231  c := AnInfo.AlphaCount - 1;
1232
1233  //if c >= 0 then begin
1234    while (c >= 0) and (AnInfo.AlphaStack[c].Priority < p) do
1235      dec(c);
1236    i := 1;
1237    while i <= c do begin
1238      if AnInfo.AlphaStack[i].Priority < p then begin
1239        AnInfo.AlphaStack[i] := AnInfo.AlphaStack[c];
1240        dec(c);
1241        while (c >= 0) and (AnInfo.AlphaStack[c].Priority < p) do
1242          dec(c);
1243        Continue;
1244      end;
1245
1246      j := i - 1;
1247      if AnInfo.AlphaStack[j].Priority > AnInfo.AlphaStack[i].Priority then begin
1248        tmp := AnInfo.AlphaStack[i];
1249        AnInfo.AlphaStack[i] := AnInfo.AlphaStack[j];
1250        while (j > 0) and (AnInfo.AlphaStack[j-1].Priority > AnInfo.AlphaStack[j].Priority) do begin
1251          AnInfo.AlphaStack[j] := AnInfo.AlphaStack[j-1];
1252          dec(j);
1253        end;
1254        AnInfo.AlphaStack[j] := tmp;
1255      end;
1256
1257      inc(i);
1258    end;
1259  //end;
1260
1261  Result := AnInfo.BaseColor;
1262
1263  // The highlighter may have merged, before defaults where set in
1264  // TLazSynPaintTokenBreaker.GetNextHighlighterTokenFromView / InitSynAttr
1265  if (Result = clNone) and (not IsFrame) then
1266    Result := ANoneColor;
1267
1268  if (c >= 0) and (AnInfo.AlphaStack[0].Priority >= p) then begin
1269    if (Result = clNone) then
1270      Result := ANoneColor;
1271    Result := ColorToRGB(Result);  // no system color.
1272    C1 := Red(Result);
1273    C2 := Green(Result);
1274    C3 := Blue(Result);
1275    for i := 0 to c do begin
1276      Col := ColorToRGB(AnInfo.AlphaStack[i].Color);
1277      Alpha := AnInfo.AlphaStack[i].Alpha;
1278      M1 := Red(Col);
1279      M2 := Green(Col);
1280      M3 := Blue(Col);
1281      C1 := MinMax(C1 + (M1 - C1) * Alpha div 256, 0, 255);
1282      C2 := MinMax(C2 + (M2 - C2) * Alpha div 256, 0, 255);
1283      C3 := MinMax(C3 + (M3 - C3) * Alpha div 256, 0, 255);
1284
1285    end;
1286    Result := RGBToColor(C1, C2, C3);
1287  end;
1288end;
1289
1290destructor TSynSelectedColorMergeResult.Destroy;
1291begin
1292  CleanupMergeInfo;
1293  inherited Destroy;
1294end;
1295
1296procedure TSynSelectedColorMergeResult.InitMergeInfo;
1297begin
1298  MaybeInitFrameSides;
1299
1300  FMergeInfos[sscBack].AlphaCount   := 0;
1301  FMergeInfos[sscBack].BaseColor    := Background;
1302  FMergeInfos[sscBack].BasePriority := BackPriority;
1303
1304  FMergeInfos[sscFore].AlphaCount   := 0;
1305  FMergeInfos[sscFore].BaseColor    := Foreground;
1306  FMergeInfos[sscFore].BasePriority := ForePriority;
1307
1308  FMergeInfos[sscFrameLeft].AlphaCount   := 0;
1309  FMergeInfos[sscFrameLeft].BaseColor    := FrameSideColors[bsLeft];
1310  FMergeInfos[sscFrameLeft].BasePriority := FrameSidePriority[bsLeft];
1311
1312  FMergeInfos[sscFrameRight].AlphaCount   := 0;
1313  FMergeInfos[sscFrameRight].BaseColor    := FrameSideColors[bsRight];
1314  FMergeInfos[sscFrameRight].BasePriority := FrameSidePriority[bsRight];
1315
1316  FMergeInfos[sscFrameTop].AlphaCount   := 0;
1317  FMergeInfos[sscFrameTop].BaseColor    := FrameSideColors[bsTop];
1318  FMergeInfos[sscFrameTop].BasePriority := FrameSidePriority[bsTop];
1319
1320  FMergeInfos[sscFrameBottom].AlphaCount   := 0;
1321  FMergeInfos[sscFrameBottom].BaseColor    := FrameSideColors[bsBottom];
1322  FMergeInfos[sscFrameBottom].BasePriority := FrameSidePriority[bsBottom];
1323
1324  FMergeInfoInitialized := True;
1325end;
1326
1327procedure TSynSelectedColorMergeResult.ProcessMergeInfo;
1328begin
1329  if not FMergeInfoInitialized then
1330    exit;
1331  BeginUpdate;
1332  Background := CalculateInfo(FMergeInfos[sscBack], Background);
1333  Foreground := CalculateInfo(FMergeInfos[sscFore], Foreground);
1334  // if the frame is clNone, and alpha is aplied, use the background as base
1335  FFrameSideColors[bsLeft]   := CalculateInfo(FMergeInfos[sscFrameLeft],   Background, True);
1336  FFrameSideColors[bsRight]  := CalculateInfo(FMergeInfos[sscFrameRight],  Background, True);
1337  FFrameSideColors[bsTop]    := CalculateInfo(FMergeInfos[sscFrameTop],    Background, True);
1338  FFrameSideColors[bsBottom] := CalculateInfo(FMergeInfos[sscFrameBottom], Background, True);
1339  EndUpdate;
1340  FMergeInfoInitialized := False;
1341end;
1342
1343procedure TSynSelectedColorMergeResult.CleanupMergeInfo;
1344var
1345  i: TSynSelectedColorEnum;
1346begin
1347  for i := low(TSynSelectedColorEnum) to high(TSynSelectedColorEnum) do
1348    SetLength(FMergeInfos[i].AlphaStack, 0);
1349  FMergeInfoInitialized := False;
1350end;
1351
1352procedure TSynSelectedColorMergeResult.Merge(Other: TSynHighlighterAttributesModifier);
1353begin
1354  Merge(Other, FStartX, FEndX); // always merge frame
1355end;
1356
1357procedure TSynSelectedColorMergeResult.Merge(Other: TSynHighlighterAttributesModifier; LeftCol,
1358  RightCol: TLazSynDisplayTokenBound);
1359var
1360  sKeep, sSet, sClr, sInv, sInvInv: TFontStyles;
1361  j: TFontStyle;
1362begin
1363  BeginUpdate;
1364  if not FMergeInfoInitialized then
1365    InitMergeInfo;
1366
1367  MergeToInfo(FMergeInfos[sscBack], Other.Background, Other.BackPriority, Other.BackAlpha);
1368  MergeToInfo(FMergeInfos[sscFore], Other.Foreground, Other.ForePriority, Other.ForeAlpha);
1369
1370  MergeFrames(Other, LeftCol, RightCol);
1371
1372  sKeep := [];
1373  for j := Low(TFontStyle) to High(TFontStyle) do
1374    if Other.StylePriority[j] < StylePriority[j]
1375     then sKeep := sKeep + [j];
1376
1377  sSet := (Other.Style        * Other.StyleMask) - sKeep;
1378  sClr := (fsNot(Other.Style) * Other.StyleMask) - sKeep;
1379  sInv := (Other.Style        * fsNot(Other.StyleMask)) - sKeep;
1380
1381  if MergeFinalStyle then begin
1382    Style := fsXor(Style, sInv) + sSet - sClr;
1383  end else begin
1384    sKeep := fsNot(Other.Style) * fsNot(Other.StyleMask);
1385    sInvInv := sInv * (Style * fsNot(StyleMask)); // invert * invert = not modified
1386    sInv    := sInv - sInvInv;
1387    sSet := sSet + sInv * (fsnot(Style) * StyleMask); // currently not set
1388    sClr := sClr + sInv * (Style        * StyleMask); // currently set
1389    sInv    := sInv - StyleMask; // now SInv only inverts currently "not modifying"
1390
1391    Style     := (Style     * sKeep) + sSet - sClr - sInvInv + sInv;
1392    StyleMask := (StyleMask * sKeep) + sSet + sClr - sInvInv - sInv;
1393  end;
1394
1395
1396  //sMask := Other.StyleMask                            // Styles to be taken from Other
1397  //       + (fsNot(Other.StyleMask) * Other.Style);    // Styles to be inverted
1398  //Style     := (Style * fsNot(sMask))    // Styles that are neither taken, nor inverted
1399  //           + (Other.Style * sMask);    // Styles that are either inverted or set
1400  //StyleMask := (StyleMask * fsNot(sMask)) + (Other.StyleMask * sMask);
1401
1402  EndUpdate;
1403end;
1404
1405procedure TSynSelectedColorMergeResult.MergeFrames(Other: TSynHighlighterAttributesModifier; LeftCol,
1406  RightCol: TLazSynDisplayTokenBound);
1407
1408  //procedure SetSide(ASide: TLazSynBorderSide; ASrc: TSynHighlighterAttributesModifier);
1409  //begin
1410  //(*
1411  //  if (FrameSideColors[ASide] <> clNone) and
1412  //     ( (ASrc.FramePriority < FrameSidePriority[ASide]) or
1413  //       ( (ASrc.FramePriority = FrameSidePriority[ASide]) and
1414  //         (SynFrameEdgePriorities[ASrc.FrameEdges] < SynFrameEdgePriorities[FrameSideOrigin[ASide]]) )
1415  //     )
1416  //
1417  //*)
1418  //  if (FrameSideColors[ASide] <> clNone) and
1419  //     ( (ASrc.FramePriority < FrameSidePriority[ASide]) or
1420  //       ( (ASrc.FramePriority = FrameSidePriority[ASide]) and
1421  //         (SynFrameEdgePriorities[ASrc.FrameEdges] < SynFrameEdgePriorities[FrameSideOrigin[ASide]]) )
1422  //     )
1423  //  then
1424  //    exit;
1425  //  FFrameSideColors[ASide] := ASrc.FrameColor;
1426  //  FFrameSideStyles[ASide] := ASrc.FrameStyle;
1427  //  FFrameSidePriority[ASide] := ASrc.FramePriority;
1428  //  FFrameSideOrigin[ASide]   := ASrc.FrameEdges;
1429  //  if ASide = bsLeft then
1430  //    FStartX := LeftCol; // LeftCol has Phys and log ; // ASrc.FStartX;
1431  //  if ASide = bsRight then
1432  //    FEndX := RightCol; // ASrc.FEndX;
1433  //end;
1434
1435  procedure SetSide(AInfoSide: TSynSelectedColorEnum; ASide: TLazSynBorderSide;
1436    ASrc: TSynHighlighterAttributesModifier);
1437  begin
1438    if (FMergeInfos[AInfoSide].BaseColor <> clNone) and
1439       ( (ASrc.FramePriority < FMergeInfos[AInfoSide].BasePriority) or
1440         ( (ASrc.FramePriority = FMergeInfos[AInfoSide].BasePriority) and
1441           (SynFrameEdgePriorities[ASrc.FrameEdges] < SynFrameEdgePriorities[FrameSideOrigin[ASide]]) )
1442       )
1443    then
1444      exit;
1445
1446    MergeToInfo(FMergeInfos[AInfoSide], ASrc.FrameColor, ASrc.FramePriority, ASrc.FrameAlpha);
1447
1448    FFrameSidePriority[ASide] := ASrc.FramePriority; // used for style (style may be taken, from an alpha frame
1449    if ( (ASrc.FramePriority > FFrameSidePriority[ASide]) or
1450         ( (ASrc.FramePriority = FFrameSidePriority[ASide]) and
1451           (SynFrameEdgePriorities[ASrc.FrameEdges] >= SynFrameEdgePriorities[FrameSideOrigin[ASide]]) )
1452       )
1453    then
1454      FFrameSideStyles[ASide] := ASrc.FrameStyle;
1455
1456    if ASrc.FrameAlpha = 0 then
1457      FFrameSideOrigin[ASide] := ASrc.FrameEdges;
1458  end;
1459
1460begin
1461  if not FFrameSidesInitialized then
1462    MaybeInitFrameSides;
1463
1464  If (Other = nil) or (Other.FrameColor = clNone) then
1465    exit;
1466
1467  // Merge Values
1468  case Other.FrameEdges of
1469    sfeAround: begin
1470        // UpdateOnly, frame keeps behind individual sites
1471        if (not (Other is TSynSelectedColor)) or  // always merge, if it has no startx
1472           IsMatching(TSynSelectedColor(Other).StartX, LeftCol)
1473        then
1474          SetSide(sscFrameLeft, bsLeft, Other);
1475        if  (not (Other is TSynSelectedColor)) or
1476           IsMatching(TSynSelectedColor(Other).EndX, RightCol)
1477        then
1478          SetSide(sscFrameRight, bsRight, Other);
1479        SetSide(sscFrameBottom, bsBottom, Other);
1480        SetSide(sscFrameTop, bsTop, Other);
1481        //FrameColor := Other.FrameColor;
1482        //FrameStyle := Other.FrameStyle;
1483        //FrameEdges := Other.FrameEdges;
1484      end;
1485    sfeBottom: begin
1486        SetSide(sscFrameBottom, bsBottom, Other);
1487      end;
1488    sfeLeft: begin
1489       // startX ?
1490        SetSide(sscFrameLeft, bsLeft, Other);
1491      end;
1492  end;
1493end;
1494
1495{ TSynSelectedColor }
1496
1497function TSynSelectedColor.GetModifiedStyle(aStyle : TFontStyles) : TFontStyles;
1498begin
1499  Result := fsXor(aStyle, Style * fsNot(StyleMask)) // Invert Styles
1500            + (Style*StyleMask)                     // Set Styles
1501            - (fsNot(Style)*StyleMask);             // Remove Styles
1502end;
1503
1504procedure TSynSelectedColor.ModifyColors(var AForeground, ABackground,
1505    AFrameColor: TColor; var AStyle: TFontStyles; var AFrameStyle: TSynLineStyle);
1506begin
1507  if Foreground <> clNone then AForeground := Foreground;
1508  if Background <> clNone then ABackground := Background;
1509  if FrameColor <> clNone then
1510  begin
1511    AFrameColor := FrameColor;
1512    AFrameStyle := FrameStyle;
1513  end;
1514
1515  AStyle := GetModifiedStyle(AStyle);
1516end;
1517
1518procedure TSynSelectedColor.AssignFrom(Src: TLazSynCustomTextAttributes);
1519begin
1520  inherited AssignFrom(Src);
1521  if not (Src is TSynSelectedColor) then exit;
1522
1523  FStartX := TSynSelectedColor(Src).FStartX;
1524  FEndX   := TSynSelectedColor(Src).FEndX;
1525
1526  Changed; {TODO: only if really changed}
1527end;
1528
1529procedure TSynSelectedColor.Init;
1530begin
1531  inherited Init;
1532  Background := clHighLight;
1533  Foreground := clHighLightText;
1534  FrameColor := clNone;
1535  FrameStyle := slsSolid;
1536  FrameEdges := sfeAround;
1537  InternalSaveDefaultValues;
1538end;
1539
1540procedure TSynSelectedColor.SetFrameBoundsPhys(AStart, AEnd: Integer);
1541begin
1542  FStartX.Physical := AStart;
1543  FEndX.Physical   := AEnd;
1544  FStartX.Logical  := -1;
1545  FEndX.Logical    := -1;
1546  FStartX.Offset   := 0;
1547  FEndX.Offset     := 0;
1548end;
1549
1550procedure TSynSelectedColor.SetFrameBoundsLog(AStart, AEnd: Integer; AStartOffs: Integer;
1551  AEndOffs: Integer);
1552begin
1553  FStartX.Physical := -1;
1554  FEndX.Physical   := -1;
1555  FStartX.Logical  := AStart;
1556  FEndX.Logical    := AEnd;
1557  FStartX.Offset   := AStartOffs;
1558  FEndX.Offset     := AEndOffs;
1559end;
1560
1561procedure TSynSelectedColor.DoClear;
1562begin
1563  inherited;
1564  FStartX.Physical := -1;
1565  FEndX.Physical   := -1;
1566  FStartX.Logical  := -1;
1567  FEndX.Logical    := -1;
1568  FStartX.Offset   := 0;
1569  FEndX.Offset     := 0;
1570end;
1571
1572{ TLazSynSurface }
1573
1574function TLazSynSurface.GetHandle: HWND;
1575begin
1576  Result := FOwner.Handle;
1577end;
1578
1579procedure TLazSynSurface.SetDisplayView(AValue: TLazSynDisplayView);
1580begin
1581  if FDisplayView = AValue then Exit;
1582  FDisplayView := AValue;
1583  DoDisplayViewChanged;
1584end;
1585
1586procedure TLazSynSurface.BoundsChanged;
1587begin
1588  //
1589end;
1590
1591procedure TLazSynSurface.DoDisplayViewChanged;
1592begin
1593  //
1594end;
1595
1596constructor TLazSynSurface.Create(AOwner: TWinControl);
1597begin
1598  FOwner := AOwner;
1599  FBoundsChangeList := TMethodList.Create;
1600end;
1601
1602destructor TLazSynSurface.Destroy;
1603begin
1604  inherited Destroy;
1605  FreeAndNil(FBoundsChangeList);
1606end;
1607
1608procedure TLazSynSurface.Assign(Src: TLazSynSurface);
1609begin
1610  // do not assign the bounds
1611  DisplayView := Src.DisplayView;
1612end;
1613
1614procedure TLazSynSurface.AddBoundsChangeHandler(AHandler: TNotifyEvent);
1615begin
1616  FBoundsChangeList.Add(TMethod(AHandler));
1617end;
1618
1619procedure TLazSynSurface.RemoveBoundsChangeHandler(AHandler: TNotifyEvent);
1620begin
1621  FBoundsChangeList.Remove(TMethod(AHandler));
1622end;
1623
1624procedure TLazSynSurface.Paint(ACanvas: TCanvas; AClip: TRect);
1625begin
1626  if (AClip.Left   >= Bounds.Right) or
1627     (AClip.Right  <= Bounds.Left) or
1628     (AClip.Top    >= Bounds.Bottom) or
1629     (AClip.Bottom <= Bounds.Top)
1630  then
1631    exit;
1632
1633  if (AClip.Left   < Bounds.Left)   then AClip.Left   := Bounds.Left;
1634  if (AClip.Right  > Bounds.Right)  then AClip.Right  := Bounds.Right;
1635  if (AClip.Top    < Bounds.Top)    then AClip.Top    := Bounds.Top;
1636  if (AClip.Bottom > Bounds.Bottom) then AClip.Bottom := Bounds.Bottom;
1637
1638  DoPaint(ACanvas, AClip);
1639end;
1640
1641procedure TLazSynSurface.InvalidateLines(FirstTextLine, LastTextLine: TLineIdx);
1642begin
1643  //
1644end;
1645
1646procedure TLazSynSurface.SetBounds(ATop, ALeft, ABottom, ARight: Integer);
1647begin
1648  if (FBounds.Left = ALeft) and (FBounds.Top = ATop) and
1649     (FBounds.Right = ARight) and (FBounds.Bottom = ABottom)
1650  then exit;
1651
1652  FBounds.Left := ALeft;
1653  FBounds.Top := ATop;
1654  FBounds.Right := ARight;
1655  FBounds.Bottom := ABottom;
1656  BoundsChanged;
1657  FBoundsChangeList.CallNotifyEvents(Self);
1658end;
1659
1660{ TSynBookMarkOpt }
1661
1662constructor TSynBookMarkOpt.Create(AOwner: TComponent);
1663begin
1664  inherited Create;
1665  fDrawBookmarksFirst := TRUE;                                                  //mh 2000-10-12
1666  fEnableKeys := True;
1667  fGlyphsVisible := True;
1668  fLeftMargin := 2;
1669  fOwner := AOwner;
1670  fXOffset := 12;
1671end;
1672
1673procedure TSynBookMarkOpt.SetBookmarkImages(const Value: TCustomImageList);
1674begin
1675  if fBookmarkImages <> Value then begin
1676    if Assigned(fBookmarkImages) then fBookmarkImages.RemoveFreeNotification(fOwner);
1677    fBookmarkImages := Value;
1678    if Assigned(fBookmarkImages) then fBookmarkImages.FreeNotification(fOwner);
1679    if Assigned(fOnChange) then fOnChange(Self);
1680  end;
1681end;
1682
1683{begin}                                                                         //mh 2000-10-12
1684procedure TSynBookMarkOpt.SetDrawBookmarksFirst(Value: boolean);
1685begin
1686  if Value <> fDrawBookmarksFirst then begin
1687    fDrawBookmarksFirst := Value;
1688    if Assigned(fOnChange) then fOnChange(Self);
1689  end;
1690end;
1691{end}                                                                           //mh 2000-10-12
1692
1693procedure TSynBookMarkOpt.SetGlyphsVisible(Value: Boolean);
1694begin
1695  if fGlyphsVisible <> Value then begin
1696    fGlyphsVisible := Value;
1697    if Assigned(fOnChange) then fOnChange(Self);
1698  end;
1699end;
1700
1701procedure TSynBookMarkOpt.SetLeftMargin(Value: Integer);
1702begin
1703  if fLeftMargin <> Value then begin
1704    fLeftMargin := Value;
1705    if Assigned(fOnChange) then fOnChange(Self);
1706  end;
1707end;
1708
1709procedure TSynBookMarkOpt.SetXOffset(Value: integer);
1710begin
1711  if fXOffset <> Value then begin
1712    fXOffset := Value;
1713    if Assigned(fOnChange) then fOnChange(Self);
1714  end;
1715end;
1716
1717var
1718  InternalImages: TBitmap;
1719  InternalImagesUsers: integer;
1720  IIWidth, IIHeight: integer;
1721  IICount: integer;
1722
1723constructor TSynInternalImage.Create(const AName: string; Count: integer);
1724begin
1725  inherited Create;
1726  Inc(InternalImagesUsers);
1727  if InternalImagesUsers = 1 then begin
1728    InternalImages := TBitmap.Create;
1729    InternalImages.LoadFromResourceName(HInstance, AName);
1730    IIWidth := (InternalImages.Width + Count shr 1) div Count;
1731    IIHeight := InternalImages.Height;
1732    IICount := Count;
1733  end;
1734end;
1735
1736destructor TSynInternalImage.Destroy;
1737begin
1738  Dec(InternalImagesUsers);
1739  if InternalImagesUsers = 0 then begin
1740    InternalImages.Free;
1741    InternalImages := nil;
1742  end;
1743  inherited Destroy;
1744end;
1745
1746procedure TSynInternalImage.DrawMark(ACanvas: TCanvas;
1747  Number, X, Y, LineHeight: integer);
1748var
1749  rcSrc, rcDest: TRect;
1750begin
1751  if (Number >= 0) and (Number < IICount) then
1752  begin
1753    if LineHeight >= IIHeight then begin
1754      rcSrc := Rect(Number * IIWidth, 0, (Number + 1) * IIWidth, IIHeight);
1755      Inc(Y, (LineHeight - IIHeight) div 2);
1756      rcDest := Rect(X, Y, X + IIWidth, Y + IIHeight);
1757    end else begin
1758      rcDest := Rect(X, Y, X + IIWidth, Y + LineHeight);
1759      Y := (IIHeight - LineHeight) div 2;
1760      rcSrc := Rect(Number * IIWidth, Y, (Number + 1) * IIWidth, Y + LineHeight);
1761    end;
1762    ACanvas.CopyRect(rcDest, InternalImages.Canvas, rcSrc);
1763  end;
1764end;
1765
1766{ TSynObjectList }
1767
1768constructor TSynObjectList.Create(AOwner: TComponent);
1769begin
1770  Inherited Create(AOwner);
1771  SetAncestor(True);
1772  SetInline(True);
1773  FList := TList.Create;
1774  FOwner := AOwner;
1775end;
1776
1777destructor TSynObjectList.Destroy;
1778begin
1779  Clear;
1780  FreeAndNil(FList);
1781  inherited Destroy;
1782end;
1783
1784procedure TSynObjectList.Assign(Source: TPersistent);
1785begin
1786  FList.Assign(TSynObjectList(Source).FList);
1787  DoChange(self);
1788end;
1789
1790function TSynObjectList.GetChildOwner: TComponent;
1791begin
1792  Result := self;
1793end;
1794
1795procedure TSynObjectList.GetChildren(Proc: TGetChildProc; Root: TComponent);
1796var
1797  i: Integer;
1798begin
1799  if Root = self then
1800    for i:= 0 to Count -1 do
1801      Proc(BaseItems[i]);
1802end;
1803
1804procedure TSynObjectList.SetChildOrder(Child: TComponent; Order: Integer);
1805begin
1806  (Child as TSynObjectListItem).Index := Order;
1807  DoChange(self);;
1808end;
1809
1810procedure TSynObjectList.RegisterItem(AnItem: TSynObjectListItem);
1811begin
1812  Add(AnItem);
1813end;
1814
1815function TSynObjectList.GetBasePart(Index: Integer): TSynObjectListItem;
1816begin
1817  Result := TSynObjectListItem(FList[Index]);
1818end;
1819
1820procedure TSynObjectList.PutBasePart(Index: Integer; const AValue: TSynObjectListItem);
1821begin
1822  FList[Index] := Pointer(AValue);
1823  DoChange(self);
1824end;
1825
1826procedure TSynObjectList.SetSorted(const AValue: Boolean);
1827begin
1828  if FSorted = AValue then exit;
1829  FSorted := AValue;
1830  Sort;
1831end;
1832
1833procedure TSynObjectList.DoChange(Sender: TObject);
1834begin
1835  if Assigned(FOnChange) then
1836    FOnChange(Self);
1837end;
1838
1839function CompareSynObjectListItems(Item1, Item2: Pointer): Integer;
1840begin
1841  Result := TSynObjectListItem(Item1).Compare(TSynObjectListItem(Item2));
1842end;
1843
1844procedure TSynObjectList.Sort;
1845begin
1846  FList.Sort(@CompareSynObjectListItems);
1847end;
1848
1849function TSynObjectList.Add(AnItem: TSynObjectListItem): Integer;
1850begin
1851  Result := FList.Add(Pointer(AnItem));
1852  if FSorted then Sort;
1853  DoChange(self);
1854end;
1855
1856procedure TSynObjectList.Delete(Index: Integer);
1857begin
1858  FList.Delete(Index);
1859  DoChange(self);
1860end;
1861
1862procedure TSynObjectList.Clear;
1863begin
1864  while FList.Count > 0 do
1865    BaseItems[0].Free;
1866  FList.Clear;
1867  DoChange(self);
1868end;
1869
1870function TSynObjectList.Count: Integer;
1871begin
1872  Result := FList.Count;
1873end;
1874
1875function TSynObjectList.IndexOf(AnItem: TSynObjectListItem): Integer;
1876begin
1877  Result := Flist.IndexOf(Pointer(AnItem));
1878end;
1879
1880procedure TSynObjectList.Move(AOld, ANew: Integer);
1881begin
1882  if FSorted then raise Exception.Create('not allowed');
1883  FList.Move(AOld, ANew);
1884  DoChange(self);;
1885end;
1886
1887{ TSynObjectListItem }
1888
1889function TSynObjectListItem.GetIndex: Integer;
1890begin
1891  Result := Owner.IndexOf(self);
1892end;
1893
1894function TSynObjectListItem.GetDisplayName: String;
1895begin
1896  Result := Name + ' (' + ClassName + ')';
1897end;
1898
1899procedure TSynObjectListItem.Init;
1900begin
1901  //
1902end;
1903
1904procedure TSynObjectListItem.SetIndex(const AValue: Integer);
1905begin
1906  Owner.Move(GetIndex, AValue);
1907end;
1908
1909function TSynObjectListItem.Compare(Other: TSynObjectListItem): Integer;
1910begin
1911  Result := ComparePointers(Pointer(self), Pointer(Other));
1912end;
1913
1914constructor TSynObjectListItem.Create(AOwner: TComponent);
1915begin
1916  inherited Create(AOwner);
1917  SetAncestor(True);
1918  FOwner := AOwner as TSynObjectList;
1919  Init;
1920  FOwner.RegisterItem(self);
1921end;
1922
1923destructor TSynObjectListItem.Destroy;
1924begin
1925  inherited Destroy;
1926  FOwner.Delete(FOwner.IndexOf(self));
1927end;
1928
1929function TSynObjectListItem.GetParentComponent: TComponent;
1930begin
1931  Result := FOwner;
1932end;
1933
1934{ TSynClipboardStream }
1935
1936function TSynClipboardStream.GetMemory: Pointer;
1937begin
1938  Result := FMemStream.Memory;
1939end;
1940
1941function TSynClipboardStream.GetSize: LongInt;
1942begin
1943  Result := FMemStream.Size;
1944end;
1945
1946procedure TSynClipboardStream.SetInternalText(const AValue: String);
1947begin
1948  FIsPlainText := False;
1949  // Text, if we don't need CF_TEXT // Must include a zero byte
1950  AddTag(synClipTagText, @AValue[1], length(AValue) + 1);
1951end;
1952
1953function TSynClipboardStream.GetSelectionMode: TSynSelectionMode;
1954var
1955  PasteMode: ^TSynSelectionMode;
1956begin
1957  PasteMode := GetTagPointer(synClipTagMode);
1958  if PasteMode = nil then
1959    if FColumnModeFlag then
1960      Result := smColumn
1961    else
1962      Result := smNormal
1963  else
1964    Result := PasteMode^;
1965end;
1966
1967procedure TSynClipboardStream.SetSelectionMode(const AValue: TSynSelectionMode);
1968begin
1969  AddTag(synClipTagMode, @AValue, SizeOf(TSynSelectionMode));
1970  FColumnModeFlag := AValue = smColumn;
1971end;
1972
1973procedure TSynClipboardStream.SetText(const AValue: String);
1974var
1975  SLen: Integer;
1976begin
1977  FIsPlainText := True;
1978  FText := AValue;
1979  SLen := length(FText);
1980  AddTag(synClipTagExtText, @SLen, SizeOf(Integer));
1981end;
1982
1983constructor TSynClipboardStream.Create;
1984begin
1985  FMemStream := TMemoryStream.Create;
1986end;
1987
1988destructor TSynClipboardStream.Destroy;
1989begin
1990  FreeAndNil(FMemStream);
1991  inherited Destroy;
1992end;
1993
1994class function TSynClipboardStream.ClipboardFormatId: TClipboardFormat;
1995const
1996  SYNEDIT_CLIPBOARD_FORMAT_TAGGED = 'Application/X-Laz-SynEdit-Tagged';
1997  Format: TClipboardFormat = 0;
1998begin
1999  if Format = 0 then
2000    Format := ClipboardRegisterFormat(SYNEDIT_CLIPBOARD_FORMAT_TAGGED);
2001  Result := Format;
2002end;
2003
2004class function TSynClipboardStream.ClipboardFormatMSDEVColumnSelect: TClipboardFormat;
2005const
2006  MSDEV_CLIPBOARD_FORMAT_TAGGED = 'MSDEVColumnSelect';
2007  Format: TClipboardFormat = 0;
2008begin
2009  if Format = 0 then
2010    Format := ClipboardRegisterFormat(MSDEV_CLIPBOARD_FORMAT_TAGGED);
2011  Result := Format;
2012end;
2013
2014class function TSynClipboardStream.ClipboardFormatBorlandIDEBlockType: TClipboardFormat;
2015const
2016  BORLAND_CLIPBOARD_FORMAT_TAGGED = 'Borland IDE Block Type';
2017  Format: TClipboardFormat = 0;
2018begin
2019  if Format = 0 then
2020    Format := ClipboardRegisterFormat(BORLAND_CLIPBOARD_FORMAT_TAGGED);
2021  Result := Format;
2022end;
2023
2024function TSynClipboardStream.CanReadFromClipboard(AClipboard: TClipboard): Boolean;
2025begin
2026  Result := AClipboard.HasFormat(ClipboardFormatId);
2027end;
2028
2029function TSynClipboardStream.ReadFromClipboard(AClipboard: TClipboard): Boolean;
2030var
2031  ip: PInteger;
2032  len: LongInt;
2033  buf: TMemoryStream;
2034begin
2035  Result := false;
2036  Clear;
2037  FTextP := nil;
2038  // Check for embedded text
2039  if AClipboard.HasFormat(ClipboardFormatId) then begin
2040    Result := AClipboard.GetFormat(ClipboardFormatId, FMemStream);
2041    FTextP := GetTagPointer(synClipTagText);
2042    if FTextP <> nil then begin
2043      len := GetTagLen(synClipTagText);
2044      if len > 0 then
2045        (FTextP + len - 1)^ := #0
2046      else
2047        FTextP := nil;
2048    end;
2049  end;
2050  // Normal text
2051  if (FTextP = nil) then begin
2052    Result := true;
2053    FText := AClipboard.AsText;
2054    if FText <> '' then begin
2055      FTextP := @FText[1];
2056      ip := GetTagPointer(synClipTagExtText);
2057      if (length(FText) = 0) or (ip = nil) or (length(FText) <> ip^) then
2058        FIsPlainText := True;
2059    end;
2060    FColumnModeFlag := AClipboard.HasFormat(ClipboardFormatMSDEVColumnSelect);
2061    if (not FColumnModeFlag) and AClipboard.HasFormat(ClipboardFormatBorlandIDEBlockType) then begin
2062      buf := TMemoryStream.Create;
2063      try
2064      AClipboard.GetFormat(ClipboardFormatBorlandIDEBlockType, buf);
2065      except
2066        buf.Clear;
2067      end;
2068      if buf.Size = 1 then begin
2069        buf.Position := 0;
2070        FColumnModeFlag := buf.ReadByte = 2;
2071      end;
2072      buf.Free;
2073    end;
2074  end;
2075end;
2076
2077function TSynClipboardStream.WriteToClipboard(AClipboard: TClipboard): Boolean;
2078const
2079  FormatBuf: array [0..0] of byte = (2);
2080begin
2081  AClipboard.Open;
2082  try
2083    if FIsPlainText and (FText <> '') then begin
2084      AClipboard.AsText:= FText;
2085    end;
2086    Result := AClipboard.AddFormat(ClipboardFormatId, FMemStream.Memory^, FMemStream.Size);
2087    if FColumnModeFlag then begin
2088      AClipboard.AddFormat(ClipboardFormatMSDEVColumnSelect, FormatBuf[0], 0);
2089      AClipboard.AddFormat(ClipboardFormatBorlandIDEBlockType, FormatBuf[0], 1);
2090    end;
2091  finally
2092    AClipboard.Close;
2093  end;
2094  {$IFDEF SynClipboardExceptions}
2095  if not AClipboard.HasFormat(CF_TEXT) then
2096    raise ESynEditError.Create('Clipboard copy operation failed: HasFormat');
2097  {$ENDIF}
2098end;
2099
2100procedure TSynClipboardStream.Clear;
2101begin
2102  FMemStream.Clear;
2103  FIsPlainText := False;
2104  FColumnModeFlag := False;
2105end;
2106
2107function TSynClipboardStream.HasTag(ATag: TSynClipboardStreamTag): Boolean;
2108begin
2109  Result := GetTagPointer(ATag) <> nil;
2110end;
2111
2112function TSynClipboardStream.GetTagPointer(ATag: TSynClipboardStreamTag): Pointer;
2113var
2114  ctag, mend: Pointer;
2115begin
2116  Result :=  nil;
2117  if FIsPlainText then
2118    exit;
2119  ctag := FMemStream.Memory;
2120  mend := ctag + FMemStream.Size;
2121  while (result = nil) and
2122        (ctag + SizeOf(TSynClipboardStreamTag) + SizeOf(Integer) <= mend) do
2123  begin
2124     if TSynClipboardStreamTag(ctag^) = ATag then begin
2125      Result := ctag + SizeOf(TSynClipboardStreamTag) + SizeOf(Integer)
2126    end else begin
2127      inc(ctag, SizeOf(TSynClipboardStreamTag));
2128      inc(ctag, PInteger(ctag)^);
2129      inc(ctag, SizeOf(Integer));
2130      {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
2131      ctag := Align(ctag, SizeOf(integer));
2132      {$ENDIF}
2133    end;
2134  end;
2135  if (Result <> nil) and
2136     (ctag + Integer((ctag + SizeOf(TSynClipboardStreamTag))^) > mend) then
2137  begin
2138    Result := nil;
2139    raise ESynEditError.Create('Clipboard read operation failed, data corrupt');
2140  end;
2141end;
2142
2143function TSynClipboardStream.GetTagLen(ATag: TSynClipboardStreamTag): Integer;
2144var
2145  p: PInteger;
2146begin
2147  Result := 0;
2148  p := GetTagPointer(ATag);
2149  if p = nil then
2150    exit;
2151  dec(p, 1);
2152  Result := p^;
2153end;
2154
2155procedure TSynClipboardStream.AddTag(ATag: TSynClipboardStreamTag; Location: Pointer;
2156  Len: Integer);
2157var
2158  msize: Int64;
2159  mpos: Pointer;
2160  LenBlock:PtrUInt;
2161begin
2162  msize := FMemStream.Size;
2163  LenBlock:= Len + SizeOf(TSynClipboardStreamTag) + SizeOf(Integer);
2164  {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
2165  LenBlock := Align(LenBlock, SizeOf(integer));
2166  {$ENDIF}
2167  FMemStream.Size := msize +LenBlock;
2168  mpos := FMemStream.Memory + msize;
2169  TSynClipboardStreamTag(mpos^) := ATag;
2170  inc(mpos, SizeOf(TSynClipboardStreamTag));
2171  Integer(mpos^) := Len;
2172  inc(mpos, SizeOf(Integer));
2173  System.Move(Location^, mpos^, Len);
2174end;
2175
2176{ TSynWordBreaker }
2177
2178procedure TSynWordBreaker.SetIdentChars(const AValue: TSynIdentChars);
2179begin
2180  if FIdentChars = AValue then exit;
2181  FIdentChars := AValue;
2182end;
2183
2184procedure TSynWordBreaker.SetWhiteChars(const AValue: TSynIdentChars);
2185begin
2186  if FWhiteChars = AValue then exit;
2187  FWhiteChars := AValue;
2188  FWordChars := [#1..#255] - (FWordBreakChars + FWhiteChars);
2189end;
2190
2191procedure TSynWordBreaker.SetWordBreakChars(const AValue: TSynIdentChars);
2192begin
2193  if FWordBreakChars = AValue then exit;
2194  FWordBreakChars := AValue;
2195  FWordChars := [#1..#255] - (FWordBreakChars + FWhiteChars);
2196end;
2197
2198constructor TSynWordBreaker.Create;
2199begin
2200  inherited;
2201  Reset;
2202end;
2203
2204procedure TSynWordBreaker.Reset;
2205begin
2206  FWhiteChars     := TSynWhiteChars;
2207  FWordBreakChars := TSynWordBreakChars;
2208  FIdentChars     := TSynValidStringChars - TSynSpecialChars;
2209  FWordChars      := [#1..#255] - (FWordBreakChars + FWhiteChars);
2210end;
2211
2212function TSynWordBreaker.IsInWord(aLine: String; aX: Integer): Boolean;
2213var
2214  len: Integer;
2215begin
2216  len := Length(aLine);
2217  if (aX < 1) or (aX > len + 1) then exit(False);
2218  Result := ((ax <= len) and (aLine[aX] in FWordChars)) or
2219            ((aX > 1) and (aLine[aX - 1] in FWordChars));
2220end;
2221
2222function TSynWordBreaker.IsAtWordStart(aLine: String; aX: Integer): Boolean;
2223var
2224  len: Integer;
2225begin
2226  len := Length(aLine);
2227  if (aX < 1) or (aX > len) then exit(False);
2228  Result := (aLine[aX] in FWordChars) and
2229            ((aX = 1) or not (aLine[aX - 1] in FWordChars));
2230end;
2231
2232function TSynWordBreaker.IsAtWordEnd(aLine: String; aX: Integer): Boolean;
2233var
2234  len: Integer;
2235begin
2236  len := Length(aLine);
2237  if (aX <= 1) or (aX > len + 1) or (len = 0) then exit(False);
2238  Result := ((ax = len + 1) or not(aLine[aX] in FWordChars)) and
2239            (aLine[aX - 1] in FWordChars);
2240end;
2241
2242function TSynWordBreaker.NextWordStart(aLine: String; aX: Integer;
2243  aIncludeCurrent: Boolean): Integer;
2244var
2245  len: Integer;
2246begin
2247  len := Length(aLine);
2248  if (aX < 1) then exit(-1);
2249  if not aIncludeCurrent then
2250    inc(aX);
2251  if (aX > len + 1) then exit(-1);
2252  if (aX > 1) and (aLine[aX - 1] in FWordChars) then
2253    while (aX <= len) and (aLine[aX] in FWordChars) do Inc(ax);
2254  while (aX <= len) and not(aLine[aX] in FWordChars) do Inc(ax);
2255  if aX > len then
2256    exit(-1);
2257  Result := aX;
2258end;
2259
2260function TSynWordBreaker.NextWordEnd(aLine: String; aX: Integer;
2261  aIncludeCurrent: Boolean): Integer;
2262var
2263  len: Integer;
2264begin
2265  len := Length(aLine);
2266  if (aX < 1) then exit(-1);
2267  if not aIncludeCurrent then
2268    inc(aX);
2269  if (aX > len + 1) then exit(-1);
2270  if (aX = 1) or not(aLine[aX - 1] in FWordChars) then begin
2271    while (aX <= len) and not(aLine[aX] in FWordChars) do Inc(ax);
2272    if (aX >= len + 1) then exit(-1);
2273  end;
2274  while (aX <= len) and (aLine[aX] in FWordChars) do Inc(ax);
2275  Result := aX;
2276end;
2277
2278function TSynWordBreaker.PrevWordStart(aLine: String; aX: Integer;
2279  aIncludeCurrent: Boolean): Integer;
2280var
2281  len: Integer;
2282begin
2283  len := Length(aLine);
2284  if (aX < 1) or (aX > len + 1) then exit(-1);
2285  if not aIncludeCurrent then
2286    dec(aX);
2287  while (aX >= 1) and ( (ax > len) or not(aLine[aX] in FWordChars) ) do Dec(ax);
2288  if aX = 0 then
2289    exit(-1);
2290  while (aX >= 1) and ( (ax > len) or (aLine[aX] in FWordChars) ) do Dec(ax);
2291  Result := aX  + 1;
2292end;
2293
2294function TSynWordBreaker.PrevWordEnd(aLine: String; aX: Integer;
2295  aIncludeCurrent: Boolean): Integer;
2296var
2297  len: Integer;
2298begin
2299  len := Length(aLine);
2300  if (aX < 1) or (aX > len + 1) then exit(-1);
2301  if not aIncludeCurrent then
2302    dec(aX);
2303  if aX <= len then
2304    while (aX >= 1) and (aLine[aX] in FWordChars) do Dec(ax);
2305  while (aX >= 1) and ( (ax > len) or not(aLine[aX] in FWordChars) ) do Dec(ax);
2306  if aX = 0 then
2307    exit(-1);
2308  Result := aX + 1;
2309end;
2310
2311function TSynWordBreaker.NextBoundary(aLine: String; aX: Integer;
2312  aIncludeCurrent: Boolean): Integer;
2313var
2314  len: Integer;
2315begin
2316  len := Length(aLine);
2317  if (aX < 1) then exit(-1);
2318  if aIncludeCurrent then dec(ax);
2319  if (ax > len) then exit(-1);
2320
2321  if (aX > 0) and (aLine[aX] in FWordChars) then
2322    while (aX <= len) and (aLine[aX] in FWordChars) do Inc(ax)
2323  else
2324  if (aX > 0) and (aLine[aX] in FWordBreakChars) then
2325    while (aX <= len) and (aLine[aX] in FWordBreakChars) do Inc(ax)
2326  else
2327  begin
2328    while (aX <= len) and ((aX = 0) or (aLine[aX] in FWhiteChars)) do Inc(ax);
2329    if (ax > len) then exit(-1);
2330  end;
2331  Result := aX;
2332end;
2333
2334function TSynWordBreaker.PrevBoundary(aLine: String; aX: Integer;
2335  aIncludeCurrent: Boolean): Integer;
2336var
2337  len: Integer;
2338begin
2339  len := Length(aLine);
2340  if (aX > len + 1) then exit(-1);
2341  if not aIncludeCurrent then dec(ax);
2342  if (aX < 1) then exit(-1);
2343
2344  if (aX <= len) and (aLine[aX] in FWordChars) then
2345    while (aX >= 1) and (aLine[aX] in FWordChars) do dec(ax)
2346  else
2347  if (aX <= len) and (aLine[aX] in FWordBreakChars) then
2348    while (aX >= 1) and (aLine[aX] in FWordBreakChars) do dec(ax)
2349  else
2350  begin
2351    while (aX >= 1) and ((aX > len) or (aLine[aX] in FWhiteChars)) do dec(ax);
2352    if aX = 0 then exit(-1);
2353  end;
2354  Result := aX + 1;
2355end;
2356
2357{ TSynMethodList }
2358
2359function TSynMethodList.IndexToObjectIndex(const AnObject: TObject; AnIndex: Integer): integer;
2360var
2361  i, c: Integer;
2362begin
2363  Result := -1;
2364  if Self = nil then exit;
2365  i := 0;
2366  c := Count;
2367  while i < c do begin
2368    if TObject(Items[i].Data)=AnObject then begin
2369      if AnIndex = 0 then exit(i);
2370      dec(AnIndex);
2371    end;
2372    inc(i);
2373  end;
2374end;
2375
2376function TSynMethodList.GetObjectItems(AnObject: TObject; Index: integer): TMethod;
2377begin
2378  Result := Items[IndexToObjectIndex(AnObject, Index)];
2379end;
2380
2381procedure TSynMethodList.SetObjectItems(AnObject: TObject; Index: integer;
2382  const AValue: TMethod);
2383begin
2384  Items[IndexToObjectIndex(AnObject, Index)] := AValue;
2385end;
2386
2387function TSynMethodList.CountByObject(const AnObject: TObject): integer;
2388var
2389  i: Integer;
2390begin
2391  Result := 0;
2392  if Self=nil then exit;
2393  i := Count-1;
2394  while i>=0 do begin
2395    if TObject(Items[i].Data)=AnObject then inc(Result);
2396    dec(i);
2397  end;
2398end;
2399
2400procedure TSynMethodList.DeleteByObject(const AnObject: TObject; Index: integer);
2401begin
2402  Delete(IndexToObjectIndex(AnObject, Index));
2403end;
2404
2405procedure TSynMethodList.AddCopyFrom(AList: TSynMethodList; AOwner: TObject = nil);
2406var
2407  i: Integer;
2408begin
2409  if AOwner = nil then begin
2410    for i := 0 to AList.Count - 1 do
2411      Add(AList.Items[i], True);
2412  end else begin
2413    for i := 0 to AList.CountByObject(AOwner) - 1 do
2414      Add(AList.ItemsByObject[AOwner, i], True);
2415  end;
2416end;
2417
2418{ TSynFilteredMethodList }
2419
2420function TSynFilteredMethodList.IndexOf(AHandler: TMethod): Integer;
2421begin
2422  Result := FCount - 1;
2423  while (Result >= 0) and
2424        ( (FItems[Result].FHandler.Code <> AHandler.Code) or
2425          (FItems[Result].FHandler.Data <> AHandler.Data) )
2426  do
2427    dec(Result);
2428end;
2429
2430function TSynFilteredMethodList.IndexOf(AHandler: TMethod; AFilter: LongInt): Integer;
2431begin
2432  Result := FCount - 1;
2433  while (Result >= 0) and (
2434        (FItems[Result].FHandler.Code <> AHandler.Code) or
2435        (FItems[Result].FHandler.Data <> AHandler.Data) or
2436        (FItems[Result].FFilter <> AFilter) )
2437  do
2438    dec(Result);
2439end;
2440
2441function TSynFilteredMethodList.NextDownIndex(var Index: integer): boolean;
2442begin
2443  if Self<>nil then begin
2444    dec(Index);
2445    if (Index>=FCount) then
2446      Index:=FCount-1;
2447  end else
2448    Index:=-1;
2449  Result:=(Index>=0);
2450end;
2451
2452function TSynFilteredMethodList.NextDownIndexNumFilter(var Index: integer;
2453  AFilter: LongInt): boolean;
2454begin
2455  Repeat
2456    Result := NextDownIndex(Index);
2457  until (not Result) or (FItems[Index].FFilter = AFilter);
2458end;
2459
2460function TSynFilteredMethodList.NextDownIndexBitFilter(var Index: integer;
2461  AFilter: LongInt): boolean;
2462begin
2463  Repeat
2464    Result := NextDownIndex(Index);
2465  until (not Result) or ((FItems[Index].FFilter and AFilter) <> 0);
2466end;
2467
2468procedure TSynFilteredMethodList.Delete(AIndex: Integer);
2469begin
2470  if AIndex < 0 then exit;
2471  while AIndex < FCount - 1 do begin
2472    FItems[AIndex] := FItems[AIndex + 1];
2473    inc(AIndex);
2474  end;
2475  dec(FCount);
2476  if length(FItems) > FCount * 4 then
2477    SetLength(FItems, FCount * 2);
2478end;
2479
2480constructor TSynFilteredMethodList.Create;
2481begin
2482  FCount := 0;
2483end;
2484
2485procedure TSynFilteredMethodList.AddNumFilter(AHandler: TMethod; AFilter: LongInt);
2486var
2487  i: Integer;
2488begin
2489  i := IndexOf(AHandler, AFilter);
2490  if i >= 0 then
2491    raise Exception.Create('Duplicate');
2492
2493  if FCount >= high(FItems) then
2494    SetLength(FItems, Max(8, FCount * 2));
2495  FItems[FCount].FHandler := AHandler;
2496  FItems[FCount].FFilter := AFilter;
2497  inc(FCount);
2498end;
2499
2500procedure TSynFilteredMethodList.AddBitFilter(AHandler: TMethod; AFilter: LongInt);
2501var
2502  i: Integer;
2503begin
2504  i := IndexOf(AHandler);
2505  if i >= 0 then
2506    FItems[i].FFilter := FItems[i].FFilter or AFilter
2507  else begin
2508    if FCount >= high(FItems) then
2509      SetLength(FItems, Max(8, FCount * 2));
2510    FItems[FCount].FHandler := AHandler;
2511    FItems[FCount].FFilter := AFilter;
2512    inc(FCount);
2513  end;
2514end;
2515
2516procedure TSynFilteredMethodList.Remove(AHandler: TMethod);
2517begin
2518  Delete(IndexOf(AHandler));
2519end;
2520
2521procedure TSynFilteredMethodList.Remove(AHandler: TMethod; AFilter: LongInt);
2522begin
2523  Delete(IndexOf(AHandler, AFilter));
2524end;
2525
2526procedure TSynFilteredMethodList.CallNotifyEventsNumFilter(Sender: TObject; AFilter: LongInt);
2527var
2528  i: Integer;
2529begin
2530  i:=Count;
2531  while NextDownIndexNumFilter(i, AFilter) do
2532    TNotifyEvent(FItems[i].FHandler)(Sender);
2533end;
2534
2535procedure TSynFilteredMethodList.CallNotifyEventsBitFilter(Sender: TObject; AFilter: LongInt);
2536var
2537  i: Integer;
2538begin
2539  i:=Count;
2540  while NextDownIndexBitFilter(i, AFilter) do
2541    TNotifyEvent(FItems[i].FHandler)(Sender);
2542end;
2543
2544{ TSynSizedDifferentialAVLNode }
2545
2546procedure TSynSizedDifferentialAVLNode.SetLeftSizeSum(AValue: Integer);
2547begin
2548  if FLeftSizeSum = AValue then Exit;
2549  FLeftSizeSum := AValue;
2550  AdjustParentLeftCount(AValue - FLeftSizeSum);
2551end;
2552
2553{$IFDEF SynDebug}
2554function TSynSizedDifferentialAVLNode.Debug: String;
2555begin
2556  Result := Format('Size=%3d (LeftSum=%3d)  Balance=%3d ',
2557                      [FSize,   FLeftSizeSum, FBalance]);
2558end;
2559{$ENDIF}
2560
2561function TSynSizedDifferentialAVLNode.TreeDepth: integer;
2562var t: integer;
2563begin
2564  Result := 1;
2565  if FLeft <> nil  then Result := FLeft.TreeDepth+1;
2566  if FRight <> nil then t := FRight.TreeDepth+1 else t := 0;
2567  if t > Result then Result := t;
2568end;
2569
2570procedure TSynSizedDifferentialAVLNode.SetLeftChild(ANode: TSynSizedDifferentialAVLNode);
2571begin
2572  FLeft := ANode;
2573  if ANode <> nil then ANode.FParent := self;
2574end;
2575
2576procedure TSynSizedDifferentialAVLNode.SetLeftChild(ANode: TSynSizedDifferentialAVLNode;
2577  anAdjustChildPosOffset: Integer);
2578begin
2579  FLeft := ANode;
2580  if ANode <> nil then begin
2581    ANode.FParent := self;
2582    ANode.FPositionOffset := ANode.FPositionOffset + anAdjustChildPosOffset;
2583  end;
2584end;
2585
2586procedure TSynSizedDifferentialAVLNode.SetLeftChild(ANode: TSynSizedDifferentialAVLNode;
2587  anAdjustChildPosOffset, aLeftSizeSum: Integer);
2588begin
2589  FLeft := ANode;
2590  FLeftSizeSum := aLeftSizeSum;
2591  if ANode <> nil then begin
2592    ANode.FParent := self;
2593    ANode.FPositionOffset := ANode.FPositionOffset + anAdjustChildPosOffset;
2594  end
2595end;
2596
2597procedure TSynSizedDifferentialAVLNode.SetRightChild(ANode: TSynSizedDifferentialAVLNode);
2598begin
2599  FRight := ANode;
2600  if ANode <> nil then ANode.FParent := self;
2601end;
2602
2603procedure TSynSizedDifferentialAVLNode.SetRightChild(ANode: TSynSizedDifferentialAVLNode;
2604  anAdjustChildPosOffset: Integer);
2605begin
2606  FRight := ANode;
2607  if ANode <> nil then begin
2608    ANode.FParent := self;
2609    ANode.FPositionOffset := ANode.FPositionOffset + anAdjustChildPosOffset;
2610  end;
2611end;
2612
2613function TSynSizedDifferentialAVLNode.ReplaceChild(OldNode,
2614  ANode: TSynSizedDifferentialAVLNode): TReplacedChildSite;
2615begin
2616  if FLeft = OldNode then begin
2617    SetLeftChild(ANode);
2618    exit(rplcLeft);
2619  end;
2620  SetRightChild(ANode);
2621  result := rplcRight;
2622end;
2623
2624function TSynSizedDifferentialAVLNode.ReplaceChild(OldNode,
2625  ANode: TSynSizedDifferentialAVLNode; anAdjustChildPosOffset: Integer): TReplacedChildSite;
2626begin
2627  if FLeft = OldNode then begin
2628    SetLeftChild(ANode, anAdjustChildPosOffset);
2629    exit(rplcLeft);
2630  end;
2631  SetRightChild(ANode, anAdjustChildPosOffset);
2632  result := rplcRight;
2633end;
2634
2635procedure TSynSizedDifferentialAVLNode.AdjustLeftCount(AValue: Integer);
2636begin
2637  FLeftSizeSum := FLeftSizeSum + AValue;
2638  AdjustParentLeftCount(AValue);
2639end;
2640
2641procedure TSynSizedDifferentialAVLNode.AdjustParentLeftCount(AValue: Integer);
2642var
2643  node, pnode : TSynSizedDifferentialAVLNode;
2644begin
2645  node := self;
2646  pnode := node.FParent;
2647  while pnode <> nil do begin
2648    if node = pnode.FLeft
2649    then pnode.FLeftSizeSum := pnode.FLeftSizeSum + AValue;
2650    node := pnode;
2651    pnode := node.FParent;
2652  end;
2653end;
2654
2655procedure TSynSizedDifferentialAVLNode.AdjustPosition(AValue: Integer);
2656begin
2657  FPositionOffset := FPositionOffset + AValue;
2658  if FRight <> nil then
2659    FRight.FPositionOffset := FRight.FPositionOffset - AValue;;
2660  if FLeft <> nil then
2661    FLeft.FPositionOffset := FLeft.FPositionOffset - AValue;;
2662end;
2663
2664function TSynSizedDifferentialAVLNode.GetSizesBeforeSum: Integer;
2665var
2666  n1, n2: TSynSizedDifferentialAVLNode;
2667begin
2668  Result := FLeftSizeSum;
2669  n1 := FParent;
2670  n2 := Self;
2671  while n1 <> nil do begin
2672    if n2 = n1.FRight then
2673      Result := Result + n1.FLeftSizeSum + n1.FSize;
2674    n2 := n1;
2675    n1 := n1.FParent;
2676  end;
2677end;
2678
2679function TSynSizedDifferentialAVLNode.GetPosition: Integer;
2680var
2681  N: TSynSizedDifferentialAVLNode;
2682begin
2683  Result := FPositionOffset;
2684  N := FParent;
2685  while N <> nil do begin
2686    Result := Result + N.FPositionOffset;
2687    N := N.FParent;
2688  end;
2689end;
2690
2691function TSynSizedDifferentialAVLNode.Precessor: TSynSizedDifferentialAVLNode;
2692begin
2693  Result := FLeft;
2694  if Result<>nil then begin
2695    while (Result.FRight<>nil) do Result := Result.FRight;
2696  end else begin
2697    Result := self;
2698    while (Result.FParent<>nil) and (Result.FParent.FLeft=Result) do
2699      Result := Result.FParent;
2700    Result := Result.FParent;
2701  end;
2702end;
2703
2704function TSynSizedDifferentialAVLNode.Successor: TSynSizedDifferentialAVLNode;
2705begin
2706  Result := FRight;
2707  if Result<>nil then begin
2708    while (Result.FLeft<>nil) do Result := Result.FLeft;
2709  end else begin
2710    Result := self;
2711    while (Result.FParent<>nil) and (Result.FParent.FRight=Result) do
2712      Result := Result.FParent;
2713    Result := Result.FParent;
2714  end;
2715end;
2716
2717function TSynSizedDifferentialAVLNode.Precessor(var aStartPosition,
2718  aSizesBeforeSum: Integer): TSynSizedDifferentialAVLNode;
2719begin
2720  Result := FLeft;
2721  if Result<>nil then begin
2722    aStartPosition := aStartPosition + Result.FPositionOffset;
2723    while (Result.FRight<>nil) do begin
2724      Result := Result.FRight;
2725      aStartPosition := aStartPosition + Result.FPositionOffset;
2726    end;
2727  end else begin
2728    Result := self;
2729    while (Result.FParent<>nil) and (Result.FParent.FLeft=Result) do begin
2730      aStartPosition := aStartPosition - Result.FPositionOffset;
2731      Result := Result.FParent;
2732    end;
2733    // result is now a FRight son
2734    aStartPosition := aStartPosition - Result.FPositionOffset;
2735    Result := Result.FParent;
2736  end;
2737  if result <> nil then
2738    aSizesBeforeSum := aSizesBeforeSum - Result.FSize
2739  else
2740    aSizesBeforeSum := 0;
2741end;
2742
2743function TSynSizedDifferentialAVLNode.Successor(var aStartPosition,
2744  aSizesBeforeSum: Integer): TSynSizedDifferentialAVLNode;
2745begin
2746  aSizesBeforeSum := aSizesBeforeSum + FSize;
2747  Result := FRight;
2748  if Result<>nil then begin
2749    aStartPosition := aStartPosition + Result.FPositionOffset;
2750    while (Result.FLeft<>nil) do begin
2751      Result := Result.FLeft;
2752      aStartPosition := aStartPosition + Result.FPositionOffset;
2753    end;
2754  end else begin
2755    Result := self;
2756    while (Result.FParent<>nil) and (Result.FParent.FRight=Result) do begin
2757      aStartPosition := aStartPosition - Result.FPositionOffset;
2758      Result := Result.FParent;
2759    end;
2760    // Result is now a FLeft son; result has a negative FPositionOffset
2761    aStartPosition := aStartPosition - Result.FPositionOffset;
2762    Result := Result.FParent;
2763  end;
2764end;
2765
2766{ TSynSizedDifferentialAVLTree }
2767
2768procedure TSynSizedDifferentialAVLTree.SetRoot(ANode: TSynSizedDifferentialAVLNode);
2769begin
2770  fRoot := ANode;
2771  if ANode <> nil then ANode.FParent := nil;
2772end;
2773
2774procedure TSynSizedDifferentialAVLTree.SetRoot(ANode: TSynSizedDifferentialAVLNode;
2775  anAdjustChildPosOffset: Integer);
2776begin
2777  fRoot := ANode;
2778  if ANode <> nil then begin
2779    ANode.FParent := nil;
2780    ANode.FPositionOffset := ANode.FPositionOffset + anAdjustChildPosOffset;
2781  end;
2782end;
2783
2784procedure TSynSizedDifferentialAVLTree.DisposeNode(var ANode: TSynSizedDifferentialAVLNode);
2785begin
2786  FreeAndNil(ANode);
2787end;
2788
2789function TSynSizedDifferentialAVLTree.InsertNode(ANode: TSynSizedDifferentialAVLNode): Integer;
2790var
2791  current: TSynSizedDifferentialAVLNode;
2792  rStartPosition, rSizesBeforeSum: Integer;
2793  ALine, ACount: Integer;
2794begin
2795  if fRoot = nil then begin
2796    SetRoot(ANode, -fRootOffset);
2797    Result := 0;
2798    exit;
2799  end;
2800
2801  ALine := ANode.FPositionOffset;
2802  ACount := ANode.FSize;
2803
2804  current := fRoot;
2805  rStartPosition := fRootOffset;
2806  rSizesBeforeSum := 0;
2807
2808  while (current <> nil) do begin
2809    rStartPosition := rStartPosition + current.FPositionOffset;
2810
2811    if ALine < rStartPosition then begin
2812      (* *** New block goes to the Fleft *** *)
2813      if current.FLeft <> nil Then begin
2814        current := current.FLeft;
2815        continue;
2816      end
2817      else begin // insert as FLeft
2818        current.AdjustParentLeftCount(ACount);
2819        current.SetLeftChild(ANode, -rStartPosition, ANode.FSize);
2820        BalanceAfterInsert(ANode);
2821        break;
2822      end;
2823    end;
2824
2825    rSizesBeforeSum := rSizesBeforeSum + current.FLeftSizeSum;
2826
2827    if ALine = rStartPosition then begin
2828      // Should not happen // did happen when nodes with 0 lines where re-inserrted, after editor-delete-lines
2829      debugln(['Droping Foldnode / Already exists. Startline=', rStartPosition,' LineCount=',ACount]);
2830      FreeAndNil(ANode);
2831      break;
2832    end
2833
2834    else begin
2835      rSizesBeforeSum := rSizesBeforeSum + current.FSize;
2836      if current.FRight <> nil then begin
2837        current := current.FRight;
2838        continue;
2839      end
2840      else begin  // insert to the Fright - no nesting
2841        current.AdjustParentLeftCount(ACount);
2842        current.SetRightChild(ANode, -rStartPosition);
2843        BalanceAfterInsert(ANode);
2844        break;
2845      end;
2846    end;
2847  end; // while
2848
2849  Result := rSizesBeforeSum;
2850end;
2851
2852procedure TSynSizedDifferentialAVLTree.RemoveNode(ANode: TSynSizedDifferentialAVLNode);
2853var OldParent, Precessor, PrecOldParent, PrecOldLeft,
2854  OldSubTree: TSynSizedDifferentialAVLNode;
2855  OldBalance, PrecOffset, PrecLeftCount: integer;
2856
2857begin
2858  if ((ANode.FLeft<>nil) and (ANode.FRight<>nil)) then begin
2859    PrecOffset := 0;
2860//    PrecOffset := ANode.FPositionOffset;
2861    Precessor := ANode.FLeft;
2862    while (Precessor.FRight<>nil) do begin
2863      PrecOffset := PrecOffset + Precessor.FPositionOffset;
2864      Precessor := Precessor.FRight;
2865    end;
2866(*                            *OR*
2867 PnL              PnL
2868   \               \
2869   Precessor       Anode
2870   /               /
2871  *               *                     PnL             PnL
2872 /               /                        \               \
2873AnL   AnR       AnL      AnR        Precessor   AnR       AnL      AnR
2874  \   /           \      /                  \   /           \      /
2875   Anode          Precessor()               Anode          Precessor()
2876*)
2877    OldBalance := ANode.FBalance;
2878    ANode.FBalance     := Precessor.FBalance;
2879    Precessor.FBalance := OldBalance;
2880
2881    // Successor.FLeft = nil
2882    PrecOldLeft   := Precessor.FLeft;
2883    PrecOldParent := Precessor.FParent;
2884
2885    if (ANode.FParent<>nil)
2886    then ANode.FParent.ReplaceChild(ANode, Precessor, PrecOffset + ANode.FPositionOffset)
2887    else SetRoot(Precessor, PrecOffset + ANode.FPositionOffset);
2888
2889    Precessor.SetRightChild(ANode.FRight,
2890                           +ANode.FPositionOffset-Precessor.FPositionOffset);
2891
2892    PrecLeftCount := Precessor.FLeftSizeSum;
2893    // ANode.FRight will be empty  // ANode.FLeft will be Succesor.FLeft
2894    if (PrecOldParent = ANode) then begin
2895      // Precessor is Fleft son of ANode
2896      // set ANode.FPositionOffset=0 => FPositionOffset for the Prec-Children is already correct;
2897      Precessor.SetLeftChild(ANode, -ANode.FPositionOffset,
2898                             PrecLeftCount + ANode.FSize);
2899      ANode.SetLeftChild(PrecOldLeft, 0, PrecLeftCount);
2900    end else begin
2901      // at least one node between ANode and Precessor ==> Precessor = PrecOldParent.FRight
2902      Precessor.SetLeftChild(ANode.FLeft, +ANode.FPositionOffset - Precessor.FPositionOffset,
2903                             ANode.FLeftSizeSum + ANode.FSize - Precessor.FSize);
2904      PrecOffset:=PrecOffset + ANode.FPositionOffset - Precessor.FPositionOffset;
2905      // Set Anode.FPositionOffset, so ANode movesinto position of Precessor;
2906      PrecOldParent.SetRightChild(ANode, - ANode.FPositionOffset -  PrecOffset);
2907      ANode.SetLeftChild(PrecOldLeft, 0, PrecLeftCount);
2908    end;
2909
2910    ANode.FRight := nil;
2911  end;
2912
2913  if (ANode.FRight<>nil) then begin
2914    OldSubTree := ANode.FRight;
2915    ANode.FRight := nil;
2916  end
2917  else if (ANode.FLeft<>nil) then begin
2918    OldSubTree := ANode.FLeft;
2919    ANode.FLeft := nil;
2920  end
2921  else OldSubTree := nil;
2922
2923  OldParent := ANode.FParent;
2924  ANode.FParent := nil;
2925  ANode.FLeft := nil;
2926  ANode.FRight := nil;
2927  ANode.FBalance := 0;
2928  ANode.FLeftSizeSum := 0;
2929  // nested???
2930
2931  if (OldParent<>nil) then begin      // Node has Fparent
2932    if OldParent.ReplaceChild(ANode, OldSubTree, ANode.FPositionOffset) = rplcLeft
2933    then begin
2934      Inc(OldParent.FBalance);
2935      OldParent.AdjustLeftCount(-ANode.FSize);
2936    end
2937    else begin
2938      Dec(OldParent.FBalance);
2939      OldParent.AdjustParentLeftCount(-ANode.FSize);
2940    end;
2941    BalanceAfterDelete(OldParent);
2942  end
2943  else SetRoot(OldSubTree, ANode.FPositionOffset);
2944end;
2945
2946procedure TSynSizedDifferentialAVLTree.BalanceAfterInsert(ANode: TSynSizedDifferentialAVLNode);
2947var
2948  OldParent, OldParentParent, OldRight, OldRightLeft, OldRightRight, OldLeft,
2949  OldLeftLeft, OldLeftRight: TSynSizedDifferentialAVLNode;
2950  tmp : integer;
2951begin
2952  OldParent := ANode.FParent;
2953  if (OldParent=nil) then exit;
2954
2955  if (OldParent.FLeft=ANode) then begin
2956    (* *** Node is left son *** *)
2957    dec(OldParent.FBalance);
2958    if (OldParent.FBalance=0) then exit;
2959    if (OldParent.FBalance=-1) then begin
2960      BalanceAfterInsert(OldParent);
2961      exit;
2962    end;
2963
2964    // OldParent.FBalance=-2
2965    if (ANode.FBalance=-1) then begin
2966      (* ** single rotate ** *)
2967      (*  []
2968           \
2969           []  ORight                     []    ORight    []
2970            \   /                          \      \       /
2971            ANode(-1)  []        =>        []     OldParent(0)
2972               \       /                    \     /
2973               OldParent(-2)                 ANode(0)
2974      *)
2975      OldRight := ANode.FRight;
2976      OldParentParent := OldParent.FParent;
2977      (* ANode moves into position of OldParent *)
2978      if (OldParentParent<>nil)
2979      then OldParentParent.ReplaceChild(OldParent, ANode, OldParent.FPositionOffset)
2980      else SetRoot(ANode, OldParent.FPositionOffset);
2981
2982      (* OldParent moves under ANode, replacing Anode.FRight, which moves under OldParent *)
2983      ANode.SetRightChild(OldParent, -ANode.FPositionOffset );
2984      OldParent.SetLeftChild(OldRight, -OldParent.FPositionOffset, OldParent.FLeftSizeSum - ANode.FSize - ANode.FLeftSizeSum);
2985
2986      ANode.FBalance := 0;
2987      OldParent.FBalance := 0;
2988      (* ** END single rotate ** *)
2989    end
2990    else begin  // ANode.FBalance = +1
2991      (* ** double rotate ** *)
2992      OldParentParent := OldParent.FParent;
2993      OldRight := ANode.FRight;
2994      OldRightLeft := OldRight.FLeft;
2995      OldRightRight := OldRight.FRight;
2996
2997      (* OldRight moves into position of OldParent *)
2998      if (OldParentParent<>nil)
2999      then OldParentParent.ReplaceChild(OldParent, OldRight, OldParent.FPositionOffset + ANode.FPositionOffset)
3000      else SetRoot(OldRight, OldParent.FPositionOffset + ANode.FPositionOffset);        // OldParent was root node. new root node
3001
3002      OldRight.SetRightChild(OldParent, -OldRight.FPositionOffset);
3003      OldRight.SetLeftChild(ANode, OldParent.FPositionOffset, OldRight.FLeftSizeSum + ANode.FLeftSizeSum + ANode.FSize);
3004      ANode.SetRightChild(OldRightLeft, -ANode.FPositionOffset);
3005      OldParent.SetLeftChild(OldRightRight, -OldParent.FPositionOffset, OldParent.FLeftSizeSum - OldRight.FLeftSizeSum - OldRight.FSize);
3006
3007      // balance
3008      if (OldRight.FBalance<=0)
3009      then ANode.FBalance := 0
3010      else ANode.FBalance := -1;
3011      if (OldRight.FBalance=-1)
3012      then OldParent.FBalance := 1
3013      else OldParent.FBalance := 0;
3014      OldRight.FBalance := 0;
3015      (* ** END double rotate ** *)
3016    end;
3017    (* *** END Node is left son *** *)
3018  end
3019  else begin
3020    (* *** Node is right son *** *)
3021    Inc(OldParent.FBalance);
3022    if (OldParent.FBalance=0) then exit;
3023    if (OldParent.FBalance=+1) then begin
3024      BalanceAfterInsert(OldParent);
3025      exit;
3026    end;
3027
3028    // OldParent.FBalance = +2
3029    if(ANode.FBalance=+1) then begin
3030      (* ** single rotate ** *)
3031      OldLeft := ANode.FLeft;
3032      OldParentParent := OldParent.FParent;
3033
3034      if (OldParentParent<>nil)
3035      then  OldParentParent.ReplaceChild(OldParent, ANode, OldParent.FPositionOffset)
3036      else SetRoot(ANode, OldParent.FPositionOffset);
3037
3038      (* OldParent moves under ANode, replacing Anode.FLeft, which moves under OldParent *)
3039      ANode.SetLeftChild(OldParent, -ANode.FPositionOffset, ANode.FLeftSizeSum + OldParent.FSize + OldParent.FLeftSizeSum);
3040      OldParent.SetRightChild(OldLeft, -OldParent.FPositionOffset);
3041
3042      ANode.FBalance := 0;
3043      OldParent.FBalance := 0;
3044      (* ** END single rotate ** *)
3045    end
3046    else begin  // Node.Balance = -1
3047      (* ** double rotate ** *)
3048      OldLeft := ANode.FLeft;
3049      OldParentParent := OldParent.FParent;
3050      OldLeftLeft := OldLeft.FLeft;
3051      OldLeftRight := OldLeft.FRight;
3052
3053      (* OldLeft moves into position of OldParent *)
3054      if (OldParentParent<>nil)
3055      then  OldParentParent.ReplaceChild(OldParent, OldLeft, OldParent.FPositionOffset + ANode.FPositionOffset)
3056      else SetRoot(OldLeft, OldParent.FPositionOffset + ANode.FPositionOffset);
3057
3058      tmp := OldLeft.FLeftSizeSum;
3059      OldLeft.SetLeftChild (OldParent, -OldLeft.FPositionOffset, tmp + OldParent.FLeftSizeSum + OldParent.FSize);
3060      OldLeft.SetRightChild(ANode, OldParent.FPositionOffset);
3061
3062      OldParent.SetRightChild(OldLeftLeft, -OldParent.FPositionOffset);
3063      ANode.SetLeftChild(OldLeftRight, -ANode.FPositionOffset, ANode.FLeftSizeSum - tmp - OldLeft.FSize);
3064
3065      // Balance
3066      if (OldLeft.FBalance>=0)
3067      then ANode.FBalance := 0
3068      else ANode.FBalance := +1;
3069      if (OldLeft.FBalance=+1)
3070      then OldParent.FBalance := -1
3071      else OldParent.FBalance := 0;
3072      OldLeft.FBalance := 0;
3073      (* ** END double rotate ** *)
3074    end;
3075  end;
3076end;
3077
3078procedure TSynSizedDifferentialAVLTree.BalanceAfterDelete(ANode: TSynSizedDifferentialAVLNode);
3079var
3080  OldParent, OldRight, OldRightLeft, OldLeft, OldLeftRight,
3081  OldRightLeftLeft, OldRightLeftRight, OldLeftRightLeft, OldLeftRightRight: TSynSizedDifferentialAVLNode;
3082  tmp: integer;
3083begin
3084  if (ANode=nil) then exit;
3085  if ((ANode.FBalance=+1) or (ANode.FBalance=-1)) then exit;
3086  OldParent := ANode.FParent;
3087  if (ANode.FBalance=0) then begin
3088    // Treeheight has decreased by one
3089    if (OldParent<>nil) then begin
3090      if(OldParent.FLeft=ANode) then
3091        Inc(OldParent.FBalance)
3092      else
3093        Dec(OldParent.FBalance);
3094      BalanceAfterDelete(OldParent);
3095    end;
3096    exit;
3097  end;
3098
3099  if (ANode.FBalance=-2) then begin
3100    // Node.Balance=-2
3101    // Node is overweighted to the left
3102    (*
3103          OLftRight
3104           /
3105        OLeft(<=0)
3106           \
3107             ANode(-2)
3108    *)
3109    OldLeft := ANode.FLeft;
3110    if (OldLeft.FBalance<=0) then begin
3111      // single rotate left
3112      OldLeftRight := OldLeft.FRight;
3113
3114      if (OldParent<>nil)
3115      then OldParent.ReplaceChild(ANode, OldLeft, ANode.FPositionOffset)
3116      else SetRoot(OldLeft, ANode.FPositionOffset);
3117
3118      OldLeft.SetRightChild(ANode, -OldLeft.FPositionOffset);
3119      ANode.SetLeftChild(OldLeftRight, -ANode.FPositionOffset, ANode.FLeftSizeSum - OldLeft.FSize - OldLeft.FLeftSizeSum);
3120
3121      ANode.FBalance := (-1-OldLeft.FBalance);
3122      Inc(OldLeft.FBalance);
3123
3124      BalanceAfterDelete(OldLeft);
3125    end else begin
3126      // OldLeft.FBalance = 1
3127      // double rotate left left
3128      OldLeftRight := OldLeft.FRight;
3129      OldLeftRightLeft := OldLeftRight.FLeft;
3130      OldLeftRightRight := OldLeftRight.FRight;
3131
3132(*
3133 OLR-Left   OLR-Right
3134      \     /
3135      OldLeftRight          OLR-Left    OLR-Right
3136       /                       /            \
3137   OldLeft                 OldLeft         ANode
3138      \                         \           /
3139     ANode                       OldLeftRight
3140       |                            |
3141     OldParent                   OldParent  (or root)
3142*)
3143      if (OldParent<>nil)
3144      then OldParent.ReplaceChild(ANode, OldLeftRight, ANode.FPositionOffset + OldLeft.FPositionOffset)
3145      else SetRoot(OldLeftRight, ANode.FPositionOffset + OldLeft.FPositionOffset);
3146
3147      OldLeftRight.SetRightChild(ANode, -OldLeftRight.FPositionOffset);
3148      OldLeftRight.SetLeftChild(OldLeft, ANode.FPositionOffset, OldLeftRight.FLeftSizeSum + OldLeft.FLeftSizeSum + OldLeft.FSize);
3149      OldLeft.SetRightChild(OldLeftRightLeft, -OldLeft.FPositionOffset);
3150      ANode.SetLeftChild(OldLeftRightRight,  -ANode.FPositionOffset, ANode.FLeftSizeSum - OldLeftRight.FLeftSizeSum - OldLeftRight.FSize);
3151
3152      if (OldLeftRight.FBalance<=0)
3153      then OldLeft.FBalance := 0
3154      else OldLeft.FBalance := -1;
3155      if (OldLeftRight.FBalance>=0)
3156      then ANode.FBalance := 0
3157      else ANode.FBalance := +1;
3158      OldLeftRight.FBalance := 0;
3159
3160      BalanceAfterDelete(OldLeftRight);
3161    end;
3162  end else begin
3163    // Node is overweighted to the right
3164    OldRight := ANode.FRight;
3165    if (OldRight.FBalance>=0) then begin
3166      // OldRight.FBalance=={0 or -1}
3167      // single rotate right
3168      OldRightLeft := OldRight.FLeft;
3169
3170      if (OldParent<>nil)
3171      then OldParent.ReplaceChild(ANode, OldRight, ANode.FPositionOffset)
3172      else SetRoot(OldRight, ANode.FPositionOffset);
3173
3174      OldRight.SetLeftChild(ANode, -OldRight.FPositionOffset, OldRight.FLeftSizeSum + ANode.FSize + ANode.FLeftSizeSum);
3175      ANode.SetRightChild(OldRightLeft, -ANode.FPositionOffset);
3176
3177      ANode.FBalance := (1-OldRight.FBalance);
3178      Dec(OldRight.FBalance);
3179
3180      BalanceAfterDelete(OldRight);
3181    end else begin
3182      // OldRight.FBalance=-1
3183      // double rotate right left
3184      OldRightLeft := OldRight.FLeft;
3185      OldRightLeftLeft := OldRightLeft.FLeft;
3186      OldRightLeftRight := OldRightLeft.FRight;
3187      if (OldParent<>nil)
3188      then OldParent.ReplaceChild(ANode, OldRightLeft, ANode.FPositionOffset + OldRight.FPositionOffset)
3189      else SetRoot(OldRightLeft, ANode.FPositionOffset + OldRight.FPositionOffset);
3190
3191      tmp := OldRightLeft.FLeftSizeSum;
3192      OldRightLeft.SetLeftChild(ANode, -OldRightLeft.FPositionOffset, tmp + ANode.FLeftSizeSum + ANode.FSize);
3193      OldRightLeft.SetRightChild(OldRight, ANode.FPositionOffset);
3194
3195      ANode.SetRightChild(OldRightLeftLeft, -ANode.FPositionOffset);
3196      OldRight.SetLeftChild(OldRightLeftRight, -OldRight.FPositionOffset, OldRight.FLeftSizeSum - tmp - OldRightLeft.FSize);
3197
3198      if (OldRightLeft.FBalance<=0)
3199      then ANode.FBalance := 0
3200      else ANode.FBalance := -1;
3201      if (OldRightLeft.FBalance>=0)
3202      then OldRight.FBalance := 0
3203      else OldRight.FBalance := +1;
3204      OldRightLeft.FBalance := 0;
3205      BalanceAfterDelete(OldRightLeft);
3206    end;
3207  end;
3208end;
3209
3210function TSynSizedDifferentialAVLTree.CreateNode(APosition: Integer): TSynSizedDifferentialAVLNode;
3211begin
3212  Result := TSynSizedDifferentialAVLNode.Create;
3213end;
3214
3215constructor TSynSizedDifferentialAVLTree.Create;
3216begin
3217  inherited;
3218  fRoot := nil;
3219  fRootOffset := 0;
3220end;
3221
3222destructor TSynSizedDifferentialAVLTree.Destroy;
3223begin
3224  Clear;
3225  inherited Destroy;
3226end;
3227
3228{$IFDEF SynDebug}
3229procedure TSynSizedDifferentialAVLTree.Debug;
3230  function debug2(ind, typ : String; ANode, AParent : TSynSizedDifferentialAVLNode; offset : integer) :integer;
3231  begin
3232    result := 0;
3233    if ANode = nil then exit;
3234    with ANode do
3235      DebugLn([Format('%-14s - Pos=%3d (offs=%3d)  %s',
3236                      [ind + typ,
3237                       offset + ANode.FPositionOffset,   ANode.FPositionOffset,
3238                       ANode.Debug])
3239              ]);
3240    if ANode.FParent <> AParent then DebugLn([ind,'* Bad parent']);
3241
3242    Result := debug2(ind+'  ', 'L', ANode.FLeft, ANode, offset+ANode.FPositionOffset);
3243    If Result <> ANode.FLeftSizeSum then  debugln([ind,'   ***** Leftcount was ',Result, ' but should be ', ANode.FLeftSizeSum]);
3244    Result := Result + debug2(ind+'  ', 'R', ANode.FRight, ANode, offset+ANode.FPositionOffset);
3245    Result := Result + ANode.FSize;
3246  end;
3247begin
3248  debug2('', '**', fRoot, nil, 0);
3249end;
3250{$ENDIF}
3251
3252procedure TSynSizedDifferentialAVLTree.Clear;
3253  procedure DeleteNode(var ANode: TSynSizedDifferentialAVLNode);
3254  begin
3255    if ANode.FLeft  <> nil then DeleteNode(ANode.FLeft);
3256    if ANode.FRight <> nil then DeleteNode(ANode.FRight);
3257    DisposeNode(ANode);
3258  end;
3259begin
3260  if FRoot <> nil then DeleteNode(FRoot);
3261  SetRoot(nil);
3262end;
3263
3264function TSynSizedDifferentialAVLTree.First: TSynSizedDifferentialAVLNode;
3265begin
3266  Result := FRoot;
3267  if Result = nil then
3268    exit;
3269  while Result.FLeft <> nil do
3270    Result := Result.FLeft;
3271end;
3272
3273function TSynSizedDifferentialAVLTree.Last: TSynSizedDifferentialAVLNode;
3274begin
3275  Result := FRoot;
3276  if Result = nil then
3277    exit;
3278  while Result.FRight <> nil do
3279    Result := Result.FRight;
3280end;
3281
3282function TSynSizedDifferentialAVLTree.First(out aStartPosition,
3283  aSizesBeforeSum: Integer): TSynSizedDifferentialAVLNode;
3284begin
3285  Result := FRoot;
3286  aStartPosition := FRootOffset;
3287  aSizesBeforeSum := 0;
3288  if Result = nil then
3289    exit;
3290
3291  aStartPosition := aStartPosition + Result.FPositionOffset;
3292  while Result.FLeft <> nil do begin
3293    Result := Result.FLeft;
3294    aStartPosition := aStartPosition + Result.FPositionOffset;
3295  end;
3296end;
3297
3298function TSynSizedDifferentialAVLTree.Last(out aStartPosition,
3299  aSizesBeforeSum: Integer): TSynSizedDifferentialAVLNode;
3300begin
3301  Result := FRoot;
3302  aStartPosition := FRootOffset;
3303  aSizesBeforeSum := 0;
3304  if Result = nil then
3305    exit;
3306
3307  aStartPosition := aStartPosition + Result.FPositionOffset;
3308  aSizesBeforeSum := aSizesBeforeSum + Result.FLeftSizeSum;
3309  while Result.FRight <> nil do begin
3310    aSizesBeforeSum := aSizesBeforeSum + Result.FSize;
3311    Result := Result.FRight;
3312    aStartPosition := aStartPosition + Result.FPositionOffset;
3313    aSizesBeforeSum := aSizesBeforeSum + Result.FLeftSizeSum;
3314  end;
3315end;
3316
3317function TSynSizedDifferentialAVLTree.FindNodeAtLeftSize(ALeftSum: INteger; out
3318  aStartPosition, aSizesBeforeSum: Integer): TSynSizedDifferentialAVLNode;
3319begin
3320  Result := FRoot;
3321  aStartPosition := FRootOffset;
3322  aSizesBeforeSum := 0;
3323  if Result = nil then
3324    exit;
3325
3326  aStartPosition := aStartPosition + Result.FPositionOffset;
3327  while Result <> nil do begin
3328    if ALeftSum < Result.FLeftSizeSum then begin
3329      Result := Result.FLeft;
3330      if Result <> nil then
3331        aStartPosition := aStartPosition + Result.FPositionOffset;
3332      continue;
3333    end;
3334
3335    ALeftSum := ALeftSum - Result.FLeftSizeSum;
3336    aSizesBeforeSum := aSizesBeforeSum + Result.FLeftSizeSum;
3337    if ALeftSum < Result.FSize then begin
3338      break;
3339    end
3340    else begin
3341      ALeftSum := ALeftSum - Result.FSize;
3342      aSizesBeforeSum := aSizesBeforeSum + Result.FSize;
3343      Result := Result.FRight;
3344      if Result <> nil then
3345        aStartPosition := aStartPosition + Result.FPositionOffset;
3346      continue;
3347    end;
3348  end;
3349end;
3350
3351function TSynSizedDifferentialAVLTree.FindNodeAtPosition(APosition: INteger;
3352  AMode: TSynSizedDiffAVLFindMode; out aStartPosition,
3353  aSizesBeforeSum: Integer): TSynSizedDifferentialAVLNode;
3354var
3355  NxtPrv: TSynSizedDifferentialAVLNode;
3356  NxtPrvBefore, NxtPrvPos: Integer;
3357
3358  procedure Store(N: TSynSizedDifferentialAVLNode); inline;
3359  begin
3360    NxtPrv := N;
3361    NxtPrvBefore := aSizesBeforeSum;
3362    NxtPrvPos    := aStartPosition;
3363  end;
3364
3365  function Restore: TSynSizedDifferentialAVLNode; inline;
3366  begin
3367    Result := NxtPrv;
3368    aSizesBeforeSum := NxtPrvBefore;
3369    aStartPosition  := NxtPrvPos;
3370  end;
3371
3372  function CreateRoot: TSynSizedDifferentialAVLNode; inline;
3373  begin
3374    Result := CreateNode(APosition);
3375    if Result <> nil then
3376      Result.FPositionOffset := APosition;
3377    SetRoot(Result);
3378  end;
3379
3380  function CreateLeft(N: TSynSizedDifferentialAVLNode; ACurOffs: Integer): TSynSizedDifferentialAVLNode; inline;
3381  begin
3382    Result := CreateNode(APosition);
3383    Result.FPositionOffset := APosition;
3384    N.SetLeftChild(Result, -ACurOffs);
3385    BalanceAfterInsert(Result);
3386    aStartPosition := APosition;
3387    aSizesBeforeSum := Result.GetSizesBeforeSum;
3388  end;
3389
3390  function CreateRight(N: TSynSizedDifferentialAVLNode; ACurOffs: Integer): TSynSizedDifferentialAVLNode; inline;
3391  begin
3392    Result := CreateNode(APosition);
3393    Result.FPositionOffset := APosition;
3394    N.SetRightChild(Result, -ACurOffs);
3395    BalanceAfterInsert(Result);
3396    aStartPosition := APosition;
3397    aSizesBeforeSum := Result.GetSizesBeforeSum;
3398  end;
3399
3400begin
3401  aSizesBeforeSum := 0;
3402  aStartPosition := 0;
3403  Store(nil);
3404  aStartPosition := fRootOffset;
3405  Result := FRoot;
3406  if (Result = nil) then begin
3407    if (AMode = afmCreate) then begin
3408      Result := CreateRoot;
3409      if Result <> nil then
3410        aStartPosition := aStartPosition + Result.FPositionOffset;
3411    end;
3412    exit;
3413  end;
3414
3415  while (Result <> nil) do begin
3416    aStartPosition := aStartPosition + Result.FPositionOffset;
3417
3418    if aStartPosition > APosition then begin
3419      if (Result.FLeft = nil) then begin
3420        case AMode of
3421          afmCreate: Result := CreateLeft(Result, aStartPosition);
3422          afmNil:    Result := nil;
3423          afmPrev:   Result := Restore; // Precessor
3424          //afmNext:   Result := ; //already contains next node
3425        end;
3426        break;
3427      end;
3428      if AMode = afmNext then
3429        Store(Result); // Successor
3430      Result := Result.FLeft;
3431    end
3432
3433    else
3434    if APosition = aStartPosition then begin
3435      aSizesBeforeSum := aSizesBeforeSum + Result.FLeftSizeSum;
3436      break;
3437    end
3438
3439    else
3440    if aStartPosition < APosition then begin
3441      aSizesBeforeSum := aSizesBeforeSum + Result.FLeftSizeSum;
3442      if (Result.FRight = nil) then begin
3443        case AMode of
3444          afmCreate: Result := CreateRight(Result, aStartPosition);
3445          afmNil:    Result := nil;
3446          afmNext:   Result := Restore; // Successor
3447          //afmPrev :  Result := ; //already contains prev node
3448        end;
3449        break;
3450      end;
3451      if AMode = afmPrev then
3452        Store(Result); // Precessor
3453      aSizesBeforeSum := aSizesBeforeSum + Result.FSize;
3454      Result := Result.FRight;
3455    end;
3456  end; // while
3457end;
3458
3459procedure TSynSizedDifferentialAVLTree.AdjustForLinesInserted(AStartLine, ALineCount: Integer);
3460var
3461  Current: TSynSizedDifferentialAVLNode;
3462  CurrentLine: Integer;
3463begin
3464  Current := TSynSizedDifferentialAVLNode(fRoot);
3465  CurrentLine := FRootOffset;
3466  while (Current <> nil) do begin
3467    CurrentLine := CurrentLine + Current.FPositionOffset;
3468
3469    if AStartLine <= CurrentLine then begin
3470      // move current node
3471      Current.FPositionOffset := Current.FPositionOffset + ALineCount;
3472      CurrentLine := CurrentLine + ALineCount;
3473      if Current.FLeft <> nil then
3474        Current.FLeft.FPositionOffset := Current.FLeft.FPositionOffset - ALineCount;
3475      Current := Current.FLeft;
3476    end
3477    else if AStartLine > CurrentLine then begin
3478      // The new lines are entirly behind the current node
3479      Current := Current.FRight;
3480    end
3481  end;
3482end;
3483
3484procedure TSynSizedDifferentialAVLTree.AdjustForLinesDeleted(AStartLine, ALineCount: Integer);
3485var
3486  Current : TSynSizedDifferentialAVLNode;
3487  CurrentLine: Integer;
3488begin
3489  Current := TSynSizedDifferentialAVLNode(fRoot);
3490  CurrentLine := FRootOffset;;
3491//  LastLineToDelete := AStartLine + ALineCount - 1; // only valid for delete; ALineCount < 0
3492
3493  while (Current <> nil) do begin
3494    CurrentLine := CurrentLine + Current.FPositionOffset;
3495
3496    if (AStartLine = CurrentLine) then begin
3497      Current := Current.FRight;
3498      if Current = nil then
3499        break;
3500      assert((Current.FPositionOffset > ALineCount), 'TSynSizedDifferentialAVLTree.AdjustForLinesDeleted: (Current=nil) or (Current.FPositionOffset > ALineCount)');
3501      Current.FPositionOffset := Current.FPositionOffset - ALineCount;
3502      break;
3503      // ((AStartLine < CurrentLine) and (LastLineToDelete >= CurrentLine)) then begin
3504      //{ $IFDEF AssertSynMemIndex}
3505      //raise Exception.Create('TSynEditMarkLineList.AdjustForLinesDeleted node to remove');
3506      //{ $ENDIF}
3507    end
3508
3509    else if AStartLine < CurrentLine then begin
3510      // move current node (includes Fright subtree / Fleft subtree needs eval)
3511      Current.FPositionOffset := Current.FPositionOffset - ALineCount;
3512      CurrentLine := CurrentLine - ALineCount;
3513
3514      Current := Current.FLeft;
3515      if Current <> nil then
3516        Current.FPositionOffset := Current.FPositionOffset + ALineCount;
3517    end
3518
3519    else if AStartLine > CurrentLine then begin
3520      // The deleted lines are entirly behind the current node
3521      Current := Current.FRight;
3522    end;
3523  end;
3524end;
3525
3526end.
3527
3528