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