1 {-------------------------------------------------------------------------------
2 The contents of this file are subject to the Mozilla Public License
3 Version 1.1 (the "License"); you may not use this file except in compliance
4 with the License. You may obtain a copy of the License at
5 http://www.mozilla.org/MPL/
6
7 Software distributed under the License is distributed on an "AS IS" basis,
8 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
9 the specific language governing rights and limitations under the License.
10
11 The Original Code is: SynHighlighterMulti.pas, released 2000-06-23.
12 The Original Code is based on mwMultiSyn.pas by Willo van der Merwe, part of the
13 mwEdit component suite.
14
15 Contributors to the SynEdit and mwEdit projects are listed in the
16 Contributors.txt file.
17
18 Alternatively, the contents of this file may be used under the terms of the
19 GNU General Public License Version 2 or later (the "GPL"), in which case
20 the provisions of the GPL are applicable instead of those above.
21 If you wish to allow use of your version of this file only under the terms
22 of the GPL and not to allow others to use your version of this file
23 under the MPL, indicate your decision by deleting the provisions above and
24 replace them with the notice and other provisions required by the GPL.
25 If you do not delete the provisions above, a recipient may use your version
26 of this file under either the MPL or the GPL.
27
28 You may retrieve the latest version of this file at the SynEdit home page,
29 located 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
38 The SynHighlighterMulti unit provides SynEdit with a multiple-highlighter syntax highlighter.
39 This highlighter can be used to highlight text in which several languages are present, such as HTML.
40 For example, in HTML as well as HTML tags there can also be JavaScript and/or VBScript present.
41 }
42 unit SynHighlighterMulti;
43
44 {$I synedit.inc}
45
46 {$IFDEF SynDebug}
47 {$DEFINE SynDebugMultiHL}
48 {$ENDIF}
49
50
51 interface
52
53 uses
54 Classes, Graphics, SysUtils, LCLProc, math, RegExpr,
55 SynEditStrConst, SynEditTypes, SynEditTextBase,
56 SynEditHighlighter,
57 {$IFDEF SynDebugMultiHL}LazLoggerBase{$ELSE}LazLoggerDummy{$ENDIF}, LazUTF8
58 ;
59
60 type
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
GetSectionnull80 function GetSection(Index: Integer): TSynHLightMultiVirtualSection;
GetSectionPointernull81 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;
IndexOfFirstSectionAtLineIdxnull92 function IndexOfFirstSectionAtLineIdx(ALineIdx: Integer; ACharPos: Integer = -1;
93 UseNext: Boolean = True): Integer;
IndexOfFirstSectionAtVirtualIdxnull94 function IndexOfFirstSectionAtVirtualIdx(ALineIdx: Integer; AGetLastSection: Boolean = False): Integer;
VirtualIdxToRealIdxnull95 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
GetRangenull114 function GetRange(Index: Pointer): TSynManagedStorageMem; override;
115 procedure PutRange(Index: Pointer; const ARange: TSynManagedStorageMem); override;
Getnull116 function Get(Index: integer): string; override;
117 procedure Put(Index: integer; const S: string); override; // should not be called ever
GetCountnull118 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
GetPCharnull125 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
GetVLinesnull149 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;
GetConvertedLinenull176 function GetConvertedLine: String;
GetConvertedEndExprnull177 function GetConvertedEndExpr: String;
GetConvertedStartExprnull178 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
GetDisplayNamenull187 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;
FindStartPosInLinenull194 function FindStartPosInLine(ASearchPos: Integer): Integer;
FindEndPosInLinenull195 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;
GetConvertedCurrentLinenull221 function GetConvertedCurrentLine: String;
GetItemsnull222 function GetItems(Index: integer): TSynHighlighterMultiScheme;
223 procedure SetCurrentLine(const AValue: String);
224 procedure SetItems(Index: integer; const Value: TSynHighlighterMultiScheme);
225 protected
GetOwnernull226 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;
IndexOfnull233 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;
GetVirtualLinesnull247 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;
GetCurrentRangesnull277 function GetCurrentRanges: TSynHighlighterMultiRangeList;
GetDefaultVirtualLinesnull278 function GetDefaultVirtualLines: TSynHLightMultiVirtualLines;
GetKnownMultiRangesnull279 function GetKnownMultiRanges(Index: Integer): TSynHighlighterMultiRangeList;
280 procedure SetDefaultHighlighter(const Value: TSynCustomHighLighter);
281 procedure SetSchemes(const Value: TSynHighlighterMultiSchemeList);
CurrentVirtualLinesnull282 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;
GetIdentCharsnull294 function GetIdentChars: TSynIdentChars; override;
GetDefaultAttributenull295 function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override;
GetAttribCountnull296 function GetAttribCount: integer; override;
GetAttributenull297 function GetAttribute(idx: integer): TSynHighlighterAttributes; override;
GetSampleSourcenull298 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;
CreateRangeListnull304 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);
PerformScannull311 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
GetLanguageNamenull315 class function GetLanguageName: string; override;
316 public
317 constructor Create(AOwner: TComponent); override;
318 destructor Destroy; override;
319 procedure Next; override;
GetEolnull320 function GetEol: Boolean; override;
GetTokennull321 function GetToken: string; override;
322 procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override;
GetTokenAttributenull323 function GetTokenAttribute: TSynHighlighterAttributes; override;
GetTokenKindnull324 function GetTokenKind: integer; override;
GetTokenPosnull325 function GetTokenPos: Integer; override; // 0-based
326 procedure SetLine(const NewValue: string; LineNumber: Integer); override;
GetRangenull327 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
dbgsnull340 function dbgs(const ASect: TSynHLightMultiVirtualSection): String; overload;
341
342 implementation
343
344 var
345 SYNDEBUG_MULTIHL: PLazLoggerLogGroup;
346
347 const
348 TokenKindPerHighlighter = 100;
349
350 operator > (p1, p2 : TPoint) b : boolean;
351 begin
352 Result := (p1.y > p2.y) or ( (p1.y = p2.y) and (p1.x > p2.x) );
353 end;
354
355 operator >= (p1, p2 : TPoint) b : boolean;
356 begin
357 Result := (p1.y > p2.y) or ( (p1.y = p2.y) and (p1.x >= p2.x) );
358 end;
359
360 operator < (p1, p2 : TPoint) b : boolean;
361 begin
362 Result := (p1.y < p2.y) or ( (p1.y = p2.y) and (p1.x < p2.x) );
363 end;
364
dbgsnull365 function dbgs(const ASect: TSynHLightMultiVirtualSection): String;
366 begin
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]);
369 end;
370
371 { TSynHLightMultiSectionList }
372
GetSectionnull373 function TSynHLightMultiSectionList.GetSection(Index: Integer): TSynHLightMultiVirtualSection;
374 begin
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])^;
380 end;
381
TSynHLightMultiSectionList.GetSectionPointernull382 function TSynHLightMultiSectionList.GetSectionPointer(Index: Integer): PSynHLightMultiVirtualSection;
383 begin
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]);
389 end;
390
391 procedure TSynHLightMultiSectionList.SetSection(Index: Integer;
392 const AValue: TSynHLightMultiVirtualSection);
393 begin
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;
399 end;
400
401 constructor TSynHLightMultiSectionList.Create;
402 begin
403 inherited;
404 ItemSize := SizeOf(TSynHLightMultiVirtualSection);
405 end;
406
407 procedure TSynHLightMultiSectionList.Debug;
408 var
409 i: Integer;
410 begin
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]^)]);
414 end;
415
416 procedure TSynHLightMultiSectionList.Insert(AnIndex: Integer;
417 AnSection: TSynHLightMultiVirtualSection);
418 begin
419 InsertRows(AnIndex, 1);
420 Sections[AnIndex] := AnSection;
421 end;
422
423 procedure TSynHLightMultiSectionList.Delete(AnIndex: Integer);
424 begin
425 DeleteRows(AnIndex, 1);
426 if (Capacity > 16) and (Capacity > (Count * 2)) then
427 Capacity := Capacity - (Count div 2);
428 end;
429
IndexOfFirstSectionAtLineIdxnull430 function TSynHLightMultiSectionList.IndexOfFirstSectionAtLineIdx(ALineIdx: Integer;
431 ACharPos: Integer = -1; UseNext: Boolean = True): Integer;
432 var
433 p, p1, p2: Integer;
434 s: PSynHLightMultiVirtualSection;
435 begin
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;
481 end;
482
TSynHLightMultiSectionList.IndexOfFirstSectionAtVirtualIdxnull483 function TSynHLightMultiSectionList.IndexOfFirstSectionAtVirtualIdx(ALineIdx: Integer;
484 AGetLastSection: Boolean): Integer;
485 var
486 p, p1, p2: Integer;
487 s: PSynHLightMultiVirtualSection;
488 begin
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;
531 end;
532
TSynHLightMultiSectionList.VirtualIdxToRealIdxnull533 function TSynHLightMultiSectionList.VirtualIdxToRealIdx(AVLineIdx: Integer): Integer;
534 var
535 i: Integer;
536 begin
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;
541 end;
542
543 { TSynHLightMultiVirtualLines }
544
TSynHLightMultiVirtualLines.GetRangenull545 function TSynHLightMultiVirtualLines.GetRange(Index: Pointer): TSynManagedStorageMem;
546 begin
547 Result := FRangeList[Index];
548 end;
549
550 procedure TSynHLightMultiVirtualLines.PutRange(Index: Pointer; const ARange: TSynManagedStorageMem);
551 begin
552 FRangeList[Index] := ARange;
553 if ARange <> nil then begin
554 ARange.Capacity := Count;
555 ARange.Count := Count;
556 end;
557 end;
558
TSynHLightMultiVirtualLines.Getnull559 function TSynHLightMultiVirtualLines.Get(Index: integer): string;
560 var
561 i, i2, c1, c2: Integer;
562 s: TSynHLightMultiVirtualSection;
563 t: String;
564 begin
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;
587 end;
588
589 procedure TSynHLightMultiVirtualLines.Put(Index: integer; const S: string);
590 begin
591 raise Exception.Create('Not allowed');
592 end;
593
594 procedure TSynHLightMultiVirtualLines.Clear;
595 begin
596 raise Exception.Create('Not allowed');
597 end;
598
599 procedure TSynHLightMultiVirtualLines.Delete(Index: Integer);
600 begin
601 raise Exception.Create('Not allowed');
602 end;
603
604 procedure TSynHLightMultiVirtualLines.Insert(Index: Integer; const S: string);
605 begin
606 raise Exception.Create('Not allowed');
607 end;
608
GetPCharnull609 function TSynHLightMultiVirtualLines.GetPChar(ALineIndex: Integer; out ALen: Integer): PChar;
610 begin
611 FLastPCharLine := Get(ALineIndex);
612 ALen := length(FLastPCharLine);
613 Result := PChar(FLastPCharLine);
614 end;
615
GetCountnull616 function TSynHLightMultiVirtualLines.GetCount: integer;
617 var
618 s: TSynHLightMultiVirtualSection;
619 begin
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;
624 end;
625
626 procedure TSynHLightMultiVirtualLines.SendHighlightChanged(aIndex, aCount: Integer);
627 begin
628 if (FFirstHLChangedLine < 0) or (FFirstHLChangedLine > aIndex) then
629 FFirstHLChangedLine := aIndex;
630 if (FLastHLChangedLine < aIndex + aCount - 1) then
631 FLastHLChangedLine := aIndex + aCount - 1;
632 end;
633
634 constructor TSynHLightMultiVirtualLines.Create(ALines: TSynEditStringsBase);
635 begin
636 FRangeList := TSynManagedStorageMemList.Create;
637 FSectionList := TSynHLightMultiSectionList.Create;
638 FRealLines := ALines;
639 end;
640
641 destructor TSynHLightMultiVirtualLines.Destroy;
642 begin
643 inherited Destroy;
644 FreeAndNil(FSectionList);
645 FreeAndNil(FRangeList);
646 end;
647
648 procedure TSynHLightMultiVirtualLines.PrepareRegionScan(AStartLineIdx: Integer);
649 var
650 p: PSynHLightMultiVirtualSection;
651 begin
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}
669 end;
670
671 procedure TSynHLightMultiVirtualLines.FinishRegionScan(AEndLineIdx: Integer);
672 var
673 i, NewVLine, LastVline, LastEnd: Integer;
674 s: TSynHLightMultiVirtualSection;
675 VDiff: Integer;
676 begin
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);
730 end;
731
732 procedure TSynHLightMultiVirtualLines.RegionScanUpdateFirstRegionEnd(AnEndPoint: TPoint;
733 ATokenEndPos: Integer);
734 var
735 p: PSynHLightMultiVirtualSection;
736 begin
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);
747 end;
748
749 procedure TSynHLightMultiVirtualLines.RegionScanUpdateOrInsertRegion(AStartPoint,
750 AnEndPoint: TPoint; ATokenStartPos, ATokenEndPos: Integer);
751 var
752 Sect: TSynHLightMultiVirtualSection;
753 p: PSynHLightMultiVirtualSection;
754 begin
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);
779 end;
780
781 procedure TSynHLightMultiVirtualLines.RegionScanUpdateLastRegionStart(AStartPoint: TPoint;
782 ATokenStartPos: Integer; ALineIndex: Integer);
783 var
784 p: PSynHLightMultiVirtualSection;
785 begin
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);
794 end;
795
796 procedure TSynHLightMultiVirtualLines.RealLinesInserted(AIndex, ACount: Integer);
797 var
798 i, VLineDiff: Integer;
799 s: TSynHLightMultiVirtualSection;
800 p: PSynHLightMultiVirtualSection;
801 begin
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;
821 end;
822
823 procedure TSynHLightMultiVirtualLines.RealLinesDeleted(AIndex, ACount: Integer);
824 var
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;
836 begin
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;
894 end;
895
896 procedure TSynHLightMultiVirtualLines.RealLinesChanged(AIndex, ACount: Integer);
897 var
898 i, VLine1, VLine2: Integer;
899 s: TSynHLightMultiVirtualSection;
900 begin
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);
913 end;
914
915 procedure TSynHLightMultiVirtualLines.ResetHLChangedLines;
916 begin
917 FFirstHLChangedLine := -1;
918 FLastHLChangedLine := -1;
919 end;
920
921 { TSynHLightMultiVirtualLinesList }
922
GetVLinesnull923 function TSynHLightMultiVirtualLinesList.GetVLines(Index: Integer): TSynHLightMultiVirtualLines;
924 begin
925 Result := TSynHLightMultiVirtualLines(inherited Items[Index]);
926 end;
927
928 procedure TSynHLightMultiVirtualLinesList.PutVLines(Index: Integer;
929 const AValue: TSynHLightMultiVirtualLines);
930 begin
931 inherited Items[Index] := AValue;
932 end;
933
934 { TSynHighlighterMultiRangeList }
935
GetVirtualLinesnull936 function TSynHighlighterMultiRangeList.GetVirtualLines(Index: TSynHighlighterMultiScheme): TSynHLightMultiVirtualLines;
937 var
938 i: Integer;
939 begin
940 Result := nil;
941 for i := 0 to FVirtualLines.Count - 1 do
942 if FVirtualLines[i].Scheme = Index then
943 exit(FVirtualLines[i]);
944 end;
945
946 procedure TSynHighlighterMultiRangeList.LineTextChanged(AIndex: Integer; ACount: Integer);
947 var
948 i: Integer;
949 begin
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);
954 end;
955
956 procedure TSynHighlighterMultiRangeList.InsertedLines(AIndex, ACount: Integer);
957 var
958 i: Integer;
959 begin
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);
964 end;
965
966 procedure TSynHighlighterMultiRangeList.DeletedLines(AIndex, ACount: Integer);
967 var
968 i: Integer;
969 begin
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);
974 end;
975
976 constructor TSynHighlighterMultiRangeList.Create(ALines: TSynEditStringsBase);
977 begin
978 inherited Create;
979 FLines := ALines;
980 FVirtualLines := TSynHLightMultiVirtualLinesList.Create;
981 end;
982
983 destructor TSynHighlighterMultiRangeList.Destroy;
984 begin
985 inherited Destroy;
986 ClearVLines;
987 FreeAndNil(FVirtualLines);
988 end;
989
990 procedure TSynHighlighterMultiRangeList.ClearVLines;
991 begin
992 FreeAndNil(FDefaultVirtualLines);
993 while FVirtualLines.Count > 0 do begin
994 FVirtualLines[0].Destroy;
995 FVirtualLines.Delete(0);
996 end;
997 FVirtualLines.Clear;
998 end;
999
1000 procedure TSynHighlighterMultiRangeList.UpdateForScheme(AScheme: TSynHighlighterMultiSchemeList);
1001 var
1002 i: Integer;
1003 NewVline: TSynHLightMultiVirtualLines;
1004 begin
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;
1020 end;
1021
1022 procedure TSynHighlighterMultiRangeList.CleanUpForScheme(AScheme: TSynHighlighterMultiSchemeList);
1023 // Called before destruction / in detach
1024 var
1025 i: Integer;
1026 begin
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]]);
1030 end;
1031
1032 procedure TSynHighlighterMultiRangeList.CopyToScheme(AScheme: TSynHighlighterMultiSchemeList);
1033 var
1034 i: Integer;
1035 begin
1036 for i := 0 to AScheme.Count - 1 do
1037 AScheme[i].VirtualLines := FVirtualLines[i];
1038 end;
1039
1040 { TSynMultiSyn }
1041
CurrentVirtualLinesnull1042 function TSynMultiSyn.CurrentVirtualLines: TSynHLightMultiVirtualLines;
1043 begin
1044 if FCurScheme <> nil then
1045 Result := FCurScheme.VirtualLines
1046 else
1047 Result := DefaultVirtualLines;
1048 end;
1049
1050 constructor TSynMultiSyn.Create(AOwner: TComponent);
1051 begin
1052 inherited Create(AOwner);
1053 fSchemes := TSynHighlighterMultiSchemeList.Create(Self);
1054 FCurScheme := nil;
1055 end;
1056
1057 destructor TSynMultiSyn.Destroy;
1058 var
1059 s: TSynHighlighterMultiSchemeList;
1060 begin
1061 s := FSchemes;
1062 FSchemes := nil;
1063 s.Free;
1064 { unhook notification handlers }
1065 DefaultHighlighter := nil;
1066 inherited Destroy;
1067 end;
1068
TSynMultiSyn.PerformScannull1069 function TSynMultiSyn.PerformScan(StartIndex, EndIndex: Integer; ForceEndIndex: Boolean = False): Integer;
1070 var
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
1115 begin
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;
1226 end;
1227
TSynMultiSyn.GetAttribCountnull1228 function TSynMultiSyn.GetAttribCount: integer;
1229 var
1230 i: Integer;
1231 begin
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);
1238 end;
1239
GetAttributenull1240 function TSynMultiSyn.GetAttribute(
1241 idx: integer): TSynHighlighterAttributes;
1242 var
1243 i, j: Integer;
1244 begin
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');
1266 end;
1267
TSynMultiSyn.GetDefaultAttributenull1268 function TSynMultiSyn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
1269 var
1270 iHL: TSynCustomHighlighter;
1271 begin
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;
1283 end;
1284
GetEolnull1285 function TSynMultiSyn.GetEol: Boolean;
1286 begin
1287 Result := FTokenPos > FLineLen;
1288 end;
1289
GetIdentCharsnull1290 function TSynMultiSyn.GetIdentChars: TSynIdentChars;
1291 begin
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;
1298 end;
1299
TSynMultiSyn.GetLanguageNamenull1300 class function TSynMultiSyn.GetLanguageName: string;
1301 begin
1302 Result := SYNS_LangGeneralMulti;
1303 end;
1304
TSynMultiSyn.GetRangenull1305 function TSynMultiSyn.GetRange: Pointer;
1306 begin
1307 Result := FCurScheme;
1308 end;
1309
TSynMultiSyn.GetTokennull1310 function TSynMultiSyn.GetToken: string;
1311 begin
1312 SetString(Result, (PChar(FLine) + FTokenPos - 1), FRun - FTokenPos);
1313 end;
1314
1315 procedure TSynMultiSyn.GetTokenEx(out TokenStart: PChar;
1316 out TokenLength: integer);
1317 begin
1318 TokenLength := FRun-FTokenPos;
1319 if TokenLength > 0 then begin
1320 TokenStart := @fLine[FTokenPos];
1321 end else begin
1322 TokenStart := nil;
1323 end;
1324 end;
1325
TSynMultiSyn.GetTokenAttributenull1326 function TSynMultiSyn.GetTokenAttribute: TSynHighlighterAttributes;
1327 begin
1328 Result := FTokenAttr;
1329 end;
1330
GetTokenKindnull1331 function TSynMultiSyn.GetTokenKind: integer;
1332 begin
1333 Result := FTokenKind;
1334 end;
1335
TSynMultiSyn.GetTokenPosnull1336 function TSynMultiSyn.GetTokenPos: Integer;
1337 begin
1338 Result := fTokenPos - 1;
1339 end;
1340
1341 procedure TSynMultiSyn.HookHighlighter(aHL: TSynCustomHighlighter);
1342 begin
1343 aHL.HookAttrChangeEvent( @DefHighlightChange );
1344 end;
1345
1346 procedure 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
1395 var
1396 idx: Integer;
1397 RSect: TRunSectionInfo;
1398 HL: TSynCustomHighlighter;
1399 dummy: PChar;
1400 tkpos, tklen: Integer;
1401 begin
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);
1484 end;
1485
1486 procedure TSynMultiSyn.Notification(aComp: TComponent; aOp: TOperation);
1487 var
1488 i: Integer;
1489 begin
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;
1498 end;
1499
CreateRangeListnull1500 function TSynMultiSyn.CreateRangeList(ALines: TSynEditStringsBase): TSynHighlighterRangeList;
1501 var
1502 NewRangeList: TSynHighlighterMultiRangeList;
1503 begin
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;
1510 end;
1511
1512 procedure TSynMultiSyn.BeforeDetachedFromRangeList(ARangeList: TSynHighlighterRangeList);
1513 begin
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;
1522 end;
1523
1524 procedure TSynMultiSyn.SetCurrentLines(const AValue: TSynEditStringsBase);
1525 begin
1526 inherited SetCurrentLines(AValue);
1527 CurrentRanges.CopyToScheme(Schemes);
1528 if FDefaultHighlighter <> nil then
1529 FDefaultHighlighter.CurrentLines := CurrentRanges.DefaultVirtualLines;
1530 end;
1531
1532 procedure TSynMultiSyn.ResetRange;
1533 begin
1534 FCurScheme := nil;
1535 if DefaultHighlighter <> nil then begin
1536 DefaultHighlighter.ResetRange;
1537 end;
1538 end;
1539
1540 procedure TSynMultiSyn.SetDefaultHighlighter(
1541 const Value: TSynCustomHighLighter);
1542 const
1543 sDefaultHlSetToSelf = 'Not allowed';
1544 var
1545 i: Integer;
1546 begin
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 );
1566 end;
1567
TSynMultiSyn.GetDefaultVirtualLinesnull1568 function TSynMultiSyn.GetDefaultVirtualLines: TSynHLightMultiVirtualLines;
1569 begin
1570 Result := CurrentRanges.DefaultVirtualLines;
1571 end;
1572
TSynMultiSyn.GetKnownMultiRangesnull1573 function TSynMultiSyn.GetKnownMultiRanges(Index: Integer): TSynHighlighterMultiRangeList;
1574 begin
1575 Result := TSynHighlighterMultiRangeList(inherited KnownRanges[Index])
1576 end;
1577
GetCurrentRangesnull1578 function TSynMultiSyn.GetCurrentRanges: TSynHighlighterMultiRangeList;
1579 begin
1580 Result := TSynHighlighterMultiRangeList(inherited CurrentRanges)
1581 end;
1582
1583 procedure 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;
1636 var
1637 i: Integer;
1638 begin
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;
1653 end;
1654
1655 procedure TSynMultiSyn.SetRange(Value: Pointer);
1656 begin
1657 inherited;
1658 FCurScheme := TSynHighlighterMultiScheme(Value);
1659 end;
1660
1661 procedure TSynMultiSyn.SetSchemes(const Value: TSynHighlighterMultiSchemeList);
1662 begin
1663 fSchemes.Assign(Value);
1664 end;
1665
1666 procedure TSynMultiSyn.UnhookHighlighter(aHL: TSynCustomHighlighter);
1667 begin
1668 if csDestroying in aHL.ComponentState then
1669 Exit;
1670 aHL.UnhookAttrChangeEvent( @DefHighlightChange );
1671 end;
1672
GetSampleSourcenull1673 function TSynMultiSyn.GetSampleSource: string;
1674 begin
1675 Result := fSampleSource;
1676 end;
1677
1678 procedure TSynMultiSyn.SetSampleSource(Value: string);
1679 begin
1680 fSampleSource := Value;
1681 end;
1682
1683 procedure TSynMultiSyn.SchemeItemChanged(Item: TObject);
1684 var
1685 i: Integer;
1686 begin
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;
1692 end;
1693
1694 procedure TSynMultiSyn.SchemeChanged;
1695 var
1696 i: Integer;
1697 begin
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);
1705 end;
1706
1707 procedure TSynMultiSyn.DetachHighlighter(AHighlighter: TSynCustomHighlighter;
1708 AScheme: TSynHighlighterMultiScheme);
1709 var
1710 i: Integer;
1711 begin
1712 for i := 0 to KnownLines.Count - 1 do
1713 AHighlighter.DetachFromLines(KnownRanges[i].VirtualLines[AScheme]);
1714 end;
1715
1716 procedure TSynMultiSyn.AttachHighlighter(AHighlighter: TSynCustomHighlighter;
1717 AScheme: TSynHighlighterMultiScheme);
1718 var
1719 i: Integer;
1720 begin
1721 for i := 0 to KnownLines.Count - 1 do
1722 AHighlighter.AttachToLines(KnownRanges[i].VirtualLines[AScheme]);
1723 end;
1724
1725 { TSynHighlighterMultiSchemeList }
1726
1727 constructor TSynHighlighterMultiSchemeList.Create(aOwner: TSynMultiSyn);
1728 begin
1729 inherited Create(TSynHighlighterMultiScheme);
1730 FOwner := aOwner;
1731 end;
1732
IndexOfnull1733 function TSynHighlighterMultiSchemeList.IndexOf(AnItem: TSynHighlighterMultiScheme): Integer;
1734 begin
1735 Result := Count - 1;
1736 while (Result >= 0) and (Items[Result] <> AnItem) do
1737 dec(Result);
1738 end;
1739
TSynHighlighterMultiSchemeList.GetItemsnull1740 function TSynHighlighterMultiSchemeList.GetItems(Index: integer): TSynHighlighterMultiScheme;
1741 begin
1742 Result := inherited Items[Index] as TSynHighlighterMultiScheme;
1743 end;
1744
TSynHighlighterMultiSchemeList.GetConvertedCurrentLinenull1745 function TSynHighlighterMultiSchemeList.GetConvertedCurrentLine: String;
1746 begin
1747 if FConvertedCurrentLine = '' then
1748 FConvertedCurrentLine := UTF8UpperCase(FCurrentLine);
1749 Result := FConvertedCurrentLine;
1750 end;
1751
1752 procedure TSynHighlighterMultiSchemeList.SetCurrentLine(const AValue: String);
1753 var
1754 i: Integer;
1755 begin
1756 if FCurrentLine = AValue then exit;
1757 FCurrentLine := AValue;
1758 FConvertedCurrentLine := '';
1759 for i := 0 to Count - 1 do
1760 Items[i].ClearLinesSet;
1761 end;
1762
TSynHighlighterMultiSchemeList.GetOwnernull1763 function TSynHighlighterMultiSchemeList.GetOwner: TPersistent;
1764 begin
1765 Result := Owner;
1766 end;
1767
1768 procedure TSynHighlighterMultiSchemeList.SetItems(Index: integer; const Value: TSynHighlighterMultiScheme);
1769 begin
1770 inherited Items[Index] := Value;
1771 end;
1772
1773 procedure TSynHighlighterMultiSchemeList.Update(Item: TCollectionItem);
1774 begin
1775 // property of an Item changed
1776 Owner.SchemeItemChanged(Item);
1777 end;
1778
1779 procedure TSynHighlighterMultiSchemeList.Notify(Item: TCollectionItem;
1780 Action: TCollectionNotification);
1781 begin
1782 // Item added/removed
1783 inherited Notify(Item, Action);
1784 Owner.SchemeChanged;
1785 end;
1786
1787 { TSynHighlighterMultiScheme }
1788
TSynHighlighterMultiScheme.GetConvertedLinenull1789 function TSynHighlighterMultiScheme.GetConvertedLine: String;
1790 begin
1791 if FCaseSensitive then
1792 Result := TSynHighlighterMultiSchemeList(Collection).CurrentLine
1793 else
1794 Result := TSynHighlighterMultiSchemeList(Collection).ConvertedCurrentLine;
1795 end;
1796
TSynHighlighterMultiScheme.GetConvertedEndExprnull1797 function TSynHighlighterMultiScheme.GetConvertedEndExpr: String;
1798 begin
1799 if FCaseSensitive then
1800 Result := FEndExpr
1801 else begin
1802 if FConvertedEndExpr = '' then
1803 FConvertedEndExpr := Utf8UpperCase(FEndExpr);
1804 Result := FConvertedEndExpr;
1805 end;
1806 end;
1807
GetConvertedStartExprnull1808 function TSynHighlighterMultiScheme.GetConvertedStartExpr: String;
1809 begin
1810 if FCaseSensitive then
1811 Result := FStartExpr
1812 else begin
1813 if FConvertedStartExpr = '' then
1814 FConvertedStartExpr := Utf8UpperCase(FStartExpr);
1815 Result := FConvertedStartExpr;
1816 end;
1817 end;
1818
1819 constructor TSynHighlighterMultiScheme.Create(TheCollection: TCollection);
1820 begin
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
1830 end;
1831
1832 destructor TSynHighlighterMultiScheme.Destroy;
1833 begin
1834 { unhook notification handlers }
1835 Highlighter := nil;
1836 fMarkerAttri.Free;
1837 inherited Destroy;
1838 FreeAndNil(FStartExprScanner);
1839 FreeAndNil(FEndExprScanner);
1840 end;
1841
1842 procedure TSynHighlighterMultiScheme.ClearLinesSet;
1843 begin
1844 FStartLineSet := False;
1845 FEndLineSet := False;
1846 end;
1847
TSynHighlighterMultiScheme.FindStartPosInLinenull1848 function TSynHighlighterMultiScheme.FindStartPosInLine(ASearchPos: Integer): Integer;
1849 var
1850 t: String;
1851 begin
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;
1881 end;
1882
FindEndPosInLinenull1883 function TSynHighlighterMultiScheme.FindEndPosInLine(ASearchPos: Integer): Integer;
1884 var
1885 t: String;
1886 begin
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;
1913 end;
1914
TSynHighlighterMultiScheme.GetDisplayNamenull1915 function TSynHighlighterMultiScheme.GetDisplayName: String;
1916 begin
1917 if SchemeName <> '' then
1918 Result := SchemeName
1919 else
1920 Result := inherited GetDisplayName;
1921 end;
1922
1923 procedure TSynHighlighterMultiScheme.MarkerAttriChanged(Sender: TObject);
1924 begin
1925 Changed( False );
1926 end;
1927
1928 procedure TSynHighlighterMultiScheme.SetCaseSensitive(const Value: Boolean);
1929 begin
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;
1940 end;
1941
1942 procedure TSynHighlighterMultiScheme.SetVirtualLines(const AValue: TSynHLightMultiVirtualLines);
1943 begin
1944 FVirtualLines := AValue;
1945 if FHighlighter <> nil then
1946 FHighlighter.CurrentLines := AValue;
1947 end;
1948
1949 procedure TSynHighlighterMultiScheme.SetDisplayName(const Value: String);
1950 begin
1951 SchemeName := Value;
1952 end;
1953
1954 procedure TSynHighlighterMultiScheme.SetEndExpr(const Value: string);
1955 var OldValue: String;
1956 begin
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;
1968 end;
1969
1970 procedure TSynHighlighterMultiScheme.SetHighlighter(const Value: TSynCustomHighLighter);
1971 var
1972 ParentHLighter: TSynMultiSyn;
1973 begin
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;
1996 end;
1997
1998 procedure TSynHighlighterMultiScheme.SetMarkerAttri(const Value: TSynHighlighterAttributes);
1999 begin
2000 fMarkerAttri.Assign(Value);
2001 end;
2002
2003 procedure TSynHighlighterMultiScheme.SetStartExpr(const Value: string);
2004 var OldValue: String;
2005 begin
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;
2017 end;
2018
2019 initialization
2020 SYNDEBUG_MULTIHL := DebugLogger.RegisterLogGroup('SYNDEBUG_MULTIHL', False);
2021
2022 end.
2023
2024