1 {
2 Copyright (C) Alexey Torgashin, uvviewsoft.com
3 License: MPL 2.0 or LGPL
4 }
5 unit ATSynEdit_Ranges;
6
7 {$mode objfpc}{$H+}
8 {$ModeSwitch advancedrecords}
9
10 interface
11
12 uses
13 Classes, SysUtils,
14 ATStringProc,
15 ATSynEdit_FGL;
16
17 type
18 { TATSynRange }
19
20 PATSynRange = ^TATSynRange;
21 TATSynRange = packed record
22 Tag: Int64;
23 Hint: string[95];
24 X: integer; //start column
25 Y: integer; //start line
26 Y2: integer; //end line which is fully folded (can't partially fold)
27 Folded: boolean;
28 Staple: boolean;
29 procedure Init(AX, AY, AY2: integer; AStaple: boolean; const AHint: string; const ATag: Int64);
30 function IsSimple: boolean;
31 function IsLineInside(ALine: integer): boolean;
32 function MessageText: string;
33 class operator =(const a, b: TATSynRange): boolean;
34 end;
35
36 { TATSynRangeList }
37
38 TATSynRangeList = class(specialize TFPGList<TATSynRange>)
39 public
40 function ItemPtr(AIndex: integer): PATSynRange; inline;
41 end;
42
43 type
44 { TATSynRanges }
45
46 TATSynRanges = class
47 private
48 FList: TATSynRangeList;
49 FLineIndexer: array of array of integer;
50 FHasTagPersist: boolean;
51 FHasStaples: boolean;
52 procedure AddToLineIndexer(ALine1, ALine2, AIndex: integer); inline;
53 function GetItems(Index: integer): TATSynRange;
54 procedure SetItems(Index: integer; const AValue: TATSynRange);
55 //function MessageTextForIndexList(const L: TATIntArray): string;
56 public
57 constructor Create; virtual;
58 destructor Destroy; override;
59 function Count: integer; inline;
60 function CountOfLineIndexer: integer;
61 function IsIndexValid(N: integer): boolean; inline;
62 function IsRangesTouch(N1, N2: integer): boolean;
63 function Add(AX, AY, AY2: integer; AWithStaple: boolean; const AHint: string;
64 const ATag: Int64=0): TATSynRange;
65 function Insert(AIndex: integer; AX, AY, AY2: integer; AWithStaple: boolean;
66 const AHint: string; const ATag: Int64=0): TATSynRange;
67 procedure Clear;
68 procedure ClearLineIndexer(ALineCount: integer; ASetLenOnly: boolean=false);
69 procedure Delete(AIndex: integer);
70 procedure DeleteAllByTag(const ATag: Int64);
71 procedure DeleteAllExceptTag(const ATag: Int64);
72 property Items[Index: integer]: TATSynRange read GetItems write SetItems; default;
73 function ItemPtr(AIndex: integer): PATSynRange;
74 function IsRangeInsideOther(R1, R2: PATSynRange): boolean;
75 function IsRangesSame(R1, R2: PATSynRange): boolean;
76 function FindRanges(AOuterRange: integer; AOnlyFolded, ATopLevelOnly: boolean): TATIntArray;
77 function FindRangesWithLine(ALine: integer; AOnlyFolded: boolean): TATIntArray;
78 function FindRangesWithAnyOfLines(ALineFrom, ALineTo: integer): TATIntArray;
79 function FindRangesWithStaples(ALineFrom, ALineTo: integer): TATIntArray;
80 function FindDeepestRangeContainingLine_Old(ALine: integer; const AIndexes: TATIntArray): integer;
81 function FindDeepestRangeContainingLine(ALine: integer; AWithStaple: boolean): integer;
82 function FindRangeWithPlusAtLine(ALine: integer): integer;
83 function FindRangeWithPlusAtLine_ViaIndexer(ALine: integer): integer;
84 function FindRangeLevel(AIndex: integer): integer;
85 function MessageText(AMaxCount: integer): string;
86 function MessageLineIndexer(AMaxCount: integer): string;
87 procedure UpdateLineIndexer;
88 procedure Update(AChange: TATLineChangeKind; ALineIndex, AItemCount: integer);
89 property HasTagPersist: boolean read FHasTagPersist;
90 property HasStaples: boolean read FHasStaples;
91 end;
92
93 const
94 cTagPersistentFoldRange = -1;
95
96 implementation
97
98 uses
99 Math,
100 ATSynEdit_Carets;
101
102 //we allow one block to hangout 1 line by Y2 from outer block:
103 //it's needed for Pascal econtrol lexer
104 //(don't know why it gives such blocks)
105 const
106 cAllowHangoutLines = 1; //0 or 1, do not bigger
107
108 { TATSynRangeList }
109
ItemPtrnull110 function TATSynRangeList.ItemPtr(AIndex: integer): PATSynRange;
111 begin
112 Result:= PATSynRange(InternalGet(AIndex));
113 end;
114
115
116 { TATSynRange }
117
118 procedure TATSynRange.Init(AX, AY, AY2: integer; AStaple: boolean;
119 const AHint: string; const ATag: Int64);
120 begin
121 if (AX<=0) then raise Exception.Create('Incorrect range with x<=0: '+MessageText);
122 if (AY<0) then raise Exception.Create('Incorrect range with y<0: '+MessageText);
123 //if (AY>AY2) then raise Exception.Create('Incorrect range with y>y2: '+MessageText);
124 if (AY>AY2) then AY2:= AY; //hide this error, it happens in Rexx lexer
125
126 X:= AX;
127 Y:= AY;
128 Y2:= AY2;
129 Staple:= AStaple;
130 Hint:= AHint;
131 Folded:= false;
132 Tag:= ATag;
133 end;
134
IsSimplenull135 function TATSynRange.IsSimple: boolean; inline;
136 //ranges of only 2 lines are needed sometimes, e.g. in FindInFiles lexer
137 begin
138 Result:= Y2-Y < 1;
139 end;
140
IsLineInsidenull141 function TATSynRange.IsLineInside(ALine: integer): boolean; inline;
142 begin
143 Result:= (ALine>=Y) and (ALine<=Y2);
144 end;
145
MessageTextnull146 function TATSynRange.MessageText: string;
147 begin
148 Result:= Format('%d..%d', [Y+1, Y2+1]);
149 end;
150
151 class operator TATSynRange.=(const a, b: TATSynRange): boolean;
152 begin
153 Result:= false;
154 end;
155
156 { TATSynRanges }
157
IsIndexValidnull158 function TATSynRanges.IsIndexValid(N: integer): boolean; inline;
159 begin
160 Result:= (N>=0) and (N<FList.Count);
161 end;
162
Countnull163 function TATSynRanges.Count: integer; inline;
164 begin
165 Result:= FList.Count;
166 end;
167
CountOfLineIndexernull168 function TATSynRanges.CountOfLineIndexer: integer;
169 begin
170 Result:= Length(FLineIndexer);
171 end;
172
GetItemsnull173 function TATSynRanges.GetItems(Index: integer): TATSynRange;
174 begin
175 Result:= FList[Index];
176 end;
177
178 procedure TATSynRanges.SetItems(Index: integer; const AValue: TATSynRange);
179 begin
180 FList[Index]:= AValue;
181 if AValue.Tag=cTagPersistentFoldRange then
182 FHasTagPersist:= true;
183 if AValue.Staple then
184 FHasStaples:= true;
185 end;
186
187 procedure TATSynRanges.ClearLineIndexer(ALineCount: integer; ASetLenOnly: boolean=false);
188 begin
189 if not ASetLenOnly then
190 {
191 for i:= High(FLineIndexer) downto 0 do
192 SetLength(FLineIndexer[i], 0);
193 }
194 SetLength(FLineIndexer, 0); //it frees old memory? seems yes
195
196 SetLength(FLineIndexer, ALineCount);
197 end;
198
199 constructor TATSynRanges.Create;
200 begin
201 FList:= TATSynRangeList.Create;
202 FList.Capacity:= 2*1024;
203 FHasTagPersist:= false;
204 FHasStaples:= false;
205 end;
206
207 destructor TATSynRanges.Destroy;
208 begin
209 Clear;
210 FreeAndNil(FList);
211 inherited;
212 end;
213
214 procedure TATSynRanges.Clear;
215 begin
216 ClearLineIndexer(0);
217 FList.Clear;
218 FHasTagPersist:= false;
219 FHasStaples:= false;
220 end;
221
Addnull222 function TATSynRanges.Add(AX, AY, AY2: integer; AWithStaple: boolean;
223 const AHint: string;
224 const ATag: Int64=0): TATSynRange;
225 var
226 NIndex: integer;
227 begin
228 Result.Init(AX, AY, AY2, AWithStaple, AHint, ATag);
229 NIndex:= FList.Add(Result);
230
231 if ATag=cTagPersistentFoldRange then
232 FHasTagPersist:= true;
233 if AWithStaple then
234 FHasStaples:= true;
235
236 AddToLineIndexer(AY, AY2, NIndex);
237 end;
238
239 procedure TATSynRanges.AddToLineIndexer(ALine1, ALine2, AIndex: integer);
240 var
241 NItemLen, i: integer;
242 begin
243 if ALine1<>ALine2 then //skip one-line ranges
244 if ALine2<=High(FLineIndexer) then
245 for i:= ALine1 to ALine2 do
246 begin
247 NItemLen:= Length(FLineIndexer[i]);
248 SetLength(FLineIndexer[i], NItemLen+1);
249 FLineIndexer[i][NItemLen]:= AIndex;
250 end;
251 end;
252
Insertnull253 function TATSynRanges.Insert(AIndex: integer; AX, AY, AY2: integer;
254 AWithStaple: boolean;
255 const AHint: string;
256 const ATag: Int64=0): TATSynRange;
257 begin
258 Result.Init(AX, AY, AY2, AWithStaple, AHint, ATag);
259 FList.Insert(AIndex, Result);
260
261 if ATag=cTagPersistentFoldRange then
262 FHasTagPersist:= true;
263 if AWithStaple then
264 FHasStaples:= true;
265
266 UpdateLineIndexer;
267 end;
268
269 procedure TATSynRanges.Delete(AIndex: integer); inline;
270 begin
271 FList.Delete(AIndex);
272 UpdateLineIndexer;
273 end;
274
275 procedure TATSynRanges.DeleteAllByTag(const ATag: Int64);
276 var
277 i: integer;
278 begin
279 for i:= FList.Count-1 downto 0 do
280 if ItemPtr(i)^.Tag=ATag then
281 FList.Delete(i);
282
283 if ATag=cTagPersistentFoldRange then
284 FHasTagPersist:= false;
285
286 UpdateLineIndexer;
287 end;
288
289 procedure TATSynRanges.DeleteAllExceptTag(const ATag: Int64);
290 var
291 TempList: TATSynRangeList;
292 i: integer;
293 begin
294 TempList:= TATSynRangeList.Create;
295 try
296 for i:= 0 to FList.Count-1 do
297 if ItemPtr(i)^.Tag=ATag then
298 TempList.Add(ItemPtr(i)^);
299 FList.Clear;
300 for i:= 0 to TempList.Count-1 do
301 FList.Add(TempList.ItemPtr(i)^);
302 finally
303 FreeAndNil(TempList);
304 end;
305
306 if ATag<>cTagPersistentFoldRange then
307 FHasTagPersist:= false;
308
309 UpdateLineIndexer;
310 end;
311
ItemPtrnull312 function TATSynRanges.ItemPtr(AIndex: integer): PATSynRange;
313 begin
314 Result:= FList.ItemPtr(AIndex);
315 end;
316
IsRangeInsideOthernull317 function TATSynRanges.IsRangeInsideOther(R1, R2: PATSynRange): boolean;
318 begin
319 Result:=
320 IsPosSorted(R2^.X, R2^.Y, R1^.X, R1^.Y, true)
321 and (R1^.Y2-cAllowHangoutLines<=R2^.Y2);
322 end;
323
IsRangesSamenull324 function TATSynRanges.IsRangesSame(R1, R2: PATSynRange): boolean;
325 begin
326 if R1=R2 then
327 exit(true);
328 if (R1^.X=R2^.X) and (R1^.Y=R2^.Y) and (Abs(R1^.Y2-R2^.Y2)<=cAllowHangoutLines) then
329 exit(true);
330
331 Result:= false;
332 end;
333
FindRangeLevelnull334 function TATSynRanges.FindRangeLevel(AIndex: integer): integer;
335 var
336 NLine, iItem: integer;
337 begin
338 Result:= 0;
339 NLine:= ItemPtr(AIndex)^.Y;
340 if NLine>High(FLineIndexer) then exit;
341
342 for iItem:= 0 to High(FLineIndexer[NLine]) do
343 if FLineIndexer[NLine][iItem] = AIndex then
344 begin
345 Result:= iItem;
346 Break;
347 end;
348
349 //first in LineIndexer item? then level 0
350 if Result=0 then
351 exit;
352
353 //skip previous ranges in the same LineIndexer line,
354 //if they only touch our range
355 while Result>0 do
356 begin
357 iItem:= FLineIndexer[NLine][Result-1];
358 if IsRangesTouch(iItem, AIndex) then
359 Dec(Result);
360 end;
361 end;
362
IsRangesTouchnull363 function TATSynRanges.IsRangesTouch(N1, N2: integer): boolean;
364 begin
365 Result:= ItemPtr(N1)^.Y2 = ItemPtr(N2)^.Y;
366 end;
367
368 type
369 TATIntegerList = specialize TFPGList<integer>;
370
FindRangesnull371 function TATSynRanges.FindRanges(AOuterRange: integer; AOnlyFolded,
372 ATopLevelOnly: boolean): TATIntArray;
373 //ATopLevel: keep from collected list only top-level ranges
374 //(not globally top-level, but top-level inside found list)
375 var
376 L: TATIntegerList;
377 R, RngOuter, RngLastAdded: PATSynRange;
378 nStartIndex, nEndLine, i: integer;
379 begin
380 RngOuter:= nil;
381 RngLastAdded:= nil;
382 nStartIndex:= 0;
383 nEndLine:= -1;
384
385 if AOuterRange>=0 then
386 begin
387 RngOuter:= FList.ItemPtr(AOuterRange);
388 nStartIndex:= AOuterRange+1;
389 nEndLine:= RngOuter^.Y2;
390 end;
391
392 SetLength(Result{%H-}, 0);
393 L:= TATIntegerList.Create;
394 L.Capacity:= 128;
395
396 try
397 for i:= nStartIndex to FList.Count-1 do
398 begin
399 R:= FList.ItemPtr(i);
400 if R^.IsSimple then
401 Continue;
402 if AOnlyFolded and not R^.Folded then
403 Continue;
404
405 //break loop after outer-range ending line
406 if nEndLine>=0 then
407 if R^.Y>=nEndLine then
408 Break;
409
410 if ATopLevelOnly then
411 if Assigned(RngLastAdded) then
412 if IsRangeInsideOther(R, RngLastAdded) then
413 Continue;
414
415 L.Add(i);
416 RngLastAdded:= R;
417 end;
418
419 SetLength(Result, L.Count);
420 for i:= 0 to L.Count-1 do
421 Result[i]:= L[i];
422 finally
423 FreeAndNil(L);
424 end;
425 end;
426
FindRangesWithLinenull427 function TATSynRanges.FindRangesWithLine(ALine: integer; AOnlyFolded: boolean): TATIntArray;
428 var
429 R: PATSynRange;
430 NLen, NRange, i: integer;
431 begin
432 SetLength(Result{%H-}, 0);
433 if ALine>High(FLineIndexer) then exit;
434
435 if not AOnlyFolded then
436 Result:= FLineIndexer[ALine]
437 else
438 begin
439 NLen:= 0;
440 for i:= 0 to High(FLineIndexer[ALine]) do
441 begin
442 NRange:= FLineIndexer[ALine][i];
443 R:= ItemPtr(NRange);
444 if R^.Folded then
445 begin
446 Inc(NLen);
447 SetLength(Result, NLen);
448 Result[NLen-1]:= NRange;
449 end;
450 end;
451 end;
452 end;
453
454 function _IsArrayItemPresent(var Ar: TATIntArray; Value: integer): boolean; inline;
455 var
456 i: integer;
457 begin
458 for i:= 0 to High(Ar) do
459 if Ar[i]=Value then
460 exit(true);
461 Result:= false;
462 end;
463
FindRangesWithAnyOfLinesnull464 function TATSynRanges.FindRangesWithAnyOfLines(ALineFrom, ALineTo: integer): TATIntArray;
465 var
466 NMax, NRange, iLine, iItem: integer;
467 begin
468 SetLength(Result{%H-}, 0);
469 NMax:= High(FLineIndexer);
470 if ALineFrom>NMax then exit;
471 if ALineTo>NMax then ALineTo:= NMax;
472
473 for iLine:= ALineFrom to ALineTo do
474 for iItem:= 0 to High(FLineIndexer[iLine]) do
475 begin
476 NRange:= FLineIndexer[iLine][iItem];
477 if not _IsArrayItemPresent(Result, NRange) then
478 begin
479 SetLength(Result, Length(Result)+1);
480 Result[High(Result)]:= NRange;
481 end;
482 end;
483 end;
484
FindRangesWithStaplesnull485 function TATSynRanges.FindRangesWithStaples(ALineFrom, ALineTo: integer): TATIntArray;
486 var
487 NMax, NRange, iLine, iItem: integer;
488 Rng: PATSynRange;
489 begin
490 SetLength(Result{%H-}, 0);
491 NMax:= High(FLineIndexer);
492 if ALineFrom>NMax then exit;
493 if ALineTo>NMax then ALineTo:= NMax;
494
495 for iLine:= ALineFrom to ALineTo do
496 for iItem:= 0 to High(FLineIndexer[iLine]) do
497 begin
498 NRange:= FLineIndexer[iLine][iItem];
499 Rng:= ItemPtr(NRange);
500 if not Rng^.Staple then Continue;
501 if Rng^.Folded then Continue;
502 if _IsArrayItemPresent(Result, NRange) then Continue;
503 SetLength(Result, Length(Result)+1);
504 Result[High(Result)]:= NRange;
505 end;
506 end;
507
508
FindDeepestRangeContainingLine_Oldnull509 function TATSynRanges.FindDeepestRangeContainingLine_Old(ALine: integer;
510 const AIndexes: TATIntArray): integer;
511 var
512 R: PATSynRange;
513 i: integer;
514 begin
515 Result:= -1;
516 for i:= 0 to High(AIndexes) do
517 begin
518 R:= FList.ItemPtr(AIndexes[i]);
519 if R^.IsSimple then Continue;
520 if (R^.Y>ALine) then Break;
521 if (R^.Y2<ALine) then Continue;
522 if (Result<0) or (R^.Y>FList.ItemPtr(Result)^.Y) then
523 Result:= AIndexes[i];
524 end;
525 end;
526
FindDeepestRangeContainingLinenull527 function TATSynRanges.FindDeepestRangeContainingLine(ALine: integer; AWithStaple: boolean): integer;
528 var
529 NItemLen, NRange, iItem: integer;
530 Ptr: PATSynRange;
531 begin
532 Result:= -1;
533 if ALine<0 then exit;
534 if ALine>High(FLineIndexer) then exit;
535
536 NItemLen:= Length(FLineIndexer[ALine]);
537 for iItem:= NItemLen-1 downto 0 do
538 begin
539 NRange:= FLineIndexer[ALine][iItem];
540 if not IsIndexValid(NRange) then Continue;
541 Ptr:= ItemPtr(NRange);
542 if Ptr^.IsSimple then
543 Continue;
544 if AWithStaple and not Ptr^.Staple then
545 Continue;
546 exit(NRange);
547 end;
548 end;
549
550
FindRangeWithPlusAtLine_ViaIndexernull551 function TATSynRanges.FindRangeWithPlusAtLine_ViaIndexer(ALine: integer): integer;
552 var
553 NItemLen, NRange, iItem: integer;
554 Ptr: PATSynRange;
555 begin
556 Result:= -1;
557 if ALine>High(FLineIndexer) then exit;
558
559 NItemLen:= Length(FLineIndexer[ALine]);
560 for iItem:= 0 to NItemLen-1 do
561 begin
562 NRange:= FLineIndexer[ALine][iItem];
563 Ptr:= ItemPtr(NRange);
564 if Ptr^.Y=ALine then
565 if not Ptr^.IsSimple then
566 exit(NRange);
567 end;
568 end;
569
FindRangeWithPlusAtLinenull570 function TATSynRanges.FindRangeWithPlusAtLine(ALine: integer): integer;
571 // issue https://github.com/Alexey-T/CudaText/issues/2566
572 // because of this, we must skip all one-line ranges
573 var
574 a, b, m, dif, NCount: integer;
575 R: PATSynRange;
576 begin
577 Result:= -1;
578 NCount:= Count;
579 a:= 0;
580 b:= NCount-1;
581
582 repeat
583 if a>b then exit; //not Break
584 m:= (a+b+1) div 2;
585
586 R:= FList.ItemPtr(m);
587 dif:= R^.Y-ALine;
588
589 if dif<0 then
590 a:= m+1
591 else
592 if dif>0 then
593 b:= m-1
594 else
595 begin
596 //find _first_ range which begins at ALine
597 while (m>0) and (FList.ItemPtr(m-1)^.Y=ALine) do
598 Dec(m);
599 Break;
600 end;
601 until false;
602
603 //some range is found, now skip all one-line ranges
604 while (m<NCount) and FList.ItemPtr(m)^.IsSimple do
605 Inc(m);
606 //if skipped not too far, it is the result
607 if (m<NCount) and (FList.ItemPtr(m)^.Y=ALine) then
608 Result:= m;
609 end;
610
MessageTextnull611 function TATSynRanges.MessageText(AMaxCount: integer): string;
612 var
613 Ptr: PATSynRange;
614 i: integer;
615 begin
616 Result:= '';
617 for i:= 0 to Min(Count-1, AMaxCount) do
618 begin
619 Ptr:= ItemPtr(i);
620 Result+= Ptr^.MessageText+#10;
621 end;
622 end;
623
624 procedure TATSynRanges.Update(AChange: TATLineChangeKind; ALineIndex, AItemCount: integer);
625 var
626 Rng: PATSynRange;
627 i: integer;
628 begin
629 case AChange of
630 cLineChangeDeletedAll:
631 Clear;
632
633 cLineChangeDeleted:
634 for i:= FList.Count-1 downto 0 do
635 begin
636 Rng:= FList.ItemPtr(i);
637 if Rng^.Tag<>cTagPersistentFoldRange then Continue;
638
639 if Rng^.Y>=ALineIndex+AItemCount then
640 begin
641 Rng^.Y-= AItemCount;
642 Rng^.Y2-= AItemCount;
643 end
644 else
645 if Rng^.Y>=ALineIndex then
646 begin
647 if Rng^.Y2<=ALineIndex+AItemCount then
648 FList.Delete(i)
649 else
650 begin
651 Rng^.Y:= Max(Rng^.Y-AItemCount, ALineIndex);
652 Rng^.Y2-= AItemCount;
653 end;
654 end
655 else
656 if Rng^.Y2>=ALineIndex then
657 begin
658 Rng^.Y2:= ALineIndex;
659 end;
660 end;
661
662 cLineChangeAdded:
663 for i:= FList.Count-1 downto 0 do
664 begin
665 Rng:= FList.ItemPtr(i);
666 if Rng^.Tag<>cTagPersistentFoldRange then Continue;
667
668 if Rng^.Y>=ALineIndex then
669 begin
670 Rng^.Y+= AItemCount;
671 Rng^.Y2+= AItemCount;
672 end
673 else
674 if Rng^.Y2>=ALineIndex then
675 begin
676 Rng^.Y2+= AItemCount;
677 end;
678 end;
679 end;
680
681 UpdateLineIndexer;
682 end;
683
684 procedure TATSynRanges.UpdateLineIndexer;
685 var
686 Ptr: PATSynRange;
687 i: integer;
688 begin
689 ClearLineIndexer(Length(FLineIndexer));
690 for i:= 0 to FList.Count-1 do
691 begin
692 Ptr:= ItemPtr(i);
693 AddToLineIndexer(Ptr^.Y, Ptr^.Y2, i);
694 end;
695 end;
696
MessageLineIndexernull697 function TATSynRanges.MessageLineIndexer(AMaxCount: integer): string;
698 var
699 S: string;
700 i, iLine: integer;
701 begin
702 Result:= '';
703 for iLine:= 0 to Min(High(FLineIndexer), AMaxCount) do
704 begin
705 S:= IntToStr(iLine)+': ';
706 for i:= 0 to High(FLineIndexer[iLine]) do
707 S+= IntToStr(FLineIndexer[iLine][i])+' ';
708 Result+= S+#10;
709 end;
710 end;
711
712
713 end.
714
715