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