/components/synedit/synhighlightermulti.pas
Pascal | 2023 lines | 1705 code | 197 blank | 121 comment | 230 complexity | 1e0d5448b33fbb746dec220f1af5305e MD5 | raw file
1{------------------------------------------------------------------------------- 2The contents of this file are subject to the Mozilla Public License 3Version 1.1 (the "License"); you may not use this file except in compliance 4with the License. You may obtain a copy of the License at 5http://www.mozilla.org/MPL/ 6 7Software distributed under the License is distributed on an "AS IS" basis, 8WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 9the specific language governing rights and limitations under the License. 10 11The Original Code is: SynHighlighterMulti.pas, released 2000-06-23. 12The Original Code is based on mwMultiSyn.pas by Willo van der Merwe, part of the 13mwEdit component suite. 14 15Contributors to the SynEdit and mwEdit projects are listed in the 16Contributors.txt file. 17 18Alternatively, the contents of this file may be used under the terms of the 19GNU General Public License Version 2 or later (the "GPL"), in which case 20the provisions of the GPL are applicable instead of those above. 21If you wish to allow use of your version of this file only under the terms 22of the GPL and not to allow others to use your version of this file 23under the MPL, indicate your decision by deleting the provisions above and 24replace them with the notice and other provisions required by the GPL. 25If you do not delete the provisions above, a recipient may use your version 26of this file under either the MPL or the GPL. 27 28You may retrieve the latest version of this file at the SynEdit home page, 29located at http://SynEdit.SourceForge.net 30 31-------------------------------------------------------------------------------} 32{ 33@created(1999, converted to SynEdit 2000-06-23) 34@author(Willo van der Merwe <willo@wack.co.za> 35@converted to SynEdit by David Muir <dhm@dmsoftware.co.uk>) 36@mostly rewritten for Lazarus by M. Friebe 04/2010 37 38The SynHighlighterMulti unit provides SynEdit with a multiple-highlighter syntax highlighter. 39This highlighter can be used to highlight text in which several languages are present, such as HTML. 40For example, in HTML as well as HTML tags there can also be JavaScript and/or VBScript present. 41} 42unit SynHighlighterMulti; 43 44{$I synedit.inc} 45 46{$IFDEF SynDebug} 47 {$DEFINE SynDebugMultiHL} 48{$ENDIF} 49 50 51interface 52 53uses 54 Classes, Graphics, SysUtils, LCLProc, math, 55 SynRegExpr, SynEditStrConst, SynEditTypes, SynEditTextBase, 56 SynEditHighlighter, 57 {$IFDEF SynDebugMultiHL}LazLoggerBase{$ELSE}LazLoggerDummy{$ENDIF}, LazUTF8 58 ; 59 60type 61 62 TSynHighlighterMultiScheme=class; 63 TSynMultiSyn = class; 64 65 TSynHLightMultiVirtualSection = record 66 // X(Char): 1-based 67 // Y(Line): 0-based 68 StartPos, EndPos: TPoint; 69 TokenStartPos, TokenEndPos: Integer; 70 VirtualLine: Integer; 71 end; 72 73 PSynHLightMultiVirtualSection = ^TSynHLightMultiVirtualSection; 74 75 { TSynHLightMultiSectionList } 76 (* List of all parts of the original TextBuffer, which are to be scanned by one highlighter *) 77 78 TSynHLightMultiSectionList=class(TSynEditStorageMem) 79 private 80 function GetSection(Index: Integer): TSynHLightMultiVirtualSection; 81 function GetSectionPointer(Index: Integer): PSynHLightMultiVirtualSection; 82 procedure SetSection(Index: Integer; const AValue: TSynHLightMultiVirtualSection); 83 public 84 constructor Create; 85 procedure Debug; 86 procedure Insert(AnIndex: Integer; AnSection: TSynHLightMultiVirtualSection); 87 procedure Delete(AnIndex: Integer); 88 property Sections[Index: Integer]: TSynHLightMultiVirtualSection 89 read GetSection write SetSection; default; 90 property PSections[Index: Integer]: PSynHLightMultiVirtualSection 91 read GetSectionPointer; 92 function IndexOfFirstSectionAtLineIdx(ALineIdx: Integer; ACharPos: Integer = -1; 93 UseNext: Boolean = True): Integer; 94 function IndexOfFirstSectionAtVirtualIdx(ALineIdx: Integer; AGetLastSection: Boolean = False): Integer; 95 function VirtualIdxToRealIdx(AVLineIdx: Integer): Integer; 96 end; 97 98 { TSynHLightMultiVirtualLines } 99 100 TSynHLightMultiVirtualLines=class(TSynEditStringsBase) 101 private 102 FFirstHLChangedLine: Integer; 103 FLastHLChangedLine: Integer; 104 FRangeList: TSynManagedStorageMemList; 105 FRealLines: TSynEditStringsBase; 106 FScheme: TSynHighlighterMultiScheme; 107 FSectionList: TSynHLightMultiSectionList; 108 FRScanStartedWithLineCount: Integer; 109 FRScanStartedAtVLine: Integer; 110 FRegionScanStartRangeIndex: Integer; 111 FRegionScanRangeIndex: Integer; 112 FLastPCharLine: String; 113 protected 114 function GetRange(Index: Pointer): TSynManagedStorageMem; override; 115 procedure PutRange(Index: Pointer; const ARange: TSynManagedStorageMem); override; 116 function Get(Index: integer): string; override; 117 procedure Put(Index: integer; const S: string); override; // should not be called ever 118 function GetCount: integer; override; 119 public 120 constructor Create(ALines: TSynEditStringsBase); 121 destructor Destroy; override; 122 procedure Clear; override; // should not be called ever 123 procedure Delete(Index: Integer); override; // should not be called ever 124 procedure Insert(Index: Integer; const S: string); override; // should not be called ever 125 function GetPChar(ALineIndex: Integer; out ALen: Integer): PChar; override; // experimental 126 procedure SendHighlightChanged(aIndex, aCount: Integer); override; 127 procedure PrepareRegionScan(AStartLineIdx: Integer); 128 procedure FinishRegionScan(AEndLineIdx: Integer); 129 procedure RegionScanUpdateFirstRegionEnd(AnEndPoint: TPoint; ATokenEndPos: Integer); 130 procedure RegionScanUpdateOrInsertRegion(AStartPoint, AnEndPoint: TPoint; 131 ATokenStartPos, ATokenEndPos: Integer); 132 procedure RegionScanUpdateLastRegionStart(AStartPoint: TPoint; 133 ATokenStartPos: Integer; ALineIndex: Integer); 134 procedure RealLinesInserted(AIndex, ACount: Integer); 135 procedure RealLinesDeleted(AIndex, ACount: Integer); 136 procedure RealLinesChanged(AIndex, ACount: Integer); 137 procedure ResetHLChangedLines; 138 property FirstHLChangedLine: Integer read FFirstHLChangedLine; 139 property LastHLChangedLine: Integer read FLastHLChangedLine; 140 property SectionList: TSynHLightMultiSectionList read FSectionList; 141 property Scheme: TSynHighlighterMultiScheme 142 read FScheme write FScheme; 143 end; 144 145 { TSynHLightMultiVirtualLinesList } 146 147 TSynHLightMultiVirtualLinesList=class(TFPList) 148 private 149 function GetVLines(Index: Integer): TSynHLightMultiVirtualLines; 150 procedure PutVLines(Index: Integer; const AValue: TSynHLightMultiVirtualLines); 151 public 152 property Items[Index: Integer]: TSynHLightMultiVirtualLines 153 read GetVLines write PutVLines; default; 154 end; 155 156 TOnCheckMarker=procedure(Sender: TObject; var StartPos, MarkerLen: Integer; 157 var MarkerText: String) of object; 158 159 { TSynHighlighterMultiScheme } 160 161 TSynHighlighterMultiScheme = class(TCollectionItem) 162 private 163 FNeedHLScan: Boolean; 164 FStartExpr, FEndExpr: string; 165 FConvertedStartExpr, FConvertedEndExpr: String; 166 FStartExprScanner, FEndExprScanner: TRegExpr; 167 FStartLineSet, FEndLineSet: Boolean; 168 FLastMatchLen: Integer; 169 FHighlighter: TSynCustomHighLighter; 170 fMarkerAttri: TSynHighlighterAttributes; 171 fSchemeName: TComponentName; 172 fCaseSensitive: Boolean; 173 fOnCheckStartMarker: TOnCheckMarker; 174 fOnCheckEndMarker: TOnCheckMarker; 175 FVirtualLines: TSynHLightMultiVirtualLines; 176 function GetConvertedLine: String; 177 function GetConvertedEndExpr: String; 178 function GetConvertedStartExpr: String; 179 procedure MarkerAttriChanged(Sender: TObject); 180 procedure SetMarkerAttri(const Value: TSynHighlighterAttributes); 181 procedure SetHighlighter(const Value: TSynCustomHighlighter); 182 procedure SetEndExpr(const Value: string); 183 procedure SetStartExpr(const Value: string); 184 procedure SetCaseSensitive(const Value: Boolean); 185 procedure SetVirtualLines(const AValue: TSynHLightMultiVirtualLines); 186 protected 187 function GetDisplayName: String; override; 188 procedure SetDisplayName(const Value: String); override; 189 public 190 constructor Create(TheCollection: TCollection); override; 191 destructor Destroy; override; 192 public 193 procedure ClearLinesSet; 194 function FindStartPosInLine(ASearchPos: Integer): Integer; 195 function FindEndPosInLine(ASearchPos: Integer): Integer; 196 property LastMatchLen: Integer read FLastMatchLen; 197 property NeedHLScan: Boolean read FNeedHLScan; 198 public 199 property VirtualLines: TSynHLightMultiVirtualLines 200 read FVirtualLines write SetVirtualLines; 201 published 202 property CaseSensitive: Boolean read fCaseSensitive write SetCaseSensitive 203 default True; 204 property StartExpr: string read fStartExpr write SetStartExpr; 205 property EndExpr: string read fEndExpr write SetEndExpr; 206 property Highlighter: TSynCustomHighlighter read fHighlighter 207 write SetHighlighter; 208 property MarkerAttri: TSynHighlighterAttributes read fMarkerAttri 209 write SetMarkerAttri; 210 property SchemeName: TComponentName read fSchemeName write fSchemeName; 211 property OnCheckStartMarker: TOnCheckMarker read fOnCheckStartMarker write fOnCheckStartMarker; 212 property OnCheckEndMarker: TOnCheckMarker read fOnCheckEndMarker write fOnCheckEndMarker; 213 end; 214 215 { TSynHighlighterMultiSchemeList } 216 217 TSynHighlighterMultiSchemeList = class(TCollection) 218 private 219 FCurrentLine, FConvertedCurrentLine: String; 220 FOwner: TSynMultiSyn; 221 function GetConvertedCurrentLine: String; 222 function GetItems(Index: integer): TSynHighlighterMultiScheme; 223 procedure SetCurrentLine(const AValue: String); 224 procedure SetItems(Index: integer; const Value: TSynHighlighterMultiScheme); 225 protected 226 function GetOwner: TPersistent; override; 227 procedure Update(Item: TCollectionItem); override; 228 procedure Notify(Item: TCollectionItem;Action: TCollectionNotification); override; 229 public 230 constructor Create(aOwner: TSynMultiSyn); 231 property Items[aIndex: integer]: TSynHighlighterMultiScheme read GetItems write SetItems; 232 default; 233 function IndexOf(AnItem: TSynHighlighterMultiScheme): Integer; 234 public 235 property ConvertedCurrentLine: String read GetConvertedCurrentLine; 236 property CurrentLine: String read FCurrentLine write SetCurrentLine; 237 property Owner: TSynMultiSyn read FOwner; 238 end; 239 240 { TSynHighlighterMultiRangeList } 241 242 TSynHighlighterMultiRangeList = class(TSynHighlighterRangeList) 243 private 244 FLines: TSynEditStringsBase; 245 FDefaultVirtualLines: TSynHLightMultiVirtualLines; 246 FVirtualLines: TSynHLightMultiVirtualLinesList; 247 function GetVirtualLines(Index: TSynHighlighterMultiScheme): TSynHLightMultiVirtualLines; 248 protected 249 procedure LineTextChanged(AIndex: Integer; ACount: Integer = 1); override; 250 procedure InsertedLines(AIndex, ACount: Integer); override; 251 procedure DeletedLines(AIndex, ACount: Integer); override; 252 public 253 constructor Create(ALines: TSynEditStringsBase); 254 destructor Destroy; override; 255 procedure ClearVLines; 256 procedure UpdateForScheme(AScheme: TSynHighlighterMultiSchemeList); 257 procedure CleanUpForScheme(AScheme: TSynHighlighterMultiSchemeList); 258 procedure CopyToScheme(AScheme: TSynHighlighterMultiSchemeList); 259 property DefaultVirtualLines: TSynHLightMultiVirtualLines read FDefaultVirtualLines; 260 property VirtualLines[Index: TSynHighlighterMultiScheme]: TSynHLightMultiVirtualLines 261 read GetVirtualLines; // write SetVirtualLines; 262 end; 263 264 TRunSectionInfo = record 265 SectionIdx: Integer; 266 VirtualStartPos: Integer; // Position in the Virtual line (without token) 267 FirstChar, LastChar: Integer; // Position of the Real Line that is mapped 268 TokenFirstChar, TokenLastChar: Integer; 269 end; 270 271 { TSynMultiSyn } 272 273 TSynMultiSyn = class(TSynCustomHighLighter) 274 private 275 FDefaultLanguageName: String; 276 FCurScheme: TSynHighlighterMultiScheme; 277 function GetCurrentRanges: TSynHighlighterMultiRangeList; 278 function GetDefaultVirtualLines: TSynHLightMultiVirtualLines; 279 function GetKnownMultiRanges(Index: Integer): TSynHighlighterMultiRangeList; 280 procedure SetDefaultHighlighter(const Value: TSynCustomHighLighter); 281 procedure SetSchemes(const Value: TSynHighlighterMultiSchemeList); 282 function CurrentVirtualLines: TSynHLightMultiVirtualLines; 283 protected 284 FSchemes: TSynHighlighterMultiSchemeList; 285 FDefaultHighlighter: TSynCustomHighLighter; 286 FLine: string; 287 FCurLineIndex, FLineLen: Integer; 288 FTokenPos: integer; 289 FTokenKind: integer; 290 FTokenAttr: TSynHighlighterAttributes; 291 FRun: Integer; 292 FRunSectionInfo: Array of TRunSectionInfo; 293 FSampleSource: string; 294 function GetIdentChars: TSynIdentChars; override; 295 function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override; 296 function GetAttribCount: integer; override; 297 function GetAttribute(idx: integer): TSynHighlighterAttributes; override; 298 function GetSampleSource: string; override; 299 procedure SetSampleSource(Value: string); override; 300 301 procedure HookHighlighter(aHL: TSynCustomHighlighter); 302 procedure UnhookHighlighter(aHL: TSynCustomHighlighter); 303 procedure Notification(aComp: TComponent; aOp: TOperation); override; 304 function CreateRangeList(ALines: TSynEditStringsBase): TSynHighlighterRangeList; override; 305 procedure BeforeDetachedFromRangeList(ARangeList: TSynHighlighterRangeList); override; 306 procedure SetCurrentLines(const AValue: TSynEditStringsBase); override; 307 procedure SchemeItemChanged(Item: TObject); 308 procedure SchemeChanged; 309 procedure DetachHighlighter(AHighlighter: TSynCustomHighlighter; AScheme: TSynHighlighterMultiScheme); 310 procedure AttachHighlighter(AHighlighter: TSynCustomHighlighter; AScheme: TSynHighlighterMultiScheme); 311 function PerformScan(StartIndex, EndIndex: Integer; ForceEndIndex: Boolean = False): Integer; override; 312 property CurrentRanges: TSynHighlighterMultiRangeList read GetCurrentRanges; 313 property KnownRanges[Index: Integer]: TSynHighlighterMultiRangeList read GetKnownMultiRanges; 314 public 315 class function GetLanguageName: string; override; 316 public 317 constructor Create(AOwner: TComponent); override; 318 destructor Destroy; override; 319 procedure Next; override; 320 function GetEol: Boolean; override; 321 function GetToken: string; override; 322 procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override; 323 function GetTokenAttribute: TSynHighlighterAttributes; override; 324 function GetTokenKind: integer; override; 325 function GetTokenPos: Integer; override; // 0-based 326 procedure SetLine(const NewValue: string; LineNumber: Integer); override; 327 function GetRange: Pointer; override; 328 procedure SetRange(Value: Pointer); override; 329 procedure ResetRange; override; 330 public 331 property DefaultVirtualLines: TSynHLightMultiVirtualLines read GetDefaultVirtualLines; 332 published 333 property Schemes: TSynHighlighterMultiSchemeList read fSchemes write SetSchemes; 334 property DefaultHighlighter: TSynCustomHighLighter read fDefaultHighlighter 335 write SetDefaultHighlighter; 336 property DefaultLanguageName: String read fDefaultLanguageName 337 write fDefaultLanguageName; 338 end; 339 340function dbgs(const ASect: TSynHLightMultiVirtualSection): String; overload; 341 342implementation 343 344var 345 SYNDEBUG_MULTIHL: PLazLoggerLogGroup; 346 347const 348 TokenKindPerHighlighter = 100; 349 350operator > (p1, p2 : TPoint) b : boolean; 351begin 352 Result := (p1.y > p2.y) or ( (p1.y = p2.y) and (p1.x > p2.x) ); 353end; 354 355operator >= (p1, p2 : TPoint) b : boolean; 356begin 357 Result := (p1.y > p2.y) or ( (p1.y = p2.y) and (p1.x >= p2.x) ); 358end; 359 360operator < (p1, p2 : TPoint) b : boolean; 361begin 362 Result := (p1.y < p2.y) or ( (p1.y = p2.y) and (p1.x < p2.x) ); 363end; 364 365function dbgs(const ASect: TSynHLightMultiVirtualSection): String; 366begin 367 Result := Format('Start=%s, End=%s, VLine=%d, TokStart=%d, TokEnd=%d', 368 [dbgs(ASect.StartPos), dbgs(ASect.EndPos), ASect.VirtualLine, ASect.TokenStartPos, ASect.TokenEndPos]); 369end; 370 371{ TSynHLightMultiSectionList } 372 373function TSynHLightMultiSectionList.GetSection(Index: Integer): TSynHLightMultiVirtualSection; 374begin 375 {$IFDEF AssertSynMemIndex} 376 if (Index < 0) or (Index >= Count) then 377 raise Exception.Create(Format('TSynHLightMultiSectionList.GetSection - Bad Index cnt= %d idx= %d',[Count, Index])); 378 {$ENDIF} 379 Result := PSynHLightMultiVirtualSection(ItemPointer[Index])^; 380end; 381 382function TSynHLightMultiSectionList.GetSectionPointer(Index: Integer): PSynHLightMultiVirtualSection; 383begin 384 {$IFDEF AssertSynMemIndex} 385 if (Index < 0) or (Index >= Count) then 386 raise Exception.Create(Format('TSynHLightMultiSectionList.GetSectionPointer - Bad Index cnt= %d idx= %d',[Count, Index])); 387 {$ENDIF} 388 Result := PSynHLightMultiVirtualSection(ItemPointer[Index]); 389end; 390 391procedure TSynHLightMultiSectionList.SetSection(Index: Integer; 392 const AValue: TSynHLightMultiVirtualSection); 393begin 394 {$IFDEF AssertSynMemIndex} 395 if (Index < 0) or (Index >= Count) then 396 raise Exception.Create(Format('TSynHLightMultiSectionList.SetSection - Bad Index cnt= %d idx= %d',[Count, Index])); 397 {$ENDIF} 398 PSynHLightMultiVirtualSection(ItemPointer[Index])^ := AValue; 399end; 400 401constructor TSynHLightMultiSectionList.Create; 402begin 403 inherited; 404 ItemSize := SizeOf(TSynHLightMultiVirtualSection); 405end; 406 407procedure TSynHLightMultiSectionList.Debug; 408var 409 i: Integer; 410begin 411 debugln(SYNDEBUG_MULTIHL, ['SectionList ', dbgs(self), ' Count=', Count]); 412 for i := 0 to Count - 1 do 413 debugln(SYNDEBUG_MULTIHL, [' ', i, ': ', dbgs(PSections[i]^)]); 414end; 415 416procedure TSynHLightMultiSectionList.Insert(AnIndex: Integer; 417 AnSection: TSynHLightMultiVirtualSection); 418begin 419 InsertRows(AnIndex, 1); 420 Sections[AnIndex] := AnSection; 421end; 422 423procedure TSynHLightMultiSectionList.Delete(AnIndex: Integer); 424begin 425 DeleteRows(AnIndex, 1); 426 if (Capacity > 16) and (Capacity > (Count * 2)) then 427 Capacity := Capacity - (Count div 2); 428end; 429 430function TSynHLightMultiSectionList.IndexOfFirstSectionAtLineIdx(ALineIdx: Integer; 431 ACharPos: Integer = -1; UseNext: Boolean = True): Integer; 432var 433 p, p1, p2: Integer; 434 s: PSynHLightMultiVirtualSection; 435begin 436 Result := -1; 437 p2 := Count; 438 if p2 = 0 then begin 439 if UseNext then Result := 0; 440 exit; 441 end; 442 p1 := p2 div 2; 443 dec(p2); 444 s := PSynHLightMultiVirtualSection(ItemPointer[p1]); 445 if (ALineIdx < s^.StartPos.y) or ( (ALineIdx = s^.StartPos.y) and (ACharPos < s^.StartPos.x) ) 446 then begin // target is in 0 .. p1-1 447 p2 := p1 - 1; 448 p1 := 0; 449 end; 450 451 while (p1 < p2) do begin 452 p := (p1 + p2 + 1) div 2; 453 s := PSynHLightMultiVirtualSection(ItemPointer[p]); 454 if (ALineIdx < s^.StartPos.y) or 455 ( (ALineIdx = s^.StartPos.y) and (ACharPos < s^.StartPos.x) ) 456 then 457 p2 := p - 1 // target is in p1 .. p-1 458 else 459 p1 := p; // target is in p .. p2 460 end; 461 462 s := PSynHLightMultiVirtualSection(ItemPointer[p1]); 463 if ( (s^.StartPos.y > ALineIdx) or ((s^.StartPos.y = ALineIdx) and (s^.StartPos.x > ACharPos)) ) 464 then begin 465 dec(p1); 466 if p1 >= 0 then 467 s := PSynHLightMultiVirtualSection(ItemPointer[p1]); 468 end; 469 470 if (p1 < 0) or (s^.EndPos.y < ALineIdx) or 471 ( (s^.EndPos.y = ALineIdx) and (s^.EndPos.x < ACharPos) ) 472 then begin 473 if UseNext then 474 Result := p1 + 1 // Could be p1 = Count // behind end 475 else 476 Result := -1; 477 end 478 else begin 479 Result := p1; 480 end; 481end; 482 483function TSynHLightMultiSectionList.IndexOfFirstSectionAtVirtualIdx(ALineIdx: Integer; 484 AGetLastSection: Boolean): Integer; 485var 486 p, p1, p2: Integer; 487 s: PSynHLightMultiVirtualSection; 488begin 489 Result := -1; 490 p2 := Count; 491 if p2 = 0 then 492 exit; 493 p1 := p2 div 2; 494 dec(p2); 495 s := PSynHLightMultiVirtualSection(ItemPointer[p1]); 496 if (ALineIdx < s^.VirtualLine) then begin 497 p2 := p1 - 1; // target is in 0 .. p1-1 498 p1 := 0; 499 end; 500 501 while (p1 < p2) do begin 502 p := (p1 + p2 + 1) div 2; 503 s := PSynHLightMultiVirtualSection(ItemPointer[p]); 504 if (ALineIdx < s^.VirtualLine) then 505 p2 := p - 1 // target is in p1 .. p-1 506 else 507 p1 := p; // target is in p .. p2 508 end; 509 510 s := PSynHLightMultiVirtualSection(ItemPointer[p1]); 511 if (ALineIdx = s^.VirtualLine) and (not AGetLastSection) then begin 512 while (p1 >= 0) and (s^.VirtualLine = ALineIdx) do begin 513 dec(p1); 514 if p1 >= 0 then 515 s := PSynHLightMultiVirtualSection(ItemPointer[p1]); 516 end; 517 if (p1 < 0) or (s^.VirtualLine + s^.EndPos.y - s^.StartPos.y < ALineIdx) then 518 inc(p1); 519 end else begin 520 p2 := Count; 521 while (p1 < p2) and (s^.VirtualLine < ALineIdx) do begin 522 inc(p1); 523 if p1 < p2 then 524 s := PSynHLightMultiVirtualSection(ItemPointer[p1]); 525 end; 526 if (p1 = p2) or (s^.VirtualLine > ALineIdx) then 527 dec(p1); 528 end; 529 530 Result := p1; 531end; 532 533function TSynHLightMultiSectionList.VirtualIdxToRealIdx(AVLineIdx: Integer): Integer; 534var 535 i: Integer; 536begin 537 if Count = 0 then exit(AVLineIdx); 538 i := IndexOfFirstSectionAtVirtualIdx(AVLineIdx, True); 539 if i < 0 then exit(AVLineIdx); 540 Result := PSections[i]^.StartPos.y + AVLineIdx; 541end; 542 543{ TSynHLightMultiVirtualLines } 544 545function TSynHLightMultiVirtualLines.GetRange(Index: Pointer): TSynManagedStorageMem; 546begin 547 Result := FRangeList[Index]; 548end; 549 550procedure TSynHLightMultiVirtualLines.PutRange(Index: Pointer; const ARange: TSynManagedStorageMem); 551begin 552 FRangeList[Index] := ARange; 553 if ARange <> nil then begin 554 ARange.Capacity := Count; 555 ARange.Count := Count; 556 end; 557end; 558 559function TSynHLightMultiVirtualLines.Get(Index: integer): string; 560var 561 i, i2, c1, c2: Integer; 562 s: TSynHLightMultiVirtualSection; 563 t: String; 564begin 565 i := FSectionList.IndexOfFirstSectionAtVirtualIdx(Index); 566 if (i < 0) or (i >= FSectionList.Count) then 567 exit(''); 568 s := FSectionList[i]; 569 i2 := s.StartPos.y + Index - s.VirtualLine; 570 t := FRealLines[i2]; 571 c1 := 1; 572 if Index = s.VirtualLine then c1 := s.StartPos.x; 573 c2 := length(t); 574 if Index = s.VirtualLine + s.EndPos.y - s.StartPos.y then c2 := s.EndPos.x; 575 Result := copy(t, c1, c2 - c1 + 1); 576 inc(i); 577 while (i < FSectionList.Count) do begin 578 s := FSectionList[i]; 579 if Index <> s.VirtualLine then break; 580 t := FRealLines[s.StartPos.y]; 581 c1 := s.StartPos.x; 582 c2 := length(t); 583 if s.EndPos.y = s.StartPos.y then c2 := s.EndPos.x; 584 Result := Result + copy(t, c1, c2 - c1 + 1); 585 inc(i); 586 end; 587end; 588 589procedure TSynHLightMultiVirtualLines.Put(Index: integer; const S: string); 590begin 591 raise Exception.Create('Not allowed'); 592end; 593 594procedure TSynHLightMultiVirtualLines.Clear; 595begin 596 raise Exception.Create('Not allowed'); 597end; 598 599procedure TSynHLightMultiVirtualLines.Delete(Index: Integer); 600begin 601 raise Exception.Create('Not allowed'); 602end; 603 604procedure TSynHLightMultiVirtualLines.Insert(Index: Integer; const S: string); 605begin 606 raise Exception.Create('Not allowed'); 607end; 608 609function TSynHLightMultiVirtualLines.GetPChar(ALineIndex: Integer; out ALen: Integer): PChar; 610begin 611 FLastPCharLine := Get(ALineIndex); 612 ALen := length(FLastPCharLine); 613 Result := PChar(FLastPCharLine); 614end; 615 616function TSynHLightMultiVirtualLines.GetCount: integer; 617var 618 s: TSynHLightMultiVirtualSection; 619begin 620 if FSectionList.Count = 0 then 621 exit(0); 622 s := FSectionList[FSectionList.Count - 1]; 623 Result := s.VirtualLine + 1 + s.EndPos.y - s.StartPos.y; 624end; 625 626procedure TSynHLightMultiVirtualLines.SendHighlightChanged(aIndex, aCount: Integer); 627begin 628 if (FFirstHLChangedLine < 0) or (FFirstHLChangedLine > aIndex) then 629 FFirstHLChangedLine := aIndex; 630 if (FLastHLChangedLine < aIndex + aCount - 1) then 631 FLastHLChangedLine := aIndex + aCount - 1; 632end; 633 634constructor TSynHLightMultiVirtualLines.Create(ALines: TSynEditStringsBase); 635begin 636 FRangeList := TSynManagedStorageMemList.Create; 637 FSectionList := TSynHLightMultiSectionList.Create; 638 FRealLines := ALines; 639end; 640 641destructor TSynHLightMultiVirtualLines.Destroy; 642begin 643 inherited Destroy; 644 FreeAndNil(FSectionList); 645 FreeAndNil(FRangeList); 646end; 647 648procedure TSynHLightMultiVirtualLines.PrepareRegionScan(AStartLineIdx: Integer); 649var 650 p: PSynHLightMultiVirtualSection; 651begin 652 FRegionScanRangeIndex := FSectionList.IndexOfFirstSectionAtLineIdx(AStartLineIdx, -1 ,True); 653 FRegionScanStartRangeIndex := FRegionScanRangeIndex; 654 FRScanStartedWithLineCount := Count; 655 if FRegionScanRangeIndex < FSectionList.Count then 656 FRScanStartedAtVLine := FSectionList[FRegionScanRangeIndex].VirtualLine 657 else if FSectionList.Count = 0 then 658 FRScanStartedAtVLine := 0 659 else begin 660 p := FSectionList.PSections[FSectionList.Count - 1]; 661 FRScanStartedAtVLine := p^.VirtualLine + p^.EndPos.y - p^.StartPos.y + 1; 662 end; 663 {$IFDEF SynDebugMultiHL} 664 debugln(SYNDEBUG_MULTIHL, ['TSynHLightMultiVirtualLines.PrepareRegionScan ', dbgs(self), 665 ' FRegionScanRangeIndex=', FRegionScanRangeIndex, ' FRScanStartedWithLineCount=', FRScanStartedWithLineCount, 666 ' FSectionList.Count=', FSectionList.Count, ' FRScanStartedAtVLine=', FRScanStartedAtVLine 667 ]); 668 {$ENDIF} 669end; 670 671procedure TSynHLightMultiVirtualLines.FinishRegionScan(AEndLineIdx: Integer); 672var 673 i, NewVLine, LastVline, LastEnd: Integer; 674 s: TSynHLightMultiVirtualSection; 675 VDiff: Integer; 676begin 677 {$IFDEF SynDebugMultiHL} 678 debugln(SYNDEBUG_MULTIHL, ['TSynHLightMultiVirtualLines.FinishRegionScan AEndLineIdx=', AEndLineIdx]); 679 {$ENDIF} 680 while (FRegionScanRangeIndex < FSectionList.Count) and 681 (FSectionList.Sections[FRegionScanRangeIndex].StartPos.y <= AEndLineIdx) 682 do 683 FSectionList.Delete(FRegionScanRangeIndex); 684 VDiff := 0; 685 {$IFDEF SynDebugMultiHL} 686 DebugLn(SYNDEBUG_MULTIHL, ['***** ', FRegionScanStartRangeIndex, ' cnt ', FSectionList.Count]); 687 {$ENDIF} 688 if FRegionScanStartRangeIndex < FSectionList.Count then begin 689 // fix virtual lines on sections 690 if (FRegionScanStartRangeIndex > 0) then begin 691 s := FSectionList.Sections[FRegionScanStartRangeIndex-1]; 692 NewVLine := s.VirtualLine + s.EndPos.y - s.StartPos.y; 693 {$IFDEF SynDebugMultiHL} 694 DebugLn(SYNDEBUG_MULTIHL, ['A ', NewVLine]); 695 {$ENDIF} 696 LastEnd := s.EndPos.y; 697 end 698 else begin 699 NewVLine := 0; 700 {$IFDEF SynDebugMultiHL} 701 DebugLn(SYNDEBUG_MULTIHL, ['B ', NewVLine]); 702 {$ENDIF} 703 LastEnd := FSectionList.Sections[FRegionScanStartRangeIndex].StartPos.y; 704 end; 705 LastVline := NewVLine; 706 for i := FRegionScanStartRangeIndex to FSectionList.Count - 1 do begin 707 s := FSectionList.Sections[i]; 708 if s.StartPos.y > LastEnd then 709 inc(NewVLine); 710 if i = FRegionScanRangeIndex then 711 VDiff := NewVLine - s.VirtualLine; // adjust ranges 712 FSectionList.PSections[i]^.VirtualLine := NewVLine; 713 NewVLine := NewVLine + s.EndPos.y - s.StartPos.y; 714 LastEnd := s.EndPos.y; 715 end; 716 end 717 else 718 LastVline := 0; // ToDo: Initialize LastVline properly. 719 if VDiff = 0 then 720 VDiff := Count - FRScanStartedWithLineCount; 721 if VDiff < 0 then begin 722 FRangeList.ChildDeleteRows(FRScanStartedAtVLine, -VDiff); 723 FRangeList.CallDeletedLines(FRScanStartedAtVLine, -VDiff); 724 end 725 else if VDiff > 0 then begin 726 FRangeList.ChildInsertRows(FRScanStartedAtVLine, VDiff); 727 FRangeList.CallInsertedLines(FRScanStartedAtVLine, VDiff); 728 end; 729 FRangeList.CallLineTextChanged(FRScanStartedAtVLine, LastVline - FRScanStartedAtVLine + 1); 730end; 731 732procedure TSynHLightMultiVirtualLines.RegionScanUpdateFirstRegionEnd(AnEndPoint: TPoint; 733 ATokenEndPos: Integer); 734var 735 p: PSynHLightMultiVirtualSection; 736begin 737 p := FSectionList.PSections[FRegionScanRangeIndex]; 738 {$IFDEF SynDebugMultiHL} 739 debugln(SYNDEBUG_MULTIHL, ['TSynHLightMultiVirtualLines.RegionScanUpdateFirstRegionEnd', 740 ' AnEndPoint', dbgs(AnEndPoint), ' ATokenEndPos=', ATokenEndPos, ' FRegionScanRangeIndex=', FRegionScanRangeIndex, 741 ' p^.StartPos=', dbgs(p^.StartPos), ' p^.EndPos=', dbgs(p^.EndPos) 742 ]); 743 {$ENDIF} 744 p^.EndPos := AnEndPoint; 745 p^.TokenEndPos := ATokenEndPos; 746 inc(FRegionScanRangeIndex); 747end; 748 749procedure TSynHLightMultiVirtualLines.RegionScanUpdateOrInsertRegion(AStartPoint, 750 AnEndPoint: TPoint; ATokenStartPos, ATokenEndPos: Integer); 751var 752 Sect: TSynHLightMultiVirtualSection; 753 p: PSynHLightMultiVirtualSection; 754begin 755 {$IFDEF SynDebugMultiHL} 756 debugln(SYNDEBUG_MULTIHL, ['TSynHLightMultiVirtualLines.RegionScanUpdateOrInsertRegion', 757 ' AStartPoint=', dbgs(AStartPoint), ' AnEndPoint=', dbgs(AnEndPoint), 758 ' ATokenStartPos=', ATokenStartPos, ' ATokenEndPos=', ATokenEndPos, 759 ' FRegionScanRangeIndex=', FRegionScanRangeIndex 760 ]); 761 {$ENDIF} 762 if (FRegionScanRangeIndex = FSectionList.Count) 763 or (FSectionList.Sections[FRegionScanRangeIndex].StartPos > AnEndPoint) 764 then begin 765 Sect.StartPos := AStartPoint; 766 Sect.EndPos := AnEndPoint; 767 Sect.TokenStartPos := ATokenStartPos; 768 Sect.TokenEndPos := ATokenEndPos; 769 Sect.VirtualLine := 0; 770 FSectionList.Insert(FRegionScanRangeIndex, Sect); 771 end else begin 772 p := FSectionList.PSections[FRegionScanRangeIndex]; 773 p^.StartPos := AStartPoint; 774 p^.EndPos := AnEndPoint; 775 p^.TokenStartPos := ATokenStartPos; 776 p^.TokenEndPos := ATokenEndPos; 777 end; 778 inc(FRegionScanRangeIndex); 779end; 780 781procedure TSynHLightMultiVirtualLines.RegionScanUpdateLastRegionStart(AStartPoint: TPoint; 782 ATokenStartPos: Integer; ALineIndex: Integer); 783var 784 p: PSynHLightMultiVirtualSection; 785begin 786 while (FRegionScanRangeIndex < FSectionList.Count) and 787 (FSectionList.Sections[FRegionScanRangeIndex].EndPos.y <= ALineIndex) 788 do 789 FSectionList.Delete(FRegionScanRangeIndex); 790 p := FSectionList.PSections[FRegionScanRangeIndex]; 791 p^.StartPos := AStartPoint; 792 p^.TokenStartPos := ATokenStartPos; 793 inc(FRegionScanRangeIndex); 794end; 795 796procedure TSynHLightMultiVirtualLines.RealLinesInserted(AIndex, ACount: Integer); 797var 798 i, VLineDiff: Integer; 799 s: TSynHLightMultiVirtualSection; 800 p: PSynHLightMultiVirtualSection; 801begin 802 i := FSectionList.IndexOfFirstSectionAtLineIdx(AIndex, -1, True); 803 if i = FSectionList.Count then exit; 804 VLineDiff := 0; 805 s := FSectionList[i]; 806 if AIndex > s.StartPos.y then begin 807 p := FSectionList.PSections[i]; 808 FRangeList.ChildInsertRows(p^.VirtualLine + AIndex - p^.StartPos.y, ACount); 809 FRangeList.CallInsertedLines(p^.VirtualLine + AIndex - p^.StartPos.y, ACount); 810 p^.EndPos.y := p^.EndPos.y + ACount; 811 inc(i); 812 VLineDiff := ACount; 813 end; 814 while i < FSectionList.Count do begin 815 p := FSectionList.PSections[i]; 816 p^.StartPos.y := p^.StartPos.y + ACount; 817 p^.EndPos.y := p^.EndPos.y + ACount; 818 p^.VirtualLine := p^.VirtualLine + VLineDiff; 819 inc(i); 820 end; 821end; 822 823procedure TSynHLightMultiVirtualLines.RealLinesDeleted(AIndex, ACount: Integer); 824var 825 i: Integer; 826 CountInSection, PrevEndVLine, FirstVLine, VLineCount: Integer; 827 p: PSynHLightMultiVirtualSection; 828 829 procedure DelVLines; 830 begin 831 if VLineCount > 0 then begin 832 FRangeList.ChildDeleteRows(FirstVLine, VLineCount); 833 FRangeList.CallDeletedLines(FirstVLine, VLineCount); 834 end; 835 end; 836begin 837 i := FSectionList.IndexOfFirstSectionAtLineIdx(AIndex, -1, True); 838 if i = FSectionList.Count then exit; 839 840 p := FSectionList.PSections[i]; 841 VLineCount := 0; // Count of deleted virtual lines 842 FirstVLine := p^.VirtualLine; // First deleted virtual line 843 PrevEndVLine := -1; // Keep track of overlap, when next section starts on the same V-line as previous sectian ends 844 if AIndex > p^.StartPos.y then begin 845 // Real-lines starting in the middle of the Section 846 CountInSection := Min(AIndex + ACount, p^.EndPos.y + 1) - AIndex; 847 FirstVLine := p^.VirtualLine + AIndex - p^.StartPos.y; 848 PrevEndVLine := p^.VirtualLine + p^.EndPos.y - p^.EndPos.y; 849 p^.EndPos.y := p^.EndPos.y - CountInSection; 850 inc(i); 851 if i = FSectionList.Count then begin 852 DelVLines; 853 exit; 854 end; 855 p := FSectionList.PSections[i]; 856 VLineCount := CountInSection; 857 end; 858 while p^.EndPos.y < AIndex + ACount do begin 859 // Completly delete node (All Real lines deleted) 860 VLineCount := VLineCount + p^.EndPos.y - p^.StartPos.y + 1; 861 if PrevEndVLine = p^.VirtualLine then 862 dec(VLineCount); 863 PrevEndVLine := p^.VirtualLine + p^.EndPos.y - p^.EndPos.y; 864 FSectionList.Delete(i); 865 if i = FSectionList.Count then begin 866 DelVLines; 867 exit; 868 end; 869 p := FSectionList.PSections[i]; 870 end; 871 if AIndex + ACount > p^.StartPos.y then begin 872 // Some real-lines at the start of section are deleted 873 p^.VirtualLine := p^.VirtualLine - VLineCount; 874 CountInSection := ACount - (p^.StartPos.y - AIndex); 875 VLineCount := VLineCount + CountInSection; 876 if PrevEndVLine = p^.VirtualLine then 877 dec(VLineCount); 878 p^.StartPos.y := p^.StartPos.y - (ACount - CountInSection); 879 p^.EndPos.y := p^.EndPos.y - ACount; 880 assert(p^.EndPos.y >= p^.StartPos.y, 'TSynHLightMultiVirtualLines.RealLinesDeleted: p^.EndPos.y >= p^.StartPos.y'); 881 inc(i); 882 end; 883 884 // Adjust StartPos for all sections, after the deleted. 885 while i < FSectionList.Count do begin 886 p := FSectionList.PSections[i]; 887 p^.StartPos.y := p^.StartPos.y - ACount; 888 p^.EndPos.y := p^.EndPos.y - ACount; 889 p^.VirtualLine := p^.VirtualLine - VLineCount; 890 inc(i); 891 end; 892 893 DelVLines; 894end; 895 896procedure TSynHLightMultiVirtualLines.RealLinesChanged(AIndex, ACount: Integer); 897var 898 i, VLine1, VLine2: Integer; 899 s: TSynHLightMultiVirtualSection; 900begin 901 i := FSectionList.IndexOfFirstSectionAtLineIdx(AIndex, -1, True); 902 if i = FSectionList.Count then exit; 903 s := FSectionList[i]; 904 VLine1 := s.VirtualLine + AIndex - s.StartPos.y; 905 i := FSectionList.IndexOfFirstSectionAtLineIdx(AIndex + ACount - 1, -1, True); 906 if i = FSectionList.Count then 907 VLine2 := Count-1 908 else begin 909 s := FSectionList[i]; 910 VLine2 := s.VirtualLine + AIndex + ACount - 1 - s.StartPos.y; 911 end; 912 FRangeList.CallLineTextChanged(VLine1, VLine2 - VLine1 + 1); 913end; 914 915procedure TSynHLightMultiVirtualLines.ResetHLChangedLines; 916begin 917 FFirstHLChangedLine := -1; 918 FLastHLChangedLine := -1; 919end; 920 921{ TSynHLightMultiVirtualLinesList } 922 923function TSynHLightMultiVirtualLinesList.GetVLines(Index: Integer): TSynHLightMultiVirtualLines; 924begin 925 Result := TSynHLightMultiVirtualLines(inherited Items[Index]); 926end; 927 928procedure TSynHLightMultiVirtualLinesList.PutVLines(Index: Integer; 929 const AValue: TSynHLightMultiVirtualLines); 930begin 931 inherited Items[Index] := AValue; 932end; 933 934{ TSynHighlighterMultiRangeList } 935 936function TSynHighlighterMultiRangeList.GetVirtualLines(Index: TSynHighlighterMultiScheme): TSynHLightMultiVirtualLines; 937var 938 i: Integer; 939begin 940 Result := nil; 941 for i := 0 to FVirtualLines.Count - 1 do 942 if FVirtualLines[i].Scheme = Index then 943 exit(FVirtualLines[i]); 944end; 945 946procedure TSynHighlighterMultiRangeList.LineTextChanged(AIndex: Integer; ACount: Integer); 947var 948 i: Integer; 949begin 950 inherited LineTextChanged(AIndex, ACount); 951 for i := 0 to FVirtualLines.Count - 1 do 952 FVirtualLines[i].RealLinesChanged(AIndex, ACount); 953 FDefaultVirtualLines.RealLinesChanged(AIndex, ACount); 954end; 955 956procedure TSynHighlighterMultiRangeList.InsertedLines(AIndex, ACount: Integer); 957var 958 i: Integer; 959begin 960 inherited InsertedLines(AIndex, ACount); 961 for i := 0 to FVirtualLines.Count - 1 do 962 FVirtualLines[i].RealLinesInserted(AIndex, ACount); 963 FDefaultVirtualLines.RealLinesInserted(AIndex, ACount); 964end; 965 966procedure TSynHighlighterMultiRangeList.DeletedLines(AIndex, ACount: Integer); 967var 968 i: Integer; 969begin 970 inherited DeletedLines(AIndex, ACount); 971 for i := 0 to FVirtualLines.Count - 1 do 972 FVirtualLines[i].RealLinesDeleted(AIndex, ACount); 973 FDefaultVirtualLines.RealLinesDeleted(AIndex, ACount); 974end; 975 976constructor TSynHighlighterMultiRangeList.Create(ALines: TSynEditStringsBase); 977begin 978 inherited Create; 979 FLines := ALines; 980 FVirtualLines := TSynHLightMultiVirtualLinesList.Create; 981end; 982 983destructor TSynHighlighterMultiRangeList.Destroy; 984begin 985 inherited Destroy; 986 ClearVLines; 987 FreeAndNil(FVirtualLines); 988end; 989 990procedure TSynHighlighterMultiRangeList.ClearVLines; 991begin 992 FreeAndNil(FDefaultVirtualLines); 993 while FVirtualLines.Count > 0 do begin 994 FVirtualLines[0].Destroy; 995 FVirtualLines.Delete(0); 996 end; 997 FVirtualLines.Clear; 998end; 999 1000procedure TSynHighlighterMultiRangeList.UpdateForScheme(AScheme: TSynHighlighterMultiSchemeList); 1001var 1002 i: Integer; 1003 NewVline: TSynHLightMultiVirtualLines; 1004begin 1005 for i := FVirtualLines.Count - 1 downto 0 do 1006 if AScheme.IndexOf(FVirtualLines[i].Scheme) < 0 then begin 1007 FVirtualLines[i].Destroy; 1008 FVirtualLines.Delete(i); 1009 end; 1010 if FDefaultVirtualLines = nil then 1011 FDefaultVirtualLines := TSynHLightMultiVirtualLines.Create(FLines); 1012 for i := 0 to AScheme.Count - 1 do 1013 if VirtualLines[AScheme[i]] = nil then begin 1014 NewVline := TSynHLightMultiVirtualLines.Create(FLines); 1015 NewVline.Scheme := AScheme[i]; 1016 FVirtualLines.Add(NewVline); 1017 if AScheme[i].Highlighter <> nil then 1018 AScheme[i].Highlighter.AttachToLines(NewVline); 1019 end; 1020end; 1021 1022procedure TSynHighlighterMultiRangeList.CleanUpForScheme(AScheme: TSynHighlighterMultiSchemeList); 1023// Called before destruction / in detach 1024var 1025 i: Integer; 1026begin 1027 for i := 0 to AScheme.Count - 1 do 1028 if (VirtualLines[AScheme[i]] <> nil) and (AScheme[i].Highlighter <> nil) then 1029 AScheme[i].Highlighter.DetachFromLines(VirtualLines[AScheme[i]]); 1030end; 1031 1032procedure TSynHighlighterMultiRangeList.CopyToScheme(AScheme: TSynHighlighterMultiSchemeList); 1033var 1034 i: Integer; 1035begin 1036 for i := 0 to AScheme.Count - 1 do 1037 AScheme[i].VirtualLines := FVirtualLines[i]; 1038end; 1039 1040{ TSynMultiSyn } 1041 1042function TSynMultiSyn.CurrentVirtualLines: TSynHLightMultiVirtualLines; 1043begin 1044 if FCurScheme <> nil then 1045 Result := FCurScheme.VirtualLines 1046 else 1047 Result := DefaultVirtualLines; 1048end; 1049 1050constructor TSynMultiSyn.Create(AOwner: TComponent); 1051begin 1052 inherited Create(AOwner); 1053 fSchemes := TSynHighlighterMultiSchemeList.Create(Self); 1054 FCurScheme := nil; 1055end; 1056 1057destructor TSynMultiSyn.Destroy; 1058var 1059 s: TSynHighlighterMultiSchemeList; 1060begin 1061 s := FSchemes; 1062 FSchemes := nil; 1063 s.Free; 1064 { unhook notification handlers } 1065 DefaultHighlighter := nil; 1066 inherited Destroy; 1067end; 1068 1069function TSynMultiSyn.PerformScan(StartIndex, EndIndex: Integer; ForceEndIndex: Boolean = False): Integer; 1070var 1071 i, j, c: Integer; 1072 SearchPos, NewSearchPos, TmpSearchPos: Integer; 1073 CurRegStart: TPoint; 1074 CurRegTokenPos: Integer; 1075 LineText: string; 1076 1077 procedure StartScheme(NewScheme: TSynHighlighterMultiScheme; 1078 StartAtLine, StartAtChar, TokenAtChar: Integer); 1079 var 1080 pt: TPoint; 1081 begin 1082 //debugln(['StartScheme NewScheme=',dbgs(NewScheme),' StartAtLine=',StartAtLine,' StartAtChar=',StartAtChar,' TokenAtChar=',TokenAtChar]); 1083 pt := Point(TokenAtChar-1, StartAtLine); 1084 if CurRegStart.y < 0 then 1085 DefaultVirtualLines.RegionScanUpdateFirstRegionEnd(pt, 0) 1086 else 1087 if pt >= CurRegStart then 1088 DefaultVirtualLines.RegionScanUpdateOrInsertRegion(CurRegStart, pt, 0, 0); 1089 1090 FCurScheme := NewScheme; 1091 CurRegStart.y := StartAtLine; 1092 CurRegStart.x := StartAtChar; 1093 CurRegTokenPos := TokenAtChar; 1094 end; 1095 1096 procedure EndScheme(EndAtLine, EndAtChar, TokenEndChar: Integer); 1097 var 1098 pt: TPoint; 1099 begin 1100 //debugln(['EndScheme EndAtLine=',EndAtLine,' EndAtChar=',EndAtChar,' TokenAtChar=',TokenEndChar]); 1101 pt := Point(EndAtChar, EndAtLine); 1102 if CurRegStart.y < 0 then 1103 FCurScheme.VirtualLines.RegionScanUpdateFirstRegionEnd(pt, TokenEndChar) 1104 else 1105 if pt >= CurRegStart then 1106 FCurScheme.VirtualLines.RegionScanUpdateOrInsertRegion 1107 (CurRegStart, pt, CurRegTokenPos, TokenEndChar); 1108 1109 FCurScheme := nil; 1110 CurRegStart.y := EndAtLine; 1111 CurRegStart.x := TokenEndChar + 1; 1112 CurRegTokenPos := 0; 1113 end; 1114 1115begin 1116 (* Scan regions *) 1117 Result := StartIndex; 1118 {$IFDEF SynDebugMultiHL} 1119 debugln(SYNDEBUG_MULTIHL, ['TSynMultiSyn.PerformScan StartIndex=', Result]); 1120 {$ENDIF} 1121 1122 // last node may need to extend to next line 1123 // TODO: instead check, that FCurScheme is cvered by region 1124 // p := DefaultVirtualLines.SectionList.PSections[DefaultVirtualLines.FRegionScanRangeIndex] 1125 // p := FCurScheme.VirtualLines .SectionList.PSections[FCurScheme.VirtualLines.FRegionScanRangeIndex]; 1126 if Result > 0 then dec(Result); 1127 1128 c := CurrentLines.Count - 1; 1129 if c < 0 then begin 1130 // Clear ? 1131 exit; 1132 end; 1133 1134 DefaultVirtualLines.PrepareRegionScan(Result); 1135 for i := 0 to Schemes.Count - 1 do begin 1136 Schemes[i].VirtualLines.ResetHLChangedLines; 1137 Schemes[i].VirtualLines.PrepareRegionScan(Result); 1138 end; 1139 1140 1141 CurRegStart.y := -1; 1142 if Result = 0 then begin 1143 CurRegStart.y := 0; 1144 CurRegStart.x := 1; 1145 CurRegTokenPos := 1; 1146 end 1147 else 1148 CurRegTokenPos := 0; 1149 StartAtLineIndex(Result); // Set FCurScheme 1150 1151 dec(Result); 1152 repeat 1153 inc(Result); 1154 if Result <> StartIndex then 1155 ContinueNextLine; 1156 1157 LineText := CurrentLines[Result]; 1158 FSchemes.CurrentLine := LineText; 1159 SearchPos := 1; 1160 while SearchPos <= length(LineText) do begin 1161 if FCurScheme <> nil then begin 1162 // Find Endpoint for CurScheme 1163 NewSearchPos := FCurScheme.FindEndPosInLine(SearchPos); 1164 if NewSearchPos <= 0 then 1165 break; // Ends in next line 1166 SearchPos := NewSearchPos + FCurScheme.LastMatchLen; 1167 EndScheme(Result, NewSearchPos - 1, SearchPos - 1); 1168 end 1169 else begin 1170 // Find new start of a Scheme 1171 NewSearchPos := -1; 1172 for i := 0 to Schemes.Count - 1 do begin 1173 TmpSearchPos := Schemes.Items[i].FindStartPosInLine(SearchPos); 1174 if (NewSearchPos < 0) or ((TmpSearchPos > 0) and (TmpSearchPos < NewSearchPos)) then begin 1175 j := i; 1176 NewSearchPos := TmpSearchPos; 1177 end; 1178 end; 1179 if NewSearchPos <= 0 then 1180 break; // Not in this line 1181 SearchPos := NewSearchPos + Schemes[j].LastMatchLen; 1182 StartScheme(Schemes[j], Result, SearchPos, NewSearchPos); 1183 end; 1184 end; 1185 1186 until ((not UpdateRangeInfoAtLine(Result)) and (Result > EndIndex)) 1187 or (Result = c); 1188 1189 if Result = c then begin 1190 i := length(CurrentLines[c]) + 1; 1191 if FCurScheme = nil then 1192 StartScheme(nil, c, i, i) // DefaultVirtualLines.RegionScanUpdateFirstRegionEnd(pt, 0) 1193 else 1194 EndScheme(c, i, i); 1195 end 1196 else if CurRegStart.y > 0 then begin 1197 if FCurScheme = nil 1198 then DefaultVirtualLines.RegionScanUpdateLastRegionStart(CurRegStart, 0, Result) 1199 else FCurScheme.VirtualLines.RegionScanUpdateLastRegionStart(CurRegStart, CurRegTokenPos, Result); 1200 end 1201 else begin 1202 // nothing changed, keep current 1203 if FCurScheme = nil 1204 then inc(DefaultVirtualLines.FRegionScanRangeIndex) 1205 else inc(FCurScheme.VirtualLines.FRegionScanRangeIndex); 1206 end; 1207 1208 DefaultVirtualLines.FinishRegionScan(Result); 1209 for i := 0 to Schemes.Count - 1 do 1210 Schemes[i].VirtualLines.FinishRegionScan(Result); 1211 1212 (* Scan nested Highlighters *) 1213 for i := 0 to Schemes.Count - 1 do 1214 if Schemes[i].Highlighter <> nil then begin 1215 Schemes[i].Highlighter.ScanRanges; 1216 j := Schemes[i].VirtualLines.SectionList.VirtualIdxToRealIdx(Schemes[i].VirtualLines.LastHLChangedLine); 1217 if Result < j then 1218 Result := j; 1219 end; 1220 if FDefaultHighlighter <> nil then begin 1221 FDefaultHighlighter.ScanRanges; 1222 j := DefaultVirtualLines.SectionList.VirtualIdxToRealIdx(DefaultVirtualLines.LastHLChangedLine); 1223 if Result < j then 1224 Result := j; 1225 end; 1226end; 1227 1228function TSynMultiSyn.GetAttribCount: integer; 1229var 1230 i: Integer; 1231begin 1232 Result := Schemes.Count; 1233 for i := 0 to Schemes.Count - 1 do 1234 if Schemes[i].Highlighter <> nil then 1235 inc(Result, Schemes[i].Highlighter.AttrCount); 1236 if DefaultHighlighter <> nil then 1237 Inc(Result, DefaultHighlighter.AttrCount); 1238end; 1239 1240function TSynMultiSyn.GetAttribute( 1241 idx: integer): TSynHighlighterAttributes; 1242var 1243 i, j: Integer; 1244begin 1245 if DefaultHighlighter <> nil then begin 1246 j := DefaultHighlighter.AttrCount; 1247 if idx < j then 1248 exit(DefaultHighlighter.Attribute[idx]); 1249 dec(idx, j); 1250 end; 1251 1252 for i := 0 to Schemes.Count - 1 do begin 1253 if idx = 0 then 1254 exit(Schemes[i].MarkerAttri); 1255 dec(idx); 1256 if Schemes[i].Highlighter <> nil then begin 1257 j := Schemes[i].Highlighter.AttrCount; 1258 if idx < j then 1259 exit(Schemes[i].Highlighter.Attribute[idx]); 1260 dec(idx, j); 1261 end; 1262 end; 1263 1264 Result := nil; 1265 raise Exception.Create('bad attr idx'); 1266end; 1267 1268function TSynMultiSyn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; 1269var 1270 iHL: TSynCustomHighlighter; 1271begin 1272 if (FCurScheme <> nil) and (FCurScheme.Highlighter <> nil) then 1273 iHL := FCurScheme.Highlighter 1274 else 1275 iHL := DefaultHighlighter; 1276 { the typecast to TSynMultiSyn is only necessary because the 1277 GetDefaultAttribute method is protected. 1278 And don't worry: this really works } 1279 if iHL <> nil then begin 1280 Result := TSynMultiSyn(iHL).GetDefaultAttribute(Index) 1281 end else 1282 Result := nil; 1283end; 1284 1285function TSynMultiSyn.GetEol: Boolean; 1286begin 1287 Result := FTokenPos > FLineLen; 1288end; 1289 1290function TSynMultiSyn.GetIdentChars: TSynIdentChars; 1291begin 1292 if FCurScheme <> nil then 1293 Result := FCurScheme.Highlighter.IdentChars 1294 else if DefaultHighlighter <> nil then 1295 Result := DefaultHighlighter.IdentChars 1296 else 1297 Result := inherited GetIdentChars; 1298end; 1299 1300class function TSynMultiSyn.GetLanguageName: string; 1301begin 1302 Result := SYNS_LangGeneralMulti; 1303end; 1304 1305function TSynMultiSyn.GetRange: Pointer; 1306begin 1307 Result := FCurScheme; 1308end; 1309 1310function TSynMultiSyn.GetToken: string; 1311begin 1312 SetString(Result, (PChar(FLine) + FTokenPos - 1), FRun - FTokenPos); 1313end; 1314 1315procedure TSynMultiSyn.GetTokenEx(out TokenStart: PChar; 1316 out TokenLength: integer); 1317begin 1318 TokenLength := FRun-FTokenPos; 1319 if TokenLength > 0 then begin 1320 TokenStart := @fLine[FTokenPos]; 1321 end else begin 1322 TokenStart := nil; 1323 end; 1324end; 1325 1326function TSynMultiSyn.GetTokenAttribute: TSynHighlighterAttributes; 1327begin 1328 Result := FTokenAttr; 1329end; 1330 1331function TSynMultiSyn.GetTokenKind: integer; 1332begin 1333 Result := FTokenKind; 1334end; 1335 1336function TSynMultiSyn.GetTokenPos: Integer; 1337begin 1338 Result := fTokenPos - 1; 1339end; 1340 1341procedure TSynMultiSyn.HookHighlighter(aHL: TSynCustomHighlighter); 1342begin 1343 aHL.HookAttrChangeEvent( @DefHighlightChange ); 1344end; 1345 1346procedure TSynMultiSyn.Next; 1347 procedure NextRunSection(ASchemeIdx: Integer); 1348 var 1349 VLines: TSynHLightMultiVirtualLines; 1350 idx: Integer; 1351 s: TSynHLightMultiVirtualSection; 1352 x1, x2, tx1, tx2: Integer; 1353 begin 1354 if ASchemeIdx > 0 then 1355 VLines := Schemes[ASchemeIdx-1].VirtualLines 1356 else 1357 VLines := DefaultVirtualLines; 1358 1359 idx := FRunSectionInfo[ASchemeIdx].SectionIdx + 1; 1360 FRunSectionInfo[ASchemeIdx].SectionIdx := -1; 1361 if (idx < 0) or (idx >= VLines.SectionList.Count) then 1362 exit; 1363 s := VLines.SectionList[idx]; 1364 if s.StartPos.y > FCurLineIndex then 1365 exit; 1366 1367 FRunSectionInfo[ASchemeIdx].SectionIdx := idx; 1368 FRunSectionInfo[ASchemeIdx].VirtualStartPos := 1369 FRunSectionInfo[ASchemeIdx].VirtualStartPos + 1370 FRunSectionInfo[ASchemeIdx].LastChar - FRunSectionInfo[ASchemeIdx].FirstChar + 1; 1371 if s.StartPos.y = FCurLineIndex then begin 1372 x1 := s.StartPos.x; 1373 tx1 := s.TokenStartPos; 1374 if tx1 = 0 then 1375 tx1 := x1; 1376 end else begin 1377 x1 := 1; 1378 tx1 := 1; 1379 end; 1380 if s.EndPos.y = FCurLineIndex then begin 1381 x2 := s.EndPos.x; 1382 tx2 := s.TokenEndPos; 1383 if tx2 = 0 then 1384 tx2 := x2; 1385 end else begin 1386 x2 := length(CurrentLines[FCurLineIndex]); 1387 tx2 := x2; 1388 end; 1389 FRunSectionInfo[ASchemeIdx].FirstChar := x1; 1390 FRunSectionInfo[ASchemeIdx].LastChar := x2; 1391 FRunSectionInfo[ASchemeIdx].TokenFirstChar := tx1; 1392 FRunSectionInfo[ASchemeIdx].TokenLastChar := tx2; 1393 end; 1394 1395var 1396 idx: Integer; 1397 RSect: TRunSectionInfo; 1398 HL: TSynCustomHighlighter; 1399 dummy: PChar; 1400 tkpos, tklen: Integer; 1401begin 1402 //debugln(['--- Next at ',FRun]); 1403 FTokenPos := FRun; 1404 FTokenAttr := nil; 1405 FTokenKind := 0; 1406 if FRun > FLineLen then 1407 exit; 1408 1409 idx := high(FRunSectionInfo); 1410 while (idx >= 0) and 1411 ( (FRunSectionInfo[idx].SectionIdx < 0) or 1412 not ( (FRun >= FRunSectionInfo[idx].TokenFirstChar) and 1413 (FRun <= FRunSectionInfo[idx].TokenLastChar) ) ) 1414 do 1415 dec(idx); 1416 1417 if idx < 0 then begin 1418 //debugln(['*** XXXXX No section found XXXXX ***']); 1419 FRun := FLineLen + 1; 1420 FTokenAttr := nil; 1421 FTokenKind := 0; 1422 exit; 1423 end; 1424 1425 RSect := FRunSectionInfo[idx]; 1426 //with RSect do debugln([' RSect ',idx,': SectIdx=', SectionIdx, ' Fc=',FirstChar,' LC=',LastChar,' TkFC=',TokenFirstChar, ' TkLC=',TokenLastChar]); 1427 if RSect.SectionIdx < 0 then begin 1428 //debugln(['*** XXXXX section missing XXXXX ***']); 1429 FRun := FLineLen + 1; 1430 FTokenAttr := nil; 1431 FTokenKind := 0; 1432 exit; 1433 end; 1434 1435 if (idx > 0) and (FRun < RSect.FirstChar) then begin 1436 FTokenAttr := Schemes[idx-1].FMarkerAttri; 1437 FTokenKind := 1; 1438 FRun := RSect.FirstChar; 1439 //debugln([' start-token ', FRun]); 1440 end 1441 else if (idx > 0) and (FRun > RSect.LastChar) then begin 1442 FTokenAttr := Schemes[idx-1].FMarkerAttri; 1443 FTokenKind := 1; 1444 FRun := RSect.TokenLastChar + 1; 1445 //debugln([' end-token ', FRun]); 1446 end 1447 else begin 1448 if idx = 0 then 1449 HL := DefaultHighlighter 1450 else 1451 HL := Schemes[idx-1].Highlighter; 1452 1453 if HL <> nil then begin 1454 repeat 1455 HL.GetTokenEx(dummy, tklen); 1456 tkpos := HL.GetTokenPos + 1; 1457 if tkpos - RSect.VirtualStartPos + RSect.FirstChar + tklen - 1 < FRun then begin 1458 //debugln('>'); 1459 HL.Next 1460 end else 1461 break; 1462 until HL.GetEol; 1463 if not HL.GetEol then begin 1464 FTokenAttr := HL.GetTokenAttribute; 1465 FTokenKind := idx * TokenKindPerHighlighter + HL.GetTokenKind; 1466 FRun := Min(tkpos - RSect.VirtualStartPos + RSect.FirstChar + tklen, 1467 RSect.LastChar + 1); 1468 //debugln([' FOUND-token ', FRun, ' t=',copy(FLine, FTokenPos, 2),'... kind=',FTokenKind, ' subhl: tkpos=',tkpos,' tklen=',tklen, ' t=', copy(dummy,1,tklen) ]); 1469 end 1470 else 1471 HL := nil; 1472 end; 1473 1474 if (HL = nil) then begin 1475 FTokenAttr := nil; 1476 FTokenKind := 0; 1477 FRun := RSect.LastChar + 1; 1478 //debugln([' no HL ', FRun]); 1479 end; 1480 end; 1481 1482 if (FRun > RSect.TokenLastChar) then 1483 NextRunSection(idx); 1484end; 1485 1486procedure TSynMultiSyn.Notification(aComp: TComponent; aOp: TOperation); 1487var 1488 i: Integer; 1489begin 1490 inherited; 1491 if (aOp = opRemove) and (Schemes <> nil) then begin 1492 if (aComp = DefaultHighlighter) then 1493 DefaultHighlighter := nil; 1494 for i := 0 to Schemes.Count - 1 do 1495 if aComp = Schemes[i].Highlighter then 1496 Schemes[i].Highlighter := nil; 1497 end; 1498end; 1499 1500function TSynMultiSyn.CreateRangeList(ALines: TSynEditStringsBase): TSynHighlighterRangeList; 1501var 1502 NewRangeList: TSynHighlighterMultiRangeList; 1503begin 1504 NewRangeList := TSynHighlighterMultiRangeList.Create(ALines); 1505 NewRangeList.UpdateForScheme(Schemes); 1506 NewRangeList.CopyToScheme(Schemes); 1507 if FDefaultHighlighter <> nil then 1508 FDefaultHighlighter.AttachToLines(NewRangeList.DefaultVirtualLines); 1509 Result := NewRangeList; 1510end; 1511 1512procedure TSynMultiSyn.BeforeDetachedFromRangeList(ARangeList: TSynHighlighterRangeList); 1513begin 1514 inherited BeforeDetachedFromRangeList(ARangeList); 1515 if (Schemes <> nil) and (ARangeList.RefCount = 0) then begin 1516 TSynHighlighterMultiRangeList(ARangeList).CleanUpForScheme(Schemes); 1517 if (TSynHighlighterMultiRangeList(ARangeList).DefaultVirtualLines <> nil) and 1518 (DefaultHighlighter <> nil) 1519 then 1520 DefaultHighlighter.DetachFromLines(TSynHighlighterMultiRangeList(ARangeList).DefaultVirtualLines); 1521 end; 1522end; 1523 1524procedure TSynMultiSyn.SetCurrentLines(const AValue: TSynEditStringsBase); 1525begin 1526 inherited SetCurrentLines(AValue); 1527 CurrentRanges.CopyToScheme(Schemes); 1528 if FDefaultHighlighter <> nil then 1529 FDefaultHighlighter.CurrentLines := CurrentRanges.DefaultVirtualLines; 1530end; 1531 1532procedure TSynMultiSyn.ResetRange; 1533begin 1534 FCurScheme := nil; 1535 if DefaultHighlighter <> nil then begin 1536 DefaultHighlighter.ResetRange; 1537 end; 1538end; 1539 1540procedure TSynMultiSyn.SetDefaultHighlighter( 1541 const Value: TSynCustomHighLighter); 1542const 1543 sDefaultHlSetToSelf = 'Not allowed'; 1544var 1545 i: Integer; 1546begin 1547 if DefaultHighlighter = Value then exit; 1548 if Value = Self then 1549 raise Exception.Create( sDefaultHlSetToSelf ); 1550 if DefaultHighlighter <> nil then begin 1551 DefaultHighlighter.RemoveFreeNotification(Self); 1552 UnhookHighlighter( DefaultHighlighter ); 1553 for i := 0 to KnownLines.Count - 1 do 1554 DefaultHighlighter.DetachFromLines(KnownRanges[i].DefaultVirtualLines); 1555 end; 1556 fDefaultHighlighter := Value; 1557 if DefaultHighlighter <> nil then begin 1558 HookHighlighter( DefaultHighlighter ); 1559 DefaultHighlighter.FreeNotification(Self); 1560 for i := 0 to KnownLines.Count - 1 do 1561 DefaultHighlighter.AttachToLines(KnownRanges[i].DefaultVirtualLines); 1562 end; 1563 { yes, it's necessary } 1564 if not( csDestroying in ComponentState ) then 1565 DefHighlightChange( Self ); 1566end; 1567 1568function TSynMultiSyn.GetDefaultVirtualLines: TSynHLightMultiVirtualLines; 1569begin 1570 Result := CurrentRanges.DefaultVirtualLines; 1571end; 1572 1573function TSynMultiSyn.GetKnownMultiRanges(Index: Integer): TSynHighlighterMultiRangeList; 1574begin 1575 Result := TSynHighlighterMultiRangeList(inherited KnownRanges[Index]) 1576end; 1577 1578function TSynMultiSyn.GetCurrentRanges: TSynHighlighterMultiRangeList; 1579begin 1580 Result := TSynHighlighterMultiRangeList(inherited CurrentRanges) 1581end; 1582 1583procedure TSynMultiSyn.SetLine(const NewValue: string; 1584 LineNumber: Integer); 1585 procedure InitRunSection(ASchemeIdx: Integer); 1586 var 1587 VLines: TSynHLightMultiVirtualLines; 1588 HL: TSynCustomHighlighter; 1589 s: TSynHLightMultiVirtualSection; 1590 idx, x1, x2, tx1, tx2: Integer; 1591 begin 1592 FRunSectionInfo[ASchemeIdx].SectionIdx := -1; 1593 if ASchemeIdx > 0 then begin 1594 VLines := Schemes[ASchemeIdx-1].VirtualLines; 1595 HL := Schemes[ASchemeIdx-1].Highlighter; 1596 end else begin 1597 VLines := DefaultVirtualLines; 1598 HL := DefaultHighlighter; 1599 end; 1600 idx := VLines.SectionList.IndexOfFirstSectionAtLineIdx(FCurLineIndex); 1601 if (idx < 0) or (idx >= VLines.SectionList.Count) then 1602 exit; 1603 s := VLines.SectionList[idx]; 1604 if s.StartPos.y > FCurLineIndex then 1605 exit; 1606 1607 FRunSectionInfo[ASchemeIdx].SectionIdx := idx; 1608 FRunSectionInfo[ASchemeIdx].VirtualStartPos := 1; 1609 if s.StartPos.y = FCurLineIndex then begin 1610 x1 := s.StartPos.x; 1611 tx1 := s.TokenStartPos; 1612 if tx1 = 0 then 1613 tx1 := x1; 1614 end else begin 1615 x1 := 1; 1616 tx1 := 1; 1617 end; 1618 if s.EndPos.y = FCurLineIndex then begin 1619 x2 := s.EndPos.x; 1620 tx2 := s.TokenEndPos; 1621 if tx2 = 0 then 1622 tx2 := x2; 1623 end else begin 1624 x2 := length(CurrentLines[FCurLineIndex]); 1625 tx2 := x2; 1626 end; 1627 FRunSectionInfo[ASchemeIdx].FirstChar := x1; 1628 FRunSectionInfo[ASchemeIdx].LastChar := x2; 1629 FRunSectionInfo[ASchemeIdx].TokenFirstChar := tx1; 1630 FRunSectionInfo[ASchemeIdx].TokenLastChar := tx2; 1631 1632 if HL <> nil then 1633 HL.StartAtLineIndex(s.VirtualLine + FCurLineIndex - s.StartPos.y); 1634 //with FRunSectionInfo[ASchemeIdx] do debugln([' RunSection ',ASchemeIdx,': SectIdx=', SectionIdx, ' Fc=',FirstChar,' LC=',LastChar,' TkFC=',TokenFirstChar, ' TkLC=',TokenLastChar, ' VLine=',s.VirtualLine + FCurLineIndex - s.StartPos.y]); 1635 end; 1636var 1637 i: Integer; 1638begin 1639 if IsScanning then exit; 1640 inherited; 1641 1642 FCurLineIndex := LineNumber; 1643 FLine := NewValue; 1644 FLineLen := length(FLine); 1645 fRun := 1; 1646 FTokenPos := 1; 1647 FTokenAttr := nil; 1648 FTokenKind := 0; 1649 //debugln(['>>>>> Setting Line ',FCurLineIndex,' = ',FLine]); 1650 for i := 0 to high(FRunSectionInfo) do 1651 InitRunSection(i); 1652 Next; 1653end; 1654 1655procedure TSynMultiSyn.SetRange(Value: Pointer); 1656begin 1657 inherited; 1658 FCurScheme := TSynHighlighterMultiScheme(Value); 1659end; 1660 1661procedure TSynMultiSyn.SetSchemes(const Value: TSynHighlighterMultiSchemeList); 1662begin 1663 fSchemes.Assign(Value); 1664end; 1665 1666procedure TSynMultiSyn.UnhookHighlighter(aHL: TSynCustomHighlighter); 1667begin 1668 if csDestroying in aHL.ComponentState then 1669 Exit; 1670 aHL.UnhookAttrChangeEvent( @DefHighlightChange ); 1671end; 1672 1673function TSynMultiSyn.GetSampleSource: string; 1674begin 1675 Result := fSampleSource; 1676end; 1677 1678procedure TSynMultiSyn.SetSampleSource(Value: string); 1679begin 1680 fSampleSource := Value; 1681end; 1682 1683procedure TSynMultiSyn.SchemeItemChanged(Item: TObject); 1684var 1685 i: Integer; 1686begin 1687 if Schemes = nil then exit; 1688 FAttributeChangeNeedScan := (Item <> nil) and (TSynHighlighterMultiScheme(Item).NeedHLScan); 1689 DefHighlightChange( Item ); 1690 for i := 0 to KnownLines.Count - 1 do 1691 KnownRanges[i].InvalidateAll; 1692end; 1693 1694procedure TSynMultiSyn.SchemeChanged; 1695var 1696 i: Integer; 1697begin 1698 if Schemes = nil then exit; 1699 SetLength(FRunSectionInfo, Schemes.Count + 1); // include default 1700 for i := 0 to KnownLines.Count - 1 do 1701 KnownRanges[i].UpdateForScheme(Schemes); 1702 if CurrentLines <> nil then 1703 CurrentRanges.CopyToScheme(Schemes); 1704 SchemeItemChanged(nil); 1705end; 1706 1707procedure TSynMultiSyn.DetachHighlighter(AHighlighter: TSynCustomHighlighter; 1708 AScheme: TSynHighlighterMultiScheme); 1709var 1710 i: Integer; 1711begin 1712 for i := 0 to KnownLines.Count - 1 do 1713 AHighlighter.DetachFromLines(KnownRanges[i].VirtualLines[AScheme]); 1714end; 1715 1716procedure TSynMultiSyn.AttachHighlighter(AHighlighter: TSynCustomHighlighter; 1717 AScheme: TSynHighlighterMultiScheme); 1718var 1719 i: Integer; 1720begin 1721 for i := 0 to KnownLines.Count - 1 do 1722 AHighlighter.AttachToLines(KnownRanges[i].VirtualLines[AScheme]); 1723end; 1724 1725{ TSynHighlighterMultiSchemeList } 1726 1727constructor TSynHighlighterMultiSchemeList.Create(aOwner: TSynMultiSyn); 1728begin 1729 inherited Create(TSynHighlighterMultiScheme); 1730 FOwner := aOwner; 1731end; 1732 1733function TSynHighlighterMultiSchemeList.IndexOf(AnItem: TSynHighlighterMultiScheme): Integer; 1734begin 1735 Result := Count - 1; 1736 while (Result >= 0) and (Items[Result] <> AnItem) do 1737 dec(Result); 1738end; 1739 1740function TSynHighlighterMultiSchemeList.GetItems(Index: integer): TSynHighlighterMultiScheme; 1741begin 1742 Result := inherited Items[Index] as TSynHighlighterMultiScheme; 1743end; 1744 1745function TSynHighlighterMultiSchemeList.GetConvertedCurrentLine: String; 1746begin 1747 if FConvertedCurrentLine = '' then 1748 FConvertedCurrentLine := UTF8UpperCase(FCurrentLine); 1749 Result := FConvertedCurrentLine; 1750end; 1751 1752procedure TSynHighlighterMultiSchemeList.SetCurrentLine(const AValue: String); 1753var 1754 i: Integer; 1755begin 1756 if FCurrentLine = AValue then exit; 1757 FCurrentLine := AValue; 1758 FConvertedCurrentLine := ''; 1759 for i := 0 to Count - 1 do 1760 Items[i].ClearLinesSet; 1761end; 1762 1763function TSynHighlighterMultiSchemeList.GetOwner: TPersistent; 1764begin 1765 Result := Owner; 1766end; 1767 1768procedure TSynHighlighterMultiSchemeList.SetItems(Index: integer; const Value: TSynHighlighterMultiScheme); 1769begin 1770 inherited Items[Index] := Value; 1771end; 1772 1773procedure TSynHighlighterMultiSchemeList.Update(Item: TCollectionItem); 1774begin 1775 // property of an Item changed 1776 Owner.SchemeItemChanged(Item); 1777end; 1778 1779procedure TSynHighlighterMultiSchemeList.Notify(Item: TCollectionItem; 1780 Action: TCollectionNotification); 1781begin 1782 // Item added/removed 1783 inherited Notify(Item, Action); 1784 Owner.SchemeChanged; 1785end; 1786 1787{ TSynHighlighterMultiScheme } 1788 1789function TSynHighlighterMultiScheme.GetConvertedLine: String; 1790begin 1791 if FCaseSensitive then 1792 Result := TSynHighlighterMultiSchemeList(Collection).CurrentLine 1793 else 1794 Result := TSynHighlighterMultiSchemeList(Collection).ConvertedCurrentLine; 1795end; 1796 1797function TSynHighlighterMultiScheme.GetConvertedEndExpr: String; 1798begin 1799 if FCaseSensitive then 1800 Result := FEndExpr 1801 else begin 1802 if FConvertedEndExpr = '' then 1803 FConvertedEndExpr := Utf8UpperCase(FEndExpr); 1804 Result := FConvertedEndExpr; 1805 end; 1806end; 1807 1808function TSynHighlighterMultiScheme.GetConvertedStartExpr: String; 1809begin 1810 if FCaseSensitive then 1811 Result := FStartExpr 1812 else begin 1813 if FConvertedStartExpr = '' then 1814 FConvertedStartExpr := Utf8UpperCase(FStartExpr); 1815 Result := FConvertedStartExpr; 1816 end; 1817end; 1818 1819constructor TSynHighlighterMultiScheme.Create(TheCollection: TCollection); 1820begin 1821 FStartExprScanner := TRegExpr.Create; 1822 FEndExprScanner := TRegExpr.Create; 1823 fCaseSensitive := True; 1824 fMarkerAttri := TSynHighlighterAttributes.Create(@SYNS_AttrMarker, SYNS_XML_AttrMarker); 1825 fMarkerAttri.OnChange := @MarkerAttriChanged; 1826 MarkerAttri.Background := clYellow; 1827 MarkerAttri.Style := [fsBold]; 1828 MarkerAttri.InternalSaveDefaultValues; 1829 inherited Create(TheCollection); // Calls notify, all setup must be done 1830end; 1831 1832destructor TSynHighlighterMultiScheme.Destroy; 1833begin 1834 { unhook notification handlers } 1835 Highlighter := nil; 1836 fMarkerAttri.Free; 1837 inherited Destroy; 1838 FreeAndNil(FStartExprScanner); 1839 FreeAndNil(FEndExprScanner); 1840end; 1841 1842procedure TSynHighlighterMultiScheme.ClearLinesSet; 1843begin 1844 FStartLineSet := False; 1845 FEndLineSet := False; 1846end; 1847 1848function TSynHighlighterMultiScheme.FindStartPosInLine(ASearchPos: Integer): Integer; 1849var 1850 t: String; 1851begin 1852 if (FStartExprScanner.Expression = '') or (FEndExprScanner.Expression = '') then 1853 exit(-1); 1854 1855 if not FStartLineSet then begin 1856 FStartExprScanner.InputString := GetConvertedLine; 1857 FStartLineSet := True; 1858 end; 1859 1860 Repeat 1861 if FStartExprScanner.Exec(ASearchPos) then begin 1862 Result := FStartExprScanner.MatchPos[0]; 1863 FLastMatchLen := FStartExprScanner.MatchLen[0]; 1864 1865 if Assigned(OnCheckStartMarker) then begin 1866 t := FStartExprScanner.Match[0]; 1867 OnCheckStartMarker(TSynHighlighterMultiSchemeList(Collection).Owner, Result, FLastMatchLen, t); 1868 if (t <> '') and (FLastMatchLen > 0) then 1869 exit; 1870 ASearchPos := FStartExprScanner.MatchPos[0] + 1; 1871 end 1872 else 1873 exit; 1874 end 1875 else begin 1876 Result := -1; 1877 FLastMatchLen := 0; 1878 exit; 1879 end; 1880 until False; 1881end; 1882 1883function TSynHighlighterMultiScheme.FindEndPosInLine(ASearchPos: Integer): Integer; 1884var 1885 t: String; 1886begin 1887 if not FEndLineSet then begin 1888 FEndExprScanner.InputString := GetConvertedLine; 1889 FEndLineSet:= True; 1890 end; 1891 1892 Repeat 1893 if FEndExprScanner.Exec(ASearchPos) then begin 1894 Result := FEndExprScanner.MatchPos[0]; 1895 FLastMatchLen := FEndExprScanner.MatchLen[0]; 1896 1897 if Assigned(OnCheckEndMarker) then begin 1898 t := FEndExprScanner.Match[0]; 1899 OnCheckEndMarker(TSynHighlighterMultiSchemeList(Collection).Owner, Result, FLastMatchLen, t); 1900 if (t <> '') and (FLastMatchLen > 0) then 1901 exit; 1902 ASearchPos := FEndExprScanner.MatchPos[0] + 1; 1903 end 1904 else 1905 exit; 1906 end 1907 else begin 1908 Result := -1; 1909 FLastMatchLen := 0; 1910 exit; 1911 end; 1912 until False; 1913end; 1914 1915function TSynHighlighterMultiScheme.GetDisplayName: String; 1916begin 1917 if SchemeName <> '' then 1918 Result := SchemeName 1919 else 1920 Result := inherited GetDisplayName; 1921end; 1922 1923procedure TSynHighlighterMultiScheme.MarkerAttriChanged(Sender: TObject); 1924begin 1925 Changed( False ); 1926end; 1927 1928procedure TSynHighlighterMultiScheme.SetCaseSensitive(const Value: Boolean); 1929begin 1930 if fCaseSensitive <> Value then 1931 begin 1932 fCaseSensitive := Value; 1933 FStartExprScanner.Expression := GetConvertedStartExpr; 1934 FEndExprScanner.Expression := GetConvertedEndExpr; 1935 ClearLinesSet; 1936 FNeedHLScan := True; 1937 Changed( False ); 1938 FNeedHLScan := False; 1939 end; 1940end; 1941 1942procedure TSynHighlighterMultiScheme.SetVirtualLines(const AValue: TSynHLightMultiVirtualLines); 1943begin 1944 FVirtualLines := AValue; 1945 if FHighlighter <> nil then 1946 FHighlighter.CurrentLines := AValue; 1947end; 1948 1949procedure TSynHighlighterMultiScheme.SetDisplayName(const Value: String); 1950begin 1951 SchemeName := Value; 1952end; 1953 1954procedure TSynHighlighterMultiScheme.SetEndExpr(const Value: string); 1955var OldValue: String; 1956begin 1957 if fEndExpr <> Value then 1958 begin 1959 OldValue := GetConvertedEndExpr; 1960 FConvertedEndExpr := ''; 1961 FEndExpr := Value; 1962 FEndExprScanner.Expression := GetConvertedEndExpr; 1963 FNeedHLScan := True; 1964 if GetConvertedEndExpr <> OldValue then 1965 Changed( False ); 1966 FNeedHLScan := False; 1967 end; 1968end; 1969 1970procedure TSynHighlighterMultiScheme.SetHighlighter(const Value: TSynCustomHighLighter); 1971var 1972 ParentHLighter: TSynMultiSyn; 1973begin 1974 if Highlighter <> Value then 1975 begin 1976 if (Value = TSynHighlighterMultiSchemeList(Collection).Owner) then 1977 raise Exception.Create('circular highlighter not allowed'); 1978 1979 ParentHLighter := TSynHighlighterMultiSchemeList(Collection).Owner; 1980 if Highlighter <> nil then begin 1981 Highlighter.RemoveFreeNotification(ParentHLighter); 1982 ParentHLighter.UnhookHighlighter(Highlighter); 1983 ParentHLighter.DetachHighlighter(Highlighter, Self); 1984 end; 1985 fHighlighter := Value; 1986 if Highlighter <> nil then begin 1987 ParentHLighter.AttachHighlighter(Highlighter, Self); 1988 Highlighter.FreeNotification(ParentHLighter); 1989 if FVirtualLines <> nil then 1990 FHighlighter.CurrentLines := FVirtualLines; 1991 end; 1992 FNeedHLScan := True; 1993 Changed(False); 1994 FNeedHLScan := False; 1995 end; 1996end; 1997 1998procedure TSynHighlighterMultiScheme.SetMarkerAttri(const Value: TSynHighlighterAttributes); 1999begin 2000 fMarkerAttri.Assign(Value); 2001end; 2002 2003procedure TSynHighlighterMultiScheme.SetStartExpr(const Value: string); 2004var OldValue: String; 2005begin 2006 if fStartExpr <> Value then 2007 begin 2008 OldValue := GetConvertedStartExpr; 2009 FConvertedStartExpr := ''; 2010 FStartExpr := Value; 2011 FStartExprScanner.Expression := GetConvertedStartExpr; 2012 FNeedHLScan := True; // TODO: only if EndScanne.Expression <> '' ? 2013 if GetConvertedStartExpr <> OldValue then 2014 Changed( False ); 2015 FNeedHLScan := False; 2016 end; 2017end; 2018 2019initialization 2020 SYNDEBUG_MULTIHL := DebugLogger.RegisterLogGroup('SYNDEBUG_MULTIHL', False); 2021 2022end. 2023