1{------------------------------------------------------------------------------- 2The contents of this file are subject to the Mozilla Public License 3Version 1.1 (the "License"); you may not use this file except in compliance 4with the License. You may obtain a copy of the License at 5http://www.mozilla.org/MPL/ 6 7Software distributed under the License is distributed on an "AS IS" basis, 8WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 9the specific language governing rights and limitations under the License. 10 11Alternatively, the contents of this file may be used under the terms of the 12GNU General Public License Version 2 or later (the "GPL"), in which case 13the provisions of the GPL are applicable instead of those above. 14If you wish to allow use of your version of this file only under the terms 15of the GPL and not to allow others to use your version of this file 16under the MPL, indicate your decision by deleting the provisions above and 17replace them with the notice and other provisions required by the GPL. 18If you do not delete the provisions above, a recipient may use your version 19of this file under either the MPL or the GPL. 20 21-------------------------------------------------------------------------------} 22unit SynEditMarkupHighAll; 23 24{$mode objfpc}{$H+} 25 26interface 27 28uses 29 Classes, SysUtils, 30 // LCL 31 LCLProc, Controls, ExtCtrls, 32 // LazUtils 33 LazClasses, LazUTF8, LazMethodList, 34 // SynEdit 35 SynEditMarkup, SynEditTypes, SynEditSearch, SynEditMiscClasses, SynEditHighlighter, 36 SynEditPointClasses, SynEditMiscProcs, SynEditFoldedView, SynEditTextBase; 37 38type 39 40 { TSynMarkupHighAllMatch } 41 TSynMarkupHighAllMatch = Record 42 StartPoint, EndPoint : TPoint; 43 end; 44 PSynMarkupHighAllMatch = ^TSynMarkupHighAllMatch; 45 46 { TSynMarkupHighAllMatchList } 47 48 TSynMarkupHighAllMatchList = class(TSynEditStorageMem) 49 private 50 function GetEndPoint(const Index : Integer) : TPoint; 51 function GetPoint(const Index : Integer) : TPoint; 52 function GetPointCount : Integer; 53 function GetStartPoint(const Index : Integer) : TPoint; 54 function GetMatch(const Index : Integer) : TSynMarkupHighAllMatch; 55 procedure SetEndPoint(const Index : Integer; const AValue : TPoint); 56 procedure SetMatch(const Index : Integer; const AValue : TSynMarkupHighAllMatch); 57 procedure SetStartPoint(const Index : Integer; const AValue : TPoint); 58 protected 59 function GetInintialForItemSize: Integer; override; 60 procedure SetCount(const AValue : Integer); override; 61 public 62 constructor Create; 63 Function MaybeReduceCapacity : Boolean; 64 function IndexOfFirstMatchForLine(ALine: Integer): Integer; 65 function IndexOfLastMatchForLine(ALine: Integer): Integer; 66 procedure Delete(AIndex: Integer; ACount: Integer = 1); 67 procedure Insert(AIndex: Integer; ACount: Integer = 1); 68 procedure Insert(AIndex: Integer; AStartPoint, AEndPoint: TPoint); 69 property Match [const Index : Integer] : TSynMarkupHighAllMatch read GetMatch write SetMatch; default; 70 property StartPoint [const Index : Integer] : TPoint read GetStartPoint write SetStartPoint; 71 property EndPoint [const Index : Integer] : TPoint read GetEndPoint write SetEndPoint; 72 property PointCount : Integer read GetPointCount; 73 property Point [const Index : Integer] : TPoint read GetPoint; 74 end; 75 76 { TSynMarkupHighAllMultiMatchList - Allow matches with different markup / no overlap } 77 78 TSynMarkupHighAllMultiMatchList = class(TSynMarkupHighAllMatchList) 79 private 80 FParentItemSize: Integer; 81 function GetMarkupId(Index: Integer): Integer; 82 procedure SetMarkupId(Index: Integer; AValue: Integer); 83 protected 84 function GetInintialForItemSize: Integer; override; 85 public 86 property MarkupId[Index: Integer]: Integer read GetMarkupId write SetMarkupId; 87 end; 88 89 { TSynEditMarkupHighlightMatches } 90 91 TSynEditMarkupHighlightMatches = class(TSynEditMarkup) 92 private 93 FMatches : TSynMarkupHighAllMatchList; 94 FNextPosIdx, FNextPosRow: Integer; 95 protected 96 function HasDisplayAbleMatches: Boolean; virtual; 97 function CreateMatchList: TSynMarkupHighAllMatchList; virtual; 98 function MarkupIdForMatch(Idx: Integer): Integer; virtual; 99 function MarkupInfoForId(Idx: Integer): TSynSelectedColor; virtual; 100 property Matches: TSynMarkupHighAllMatchList read FMatches; 101 102 function GetMarkupAttrIdAtRowCol(const aRow: Integer; const aStartCol: TLazSynDisplayTokenBound; 103 out AStartPos, AnEndPos: Integer): Integer; 104 public 105 constructor Create(ASynEdit : TSynEditBase); 106 destructor Destroy; override; 107 108 procedure PrepareMarkupForRow(aRow: Integer); override; 109 procedure EndMarkup; override; 110 function GetMarkupAttributeAtRowCol(const aRow: Integer; 111 const aStartCol: TLazSynDisplayTokenBound; 112 const AnRtlInfo: TLazSynDisplayRtlInfo): TSynSelectedColor; override; 113 procedure GetNextMarkupColAfterRowCol(const aRow: Integer; 114 const aStartCol: TLazSynDisplayTokenBound; 115 const AnRtlInfo: TLazSynDisplayRtlInfo; 116 out ANextPhys, ANextLog: Integer); override; 117 end; 118 119 120 { TSynEditMarkupHighlightAllBase } 121 122 TSynEditMarkupHighlightAllBase = class(TSynEditMarkupHighlightMatches) 123 private 124 FFoldView: TSynEditFoldedView; 125 FNeedValidate, FNeedValidatePaint: Boolean; 126 FMarkupEnabled: Boolean; 127 128 FStartPoint : TPoint; // First found position, before TopLine of visible area 129 FSearchedEnd: TPoint; 130 FFirstInvalidLine, FLastInvalidLine: Integer; 131 FHideSingleMatch: Boolean; 132 133 function GetMatchCount: Integer; 134 procedure SetFoldView(AValue: TSynEditFoldedView); 135 procedure SetHideSingleMatch(AValue: Boolean); 136 procedure DoFoldChanged(aLine: Integer); 137 138 Procedure ValidateMatches(SkipPaint: Boolean = False); 139 140 protected 141 function HasSearchData: Boolean; virtual; abstract; 142 function HasDisplayAbleMatches: Boolean; override; 143 function SearchStringMaxLines: Integer; virtual; abstract; 144 procedure FindInitialize; virtual; abstract; 145 function FindMatches(AStartPoint, AEndPoint: TPoint; 146 var AIndex: Integer; 147 AStopAfterLine: Integer = -1; // AEndPoint may be set further down, for multi-line matches 148 ABackward : Boolean = False 149 ): TPoint; virtual; abstract; // returns searhed until point 150 151 152 procedure DoTopLineChanged(OldTopLine : Integer); override; 153 procedure DoLinesInWindoChanged(OldLinesInWindow : Integer); override; 154 procedure DoMarkupChanged(AMarkup: TSynSelectedColor); override; 155 procedure DoEnabledChanged(Sender: TObject); override; 156 procedure DoTextChanged(StartLine, EndLine, ACountDiff: Integer); override; // 1 based 157 procedure DoVisibleChanged(AVisible: Boolean); override; 158 function HasVisibleMatch: Boolean; // does not check, if in visible line range. Only Count and DideSingleMatch 159 property MatchCount: Integer read GetMatchCount; 160 property MarkupEnabled: Boolean read FMarkupEnabled; 161 public 162 constructor Create(ASynEdit : TSynEditBase); 163 destructor Destroy; override; 164 procedure DecPaintLock; override; 165 166 // AFirst/ ALast are 1 based 167 Procedure Invalidate(SkipPaint: Boolean = False); 168 Procedure InvalidateLines(AFirstLine: Integer = 0; ALastLine: Integer = 0; SkipPaint: Boolean = False); 169 Procedure SendLineInvalidation(AFirstIndex: Integer = -1;ALastIndex: Integer = -1); 170 171 property FoldView: TSynEditFoldedView read FFoldView write SetFoldView; 172 173 property HideSingleMatch: Boolean read FHideSingleMatch write SetHideSingleMatch; 174 end; 175 176 { TSynEditMarkupHighlightAll } 177 178 TSynEditMarkupHighlightAll = class(TSynEditMarkupHighlightAllBase) 179 private 180 FSearch: TSynEditSearch; 181 FSearchOptions: TSynSearchOptions; 182 FSearchString: String; 183 FSearchStringMaxLines: Integer; 184 185 procedure SetSearchOptions(AValue: TSynSearchOptions); 186 procedure SetSearchString(AValue: String); 187 protected 188 procedure SearchStringChanged; virtual; 189 procedure DoOptionsChanged;virtual; 190 191 function HasSearchData: Boolean; override; 192 function SearchStringMaxLines: Integer; override; 193 procedure FindInitialize; override; 194 function FindMatches(AStartPoint, AEndPoint: TPoint; 195 var AIndex: Integer; 196 AStopAfterLine: Integer = -1; // AEndPoint may be set further down, for multi-line matches 197 ABackward : Boolean = False 198 ): TPoint; override; // returns searhed until point 199 public 200 constructor Create(ASynEdit: TSynEditBase); 201 destructor Destroy; override; 202 property SearchString : String read FSearchString write SetSearchString; 203 property SearchOptions : TSynSearchOptions read FSearchOptions write SetSearchOptions; 204 end; 205 206 { TSynSearchDictionary } 207 208 PSynSearchDictionaryNode = ^TSynSearchDictionaryNode; 209 TSynSearchDictionaryNode = record 210 NextCharMin, NextCharMax: Byte; // if char > 128 then char := 128+256 - char // move utf8 continuation block 211 ItemIdx: Integer; // Node is in dictionary 212 NotFoundEntry, DictLink: PSynSearchDictionaryNode; 213 NextEntry: Array [0..191] of PSynSearchDictionaryNode; // Max size 192, for utf8 start bytes 214 end; 215 216 TSynSearchDictFoundEvent = 217 procedure(MatchEnd: PChar; MatchIdx: Integer; 218 var IsMatch: Boolean; var StopSeach: Boolean 219 ) of object; 220 221 TSynSearchTermOptsBounds = (soNoBounds, soBothBounds, soBoundsAtStart, soBoundsAtEnd); 222 223 { TSynSearchDictionary } 224 225 TSynSearchDictionary = class(TObject) 226 private 227 FBuildLowerCaseDict: Boolean; 228 FList: TStringList; 229 FSortedList: TStringList; 230 FRootNode: PSynSearchDictionaryNode; 231 232 procedure ClearDictionary; 233 procedure DeleteNode(aNode: PSynSearchDictionaryNode); 234 procedure BuildDictionary; 235 function GetTerms(AIndex: Integer): String; 236 procedure SetTerms(AIndex: Integer; AValue: String); 237 public 238 constructor Create; 239 destructor Destroy; override; 240 {$IFDEF SynDictDebug} 241 procedure DebugPrint(OnlySummary: Boolean = false); 242 {$ENDIF} 243 procedure Clear; 244 245 function Add(ATerm: String; ATag: Integer): Integer; 246 function IndexOf(ATerm: String): Integer; 247 procedure Remove(ATerm: String); 248 procedure Delete(AIndex: Integer); 249 function Count: Integer; 250 property Terms[AIndex: Integer]: String read GetTerms write SetTerms; 251 252 function Search(AText: PChar; ATextLen: Integer; AFoundEvent: TSynSearchDictFoundEvent): PChar; 253 function GetMatchAtChar(AText: PChar; ATextLen: Integer; AFoundEvent: TSynSearchDictFoundEvent = nil): Integer; 254 255 property BuildLowerCaseDict: Boolean read FBuildLowerCaseDict write FBuildLowerCaseDict; 256 end; 257 258 TSynEditMarkupHighlightAllMulti = class; 259 260 { TSynSearchTerm } 261 262 TSynSearchTerm = class(TCollectionItem) 263 private 264 FEnabled: Boolean; 265 FMatchCase: Boolean; 266 FMatchWordBounds: TSynSearchTermOptsBounds; 267 FSearchTerm: String; 268 procedure SetEnabled(AValue: Boolean); 269 procedure SetMatchCase(AValue: Boolean); 270 procedure SetMatchWordBounds(AValue: TSynSearchTermOptsBounds); 271 procedure SetSearchTerm(AValue: String); 272 public 273 constructor Create(ACollection: TCollection); override; 274 procedure Assign(Source: TPersistent); override; 275 function Equals(Other: TSynSearchTerm): boolean; reintroduce; 276 published 277 property SearchTerm: String read FSearchTerm write SetSearchTerm; 278 property MatchWordBounds: TSynSearchTermOptsBounds read FMatchWordBounds write SetMatchWordBounds; 279 property MatchCase: Boolean read FMatchCase write SetMatchCase; 280 property Enabled: Boolean read FEnabled write SetEnabled; // Todo: Exclude from dict, but need to keep room for ID/Index 281 end; 282 283 TSynSearchTermClass = class of TSynSearchTerm; 284 285 { TSynSearchTermList } 286 287 TSynSearchTermList = class(TCollection) 288 private 289 FOnChanged: TNotifyEvent; 290 function GetItem(Index: Integer): TSynSearchTerm; 291 procedure SetItem(Index: Integer; AValue: TSynSearchTerm); 292 protected 293 procedure Update(Item: TCollectionItem); override; 294 procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override; 295 function DefaultItemClass: TSynSearchTermClass; virtual; 296 public 297 constructor Create; overload; 298 function Add: TSynSearchTerm; reintroduce; 299 function IndexOfSearchTerm(ATerm: String; ASearchStartIdx: Integer = 0): Integer; 300 function IndexOfSearchTerm(ATerm: TSynSearchTerm; ASearchStartIdx: Integer = 0): Integer; 301 function IndexOfSearchTerm(ATerm: String; ACaseSensitive: Boolean; ASearchStartIdx: Integer = 0): Integer; 302 property Items[Index: Integer]: TSynSearchTerm read GetItem write SetItem; default; 303 property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; 304 end; 305 306 TSynSearchTermListClass = class of TSynSearchTermList; 307 308 { TSynSearchTermDict } 309 310 TSynSearchTermDict = class(TRefCountedObject) 311 private 312 FTerms: TSynSearchTermList; 313 FDict: TSynSearchDictionary; 314 FNextTermWithSameWord: Array of Integer; 315 FChangedNotifyList: TMethodList; 316 FChangeNotifyLock: Integer; 317 FNeedNotify: Boolean; 318 319 procedure DoTermsChanged(Sender: TObject); 320 function GetItem(Index: Integer): TSynSearchTerm; 321 procedure SetItem(Index: Integer; AValue: TSynSearchTerm); 322 protected 323 procedure MaybeInitDict; 324 property Dict: TSynSearchDictionary read FDict; 325 property Terms: TSynSearchTermList read FTerms; 326 public 327 constructor Create(ATermListClass: TSynSearchTermListClass); 328 destructor Destroy; override; 329 procedure IncChangeNotifyLock; 330 procedure DecChangeNotifyLock; 331 procedure RegisterChangedHandler(AEvent: TNotifyEvent); 332 procedure UnRegisterChangedHandler(AEvent: TNotifyEvent); 333 Procedure Assign(Src: TSynSearchTermDict); virtual; 334 Procedure Assign(Src: TSynSearchTermList); virtual; 335 336 procedure Clear; 337 procedure ClearDictionary; 338 function Count: Integer; 339 function Add: TSynSearchTerm; 340 procedure Delete(AIndex: Integer); 341 function IndexOfSearchTerm(ATerm: String): Integer; 342 function IndexOfSearchTerm(ATerm: TSynSearchTerm): Integer; 343 344 procedure Search(AText: PChar; ATextLen: Integer; AFoundEvent: TSynSearchDictFoundEvent); 345 function GetIndexForNextWordOccurrence(AIndex: Integer): Integer; 346 347 property Items[Index: Integer]: TSynSearchTerm read GetItem write SetItem; default; 348 end; 349 350 { TSynEditMarkupHighlightAllMulti } 351 352 TSynEditMarkupHighlightAllMulti = class(TSynEditMarkupHighlightAllBase) 353 private 354 FTermDict: TSynSearchTermDict; 355 //FNextTermWIthSameWord: Array of Integer; 356 357 FFindInsertIndex, FFindStartedAtIndex: Integer; 358 FFindLineY: Integer; 359 FFindLineText, FFindLineTextEnd, FFindLineTextLower, FFindLineTextLowerEnd: PChar; 360 FBackward, FBackwardReplace: Boolean; 361 FWordBreakChars: TSynIdentChars; 362 363 procedure DoMatchFound(MatchEnd: PChar; MatchIdx: Integer; var IsMatch: Boolean; 364 var StopSeach: Boolean); 365 procedure SetTerms(AValue: TSynSearchTermDict); 366 procedure SetWordBreakChars(AValue: TSynIdentChars); 367 protected 368 procedure DoTermsChanged(Sender: TObject); 369 function HasSearchData: Boolean; override; 370 function SearchStringMaxLines: Integer; override; 371 procedure FindInitialize; override; 372 function FindMatches(AStartPoint, AEndPoint: TPoint; 373 var AIndex: Integer; 374 AStopAfterLine: Integer = -1; // AEndPoint may be set further down, for multi-line matches 375 ABackward : Boolean = False 376 ): TPoint; override; // returns searched until point 377 function CreateTermsList: TSynSearchTermDict; virtual; 378 public 379 constructor Create(ASynEdit: TSynEditBase); 380 destructor Destroy; override; 381 procedure Clear; 382 procedure ResetWordBreaks; 383 384 function AddSearchTerm(ATerm: String): Integer; 385 function IndexOfSearchTerm(ATerm: String): Integer; 386 procedure RemoveSearchTerm(ATerm: String); 387 procedure DeleteSearchTerm(AIndex: Integer); 388 389 property WordBreakChars: TSynIdentChars read FWordBreakChars write SetWordBreakChars; 390 property Terms: TSynSearchTermDict read FTermDict write SetTerms; 391 end; 392 393 { TSynEditMarkupHighlightAllCaret } 394 395 TSynEditMarkupHighlightAllCaret = class(TSynEditMarkupHighlightAll) 396 private 397 FTimer: TTimer; 398 FTrim: Boolean; 399 FWaitTime: Integer; 400 FFullWord: Boolean; 401 FFullWordMaxLen: Integer; 402 FIgnoreKeywords: Boolean; 403 FSelection: TSynEditSelection; 404 FHighlighter: TSynCustomHighlighter; 405 FLowBound, FUpBound, FOldLowBound, FOldUpBound: TPoint; 406 FToggledWord: String; 407 FToggledOption: TSynSearchOptions; 408 FStateChanged, FValidateNeeded: Boolean; 409 FWaitForHandle: Boolean; 410 procedure SetFullWord(const AValue: Boolean); 411 procedure SetFullWordMaxLen(const AValue: Integer); 412 procedure SetHighlighter(const AValue: TSynCustomHighlighter); 413 procedure SetIgnoreKeywords(const AValue: Boolean); 414 procedure SetSelection(const AValue: TSynEditSelection); 415 procedure SetTrim(const AValue: Boolean); 416 procedure SetWaitTime(const AValue: Integer); 417 protected 418 procedure SearchStringChanged; override; 419 procedure SelectionChanged(Sender: TObject); 420 procedure DoCaretChanged(Sender: TObject); override; 421 procedure DoTextChanged(StartLine, EndLine, ACountDiff: Integer); override; 422 procedure DoMarkupChanged(AMarkup: TSynSelectedColor); override; 423 procedure DoOptionsChanged;override; 424 procedure RestartTimer; 425 procedure ScrollTimerHandler(Sender: TObject); 426 function GetCurrentText: String; 427 function GetCurrentOption: TSynSearchOptions; 428 public 429 constructor Create(ASynEdit : TSynEditBase); 430 destructor Destroy; override; 431 procedure DecPaintLock; override; 432 procedure CheckState; 433 procedure ToggleCurrentWord; 434 property WaitTime: Integer read FWaitTime write SetWaitTime; 435 property Trim: Boolean read FTrim write SetTrim; 436 property FullWord: Boolean read FFullWord write SetFullWord; 437 property FullWordMaxLen: Integer read FFullWordMaxLen write SetFullWordMaxLen; 438 property IgnoreKeywords: Boolean read FIgnoreKeywords write SetIgnoreKeywords; 439 property Highlighter: TSynCustomHighlighter 440 read FHighlighter write SetHighlighter; 441 property Selection: TSynEditSelection write SetSelection; 442 end; 443 444implementation 445uses SynEdit; 446 447const 448 SEARCH_START_OFFS = 100; // Search n lises before/after visible area. (Before applies only, if no exact offset can not be calculated from searchtext) 449 MATCHES_CLEAN_CNT_THRESHOLD = 2500; // Remove matches out of range, only if more Matches are present 450 MATCHES_CLEAN_LINE_THRESHOLD = 300; // Remove matches out of range, only if they are at least n lines from visible area. 451 MATCHES_CLEAN_LINE_KEEP = 200; // LinesKept, if cleaning. MUST be LESS than MATCHES_CLEAN_LINE_THRESHOLD 452 453{ TSynEditMarkupHighlightMatches } 454 455function TSynEditMarkupHighlightMatches.HasDisplayAbleMatches: Boolean; 456begin 457 Result := FMatches.Count > 0; 458end; 459 460function TSynEditMarkupHighlightMatches.CreateMatchList: TSynMarkupHighAllMatchList; 461begin 462 Result := TSynMarkupHighAllMatchList.Create; 463end; 464 465function TSynEditMarkupHighlightMatches.MarkupIdForMatch(Idx: Integer): Integer; 466begin 467 Result := 0; 468end; 469 470function TSynEditMarkupHighlightMatches.MarkupInfoForId(Idx: Integer): TSynSelectedColor; 471begin 472 Result := MarkupInfo; 473end; 474 475constructor TSynEditMarkupHighlightMatches.Create(ASynEdit: TSynEditBase); 476begin 477 FMatches := CreateMatchList; 478 inherited Create(ASynEdit); 479end; 480 481destructor TSynEditMarkupHighlightMatches.Destroy; 482begin 483 inherited Destroy; 484 FreeAndNil(FMatches); 485end; 486 487procedure TSynEditMarkupHighlightMatches.PrepareMarkupForRow(aRow: Integer); 488begin 489 FNextPosRow := -1; 490 if not HasDisplayAbleMatches then 491 exit; 492 493 if (FNextPosRow > 0) and (aRow > FNextPosRow) and 494 ( (FNextPosIdx = -2) or // No match after FNextPosRow 495 ( (FNextPosIdx >= 0) and (FNextPosIdx < FMatches.PointCount) and (aRow <= FMatches.Point[FNextPosIdx].y) ) 496 ) 497 then begin 498 if (FNextPosIdx >= 0) and 499 ( (aRow = FMatches.Point[FNextPosIdx].y) or (FNextPosIdx and 1 = 1) ) 500 then 501 FNextPosRow := aRow; 502 exit; 503 end; 504 505 FNextPosRow := aRow; 506 FNextPosIdx := FMatches.IndexOfFirstMatchForLine(aRow) * 2; 507 if (FNextPosIdx < 0) or (FNextPosIdx >= FMatches.PointCount) then 508 exit; 509 if (FMatches.Point[FNextPosIdx].y < aRow) then 510 inc(FNextPosIdx); // Use EndPoint 511end; 512 513procedure TSynEditMarkupHighlightMatches.EndMarkup; 514begin 515 inherited EndMarkup; 516 FNextPosRow := -1; 517end; 518 519function TSynEditMarkupHighlightMatches.GetMarkupAttrIdAtRowCol(const aRow: Integer; 520 const aStartCol: TLazSynDisplayTokenBound; out AStartPos, AnEndPos: Integer): Integer; 521var 522 pos: Integer; 523begin 524 Result := -1; 525 if (aRow <> FNextPosRow) or (FNextPosIdx < 0) then 526 exit; 527 528 while (FNextPosIdx < fMatches.PointCount) and 529 (fMatches.Point[FNextPosIdx].y = aRow) and 530 (fMatches.Point[FNextPosIdx].x <= aStartCol.Logical) 531 do 532 inc(FNextPosIdx); 533 534 if FNextPosIdx >= fMatches.PointCount // last point was EndPoint => no markup 535 then exit; 536 537 pos := FNextPosIdx - 1; 538 while (pos >= 0) and (fMatches.Point[pos].y = aRow) and 539 (fMatches.Point[pos].x > aStartCol.Logical) 540 do 541 dec(pos); 542 543 if pos < 0 then 544 exit; 545 546 //pos is the point at or before LogPos 547 if (pos and 1)= 1 // the Point is a EndPoint => Outside Match 548 then exit; 549 550 if fMatches.Point[pos].y < aRow then 551 AStartPos := -1 552 else 553 AStartPos := fMatches.Point[pos].x; 554 if (pos = FMatches.PointCount) or (fMatches.Point[pos+1].y > aRow) then 555 AnEndPos := -1 556 else 557 AnEndPos := fMatches.Point[pos+1].x; 558 559 Result := MarkupIdForMatch(pos div 2); 560end; 561 562function TSynEditMarkupHighlightMatches.GetMarkupAttributeAtRowCol(const aRow: Integer; 563 const aStartCol: TLazSynDisplayTokenBound; 564 const AnRtlInfo: TLazSynDisplayRtlInfo): TSynSelectedColor; 565var 566 i, s, e: Integer; 567begin 568 result := nil; 569 if not HasDisplayAbleMatches then 570 exit; 571 572 i := GetMarkupAttrIdAtRowCol(aRow, aStartCol, s, e); 573 if i < 0 then 574 exit; 575 Result := MarkupInfoForId(i); 576 Result.SetFrameBoundsLog(s, e); 577end; 578 579procedure TSynEditMarkupHighlightMatches.GetNextMarkupColAfterRowCol(const aRow: Integer; 580 const aStartCol: TLazSynDisplayTokenBound; const AnRtlInfo: TLazSynDisplayRtlInfo; out 581 ANextPhys, ANextLog: Integer); 582begin 583 ANextLog := -1; 584 ANextPhys := -1; 585 if not HasDisplayAbleMatches then 586 exit; 587 if (aRow <> FNextPosRow) or (FNextPosIdx < 0) or 588 (FNextPosIdx >= fMatches.PointCount) or (FMatches.Point[FNextPosIdx].y > aRow) 589 then 590 exit; 591 592 while (FNextPosIdx < fMatches.PointCount) and 593 (fMatches.Point[FNextPosIdx].y = aRow) and 594 (fMatches.Point[FNextPosIdx].x <= aStartCol.Logical) 595 do 596 inc(FNextPosIdx); 597 598 if FNextPosIdx >= fMatches.PointCount then 599 exit; 600 if fMatches.Point[FNextPosIdx].y <> aRow then 601 exit; 602 603 ANextLog := fMatches.Point[FNextPosIdx].x; 604end; 605 606{ TSynSearchTermDict } 607 608procedure TSynSearchTermDict.DoTermsChanged(Sender: TObject); 609begin 610 if FDict = nil then 611 exit; 612 613 FDict.Clear; 614 if FChangeNotifyLock > 0 then begin 615 FNeedNotify := True; 616 exit; 617 end; 618 FNeedNotify := False; 619 FChangedNotifyList.CallNotifyEvents(Self); 620end; 621 622function TSynSearchTermDict.GetItem(Index: Integer): TSynSearchTerm; 623begin 624 Result := FTerms[Index]; 625end; 626 627procedure TSynSearchTermDict.IncChangeNotifyLock; 628begin 629 inc(FChangeNotifyLock); 630end; 631 632procedure TSynSearchTermDict.DecChangeNotifyLock; 633begin 634 dec(FChangeNotifyLock); 635 if FNeedNotify then 636 DoTermsChanged(Self); 637end; 638 639procedure TSynSearchTermDict.SetItem(Index: Integer; AValue: TSynSearchTerm); 640begin 641 FTerms[Index] := AValue; 642end; 643 644procedure TSynSearchTermDict.MaybeInitDict; 645var 646 i, j: Integer; 647 s: String; 648begin 649 if FDict.Count > 0 then 650 exit; 651 652 SetLength(FNextTermWIthSameWord, FTerms.Count); 653 654 for i := 0 to FTerms.Count - 1 do begin 655 FNextTermWIthSameWord[i] := -1; 656 if not FTerms[i].Enabled then 657 Continue; 658 s := LowerCase(FTerms[i].SearchTerm); 659 FDict.Add(FTerms[i].SearchTerm, i); 660 for j := i + 1 to FTerms.Count - 1 do 661 if LowerCase(FTerms[j].SearchTerm) = s then begin 662 FNextTermWIthSameWord[i] := j; 663 break; 664 end; 665 end; 666end; 667 668constructor TSynSearchTermDict.Create(ATermListClass: TSynSearchTermListClass); 669begin 670 inherited Create; 671 FChangedNotifyList := TMethodList.Create; 672 FNeedNotify := False; 673 FTerms := ATermListClass.Create; 674 FTerms.OnChanged := @DoTermsChanged; 675 FDict := TSynSearchDictionary.Create; 676 FDict.BuildLowerCaseDict := True; 677end; 678 679destructor TSynSearchTermDict.Destroy; 680begin 681 inherited Destroy; 682 FChangeNotifyLock := 1; // Disable notifications 683 FreeAndNil(FDict); 684 FreeAndNil(FTerms); 685 FreeAndNil(FChangedNotifyList); 686end; 687 688procedure TSynSearchTermDict.RegisterChangedHandler(AEvent: TNotifyEvent); 689begin 690 FChangedNotifyList.Add(TMethod(AEvent)); 691end; 692 693procedure TSynSearchTermDict.UnRegisterChangedHandler(AEvent: TNotifyEvent); 694begin 695 FChangedNotifyList.Remove(TMethod(AEvent)); 696end; 697 698procedure TSynSearchTermDict.Assign(Src: TSynSearchTermDict); 699begin 700 IncChangeNotifyLock; 701 FDict.Clear; 702 FTerms.Assign(Src.FTerms); 703 DecChangeNotifyLock; 704end; 705 706procedure TSynSearchTermDict.Assign(Src: TSynSearchTermList); 707begin 708 IncChangeNotifyLock; 709 FDict.Clear; 710 FTerms.Assign(Src); 711 DecChangeNotifyLock; 712end; 713 714procedure TSynSearchTermDict.Clear; 715begin 716 IncChangeNotifyLock; 717 FTerms.Clear; 718 FDict.Clear; 719 DecChangeNotifyLock; 720end; 721 722procedure TSynSearchTermDict.ClearDictionary; 723begin 724 FDict.Clear; 725end; 726 727function TSynSearchTermDict.Count: Integer; 728begin 729 Result := FTerms.Count; 730end; 731 732function TSynSearchTermDict.Add: TSynSearchTerm; 733begin 734 Result := TSynSearchTerm(FTerms.Add); 735end; 736 737procedure TSynSearchTermDict.Delete(AIndex: Integer); 738begin 739 FTerms.Delete(AIndex); 740end; 741 742function TSynSearchTermDict.IndexOfSearchTerm(ATerm: String): Integer; 743begin 744 Result := FTerms.IndexOfSearchTerm(ATerm); 745end; 746 747function TSynSearchTermDict.IndexOfSearchTerm(ATerm: TSynSearchTerm): Integer; 748begin 749 Result := FTerms.IndexOfSearchTerm(ATerm); 750end; 751 752procedure TSynSearchTermDict.Search(AText: PChar; ATextLen: Integer; 753 AFoundEvent: TSynSearchDictFoundEvent); 754begin 755 MaybeInitDict; 756 FDict.Search(AText, ATextLen, AFoundEvent); 757end; 758 759function TSynSearchTermDict.GetIndexForNextWordOccurrence(AIndex: Integer): Integer; 760begin 761 Result := FNextTermWIthSameWord[AIndex]; 762end; 763 764{ TSynSearchTermList } 765 766 767{ TSynSearchDictionary } 768 769procedure TSynSearchDictionary.ClearDictionary; 770begin 771 DeleteNode(FRootNode); 772 FRootNode := nil; 773end; 774 775procedure TSynSearchDictionary.DeleteNode(aNode: PSynSearchDictionaryNode); 776var 777 i: Integer; 778begin 779 if aNode = nil then 780 exit; 781 For i := 0 to aNode^.NextCharMax - aNode^.NextCharMin do 782 DeleteNode(aNode^.NextEntry[i]); 783 FreeMem(aNode); 784end; 785 786function CompareBinary(List: TStringList; Index1, Index2: Integer): Integer; 787var 788 s1, s2: String; 789 l: Integer; 790begin 791 Result := 0; 792 s1 := List[Index1]; 793 s2 := List[Index2]; 794 l := Length(s1); 795 if Length(s2) < l then begin 796 l := Length(s2); 797 if l > 0 then 798 Result := CompareByte(s1[1], s2[1], l); 799 if Result = 0 then 800 Result := 1; 801 end else begin 802 if l > 0 then 803 Result := CompareByte(s1[1], s2[1], l); 804 if (Result = 0) and (Length(s2) > l) then 805 Result := -1; 806 end; 807end; 808 809procedure TSynSearchDictionary.BuildDictionary; 810 811 function ChangeBytes(ATerm: String): String; 812 var 813 i: Integer; 814 c: Char; 815 begin 816 (* Map utf8 continuation bytes (128..191) to the end of the char-range (192..255) 817 This way the max size for "NextEntry" array will be 192 (for utf8 char start) 818 or 64 for continuation 819 Also by mapping #252..#255 to #188..#191, makes them a requiremnt for any 820 node having a full 192 sized array. This will reduce the risk of worst case 821 memory consumption, since they have 4 continuation bytes (array size 64) 822 to bring down the average. 823 *) 824 SetLength(Result, Length(ATerm)); 825 for i := 1 to Length(ATerm) do begin 826 c := ATerm[i]; 827 if c < #128 828 then Result[i] := c 829 else Result[i] := chr(383-ord(c)); 830 end; 831 end; 832 833 function GetNodeForCharAt(AListIndex, AMaxListIdx, ACharPos: Integer) :PSynSearchDictionaryNode; 834 var 835 c: Char; 836 i, LastListIdx, MatchIdx, MinChar, MaxChar: Integer; 837 begin 838 // Find all continuation chars 839 if ACharPos = 0 then begin 840 LastListIdx := AMaxListIdx; 841 end 842 else begin 843 c := FSortedList[AListIndex][ACharPos]; 844 LastListIdx := AListIndex; 845 while (LastListIdx < AMaxListIdx) and 846 (length(FSortedList[LastListIdx+1]) >= ACharPos) and 847 (FSortedList[LastListIdx+1][ACharPos] = c) 848 do 849 inc(LastListIdx); 850 end; 851 852 if length(FSortedList[AListIndex]) = ACharPos then 853 MatchIdx := PtrInt(FSortedList.Objects[AListIndex]) // this is a match, TODO: there could be sevelal matches of the same length 854 else 855 MatchIdx := -1; 856 while (AListIndex <= LastListIdx) and (length(FSortedList[AListIndex]) = ACharPos) do begin 857 // for identical words, store smallest matchidx (TODO: true case sensitive search) 858 if PtrInt(FSortedList.Objects[AListIndex]) < MatchIdx then 859 MatchIdx := PtrInt(FSortedList.Objects[AListIndex]); 860 inc(AListIndex); // Skip match, if any 861 end; 862 863 if length(FSortedList[LastListIdx]) > ACharPos then begin 864 // there are possible continuations 865 MinChar := ord(FSortedList[AListIndex][ACharPos+1]); 866 MaxChar := ord(FSortedList[LastListIdx][ACharPos+1]); 867 end 868 else begin 869 // No continuatian 870 MinChar := 1; 871 MaxChar := 0; 872 end; 873 874 Result := AllocMem(PtrUInt(@PSynSearchDictionaryNode(nil)^.NextEntry[0]) + 875 PtrUInt(MaxChar - MinChar + 1)*SizeOf(PSynSearchDictionaryNode)); 876 Result^.NextCharMin := MinChar; 877 Result^.NextCharMax := MaxChar; 878 Result^.ItemIdx := MatchIdx; 879 880 inc(ACharPos); 881 for i := MinChar to MaxChar do begin 882 c := FSortedList[AListIndex][ACharPos]; 883 if c = chr(i) then begin 884 Result^.NextEntry[i-MinChar] := GetNodeForCharAt(AListIndex, LastListIdx, ACharPos); 885 while (AListIndex < LastListIdx) and (FSortedList[AListIndex][ACharPos] = c) do 886 inc(AListIndex); 887 end 888 else 889 Result^.NextEntry[i-MinChar] := nil; 890 end; 891 end; 892 893 function FindNode(ANodeValue: String) :PSynSearchDictionaryNode; 894 var 895 i, b, m: Integer; 896 begin 897 Result := FRootNode; 898 for i := 1 to length(ANodeValue) do begin 899 b := ord(ANodeValue[i]); 900 m := Result^.NextCharMin; 901 if (b < m) or (b > Result^.NextCharMax) or 902 (Result^.NextEntry[b-m] = nil) 903 then 904 exit(nil); 905 Result := Result^.NextEntry[b-m]; 906 end; 907 end; 908 909 procedure SetNotFoundNote(ANode: PSynSearchDictionaryNode; ANodeValue: String); 910 var 911 i, m: Integer; 912 begin 913 if ANodeValue <> '' then begin 914 for i := 2 to length(ANodeValue) do begin 915 ANode^.NotFoundEntry := FindNode(copy(ANodeValue, i, length(ANodeValue))); 916 if ANode^.NotFoundEntry <> nil then 917 break; 918 end; 919 if ANode^.NotFoundEntry = nil then 920 ANode^.NotFoundEntry := FRootNode; 921 end; 922 923 m := ANode^.NextCharMin; 924 for i := ANode^.NextCharMin to ANode^.NextCharMax do 925 if ANode^.NextEntry[i-m] <> nil then 926 SetNotFoundNote(ANode^.NextEntry[i-m], ANodeValue + chr(i)); 927 end; 928 929 procedure FindDictLinks(ANode: PSynSearchDictionaryNode); 930 var 931 i, m: Integer; 932 NotFound: PSynSearchDictionaryNode; 933 begin 934 NotFound := ANode^.NotFoundEntry; 935 while (NotFound <> nil) and (NotFound^.ItemIdx < 0) do 936 NotFound := NotFound^.NotFoundEntry; 937 ANode^.DictLink := NotFound; 938 939 m := ANode^.NextCharMin; 940 for i := ANode^.NextCharMin to ANode^.NextCharMax do 941 if ANode^.NextEntry[i-m] <> nil then 942 FindDictLinks(ANode^.NextEntry[i-m]); 943 end; 944 945var 946 i: Integer; 947begin 948 ClearDictionary; 949 if FList.Count = 0 then 950 exit; 951 952 FSortedList.Clear; 953 for i := 0 to FList.Count - 1 do begin 954 if FBuildLowerCaseDict then // TODO: Create a case-insesitive dictionary 955 FSortedList.AddObject(ChangeBytes(LowerCase(FList[i])), FList.Objects[i]) 956 else 957 FSortedList.AddObject(ChangeBytes(FList[i]), FList.Objects[i]); 958 end; 959 FSortedList.CustomSort(@CompareBinary); 960 961 FRootNode := GetNodeForCharAt(0, FSortedList.Count - 1, 0); 962 SetNotFoundNote(FRootNode, ''); 963 FindDictLinks(FRootNode); 964 FRootNode^.NotFoundEntry := nil; 965 966 FSortedList.Clear; 967end; 968 969function TSynSearchDictionary.GetTerms(AIndex: Integer): String; 970begin 971 Result := FList[AIndex]; 972end; 973 974procedure TSynSearchDictionary.SetTerms(AIndex: Integer; AValue: String); 975begin 976 FList[AIndex] := AValue; 977 ClearDictionary; 978end; 979 980constructor TSynSearchDictionary.Create; 981begin 982 inherited Create; 983 FList := TStringList.Create; 984 FList.OwnsObjects := False; 985 FSortedList := TStringList.Create; 986 FSortedList.OwnsObjects := False; 987 FBuildLowerCaseDict := False; 988end; 989 990destructor TSynSearchDictionary.Destroy; 991begin 992 inherited Destroy; 993 Clear; 994 FreeAndNil(FList); 995 FreeAndNil(FSortedList); 996end; 997 998{$IFDEF SynDictDebug} 999procedure TSynSearchDictionary.DebugPrint(OnlySummary: Boolean); 1000var 1001 NCnt, ArrayLen, EmptyCnt: Integer; 1002 1003 function FlipByte(b: Integer): Integer; 1004 begin 1005 if b < 128 1006 then Result := b 1007 else Result := 383-b; 1008 end; 1009 1010 procedure DebugNode(ANode: PSynSearchDictionaryNode; APreFix: String = ''; AIndent: String = ''); 1011 var 1012 i, j: Integer; 1013 begin 1014 inc(NCnt); 1015 if not OnlySummary then 1016 DebugLn([AIndent, 'Node for "', APreFix, '": ItemIdx=', ANode^.ItemIdx, 1017 ' Min=', FlipByte(ANode^.NextCharMin), ' Max=', FlipByte(ANode^.NextCharMax), 1018 ' At ', IntToHex(PtrUInt(ANode), 2*sizeof(PtrUInt)), 1019 ' Not Found ', IntToHex(PtrUInt(ANode^.NotFoundEntry), 2*sizeof(PtrUInt)), 1020 ' Dict ', IntToHex(PtrUInt(ANode^.DictLink), 2*sizeof(PtrUInt)) 1021 ]); 1022 j := ANode^.NextCharMin; 1023 ArrayLen := ArrayLen + ANode^.NextCharMax - ANode^.NextCharMin + 1; 1024 for i := ANode^.NextCharMin to ANode^.NextCharMax do 1025 if ANode^.NextEntry[i-j] <> nil then begin 1026 if not OnlySummary then 1027 debugln([AIndent, '> ', FlipByte(i)]); 1028 DebugNode(ANode^.NextEntry[i-j], APreFix+chr(FlipByte(i)), AIndent+' '); 1029 end 1030 else 1031 inc(EmptyCnt); 1032 end; 1033begin 1034 if FRootNode = nil then 1035 BuildDictionary; 1036 ArrayLen := 0; 1037 NCnt := 0; 1038 EmptyCnt := 0; 1039 DebugNode(FRootNode); 1040 DebugLn(['Nodes: ', NCnt, ' Sum(len(array))=', ArrayLen, ' Empty=', EmptyCnt]); 1041end; 1042{$ENDIF} 1043 1044procedure TSynSearchDictionary.Clear; 1045begin 1046 FList.Clear; 1047 ClearDictionary; 1048end; 1049 1050function TSynSearchDictionary.Add(ATerm: String; ATag: Integer): Integer; 1051begin 1052 Result := FList.AddObject(ATerm, TObject(PtrInt(ATag))); 1053 ClearDictionary; 1054end; 1055 1056function TSynSearchDictionary.IndexOf(ATerm: String): Integer; 1057begin 1058 Result := FList.IndexOf(ATerm); 1059end; 1060 1061procedure TSynSearchDictionary.Remove(ATerm: String); 1062begin 1063 FList.Delete(FList.IndexOf(ATerm)); 1064 ClearDictionary; 1065end; 1066 1067procedure TSynSearchDictionary.Delete(AIndex: Integer); 1068begin 1069 FList.Delete(AIndex); 1070 ClearDictionary; 1071end; 1072 1073function TSynSearchDictionary.Count: Integer; 1074begin 1075 Result := FList.Count; 1076end; 1077 1078function TSynSearchDictionary.Search(AText: PChar; ATextLen: Integer; 1079 AFoundEvent: TSynSearchDictFoundEvent): PChar; 1080var 1081 DictLink, CurrentNode: PSynSearchDictionaryNode; 1082 b, m: Integer; 1083 IsMatch, DoWork: Boolean; 1084 TextEnd: PChar; 1085 HasNextNode: Boolean; 1086begin 1087 Result := nil; 1088 if AText = nil then 1089 exit; 1090 if FList.Count = 0 then 1091 exit; 1092 if FRootNode = nil then 1093 BuildDictionary; 1094 1095 DoWork := True; 1096 CurrentNode := FRootNode; 1097 TextEnd := AText + ATextLen; 1098 1099 Repeat 1100 b := ord(AText^); 1101 if b > 128 then b := 383 - b; 1102 m := CurrentNode^.NextCharMin; 1103 HasNextNode := (b >= m) and (b <= CurrentNode^.NextCharMax) and 1104 (CurrentNode^.NextEntry[b-m] <> nil); 1105 1106 if HasNextNode then begin 1107 // DictLink, before going to next node 1108 // If we do not have a next node, then we will continue with NotFoundEntry, so we do not need to test here (yet) 1109 DictLink := CurrentNode^.DictLink; 1110 if DictLink <> nil then begin 1111 repeat 1112 //while DictLink <> nil do begin 1113 IsMatch := True; 1114 Result := AText; 1115 if Assigned(AFoundEvent) then 1116 AFoundEvent(AText, DictLink^.ItemIdx, IsMatch, DoWork) 1117 else 1118 exit; 1119 if not DoWork then 1120 exit; 1121 if IsMatch then 1122 break; 1123 DictLink := DictLink^.DictLink; 1124 until DictLink = nil; 1125 if IsMatch then begin 1126 CurrentNode := FRootNode; // Do not do overlapping matches 1127 continue; 1128 end; 1129 end; 1130 end; 1131 1132 if HasNextNode then begin 1133 if AText >= TextEnd then 1134 break; 1135 CurrentNode := CurrentNode^.NextEntry[b-m]; // go on with next char 1136 inc(AText); 1137 end 1138 else begin 1139 CurrentNode := CurrentNode^.NotFoundEntry; // check current char again 1140 1141 if CurrentNode = nil then begin 1142 if AText >= TextEnd then 1143 break; 1144 CurrentNode := FRootNode; 1145 inc(AText); 1146 Continue; 1147 end; 1148 end; 1149 1150 1151 // Check match in CurrentNode; 1152 if CurrentNode^.ItemIdx >= 0 then begin 1153 IsMatch := True; 1154 Result := AText; 1155 if Assigned(AFoundEvent) then 1156 AFoundEvent(AText, CurrentNode^.ItemIdx, IsMatch, DoWork) 1157 else 1158 exit; 1159 if not DoWork then 1160 exit; 1161 if IsMatch then 1162 CurrentNode := FRootNode; // Do not do overlapping matches 1163 end; 1164 1165 until False; 1166end; 1167 1168function TSynSearchDictionary.GetMatchAtChar(AText: PChar; ATextLen: Integer; 1169 AFoundEvent: TSynSearchDictFoundEvent): Integer; 1170var 1171 CurrentNode: PSynSearchDictionaryNode; 1172 b, m: Integer; 1173 TextEnd: PChar; 1174 IsMatch, DoWork: Boolean; 1175begin 1176 Result := -1; 1177 if FList.Count = 0 then 1178 exit; 1179 if FRootNode = nil then 1180 BuildDictionary; 1181 1182 DoWork := True; 1183 CurrentNode := FRootNode; 1184 TextEnd := AText + ATextLen; 1185 b := ord(AText^); 1186 if b > 128 then b := 383 - b; 1187 1188 while true do begin 1189 // CurrentNode is for (AText-1)^ 1190 // b is for AText^ 1191 if CurrentNode^.ItemIdx >= 0 then begin 1192 Result := CurrentNode^.ItemIdx; 1193 IsMatch := True; 1194 if Assigned(AFoundEvent) then 1195 AFoundEvent(AText, CurrentNode^.ItemIdx, IsMatch, DoWork) 1196 else 1197 exit; 1198 if (not DoWork) or (IsMatch) then 1199 exit; 1200 end; 1201 1202 m := CurrentNode^.NextCharMin; 1203 if (b >= m) and (b <= CurrentNode^.NextCharMax) and 1204 (CurrentNode^.NextEntry[b-m] <> nil) 1205 then begin 1206 CurrentNode := CurrentNode^.NextEntry[b-m]; 1207 inc(AText); 1208 if AText > TextEnd then 1209 exit; 1210 b := ord(AText^); 1211 if b > 128 then b := 383 - b; 1212 continue; 1213 end; 1214 1215 exit; 1216 end; 1217end; 1218 1219{ TSynSearchTerm } 1220 1221procedure TSynSearchTerm.SetMatchCase(AValue: Boolean); 1222begin 1223 if FMatchCase = AValue then Exit; 1224 FMatchCase := AValue; 1225 Changed(False); 1226end; 1227 1228procedure TSynSearchTerm.SetEnabled(AValue: Boolean); 1229begin 1230 if FEnabled = AValue then Exit; 1231 FEnabled := AValue; 1232 Changed(False); 1233end; 1234 1235procedure TSynSearchTerm.SetMatchWordBounds(AValue: TSynSearchTermOptsBounds); 1236begin 1237 if FMatchWordBounds = AValue then Exit; 1238 FMatchWordBounds := AValue; 1239 Changed(False); 1240end; 1241 1242procedure TSynSearchTerm.SetSearchTerm(AValue: String); 1243begin 1244 if FSearchTerm = AValue then Exit; 1245 FSearchTerm := AValue; 1246 Changed(False); 1247end; 1248 1249constructor TSynSearchTerm.Create(ACollection: TCollection); 1250begin 1251 inherited Create(ACollection); 1252 FMatchCase := False; 1253 FMatchWordBounds := soNoBounds; 1254 FEnabled := True; 1255end; 1256 1257procedure TSynSearchTerm.Assign(Source: TPersistent); 1258begin 1259 if not(Source is TSynSearchTerm) then 1260 exit; 1261 FSearchTerm := TSynSearchTerm(Source).FSearchTerm; 1262 FMatchCase := TSynSearchTerm(Source).FMatchCase; 1263 FMatchWordBounds := TSynSearchTerm(Source).FMatchWordBounds; 1264 FEnabled := TSynSearchTerm(Source).FEnabled; 1265 Changed(False); 1266end; 1267 1268function TSynSearchTerm.Equals(Other: TSynSearchTerm): boolean; 1269begin 1270 Result := (FMatchCase = Other.FMatchCase) and 1271 (FMatchWordBounds = Other.FMatchWordBounds) and 1272 (FSearchTerm = Other.FSearchTerm); 1273end; 1274 1275{ TSynSearchTermList } 1276 1277function TSynSearchTermList.GetItem(Index: Integer): TSynSearchTerm; 1278begin 1279 Result := TSynSearchTerm(inherited GetItem(Index)); 1280end; 1281 1282procedure TSynSearchTermList.SetItem(Index: Integer; AValue: TSynSearchTerm); 1283begin 1284 inherited SetItem(Index, AValue); 1285end; 1286 1287procedure TSynSearchTermList.Update(Item: TCollectionItem); 1288begin 1289 inherited Update(Item); 1290 if assigned(FOnChanged) then 1291 FOnChanged(Self); 1292end; 1293 1294procedure TSynSearchTermList.Notify(Item: TCollectionItem; Action: TCollectionNotification); 1295begin 1296 inherited Notify(Item, Action); 1297 if assigned(FOnChanged) then 1298 FOnChanged(Self); 1299end; 1300 1301function TSynSearchTermList.DefaultItemClass: TSynSearchTermClass; 1302begin 1303 Result := TSynSearchTerm; 1304end; 1305 1306constructor TSynSearchTermList.Create; 1307begin 1308 inherited Create(DefaultItemClass); 1309end; 1310 1311function TSynSearchTermList.Add: TSynSearchTerm; 1312begin 1313 Result := TSynSearchTerm(inherited Add); 1314end; 1315 1316function TSynSearchTermList.IndexOfSearchTerm(ATerm: String; 1317 ASearchStartIdx: Integer): Integer; 1318begin 1319 Result := IndexOfSearchTerm(ATerm, True, ASearchStartIdx); 1320end; 1321 1322function TSynSearchTermList.IndexOfSearchTerm(ATerm: TSynSearchTerm; 1323 ASearchStartIdx: Integer): Integer; 1324var 1325 c: Integer; 1326begin 1327 Result := ASearchStartIdx; 1328 c := Count ; 1329 while (Result < c) and (not Items[Result].Equals(ATerm)) do 1330 inc(Result); 1331 if Result >= c then 1332 Result := -1; 1333end; 1334 1335function TSynSearchTermList.IndexOfSearchTerm(ATerm: String; ACaseSensitive: Boolean; 1336 ASearchStartIdx: Integer): Integer; 1337var 1338 c: Integer; 1339begin 1340 Result := ASearchStartIdx; 1341 c := Count ; 1342 if ACaseSensitive then begin 1343 while (Result < c) and (Items[Result].SearchTerm <> ATerm) do 1344 inc(Result); 1345 end 1346 else begin 1347 ATerm := LowerCase(ATerm); 1348 while (Result < c) and (LowerCase(Items[Result].SearchTerm) <> ATerm) do 1349 inc(Result); 1350 end; 1351 if Result >= c then 1352 Result := -1; 1353end; 1354 1355{ TSynEditMarkupHighlightAllMulti } 1356 1357function TSynEditMarkupHighlightAllMulti.HasSearchData: Boolean; 1358begin 1359 Result := FTermDict.Count > 0; 1360end; 1361 1362function TSynEditMarkupHighlightAllMulti.SearchStringMaxLines: Integer; 1363begin 1364 Result := 1; // Todo: implement multiline 1365end; 1366 1367procedure TSynEditMarkupHighlightAllMulti.FindInitialize; 1368begin 1369 // 1370end; 1371 1372procedure TSynEditMarkupHighlightAllMulti.DoMatchFound(MatchEnd: PChar; MatchIdx: Integer; 1373 var IsMatch: Boolean; var StopSeach: Boolean); 1374var 1375 i, NextInsertIdx, Len: Integer; 1376 o: TSynSearchTerm; 1377 MatchBegin: PChar; 1378begin 1379 Len := 0; 1380 MatchBegin := nil; 1381 while MatchIdx >= 0 do begin 1382 o := FTermDict[MatchIdx]; 1383 1384 if not o.Enabled then begin 1385 MatchIdx := FTermDict.GetIndexForNextWordOccurrence(MatchIdx); 1386 continue; 1387 end; 1388 1389 Len := length(o.SearchTerm); 1390 MatchBegin := MatchEnd - Len - FFindLineTextLower + FFindLineText; 1391 1392 if o.MatchCase and not(copy(MatchBegin, 1, Len) = o.SearchTerm) then begin 1393 MatchIdx := FTermDict.GetIndexForNextWordOccurrence(MatchIdx); 1394 continue; 1395 end; 1396 1397 if (o.MatchWordBounds in [soBoundsAtStart, soBothBounds]) and 1398 not( (MatchBegin = FFindLineText) or 1399 ((MatchBegin-1)^ in WordBreakChars) 1400 ) 1401 then begin 1402 MatchIdx := FTermDict.GetIndexForNextWordOccurrence(MatchIdx); 1403 continue; 1404 end; 1405 1406 if (o.MatchWordBounds in [soBoundsAtEnd, soBothBounds]) and 1407 not( (MatchBegin+Len = FFindLineTextEnd) or 1408 ((MatchBegin+Len)^ in WordBreakChars) 1409 ) 1410 then begin 1411 MatchIdx := FTermDict.GetIndexForNextWordOccurrence(MatchIdx); 1412 continue; 1413 end; 1414 1415 break; 1416 end; 1417 1418 IsMatch := False; // Continue for longer match //MatchIdx >= 0; 1419 if MatchIdx < 0 then 1420 exit; 1421 1422 NextInsertIdx := FFindInsertIndex; 1423 if FBackwardReplace then 1424 inc(NextInsertIdx); // because FFindInsertIndex was not increased; 1425 i := NextInsertIdx; 1426 if (NextInsertIdx > FFindStartedAtIndex) then begin 1427 //only searching one line at a time. So only checking x 1428 Assert(FFindLineY = FMatches.EndPoint[NextInsertIdx-1].Y); 1429 While (i > FFindStartedAtIndex) and 1430 (MatchBegin-FFindLineText+1 < FMatches.EndPoint[i-1].X) // Starts within or before previous 1431 do 1432 dec(i); 1433 if (i < NextInsertIdx) and (Len <= (FMatches.EndPoint[i].X - FMatches.StartPoint[i].X)) 1434 then 1435 i := NextInsertIdx; 1436 end; 1437 1438 if (i < NextInsertIdx) then begin 1439 //DebugLn(['Replacing match at idx=', i, ' Back:', FFindInsertIndex-i, ' y=', FFindLineY, 1440 // ' x1=', FMatches.StartPoint[i].X, ' x2=', MatchBegin-FFindLineText+1, ' with longer. Len=', Len]); 1441 FMatches.StartPoint[i] := Point(MatchBegin-FFindLineText+1, FFindLineY); 1442 FMatches.EndPoint[i] := Point(MatchBegin-FFindLineText+1+Len, FFindLineY); 1443 if i + 1 < FFindInsertIndex then 1444 FMatches.Delete(i+1, FFindInsertIndex - (i + 1)); 1445 if not FBackward then 1446 FFindInsertIndex := i + 1 1447 else assert(i = FFindInsertIndex); 1448 end 1449 else begin 1450 if FBackwardReplace then begin 1451 // Replace, only keep last match 1452 FMatches.StartPoint[FFindInsertIndex] := Point(MatchBegin-FFindLineText+1, FFindLineY); 1453 FMatches.EndPoint[FFindInsertIndex] := Point(MatchBegin-FFindLineText+1+Len, FFindLineY); 1454 end 1455 else 1456 FMatches.Insert(FFindInsertIndex, 1457 Point(MatchBegin-FFindLineText+1, FFindLineY), 1458 Point(MatchBegin-FFindLineText+1+Len, FFindLineY) 1459 ); 1460 if not FBackward then 1461 inc(FFindInsertIndex) 1462 else 1463 FBackwardReplace := True; 1464 end; 1465end; 1466 1467procedure TSynEditMarkupHighlightAllMulti.SetTerms(AValue: TSynSearchTermDict); 1468begin 1469 if FTermDict = AValue then Exit; 1470 1471 if FTermDict <> nil then begin 1472 FTermDict.UnRegisterChangedHandler(@DoTermsChanged); 1473 FTermDict.ReleaseReference; 1474 end; 1475 1476 if AValue = nil then 1477 FTermDict := CreateTermsList 1478 else 1479 FTermDict := AValue; 1480 1481 FTermDict.AddReference; 1482 FTermDict.RegisterChangedHandler(@DoTermsChanged); 1483end; 1484 1485procedure TSynEditMarkupHighlightAllMulti.SetWordBreakChars(AValue: TSynIdentChars); 1486begin 1487 if FWordBreakChars = AValue then Exit; 1488 FWordBreakChars := AValue; 1489 Invalidate; 1490end; 1491 1492procedure TSynEditMarkupHighlightAllMulti.DoTermsChanged(Sender: TObject); 1493begin 1494 if (FTermDict = nil) then 1495 exit; 1496 Invalidate; 1497end; 1498 1499function TSynEditMarkupHighlightAllMulti.FindMatches(AStartPoint, AEndPoint: TPoint; 1500 var AIndex: Integer; AStopAfterLine: Integer; ABackward: Boolean): TPoint; 1501var 1502 LineLen: Integer; 1503 LineText, LineTextLower: String; 1504 x: integer; 1505begin 1506 //debugln(['FindMatches IDX=', AIndex, ' Cnt=', Matches.Count, ' LCnt=', AEndPoint.y-AStartPoint.y , ' # ', FTerms[0].SearchTerm, ' # ',dbgs(AStartPoint),' - ',dbgs(AEndPoint), ' AStopAfterLine=',AStopAfterLine, ' Back=', dbgs(ABackward), ' ']); 1507 FFindInsertIndex := AIndex; 1508 FFindStartedAtIndex := FFindInsertIndex; 1509 FBackward := ABackward; // Currently supports only finding a single match 1510 1511 if ABackward then begin 1512 FBackwardReplace := False; 1513 x := 1; 1514 while AStartPoint.y <= AEndPoint.y do begin 1515 LineText := Lines[AEndPoint.y-1]; 1516 LineTextLower := LowerCase(LineText); 1517 1518 LineLen := Min(Length(LineTextLower), AEndPoint.x-1); 1519 if (AStartPoint.y = AEndPoint.y) and (AStartPoint.x > 1) then begin 1520 x := AStartPoint.x - 1; 1521 LineLen := Max(0, LineLen - x); 1522 end; 1523 1524 if LineLen > 0 then begin 1525 FFindLineY := AEndPoint.Y; 1526 FFindStartedAtIndex := FFindInsertIndex; 1527 FFindLineText := @LineText[1]; 1528 FFindLineTextEnd := FFindLineText + LineLen; 1529 FFindLineTextLower := @LineTextLower[1]; 1530 FFindLineTextLowerEnd := FFindLineTextLower + LineLen; 1531 if LineLen > 0 then 1532 FTermDict.Search(@LineTextLower[x], LineLen, @DoMatchFound); 1533 end; 1534 1535 if FBackwardReplace then 1536 break; // Only one supported 1537 1538 dec(AEndPoint.y); 1539 AEndPoint.x := MaxInt; 1540 1541 //if (AStopAfterLine >= 0) and (AStartPoint.Y-1 > AStopAfterLine) and 1542 // (FFindInsertIndex > AIndex) 1543 //then begin 1544 // AEndPoint := point(LineLen, AStartPoint.Y-1); 1545 // break; 1546 //end; 1547 end; 1548 1549 if FBackwardReplace then 1550 inc(FFindInsertIndex); 1551 end 1552 else begin 1553 while AStartPoint.y <= AEndPoint.y do begin 1554 LineText := Lines[AStartPoint.y-1]; 1555 LineTextLower := LowerCase(LineText); 1556 1557 LineLen := Length(LineTextLower); 1558 if AStartPoint.y = AEndPoint.y then 1559 LineLen := Min(LineLen, AEndPoint.x - AStartPoint.x + 1); 1560 1561 if LineLen > 0 then begin 1562 FFindLineY := AStartPoint.Y; 1563 FFindStartedAtIndex := FFindInsertIndex; 1564 FFindLineText := @LineText[1]; 1565 FFindLineTextEnd := FFindLineText + LineLen; 1566 FFindLineTextLower := @LineTextLower[1]; 1567 FFindLineTextLowerEnd := FFindLineTextLower + LineLen; 1568 if LineLen > 0 then 1569 FTermDict.Search(@LineTextLower[1] + AStartPoint.x - 1, LineLen, @DoMatchFound); 1570 end; 1571 1572 inc(AStartPoint.y); 1573 AStartPoint.x := 1; 1574 1575 if (AStopAfterLine >= 0) and (AStartPoint.Y-1 > AStopAfterLine) and 1576 (FFindInsertIndex > AIndex) 1577 then begin 1578 AEndPoint := point(LineLen, AStartPoint.Y-1); 1579 break; 1580 end; 1581 end; 1582 end; 1583 1584 AIndex := FFindInsertIndex; 1585 Result := AEndPoint; 1586end; 1587 1588function TSynEditMarkupHighlightAllMulti.CreateTermsList: TSynSearchTermDict; 1589begin 1590 Result := TSynSearchTermDict.Create(TSynSearchTermList); 1591end; 1592 1593constructor TSynEditMarkupHighlightAllMulti.Create(ASynEdit: TSynEditBase); 1594begin 1595 inherited Create(ASynEdit); 1596 Terms := CreateTermsList; 1597 ResetWordBreaks; 1598end; 1599 1600destructor TSynEditMarkupHighlightAllMulti.Destroy; 1601begin 1602 inherited Destroy; 1603 FTermDict.UnRegisterChangedHandler(@DoTermsChanged); 1604 ReleaseRefAndNil(FTermDict); 1605end; 1606 1607procedure TSynEditMarkupHighlightAllMulti.Clear; 1608begin 1609 FTermDict.Clear; 1610end; 1611 1612procedure TSynEditMarkupHighlightAllMulti.ResetWordBreaks; 1613begin 1614 FWordBreakChars := TSynWordBreakChars + TSynWhiteChars; 1615 FTermDict.ClearDictionary; 1616 Invalidate; 1617end; 1618 1619function TSynEditMarkupHighlightAllMulti.AddSearchTerm(ATerm: String): Integer; 1620var 1621 Itm: TSynSearchTerm; 1622begin 1623 Itm := FTermDict.Add; 1624 Itm.SearchTerm := ATerm; 1625 Result := Itm.Index; 1626end; 1627 1628function TSynEditMarkupHighlightAllMulti.IndexOfSearchTerm(ATerm: String): Integer; 1629begin 1630 Result:= FTermDict.IndexOfSearchTerm(ATerm); 1631end; 1632 1633procedure TSynEditMarkupHighlightAllMulti.RemoveSearchTerm(ATerm: String); 1634begin 1635 FTermDict.Delete(IndexOfSearchTerm(ATerm)); 1636end; 1637 1638procedure TSynEditMarkupHighlightAllMulti.DeleteSearchTerm(AIndex: Integer); 1639begin 1640 FTermDict.Delete(AIndex); 1641end; 1642 1643{ TSynEditMarkupHighlightAll } 1644 1645procedure TSynEditMarkupHighlightAll.SetSearchOptions(AValue: TSynSearchOptions); 1646begin 1647 if fSearchOptions = AValue then exit; 1648 fSearchOptions := AValue; 1649 FSearchStringMaxLines := -1; 1650 Invalidate; 1651 DoOptionsChanged; 1652end; 1653 1654procedure TSynEditMarkupHighlightAll.SetSearchString(AValue: String); 1655begin 1656 if FSearchString = AValue then exit; 1657 FSearchString := AValue; 1658 FSearchStringMaxLines := -1; 1659 Invalidate; // bad if options and string search at the same time *and* string is <> '' 1660 1661 SearchStringChanged; 1662end; 1663 1664procedure TSynEditMarkupHighlightAll.SearchStringChanged; 1665begin 1666 // 1667end; 1668 1669procedure TSynEditMarkupHighlightAll.DoOptionsChanged; 1670begin 1671 // 1672end; 1673 1674function TSynEditMarkupHighlightAll.HasSearchData: Boolean; 1675begin 1676 Result := FSearchString <> ''; 1677end; 1678 1679function TSynEditMarkupHighlightAll.SearchStringMaxLines: Integer; 1680var 1681 i, j: Integer; 1682begin 1683 Result := FSearchStringMaxLines; 1684 if Result > 0 then 1685 exit; 1686 1687 if (fSearchOptions * [ssoRegExpr, ssoRegExprMultiLine] = []) 1688 then begin 1689 // can not wrap around lines 1690 j := 1; 1691 i := Length(fSearchString); 1692 while i > 0 do begin 1693 if fSearchString[i] = #13 then begin 1694 inc(j); 1695 if (i > 1) and (fSearchString[i-1] = #10) then dec(i); // skip alternating 1696 end 1697 else 1698 if fSearchString[i] = #10 then begin 1699 inc(j); 1700 if (i > 1) and (fSearchString[i-1] = #13) then dec(i); // skip alternating 1701 end; 1702 dec(i); 1703 end; 1704 FSearchStringMaxLines := j; 1705 end 1706 else begin 1707 if (fSearchOptions * [ssoRegExpr, ssoRegExprMultiLine] = [ssoRegExpr]) then 1708 FSearchStringMaxLines := 1 // Only ssoRegExprMultiLine can expand accross lines (actually \n\r should anymay...) 1709 else 1710 FSearchStringMaxLines := 0; // Unknown 1711 end; 1712 1713 Result := FSearchStringMaxLines; 1714end; 1715 1716procedure TSynEditMarkupHighlightAll.FindInitialize; 1717begin 1718 fSearch.Pattern := fSearchString; 1719 fSearch.Sensitive := ssoMatchCase in fSearchOptions; 1720 fSearch.Whole := ssoWholeWord in fSearchOptions; 1721 fSearch.RegularExpressions := ssoRegExpr in fSearchOptions; 1722 fSearch.RegExprMultiLine := ssoRegExprMultiLine in fSearchOptions; 1723 fSearch.Backwards := False; 1724end; 1725 1726function TSynEditMarkupHighlightAll.FindMatches(AStartPoint, AEndPoint: TPoint; 1727 var AIndex: Integer; AStopAfterLine: Integer; ABackward: Boolean): TPoint; 1728var 1729 ptFoundStart, ptFoundEnd: TPoint; 1730begin 1731 fSearch.Backwards := ABackward; 1732 While (true) do begin 1733 if not fSearch.FindNextOne(Lines, AStartPoint, AEndPoint, ptFoundStart, ptFoundEnd) 1734 then break; 1735 AStartPoint := ptFoundEnd; 1736 1737 FMatches.Insert(AIndex, ptFoundStart, ptFoundEnd); 1738 inc(AIndex); // BAckward learch needs final index to point to last inserted (currently support only find ONE) 1739 1740 if (AStopAfterLine >= 0) and (ptFoundStart.Y > AStopAfterLine) then begin 1741 AEndPoint := ptFoundEnd; 1742 break; 1743 end; 1744 end; 1745 Result := AEndPoint; 1746end; 1747 1748constructor TSynEditMarkupHighlightAll.Create(ASynEdit: TSynEditBase); 1749begin 1750 inherited Create(ASynEdit); 1751 FSearch := TSynEditSearch.Create; 1752 FSearchString:=''; 1753 FSearchOptions := []; 1754end; 1755 1756destructor TSynEditMarkupHighlightAll.Destroy; 1757begin 1758 inherited Destroy; 1759 FreeAndNil(FSearch); 1760end; 1761 1762{ TSynMarkupHighAllMatchList } 1763 1764constructor TSynMarkupHighAllMatchList.Create; 1765begin 1766 inherited Create; 1767 Count := 0; 1768 Capacity := 256; 1769end; 1770 1771function TSynMarkupHighAllMatchList.MaybeReduceCapacity : Boolean; 1772begin 1773 if not( (Capacity > 512) and (Capacity > Count*4) ) 1774 then exit(False); 1775 1776 Capacity := Capacity div 2; 1777 result := true; 1778end; 1779 1780function TSynMarkupHighAllMatchList.IndexOfFirstMatchForLine(ALine: Integer): Integer; 1781var 1782 l, h: Integer; 1783begin 1784 if Count = 0 then 1785 exit(-1); 1786 l := 0; 1787 h := Count -1; 1788 Result := (l+h) div 2; 1789 while (h > l) do begin 1790 if PSynMarkupHighAllMatch(ItemPointer[Result])^.EndPoint.y >= ALine then 1791 h := Result 1792 else 1793 l := Result + 1; 1794 Result := (l+h) div 2; 1795 end; 1796 if (PSynMarkupHighAllMatch(ItemPointer[Result])^.EndPoint.y < ALine) then 1797 inc(Result); 1798end; 1799 1800function TSynMarkupHighAllMatchList.IndexOfLastMatchForLine(ALine: Integer): Integer; 1801var 1802 l, h: Integer; 1803begin 1804 if Count = 0 then 1805 exit(-1); 1806 l := 0; 1807 h := Count -1; 1808 Result := (l+h) div 2; 1809 while (h > l) do begin 1810 if PSynMarkupHighAllMatch(ItemPointer[Result])^.StartPoint.y <= ALine then 1811 l := Result + 1 1812 else 1813 h := Result; 1814 Result := (l+h) div 2; 1815 end; 1816 if (PSynMarkupHighAllMatch(ItemPointer[Result])^.StartPoint.y > ALine) then 1817 dec(Result); 1818end; 1819 1820procedure TSynMarkupHighAllMatchList.Delete(AIndex: Integer; ACount: Integer); 1821begin 1822 if AIndex >= Count then 1823 exit; 1824 if AIndex + ACount > Count then 1825 ACount := Count - AIndex 1826 else 1827 DeleteRows(AIndex, ACount); 1828end; 1829 1830procedure TSynMarkupHighAllMatchList.Insert(AIndex: Integer; ACount: Integer); 1831begin 1832 if AIndex > Count then 1833 exit; 1834 InsertRows(AIndex, ACount); 1835end; 1836 1837procedure TSynMarkupHighAllMatchList.Insert(AIndex: Integer; AStartPoint, AEndPoint: TPoint); 1838begin 1839 Insert(AIndex); 1840 PSynMarkupHighAllMatch(ItemPointer[AIndex])^.StartPoint := AStartPoint; 1841 PSynMarkupHighAllMatch(ItemPointer[AIndex])^.EndPoint := AEndPoint; 1842end; 1843 1844procedure TSynMarkupHighAllMatchList.SetCount(const AValue : Integer); 1845begin 1846 if Count=AValue then exit; 1847 if (Capacity <= AValue) then begin 1848 Capacity := Max(Capacity, AValue) * 2; 1849 inherited SetCount(AValue); 1850 end 1851 else begin 1852 inherited SetCount(AValue); 1853 MaybeReduceCapacity; 1854 end; 1855end; 1856 1857function TSynMarkupHighAllMatchList.GetPointCount : Integer; 1858begin 1859 result := Count * 2; 1860end; 1861 1862function TSynMarkupHighAllMatchList.GetPoint(const Index : Integer) : TPoint; 1863begin 1864 if (Index and 1) = 0 1865 then Result := PSynMarkupHighAllMatch(ItemPointer[Index>>1])^.StartPoint 1866 else Result := PSynMarkupHighAllMatch(ItemPointer[Index>>1])^.EndPoint 1867end; 1868 1869function TSynMarkupHighAllMatchList.GetStartPoint(const Index : Integer) : TPoint; 1870begin 1871 Result := PSynMarkupHighAllMatch(ItemPointer[Index])^.StartPoint; 1872end; 1873 1874procedure TSynMarkupHighAllMatchList.SetStartPoint(const Index : Integer; const AValue : TPoint); 1875begin 1876 if Index = Count 1877 then Count := Count + 1; // AutoIncrease 1878 PSynMarkupHighAllMatch(ItemPointer[Index])^.StartPoint := AValue; 1879end; 1880 1881function TSynMarkupHighAllMatchList.GetInintialForItemSize: Integer; 1882begin 1883 Result := SizeOf(TSynMarkupHighAllMatch); 1884end; 1885 1886function TSynMarkupHighAllMatchList.GetEndPoint(const Index : Integer) : TPoint; 1887begin 1888 Result := PSynMarkupHighAllMatch(ItemPointer[Index])^.EndPoint; 1889end; 1890 1891procedure TSynMarkupHighAllMatchList.SetEndPoint(const Index : Integer; const AValue : TPoint); 1892begin 1893 if Index = Count 1894 then Count := Count + 1; // AutoIncrease 1895 PSynMarkupHighAllMatch(ItemPointer[Index])^.EndPoint := AValue; 1896end; 1897 1898function TSynMarkupHighAllMatchList.GetMatch(const Index: Integer): TSynMarkupHighAllMatch; 1899begin 1900 Result := PSynMarkupHighAllMatch(ItemPointer[Index])^; 1901end; 1902 1903procedure TSynMarkupHighAllMatchList.SetMatch(const Index: Integer; 1904 const AValue: TSynMarkupHighAllMatch); 1905begin 1906 if Index = Count 1907 then Count := Count + 1; // AutoIncrease 1908 PSynMarkupHighAllMatch(ItemPointer[Index])^ := AValue; 1909end; 1910 1911{ TSynMarkupHighAllMultiMatchList } 1912 1913function TSynMarkupHighAllMultiMatchList.GetMarkupId(Index: Integer): Integer; 1914begin 1915 Result := PInteger(ItemPointer[Index]+FParentItemSize)^; 1916end; 1917 1918procedure TSynMarkupHighAllMultiMatchList.SetMarkupId(Index: Integer; AValue: Integer); 1919begin 1920 PInteger(ItemPointer[Index]+FParentItemSize)^ := AValue; 1921end; 1922 1923function TSynMarkupHighAllMultiMatchList.GetInintialForItemSize: Integer; 1924begin 1925 Result := inherited GetInintialForItemSize; 1926 FParentItemSize := Result; 1927 Result := FParentItemSize + SizeOf(Integer); 1928end; 1929 1930{ TSynEditMarkupHighlightAllBase } 1931 1932constructor TSynEditMarkupHighlightAllBase.Create(ASynEdit : TSynEditBase); 1933begin 1934 inherited Create(ASynEdit); 1935 fStartPoint.y := -1; 1936 FSearchedEnd.y := -1; 1937 FFirstInvalidLine := 1; 1938 FLastInvalidLine := MaxInt; 1939 FHideSingleMatch := False; 1940 FMarkupEnabled := MarkupInfo.IsEnabled; 1941end; 1942 1943destructor TSynEditMarkupHighlightAllBase.Destroy; 1944begin 1945 FoldView := nil; 1946 inherited Destroy; 1947end; 1948 1949procedure TSynEditMarkupHighlightAllBase.DecPaintLock; 1950begin 1951 inherited DecPaintLock; 1952 if (FPaintLock = 0) and FNeedValidate then 1953 ValidateMatches(not FNeedValidatePaint); 1954end; 1955 1956procedure TSynEditMarkupHighlightAllBase.DoTopLineChanged(OldTopLine : Integer); 1957begin 1958 // {TODO: Only do a partial search on the new area} 1959 ValidateMatches(True); 1960end; 1961 1962procedure TSynEditMarkupHighlightAllBase.DoLinesInWindoChanged(OldLinesInWindow : Integer); 1963begin 1964 // {TODO: Only do a partial search on the new area} 1965 ValidateMatches(True); 1966end; 1967 1968procedure TSynEditMarkupHighlightAllBase.DoMarkupChanged(AMarkup : TSynSelectedColor); 1969begin 1970 If (not FMarkupEnabled) and MarkupInfo.IsEnabled then 1971 Invalidate 1972 else 1973 SendLineInvalidation; 1974 FMarkupEnabled := MarkupInfo.IsEnabled; 1975end; 1976 1977procedure TSynEditMarkupHighlightAllBase.DoEnabledChanged(Sender: TObject); 1978begin 1979 Invalidate; 1980end; 1981 1982function TSynEditMarkupHighlightAllBase.GetMatchCount: Integer; 1983begin 1984 Result := fMatches.Count; 1985end; 1986 1987procedure TSynEditMarkupHighlightAllBase.SetFoldView(AValue: TSynEditFoldedView); 1988begin 1989 if FFoldView = AValue then Exit; 1990 1991 if FFoldView <> nil then 1992 FFoldView.RemoveFoldChangedHandler(@DoFoldChanged); 1993 1994 FFoldView := AValue; 1995 1996 if FFoldView <> nil then 1997 FFoldView.AddFoldChangedHandler(@DoFoldChanged); 1998end; 1999 2000procedure TSynEditMarkupHighlightAllBase.SetHideSingleMatch(AValue: Boolean); 2001begin 2002 if FHideSingleMatch = AValue then Exit; 2003 FHideSingleMatch := AValue; 2004 if FMatches.Count = 1 then 2005 if FHideSingleMatch then 2006 Invalidate // TODO only need extend search 2007 //ValidateMatches() // May find a 2nd, by extending startpos 2008 else 2009 SendLineInvalidation; // Show the existing match 2010end; 2011 2012procedure TSynEditMarkupHighlightAllBase.DoFoldChanged(aLine: Integer); 2013begin 2014 InvalidateLines(aLine+1, MaxInt, True); 2015end; 2016 2017procedure TSynEditMarkupHighlightAllBase.ValidateMatches(SkipPaint: Boolean); 2018var 2019 LastLine : Integer; // Last visible 2020 UnsentLineInvalidation: Integer; 2021 2022 function IsPosValid(APos: TPoint): Boolean; // Check if point is in invalid range 2023 begin 2024 Result := (APos.y > 0) and 2025 ( (FFirstInvalidLine < 1) or (APos.y < FFirstInvalidLine) or 2026 ( (FLastInvalidLine > 0) and (APos.y > FLastInvalidLine) ) 2027 ); 2028 end; 2029 2030 function HasInvalidationBetween(ARangeStart, ARangeEnd: TPoint): Boolean; // Check if point is in invalid range 2031 begin 2032 Result := 2033 ((FFirstInvalidLine >= ARangeStart.y) and (FFirstInvalidLine <= ARangeEnd.y)) or 2034 ((FLastInvalidLine >= ARangeStart.y) and (FLastInvalidLine <= ARangeEnd.y)); 2035 end; 2036 2037 function IsStartAtMatch0: Boolean; // Check if FStartPoint = FMatches[0] 2038 begin 2039 Result := (FMatches.Count > 0) and 2040 (FStartPoint.y = FMatches.StartPoint[0].y)and (FStartPoint.x = FMatches.StartPoint[0].x); 2041 end; 2042 2043 function IsEndAtMatch(APoint: TPoint): Boolean; 2044 begin 2045 Result := (FMatches.Count > 0) and 2046 (APoint.y = FMatches.EndPoint[FMatches.Count].y)and (APoint.x = FMatches.EndPoint[FMatches.Count].x); 2047 end; 2048 2049 function AdjustedSearchStrMaxLines: Integer; 2050 begin 2051 Result := SearchStringMaxLines - 1; 2052 if Result < 0 then Result := SEARCH_START_OFFS; 2053 end; 2054 2055 procedure MaybeSendLineInvalidation(AFirstIndex, ALastIndex: Integer); 2056 begin 2057 if SkipPaint or (ALastIndex < AFirstIndex) then 2058 exit; 2059 if HideSingleMatch and (FMatches.Count = 1) then begin 2060 assert((UnsentLineInvalidation < 0) and (AFirstIndex = 0) and (ALastIndex=0), 'UnsentLineInvalidation < 0'); 2061 UnsentLineInvalidation := AFirstIndex; 2062 exit; 2063 end; 2064 2065 SendLineInvalidation(AFirstIndex, ALastIndex); 2066 if UnsentLineInvalidation >= 0 then 2067 SendLineInvalidation(UnsentLineInvalidation, UnsentLineInvalidation); 2068 UnsentLineInvalidation := -1; 2069 end; 2070 2071 procedure MaybeDropOldMatches; 2072 var 2073 Idx: Integer; 2074 begin 2075 // remove matches, that are too far off the current visible area 2076 if (FMatches.Count > MATCHES_CLEAN_CNT_THRESHOLD) then begin 2077 if TopLine - FMatches.EndPoint[0].y > MATCHES_CLEAN_LINE_THRESHOLD then begin 2078 Idx := FMatches.IndexOfFirstMatchForLine(TopLine - MATCHES_CLEAN_LINE_KEEP) - 1; 2079 FMatches.Delete(0, Idx); 2080 if FMatches.Count > 0 2081 then FStartPoint := FMatches.StartPoint[0] 2082 else FStartPoint.y := -1; 2083 end; 2084 if FMatches.StartPoint[FMatches.Count-1].y - LastLine > MATCHES_CLEAN_LINE_THRESHOLD then begin 2085 Idx := FMatches.IndexOfLastMatchForLine(LastLine + MATCHES_CLEAN_LINE_KEEP) + 1; 2086 FMatches.Delete(Idx, FMatches.Count - Idx); 2087 if FMatches.Count > 0 2088 then FSearchedEnd := FMatches.EndPoint[FMatches.Count-1] 2089 else FSearchedEnd.y := -1; 2090 end; 2091 end; 2092 end; 2093 2094 function DeleteInvalidMatches: Integer; 2095 var 2096 FirstInvalIdx, LastInvalIdx: Integer; 2097 begin 2098 // Delete Matches from the invalidated line range 2099 FirstInvalIdx := -1; 2100 LastInvalIdx := -1; 2101 if (FFirstInvalidLine > 0) or (FLastInvalidLine > 0) then begin 2102 FirstInvalIdx := FMatches.IndexOfFirstMatchForLine(FFirstInvalidLine); 2103 LastInvalIdx := FMatches.IndexOfLastMatchForLine(FLastInvalidLine); 2104 if (FirstInvalIdx >= 0) and (FirstInvalIdx <= LastInvalIdx) then begin 2105 if (not SkipPaint) and HasVisibleMatch then 2106 SendLineInvalidation(FirstInvalIdx, LastInvalIdx); 2107 FMatches.Delete(FirstInvalIdx, LastInvalIdx-FirstInvalIdx+1); 2108 if FirstInvalIdx > FMatches.Count then 2109 FirstInvalIdx := FMatches.Count; 2110 end; 2111 end; 2112 Result := FirstInvalIdx; 2113 end; 2114 2115 function FindStartPoint(var AFirstKeptValidIdx: Integer): Boolean; 2116 var 2117 Idx : Integer; 2118 begin 2119 Result := False; // No Gap at start to fill 2120 2121 if (FMatches.Count > 0) and (FMatches.StartPoint[0].y < TopLine) then begin 2122 // New StartPoint from existing matches 2123 Result := True; 2124 FStartPoint := FMatches.StartPoint[0]; 2125 if AFirstKeptValidIdx = 0 then 2126 AFirstKeptValidIdx := -1; 2127 end 2128 2129 else begin 2130 if SearchStringMaxLines > 0 then 2131 // New StartPoint at fixed offset 2132 FStartPoint := Point(1, TopLine - (SearchStringMaxLines - 1)) 2133 else begin 2134 // New StartPoint Search backward 2135 Idx := 0; 2136 FindMatches(Point(1, Max(1, TopLine-SEARCH_START_OFFS)), 2137 Point(1, TopLine), 2138 Idx, 0, True); // stopAfterline=0, do only ONE find 2139 if Idx > 0 then begin 2140 FStartPoint := FMatches.StartPoint[0]; 2141 if (AFirstKeptValidIdx >= 0) then 2142 inc(AFirstKeptValidIdx, Idx); 2143 end 2144 else 2145 FStartPoint := Point(1, TopLine) // no previous match found 2146 end; 2147 end; 2148 end; 2149 2150 procedure MaybeExtendForHideSingle; 2151 var 2152 EndOffsLine: Integer; 2153 Idx: Integer; 2154 begin 2155 // Check, if there is exactly one match in the visible lines 2156 if (not HideSingleMatch) or (Matches.Count <> 1) or 2157 (FMatches.StartPoint[0].y < TopLine) or (FMatches.StartPoint[0].y > LastLine) 2158 then 2159 exit; 2160 2161 // search 2nd, if HideSingleMatch; 2162 EndOffsLine := min(LastLine+Max(SEARCH_START_OFFS, AdjustedSearchStrMaxLines), Lines.Count); 2163 if EndOffsLine > FSearchedEnd.y then begin 2164 FSearchedEnd.y := FSearchedEnd.y - AdjustedSearchStrMaxLines; 2165 if ComparePoints(FSearchedEnd, FMatches.EndPoint[0]) < 0 then 2166 FSearchedEnd := FMatches.EndPoint[0]; 2167 Idx := 1; 2168 FSearchedEnd := FindMatches(FSearchedEnd, 2169 Point(Length(Lines[EndOffsLine - 1])+1, EndOffsLine), 2170 Idx, LastLine); 2171 SendLineInvalidation; 2172 if Idx > 1 then 2173 exit; 2174 end; 2175 2176 // search back from start 2177 if FStartPoint.y < TopLine-SEARCH_START_OFFS then 2178 exit; 2179 Idx := 0; 2180 FindMatches(Point(1, Max(1, TopLine-SEARCH_START_OFFS)), FStartPoint, 2181 Idx, 0, True); // stopAfterline=0, do only ONE find // Search backwards 2182 if Idx > 0 then begin 2183 if ComparePoints(FStartPoint, FMatches.StartPoint[0]) = 0 then begin 2184 // bad search: did return endpoint 2185 FMatches.Delete(0); 2186 exit; 2187 end; 2188 FStartPoint := FMatches.StartPoint[0]; 2189 SendLineInvalidation; 2190 end 2191 end; 2192 2193 procedure FinishValidate; 2194 begin 2195 FFirstInvalidLine := 0; 2196 FLastInvalidLine := 0; 2197 end; 2198 2199 procedure DoFullSearch(NeedStartPoint: Boolean); 2200 var 2201 dummy: Integer; 2202 EndOffsLine: Integer; 2203 Idx, Idx2: Integer; 2204 p: TPoint; 2205 begin 2206 FMatches.Count := 0; 2207 dummy := -1; 2208 if NeedStartPoint then 2209 FindStartPoint(dummy); 2210 2211 EndOffsLine := min(LastLine+AdjustedSearchStrMaxLines, Lines.Count); 2212 2213 if IsStartAtMatch0 then begin 2214 Idx := 1; 2215 p := FMatches.EndPoint[0]; 2216 end else begin 2217 Idx := 0; 2218 p := FStartPoint; 2219 end; 2220 Idx2 := Idx; 2221 FSearchedEnd := FindMatches(p, 2222 Point(Length(Lines[EndOffsLine - 1])+1, EndOffsLine), 2223 Idx, LastLine); 2224 if (not SkipPaint) and (Idx > Idx2) and HasVisibleMatch then 2225 MaybeSendLineInvalidation(0, Idx-1); 2226 2227 MaybeExtendForHideSingle; 2228 FinishValidate; 2229 end; 2230 2231var 2232 OldStartPoint, OldEndPoint, GapStartPoint, GapEndPoint: TPoint; 2233 i, j, EndOffsLine : Integer; // Stop search (LastLine + Offs) 2234 Idx, Idx2 : Integer; 2235 FirstKeptValidIdx: Integer; // The first index, kept after the removed invalidated range 2236 p, WorkStartPoint: TPoint; 2237 FindStartPointUsedExistingMatch: Boolean; 2238begin 2239 FNextPosIdx := -1; 2240 FNextPosRow := -1; 2241 if (FPaintLock > 0) or (not SynEdit.IsVisible) then begin 2242 FNeedValidate := True; 2243 if not SkipPaint then 2244 FNeedValidatePaint := True; 2245 exit; 2246 end; 2247 FNeedValidate := False; 2248 2249 if (not HasSearchData) or (not MarkupInfo.IsEnabled) then begin 2250 if (not SkipPaint) and (fMatches.Count > 0) then 2251 SendLineInvalidation; 2252 fMatches.Count := 0; 2253 exit; 2254 end; 2255 2256 LastLine := ScreenRowToRow(LinesInWindow+1); 2257 UnsentLineInvalidation := -1; 2258 2259 MaybeDropOldMatches; 2260 FirstKeptValidIdx := DeleteInvalidMatches; 2261 //DebugLnEnter(['>>> ValidateMatches ', FFirstInvalidLine, '-',FLastInvalidLine, ' 1stKeepIdx: ', FirstKeptValidIdx, ' __Cnt=',FMatches.Count, '__ StartP=',dbgs(FStartPoint), ' SearchedToP=', dbgs(FSearchedEnd), ' -- ', SynEdit.Name,'.',ClassName]); try 2262 FindInitialize; 2263 2264 // Get old valid range as OldStartPoint to OldEndPoint 2265 OldStartPoint := FStartPoint; 2266 OldEndPoint := FSearchedEnd; 2267 2268 if not IsPosValid(FSearchedEnd) then 2269 FSearchedEnd.y := -1; 2270 2271 if (OldStartPoint.y >= 0) and not IsPosValid(OldStartPoint) then 2272 OldStartPoint := Point(1, 2273 Min(FLastInvalidLine, MaxInt - AdjustedSearchStrMaxLines) + AdjustedSearchStrMaxLines); 2274 if (OldStartPoint.y < 0) and (FMatches.Count > 0) then 2275 OldStartPoint := FMatches.StartPoint[0]; 2276 2277 if (OldEndPoint.y >= 0) and not IsPosValid(OldEndPoint) then 2278 OldEndPoint := Point(1, FFirstInvalidLine - AdjustedSearchStrMaxLines); 2279 if (OldEndPoint.y < 0) and (FMatches.Count > 0) then 2280 OldEndPoint := FMatches.EndPoint[FMatches.Count-1]; 2281 2282 if (OldEndPoint.y <= OldStartPoint.y) or 2283 (OldEndPoint.y < 0) or (OldStartPoint.y < 0) or 2284 (OldStartPoint.y > LastLine + MATCHES_CLEAN_LINE_KEEP) or 2285 (OldEndPoint.y < TopLine - MATCHES_CLEAN_LINE_KEEP) 2286 then begin 2287 DoFullSearch(True); 2288 exit; 2289 end; 2290 2291 // Find the minimum gap that needs to be cecalculated for invalidated lines 2292 GapStartPoint.y := -1; 2293 GapEndPoint.y := -1; 2294 if FFirstInvalidLine > 0 then begin 2295 i := AdjustedSearchStrMaxLines; 2296 2297 GapStartPoint := point(1, Max(1, FFirstInvalidLine - i)); 2298 if (FirstKeptValidIdx > 0) and 2299 (ComparePoints(GapStartPoint, FMatches.EndPoint[FirstKeptValidIdx-1]) < 0) 2300 then 2301 GapStartPoint := FMatches.EndPoint[FirstKeptValidIdx-1]; // GapStartPoint is before known good point 2302 2303 j := Min(FLastInvalidLine, FLastInvalidLine-i) + i; 2304 GapEndPoint := point(length(SynEdit.Lines[j-1])+1, j); 2305 if (FirstKeptValidIdx >= 0) and (FirstKeptValidIdx < FMatches.Count) and 2306 (ComparePoints(GapEndPoint, FMatches.EndPoint[FirstKeptValidIdx]) > 0) 2307 then 2308 GapEndPoint := FMatches.EndPoint[FirstKeptValidIdx]; // GapEndPoint is after known good point 2309 2310 // Merge ranges (all points are valid / y >= 0) 2311 if (ComparePoints(GapEndPoint, OldStartPoint) <= 0) or 2312 (ComparePoints(OldEndPoint, GapStartPoint) <= 0) 2313 then begin 2314 // gap outside valid range 2315 GapStartPoint.y := -1; 2316 GapEndPoint.y := -1; 2317 end 2318 else 2319 if (ComparePoints(OldStartPoint, GapStartPoint) >= 0) then begin 2320 // gap starts before valid range, move start point 2321 OldStartPoint := GapEndPoint; 2322 GapStartPoint.y := -1; 2323 GapEndPoint.y := -1; 2324 end 2325 else 2326 if (ComparePoints(OldEndPoint, GapEndPoint) <= 0) then begin 2327 // gap ends after valid range, move end point 2328 OldEndPoint := GapStartPoint; 2329 GapStartPoint.y := -1; 2330 GapEndPoint.y := -1; 2331 end; 2332 2333 if (OldEndPoint.y <= OldStartPoint.y) or 2334 (OldEndPoint.y < 0) or (OldStartPoint.y < 0) 2335 then begin 2336 DoFullSearch(True); 2337 exit; 2338 end; 2339 end; 2340 2341 // There is some valid range 2342 // There may be a gap (the gap needs to be inserted at FirstKeptValidIdx) 2343 //DebugLn(['valid: ',dbgs(OldStartPoint),' - ',dbgs(OldEndPoint), ' gap: ',dbgs(GapStartPoint),' - ',dbgs(GapEndPoint)]); 2344 2345 if not ( IsPosValid(FStartPoint) and 2346 ( (IsStartAtMatch0 and (FStartPoint.y < TopLine)) or 2347 ( ( (FStartPoint.y < TopLine - AdjustedSearchStrMaxLines) or 2348 ((FStartPoint.y = TopLine - AdjustedSearchStrMaxLines) and (FStartPoint.x = 1)) 2349 ) and 2350 (FStartPoint.y > TopLine - Max(MATCHES_CLEAN_LINE_THRESHOLD, 2*AdjustedSearchStrMaxLines) ) 2351 ) 2352 ) 2353 ) 2354 then begin 2355 FindStartPointUsedExistingMatch := FindStartPoint(FirstKeptValidIdx); 2356 2357 //, existing point must be in valid range, otherwise: 2358 if not FindStartPointUsedExistingMatch then begin 2359 if IsStartAtMatch0 then begin 2360 Idx := 1; 2361 WorkStartPoint := FMatches.EndPoint[0]; 2362 end else begin 2363 Idx := 0; 2364 WorkStartPoint := FStartPoint; 2365 end; 2366 2367 if ComparePoints(WorkStartPoint, OldEndPoint) >= 1 then begin 2368 // Behind valid range 2369 DoFullSearch(False); 2370 exit; 2371 end; 2372 2373 if ComparePoints(WorkStartPoint, OldStartPoint) < 1 then begin 2374 // Gap before valid range 2375 if OldStartPoint.y > LastLine+SEARCH_START_OFFS then begin 2376 // Delete all, except StartPoint: New search has smaller range than gap 2377 DoFullSearch(False); 2378 exit; 2379 end 2380 else begin 2381 // *** Fill gap at start 2382 Idx2 := Idx; 2383 FindMatches(WorkStartPoint, OldStartPoint, Idx); 2384 //WorkStartPoint := OldStartPoint; 2385 if (not SkipPaint) and (Idx > Idx2) then // TODO: avoid, if only 1 and 1 to hide 2386 MaybeSendLineInvalidation(Idx2, Idx-1); 2387 if (FirstKeptValidIdx >= 0) and (Idx > Idx2) then 2388 inc(FirstKeptValidIdx, Idx-Idx2); 2389 end; 2390 end; 2391 2392 end; 2393 end; 2394 2395 FSearchedEnd := OldEndPoint; 2396 2397 // Search for the Gap 2398 if (GapStartPoint.y >= 0) then begin 2399 Assert((FirstKeptValidIdx >= 0) or (FMatches.Count = 0), 'FirstKeptValidIdx > 0'); 2400 if FirstKeptValidIdx < 0 then 2401 FirstKeptValidIdx := 0; 2402 if (GapStartPoint.y > LastLine) and 2403 ((not HideSingleMatch) or (FirstKeptValidIdx > 1)) 2404 then begin 2405 // no need to search, done with visible area 2406 FMatches.Delete(FirstKeptValidIdx, FMatches.Count); 2407 FSearchedEnd := GapStartPoint; 2408 FinishValidate; 2409 exit; 2410 end; 2411 2412 Idx := FirstKeptValidIdx; 2413 GapStartPoint := FindMatches(GapStartPoint, GapEndPoint, Idx, LastLine); 2414 2415 if (ComparePoints(GapStartPoint, GapEndPoint) < 0) and 2416 HideSingleMatch and (FirstKeptValidIdx < 2) 2417 then 2418 GapStartPoint := FindMatches(GapStartPoint, GapEndPoint, Idx, LastLine); 2419 2420 if (not SkipPaint) and (Idx > FirstKeptValidIdx) then // TODO: avoid, if only 1 and 1 to hide 2421 MaybeSendLineInvalidation(FirstKeptValidIdx, Idx-1); 2422 2423 if (ComparePoints(GapStartPoint, GapEndPoint) < 0) and 2424 ((not HideSingleMatch) or (FirstKeptValidIdx > 1)) 2425 then begin 2426 // searched stopped in gap 2427 assert(GapStartPoint.y >= LastLine, 'GapStartPoint.y >= LastLine'); 2428 FSearchedEnd := GapStartPoint; 2429 FinishValidate; 2430 exit; 2431 end; 2432 end; 2433 2434 // Check at end 2435 if (OldEndPoint.y <= LastLine) then begin 2436 EndOffsLine := min(LastLine+AdjustedSearchStrMaxLines, Lines.Count); // Search only for visible new matches 2437 Idx := FMatches.Count; 2438 Idx2 := Idx; 2439 OldEndPoint.y := OldEndPoint.y - AdjustedSearchStrMaxLines; 2440 if (FMatches.Count > 0) and (ComparePoints(OldEndPoint, FMatches.EndPoint[Idx-1]) < 0) then 2441 OldEndPoint := FMatches.EndPoint[Idx-1]; 2442 p := Point(Length(Lines[EndOffsLine - 1])+1, EndOffsLine); 2443 if ComparePoints(OldEndPoint, p) < 0 then begin 2444 FSearchedEnd := FindMatches(OldEndPoint, p, Idx, LastLine); 2445 if (not SkipPaint) and (Idx > Idx2) and HasVisibleMatch then 2446 MaybeSendLineInvalidation(Idx2, Idx-1); 2447 end; 2448 end; 2449 2450 MaybeExtendForHideSingle; 2451 FinishValidate; 2452 //finally DebugLnExit([' < ValidateMatches Cnt=',FMatches.Count, ' <<< # ', dbgs(FStartPoint), ' - ', dbgs(FSearchedEnd)]); end; 2453end; 2454 2455function TSynEditMarkupHighlightAllBase.HasDisplayAbleMatches: Boolean; 2456begin 2457 Result := (inherited HasDisplayAbleMatches) and 2458 HasSearchData and 2459 ( (not HideSingleMatch) or (Matches.Count > 1) ); 2460end; 2461 2462procedure TSynEditMarkupHighlightAllBase.DoTextChanged(StartLine, EndLine, 2463 ACountDiff: Integer); 2464begin 2465 if (not HasSearchData) then exit; 2466 if ACountDiff = 0 then 2467 InvalidateLines(StartLine, EndLine+1) 2468 else 2469 InvalidateLines(StartLine, MaxInt); // LineCount changed 2470end; 2471 2472procedure TSynEditMarkupHighlightAllBase.DoVisibleChanged(AVisible: Boolean); 2473begin 2474 inherited DoVisibleChanged(AVisible); 2475 if FNeedValidate and SynEdit.IsVisible then 2476 ValidateMatches(True); 2477end; 2478 2479function TSynEditMarkupHighlightAllBase.HasVisibleMatch: Boolean; 2480begin 2481 Result := ( HideSingleMatch and (FMatches.Count > 1) ) or 2482 ( (not HideSingleMatch) and (FMatches.Count > 0) ); 2483end; 2484 2485procedure TSynEditMarkupHighlightAllBase.InvalidateLines(AFirstLine: Integer; 2486 ALastLine: Integer; SkipPaint: Boolean); 2487begin 2488 if AFirstLine < 1 then 2489 AFirstLine := 1; 2490 if (ALastLine < 1) then 2491 ALastLine := MaxInt 2492 else 2493 if ALastLine < AFirstLine then 2494 ALastLine := AFirstLine; 2495 2496 2497 if ( (FStartPoint.y < 0) or (ALastLine >= FStartPoint.y) ) and 2498 ( (FSearchedEnd.y < 0) or (AFirstLine <= FSearchedEnd.y) ) 2499 then begin 2500 if (AFirstLine < FFirstInvalidLine) or (FFirstInvalidLine <= 0) then 2501 FFirstInvalidLine := AFirstLine; 2502 if (ALastLine > FLastInvalidLine) then 2503 FLastInvalidLine := ALastLine; 2504 end; 2505 2506 ValidateMatches(SkipPaint); 2507end; 2508 2509procedure TSynEditMarkupHighlightAllBase.SendLineInvalidation(AFirstIndex: Integer; 2510 ALastIndex: Integer); 2511var 2512 Pos: Integer; 2513 Line1, Line2: Integer; 2514begin 2515 // Inform SynEdit which lines need repainting 2516 if fMatches.Count = 0 then 2517 exit; 2518 2519 if AFirstIndex < 0 then 2520 AFirstIndex := 0; 2521 if (ALastIndex < 0) or (ALastIndex > FMatches.Count - 1) then 2522 ALastIndex := FMatches.Count - 1; 2523 2524 Line1 := fMatches.StartPoint[AFirstIndex].y; 2525 Line2 := fMatches.EndPoint[AFirstIndex].y; 2526 Pos := AFirstIndex; 2527 while (Pos < ALastIndex) 2528 do begin 2529 inc(Pos); 2530 if fMatches.EndPoint[Pos].y <= Line2 then 2531 Continue; 2532 if fMatches.StartPoint[Pos].y <= Line2 + 1 then begin 2533 Line2 := fMatches.EndPoint[Pos].y; 2534 Continue; 2535 end; 2536 2537 InvalidateSynLines(Line1, Line2); 2538 Line1 := fMatches.StartPoint[Pos].y; 2539 Line2 := fMatches.EndPoint[Pos].y; 2540 end; 2541 2542 InvalidateSynLines(Line1, Line2); 2543end; 2544 2545procedure TSynEditMarkupHighlightAllBase.Invalidate(SkipPaint: Boolean); 2546begin 2547 if not SkipPaint then 2548 SendLineInvalidation; 2549 FStartPoint.y := -1; 2550 FSearchedEnd.y := -1; 2551 FMatches.Count := 0; 2552 FFirstInvalidLine := 1; 2553 FLastInvalidLine := MaxInt; 2554 ValidateMatches(SkipPaint); 2555end; 2556 2557{ TSynEditMarkupHighlightAllCaret } 2558 2559procedure TSynEditMarkupHighlightAllCaret.SetWaitTime(const AValue: Integer); 2560begin 2561 if FWaitTime = AValue then exit; 2562 FWaitTime := AValue; 2563 FTimer.Interval := FWaitTime; 2564 if FWaitTime = 0 then 2565 SearchString := ''; 2566 RestartTimer; 2567end; 2568 2569procedure TSynEditMarkupHighlightAllCaret.SearchStringChanged; 2570begin 2571 if SearchString = '' then 2572 FLowBound.X := -1; 2573 FOldLowBound := FLowBound; 2574 FOldUpBound := FUpBound; 2575end; 2576 2577procedure TSynEditMarkupHighlightAllCaret.SetFullWord(const AValue: Boolean); 2578begin 2579 if FFullWord = AValue then exit; 2580 FFullWord := AValue; 2581 SearchOptions := GetCurrentOption; 2582end; 2583 2584procedure TSynEditMarkupHighlightAllCaret.SetFullWordMaxLen(const AValue: Integer); 2585begin 2586 if FFullWordMaxLen = AValue then exit; 2587 FFullWordMaxLen := AValue; 2588 SearchOptions := GetCurrentOption; 2589end; 2590 2591procedure TSynEditMarkupHighlightAllCaret.SetHighlighter(const AValue: TSynCustomHighlighter); 2592begin 2593 if FHighlighter = AValue then exit; 2594 FHighlighter := AValue; 2595 if FIgnoreKeywords and (SearchString <> '') then 2596 ScrollTimerHandler(self); 2597end; 2598 2599procedure TSynEditMarkupHighlightAllCaret.SetIgnoreKeywords(const AValue: Boolean); 2600begin 2601 if FIgnoreKeywords = AValue then exit; 2602 FIgnoreKeywords := AValue; 2603 if Assigned(FHighlighter) and (SearchString <> '') then 2604 ScrollTimerHandler(self); 2605end; 2606 2607procedure TSynEditMarkupHighlightAllCaret.SetSelection(const AValue: TSynEditSelection); 2608begin 2609 if Assigned(FSelection) then 2610 FSelection.RemoveChangeHandler(@SelectionChanged); 2611 FSelection := AValue; 2612 if Assigned(FSelection) then 2613 FSelection.AddChangeHandler(@SelectionChanged); 2614end; 2615 2616procedure TSynEditMarkupHighlightAllCaret.SetTrim(const AValue: Boolean); 2617begin 2618 if FTrim = AValue then exit; 2619 FTrim := AValue; 2620 if (SearchString <> '') then 2621 ScrollTimerHandler(self) 2622 else 2623 RestartTimer; 2624end; 2625 2626procedure TSynEditMarkupHighlightAllCaret.CheckState; 2627var 2628 t: String; 2629begin 2630 if (not FStateChanged) or (Caret = nil) then 2631 exit; 2632 FStateChanged := False; 2633 2634 t := GetCurrentText; 2635 if (SearchString = t) and (SearchOptions = GetCurrentOption) then begin 2636 SearchString := t; // Update old bounds 2637 exit; 2638 end; 2639 2640 if (SearchString <> '') and 2641 ( ((CompareCarets(FLowBound, FOldLowBound) = 0) and 2642 (CompareCarets(Caret.LineBytePos, FUpBound) >= 0) and (MatchCount > 1) ) 2643 OR ((CompareCarets(FUpBound, FOldUpBound) = 0) and 2644 (CompareCarets(Caret.LineBytePos, FLowBound) <= 0) and (MatchCount > 1) ) 2645 ) 2646 then begin 2647 ScrollTimerHandler(self); 2648 exit; 2649 end; 2650 2651 SearchString := ''; 2652 RestartTimer; 2653end; 2654 2655procedure TSynEditMarkupHighlightAllCaret.SelectionChanged(Sender: TObject); 2656begin 2657 FStateChanged := True; // Something changed, paint will be called 2658 inherited; 2659end; 2660 2661procedure TSynEditMarkupHighlightAllCaret.DoCaretChanged(Sender: TObject); 2662begin 2663 FStateChanged := True; // Something changed, paint will be called 2664 inherited; 2665end; 2666 2667procedure TSynEditMarkupHighlightAllCaret.DoTextChanged(StartLine, EndLine, 2668 ACountDiff: Integer); 2669begin 2670 FStateChanged := True; // Something changed, paint will be called 2671 inherited; 2672end; 2673 2674procedure TSynEditMarkupHighlightAllCaret.DoMarkupChanged(AMarkup: TSynSelectedColor); 2675begin 2676 IncPaintLock; 2677 try 2678 inherited DoMarkupChanged(AMarkup); 2679 SearchString := ''; 2680 RestartTimer; 2681 finally 2682 DecPaintLock; 2683 end; 2684end; 2685 2686procedure TSynEditMarkupHighlightAllCaret.RestartTimer; 2687begin 2688 FTimer.Enabled := False; 2689 if not SynEdit.HandleAllocated then begin 2690 FWaitForHandle := True; // HandleCreation will call paintlock, check there 2691 exit; 2692 end; 2693 if (MarkupInfo.IsEnabled) and (FWaitTime > 0) then 2694 FTimer.Enabled := True; 2695end; 2696 2697procedure TSynEditMarkupHighlightAllCaret.ScrollTimerHandler(Sender: TObject); 2698begin 2699 FTimer.Enabled := False; 2700 if not SynEdit.HandleAllocated then begin 2701 FWaitForHandle := True; // HandleCreation will call paintlock, check there 2702 exit; 2703 end; 2704 FWaitForHandle := False; 2705 if (SearchString = GetCurrentText) and (SearchOptions = GetCurrentOption) then 2706 exit; 2707 SearchString := ''; // prevent double update 2708 SearchOptions := GetCurrentOption; 2709 SearchString := GetCurrentText; 2710end; 2711 2712function TSynEditMarkupHighlightAllCaret.GetCurrentText: String; 2713 function TrimS(s: String): String; 2714 var 2715 i: Integer; 2716 begin 2717 i := 1; 2718 while (i <= length(s)) and (s[i] in [#1..#32]) do inc(i); 2719 Result := copy(s, i, MaxInt); 2720 i := length(Result); 2721 while (i > 0) and (Result[i] in [#1..#32]) do dec(i); 2722 Result := copy(Result, 1, i); 2723 end; 2724var 2725 LowBnd, UpBnd: TPoint; 2726 i: integer; 2727begin 2728 if Caret = nil then 2729 exit(''); 2730 if FToggledWord <> '' then 2731 exit(FToggledWord); 2732 If TCustomSynEdit(SynEdit).SelAvail then begin 2733 LowBnd := TCustomSynEdit(SynEdit).BlockBegin; 2734 UpBnd := TCustomSynEdit(SynEdit).BlockEnd; 2735 i := UpBnd.y - LowBnd.y + 1; 2736 if (i > LowBnd.y) and (i > Lines.Count - UpBnd.y) then 2737 exit(''); 2738 if FTrim then 2739 Result := TrimS(TCustomSynEdit(SynEdit).SelText) 2740 else 2741 Result := TCustomSynEdit(SynEdit).SelText; 2742 if TrimS(Result) = '' then Result := ''; 2743 FLowBound := LowBnd; 2744 FUpBound := UpBnd; 2745 end else begin 2746 Result := TCustomSynEdit(SynEdit).GetWordAtRowCol(Caret.LineBytePos); 2747 if FIgnoreKeywords and assigned(FHighlighter) 2748 and FHighlighter.IsKeyword(Result) then 2749 Result := ''; 2750 FLowBound.Y := Caret.LinePos; 2751 FUpBound.Y := Caret.LinePos; 2752 TCustomSynEdit(SynEdit).GetWordBoundsAtRowCol(Caret.LineBytePos, FLowBound.X, FUpBound.X); 2753 end; 2754end; 2755 2756procedure TSynEditMarkupHighlightAllCaret.DoOptionsChanged; 2757begin 2758 if ssoMatchCase in SearchOptions then 2759 FToggledOption:=FToggledOption + [ssoMatchCase] 2760 else 2761 FToggledOption:=FToggledOption - [ssoMatchCase]; 2762end; 2763 2764function TSynEditMarkupHighlightAllCaret.GetCurrentOption: TSynSearchOptions; 2765begin 2766 if FToggledWord <> '' then 2767 exit(FToggledOption); 2768 If TCustomSynEdit(SynEdit).SelAvail or not(FFullWord) then 2769 Result := [] 2770 else 2771 if (FFullWordMaxLen >0) and (UTF8Length(GetCurrentText) > FFullWordMaxLen) then 2772 Result := [] 2773 else 2774 Result := [ssoWholeWord]; 2775 if ssoMatchCase in SearchOptions then 2776 Result := Result + [ssoMatchCase]; 2777end; 2778 2779constructor TSynEditMarkupHighlightAllCaret.Create(ASynEdit: TSynEditBase); 2780begin 2781 inherited Create(ASynEdit); 2782 FWaitForHandle := False; 2783 FStateChanged := False; 2784 FValidateNeeded := False; 2785 HideSingleMatch := True; 2786 FFullWord := False; 2787 FWaitTime := 1500; 2788 FTrim := True; 2789 FLowBound := Point(-1, -1); 2790 FUpBound := Point(-1, -1); 2791 FOldLowBound := Point(-1, -1); 2792 FOldUpBound := Point(-1, -1); 2793 FTimer := TTimer.Create(nil); 2794 FTimer.Enabled := False; 2795 FTimer.Interval := FWaitTime; 2796 FTimer.OnTimer := @ScrollTimerHandler; 2797 MarkupInfo.Clear; // calls RestartTimer 2798end; 2799 2800destructor TSynEditMarkupHighlightAllCaret.Destroy; 2801begin 2802 if Assigned(FSelection) then 2803 FSelection.RemoveChangeHandler(@SelectionChanged); 2804 FreeAndNil(FTimer); 2805 inherited Destroy; 2806end; 2807 2808procedure TSynEditMarkupHighlightAllCaret.DecPaintLock; 2809begin 2810 inherited DecPaintLock; 2811 if FWaitForHandle and SynEdit.HandleAllocated then 2812 ScrollTimerHandler(Self); 2813end; 2814 2815procedure TSynEditMarkupHighlightAllCaret.ToggleCurrentWord; 2816var 2817 s: String; 2818begin 2819 if FToggledWord = '' then begin 2820 FToggledWord := GetCurrentText; 2821 FToggledOption := GetCurrentOption; 2822 end else begin 2823 s := FToggledWord; 2824 FToggledWord := ''; 2825 if GetCurrentText <> s then begin 2826 FToggledWord := GetCurrentText; 2827 FToggledOption := GetCurrentOption; 2828 end; 2829 end; 2830 SearchString := FToggledWord; 2831 SearchOptions := GetCurrentOption; 2832 if FToggledWord = '' then begin 2833 RestartTimer; 2834 end else begin 2835 ScrollTimerHandler(self); 2836 end; 2837end; 2838 2839end. 2840 2841