1 {
2 Copyright (C) Alexey Torgashin, uvviewsoft.com
3 License: MPL 2.0 or LGPL
4 }
5 unit ATSynEdit_SortedRange;
6
7 {$mode objfpc}{$H+}
8 {$ModeSwitch advancedrecords}
9
10 interface
11
12 uses
13 Classes, SysUtils, Graphics, Math,
14 ATStrings,
15 ATStringProc,
16 ATSynEdit,
17 ATSynEdit_Carets,
18 ATSynEdit_FGL,
19 ec_SyntAnal,
20 ec_syntax_format;
21
22 type
23 TATRangeCond = (cCondInside, cCondAtBound, cCondOutside);
24
25 type
26 { TATIntegerWithPointer }
27
28 TATIntegerWithPointer = record
29 Value: integer;
30 Ptr: pointer;
31 class operator =(const a, b: TATIntegerWithPointer): boolean;
32 end;
33
34 { TATIntegersWithPointers }
35
36 TATIntegersWithPointers = class(specialize TFPGList<TATIntegerWithPointer>)
37 public
FindByIntegernull38 function FindByInteger(AValue: integer): pointer;
39 procedure SortByInteger;
40 end;
41
ComparePointsnull42 function ComparePoints(const P1, P2: TPoint): integer; inline;
43
44 type
45 { TATSortedRange }
46
47 PATSortedRange = ^TATSortedRange;
48 TATSortedRange = record
49 Pos1, Pos2: TPoint;
50 Pos1Wide, Pos2Wide: TPoint;
51 Token1, Token2: integer;
52 Color: TColor;
53 Rule: TecTagBlockCondition;
54 ActiveAlways: boolean;
55 Active: array[0..Pred(cMaxStringsClients)] of boolean;
56 class operator =(const a, b: TATSortedRange): boolean;
57 procedure Init(
58 const APos1, APos2: TPoint;
59 const APos1Wide, APos2Wide: TPoint;
60 AToken1, AToken2: integer;
61 AColor: TColor; ARule: TecTagBlockCondition;
62 AActiveAlways: boolean);
IsPosInsidenull63 function IsPosInside(const APos: TPoint): boolean;
IsPosInsideWidenull64 function IsPosInsideWide(const APos: TPoint): boolean;
65 end;
66
67 { TATSortedRanges }
68
69 TATSortedRanges = class(specialize TFPGList<TATSortedRange>)
70 private
71 FBoundTokensIndexer: TATIntegersWithPointers;
72 FLineIndexer: array of array of integer;
73 public
ItemPtrnull74 function ItemPtr(AIndex: integer): PATSortedRange; inline;
Findnull75 function Find(const APos: TPoint; AEditorIndex: integer; AOnlyActive: boolean): integer;
FindByLineIndexernull76 function FindByLineIndexer(const APos: TPoint; AEditorIndex: integer; AOnlyActive: boolean): integer;
FindStyleByTokenIndexnull77 function FindStyleByTokenIndex(ATokenIndex, AEditorIndex: integer): TecSyntaxFormat;
78 procedure UpdateOnChange(AChange: TATLineChangeKind; ALine, AItemCount: integer);
CheckCaretInRangenull79 function CheckCaretInRange(Ed: TATSynEdit; const APos1, APos2: TPoint;
80 ACond: TATRangeCond): boolean;
81 procedure UpdateRangesActive(Ed: TATSynEdit);
82 procedure UpdateBoundIndexer;
83 procedure UpdateLineIndexer(ALineCount: integer);
84 procedure DeactivateNotMinimalRanges(Ed: TATSynEdit);
85 destructor Destroy; override;
86 procedure Clear;
87 procedure ClearBoundIndexer;
88 procedure ClearLineIndexer;
DebugLineIndexernull89 function DebugLineIndexer: string;
90 end;
91
92 implementation
93
ComparePointsnull94 function ComparePoints(const P1, P2: TPoint): integer; inline;
95 begin
96 if (P1.X=P2.X) and (P1.Y=P2.Y) then exit(0);
97 if (P1.Y>P2.Y) then exit(1);
98 if (P1.Y<P2.Y) then exit(-1);
99 if (P1.X>P2.X) then exit(1) else exit(-1);
100 end;
101
102 { TATIntegerWithPointer }
103
104 class operator TATIntegerWithPointer.=(const a, b: TATIntegerWithPointer): boolean;
105 begin
106 Result:= false;
107 end;
108
109 { TATIntegersWithPointers }
110
FindByIntegernull111 function TATIntegersWithPointers.FindByInteger(AValue: integer): pointer;
112 var
113 a, b, m, dif, NCount: integer;
114 begin
115 Result:= nil;
116 NCount:= Count;
117 if NCount=0 then
118 Exit;
119
120 a:= 0;
121 b:= NCount-1;
122 while a<=b do
123 begin
124 m:= (a+b) div 2;
125 dif:= _GetItemPtr(m)^.Value - AValue;
126 if dif<0 then
127 a:= m+1
128 else
129 if dif=0 then
130 Exit(_GetItemPtr(m)^.Ptr)
131 else
132 b:= m-1;
133 end;
134 end;
135
Compare_IntegerWithPointernull136 function Compare_IntegerWithPointer(const a, b: TATIntegerWithPointer): integer;
137 begin
138 Result:= a.Value - b.Value;
139 end;
140
141 procedure TATIntegersWithPointers.SortByInteger;
142 begin
143 Sort(@Compare_IntegerWithPointer);
144 end;
145
146 { TATSortedRange }
147
148 class operator TATSortedRange.=(const a, b: TATSortedRange): boolean;
149 begin
150 Result:= false;
151 end;
152
153 procedure TATSortedRange.Init(const APos1, APos2: TPoint; const APos1Wide, APos2Wide: TPoint; AToken1,
154 AToken2: integer; AColor: TColor; ARule: TecTagBlockCondition; AActiveAlways: boolean);
155 var
156 i: integer;
157 begin
158 Pos1:= APos1;
159 Pos2:= APos2;
160 Pos1Wide:= APos1Wide;
161 Pos2Wide:= APos2Wide;
162 Token1:= AToken1;
163 Token2:= AToken2;
164 Color:= AColor;
165 Rule:= ARule;
166 ActiveAlways:= AActiveAlways;
167 for i:= Low(Active) to High(Active) do
168 Active[i]:= false;
169 end;
170
TATSortedRange.IsPosInsidenull171 function TATSortedRange.IsPosInside(const APos: TPoint): boolean;
172 begin
173 Result:= IsPosInRange(
174 APos.X, APos.Y,
175 Pos1.X, Pos1.Y,
176 Pos2.X, Pos2.Y
177 ) = cRelateInside;
178 end;
179
TATSortedRange.IsPosInsideWidenull180 function TATSortedRange.IsPosInsideWide(const APos: TPoint): boolean;
181 begin
182 Result:= IsPosInRange(
183 APos.X, APos.Y,
184 Pos1Wide.X, Pos1Wide.Y,
185 Pos2Wide.X, Pos2Wide.Y
186 ) = cRelateInside;
187 end;
188
189 { TATSortedRanges }
190
TATSortedRanges.Findnull191 function TATSortedRanges.Find(const APos: TPoint; AEditorIndex: integer; AOnlyActive: boolean): integer;
192
CompProcnull193 function CompProc(ItemIndex: integer): integer; inline;
194 var
195 Item: PATSortedRange;
196 bOk: boolean;
197 begin
198 Item:= ItemPtr(ItemIndex);
199
200 if AOnlyActive then
201 bOk:= Item^.ActiveAlways or Item^.Active[AEditorIndex]
202 else
203 bOk:= true;
204
205 if bOk and Item^.IsPosInside(APos) then
206 Result:= 0
207 else
208 Result:= ComparePoints(Item^.Pos1, APos);
209 end;
210
211 var
212 L, H, I, C, NCount: Integer;
213 bOk: boolean;
214 Item: PATSortedRange;
215 begin
216 Result := -1;
217 NCount := Count;
218 if NCount = 0 then
219 Exit;
220
221 L := 0;
222 H := NCount - 1;
223 while L <= H do
224 begin
225 I := (L + H) shr 1;
226 C := CompProc(I);
227 if C < 0 then
228 L := I + 1
229 else
230 if C = 0 then
231 Exit(I)
232 else
233 H := I - 1;
234 end;
235
236 Result := L;
237 if Result >= NCount then
238 Result := NCount - 1;
239 if Result >= 0 then
240 if CompProc(Result) > 0 then
241 Dec(Result);
242
243 if AOnlyActive then
244 if Result>=0 then
245 begin
246 Item:= ItemPtr(Result);
247 bOk:= Item^.ActiveAlways or Item^.Active[AEditorIndex];
248 if not bOk then
249 Result:= -1;
250 end;
251 end;
252
FindByLineIndexernull253 function TATSortedRanges.FindByLineIndexer(const APos: TPoint; AEditorIndex: integer; AOnlyActive: boolean): integer;
254 var
255 Rng: PATSortedRange;
256 NLine, iItem, iRange: integer;
257 begin
258 Result:= -1;
259
260 NLine:= APos.Y;
261 if NLine>High(FLineIndexer) then exit;
262
263 //test all ranges listed in FLineIndexer[NLine]
264 for iItem:= High(FLineIndexer[NLine]) downto 0 do
265 begin
266 iRange:= FLineIndexer[NLine][iItem];
267 Rng:= ItemPtr(iRange);
268 if (not AOnlyActive) or (Rng^.ActiveAlways or Rng^.Active[AEditorIndex]) then
269 if Rng^.IsPosInsideWide(APos) then
270 exit(iRange);
271 end;
272 end;
273
TATSortedRanges.FindStyleByTokenIndexnull274 function TATSortedRanges.FindStyleByTokenIndex(ATokenIndex, AEditorIndex: integer): TecSyntaxFormat;
275 var
276 Rng: PATSortedRange;
277 begin
278 Result:= nil;
279 if FBoundTokensIndexer=nil then
280 exit;
281 Rng:= FBoundTokensIndexer.FindByInteger(ATokenIndex);
282 if Assigned(Rng) then
283 if Rng^.Active[AEditorIndex] then
284 Result:= Rng^.Rule.Style;
285 end;
286
ItemPtrnull287 function TATSortedRanges.ItemPtr(AIndex: integer): PATSortedRange;
288 begin
289 Result:= PATSortedRange(InternalGet(AIndex));
290 end;
291
292 procedure TATSortedRanges.UpdateOnChange(AChange: TATLineChangeKind; ALine, AItemCount: integer);
293 var
294 Ptr: PATSortedRange;
295 i: integer;
296 begin
297 case AChange of
298 cLineChangeDeletedAll:
299 Clear;
300
301 cLineChangeAdded:
302 begin
303 for i:= Count-1 downto 0 do
304 begin
305 Ptr:= InternalGet(i);
306 if Ptr^.Pos1.Y>=ALine then
307 begin
308 Ptr^.Pos1.Y+= AItemCount;
309 Ptr^.Pos2.Y+= AItemCount;
310 end
311 else
312 if Ptr^.Pos2.Y>=ALine then
313 Ptr^.Pos2.Y+= AItemCount;
314 end;
315 end;
316
317 cLineChangeDeleted:
318 begin
319 for i:= Count-1 downto 0 do
320 begin
321 Ptr:= InternalGet(i);
322 if Ptr^.Pos1.Y>=ALine+AItemCount then
323 begin
324 Ptr^.Pos1.Y-= AItemCount;
325 Ptr^.Pos2.Y-= AItemCount;
326 end
327 else
328 if Ptr^.Pos1.Y>=ALine then
329 begin
330 if Ptr^.Pos2.Y<=ALine+AItemCount then
331 Delete(i)
332 else
333 begin
334 Ptr^.Pos1.Y:= Max(ALine, Ptr^.Pos1.Y-AItemCount);
335 Ptr^.Pos2.Y-= AItemCount;
336 end;
337 end
338 else
339 if Ptr^.Pos2.Y>=ALine then
340 begin
341 Ptr^.Pos2.Y:= Max(ALine, Ptr^.Pos2.Y-AItemCount);
342 end;
343 end;
344 end;
345 end;
346 end;
347
348
TATSortedRanges.CheckCaretInRangenull349 function TATSortedRanges.CheckCaretInRange(Ed: TATSynEdit;
350 const APos1, APos2: TPoint;
351 ACond: TATRangeCond): boolean;
352 var
353 Caret: TATCaretItem;
354 Pnt: TPoint;
355 dif1, dif2: integer;
356 i: integer;
357 ok: boolean;
358 begin
359 Result:= false;
360
361 for i:= 0 to Ed.Carets.Count-1 do
362 begin
363 Caret:= Ed.Carets[i];
364 Pnt.X:= Caret.PosX;
365 Pnt.Y:= Caret.PosY;
366
367 dif1:= ComparePoints(Pnt, APos1);
368 dif2:= ComparePoints(Pnt, APos2);
369
370 case ACond of
371 cCondInside:
372 ok:= (dif1>=0) and (dif2<0);
373 cCondOutside:
374 ok:= (dif1<0) or (dif2>=0);
375 cCondAtBound:
376 ok:= (dif1=0) or (dif2=0);
377 else
378 ok:= false;
379 end;
380
381 if ok then exit(true);
382 end;
383 end;
384
385 procedure TATSortedRanges.UpdateRangesActive(Ed: TATSynEdit);
386 var
387 Rng: PATSortedRange;
388 act: boolean;
389 i: integer;
390 begin
391 for i:= 0 to Count-1 do
392 begin
393 Rng:= ItemPtr(i);
394 if Rng^.ActiveAlways then
395 act:= true
396 else
397 begin
398 if Rng^.Rule=nil then Continue;
399 if not (Rng^.Rule.DynHighlight in [dhRange, dhRangeNoBound, dhBound]) then Continue;
400 case Rng^.Rule.HighlightPos of
401 cpAny:
402 act:= true;
403 cpBound:
404 act:= CheckCaretInRange(Ed, Rng^.Pos1, Rng^.Pos2, cCondAtBound);
405 cpBoundTag:
406 act:= false;//todo
407 cpRange:
408 act:= CheckCaretInRange(Ed, Rng^.Pos1, Rng^.Pos2, cCondInside);
409 cpBoundTagBegin:
410 act:= false;//todo
411 cpOutOfRange:
412 act:= CheckCaretInRange(Ed, Rng^.Pos1, Rng^.Pos2, cCondOutside);
413 else
414 act:= false;
415 end;
416 end;
417 Rng^.Active[Ed.EditorIndex]:= act;
418 end;
419 end;
420
421 procedure TATSortedRanges.UpdateBoundIndexer;
422 var
423 Pair: TATIntegerWithPointer;
424 Rng: PATSortedRange;
425 i: integer;
426 begin
427 if FBoundTokensIndexer=nil then
428 FBoundTokensIndexer:= TATIntegersWithPointers.Create;
429 FBoundTokensIndexer.Clear;
430 for i:= 0 to Count-1 do
431 begin
432 Rng:= ItemPtr(i);
433 Pair.Value:= Rng^.Token1;
434 Pair.Ptr:= Rng;
435 FBoundTokensIndexer.Add(Pair);
436 Pair.Value:= Rng^.Token2;
437 FBoundTokensIndexer.Add(Pair);
438 end;
439 FBoundTokensIndexer.SortByInteger;
440 end;
441
442 procedure TATSortedRanges.UpdateLineIndexer(ALineCount: integer);
443 var
444 NCount, NItemLen: integer;
445 iRange, iLine: integer;
446 Ptr: PATSortedRange;
447 begin
448 for iLine:= High(FLineIndexer) downto 0 do
449 SetLength(FLineIndexer[iLine], 0);
450
451 SetLength(FLineIndexer, ALineCount);
452 if ALineCount=0 then exit;
453
454 NCount:= Count;
455 if NCount=0 then exit;
456
457 for iRange:= 0 to NCount-1 do
458 begin
459 Ptr:= ItemPtr(iRange);
460 for iLine:= Ptr^.Pos1.Y to Ptr^.Pos2.Y do
461 begin
462 NItemLen:= Length(FLineIndexer[iLine]);
463 SetLength(FLineIndexer[iLine], NItemLen+1);
464 FLineIndexer[iLine][NItemLen]:= iRange;
465 end;
466 end;
467 end;
468
TATSortedRanges.DebugLineIndexernull469 function TATSortedRanges.DebugLineIndexer: string;
470 var
471 S: string;
472 i, iLine: integer;
473 begin
474 Result:= '';
475 for iLine:= 0 to Min(High(FLineIndexer), 30) do
476 begin
477 S:= IntToStr(iLine)+': ';
478 for i:= 0 to High(FLineIndexer[iLine]) do
479 S+= IntToStr(FLineIndexer[iLine][i])+' ';
480 Result+= S+#10;
481 end;
482 end;
483
484 procedure TATSortedRanges.DeactivateNotMinimalRanges(Ed: TATSynEdit);
485 var
486 Rng, RngOut: PATSortedRange;
487 i, j: integer;
488 begin
489 for i:= Count-1 downto 0 do
490 begin
491 Rng:= ItemPtr(i);
492 if not Rng^.Active[Ed.EditorIndex] then Continue;
493 if Rng^.Rule=nil then Continue;
494 if not Rng^.Rule.DynSelectMin then Continue;
495 if not (Rng^.Rule.DynHighlight in [dhBound, dhRange, dhRangeNoBound]) then Continue;
496 //take prev ranges which contain this range
497 for j:= i-1 downto 0 do
498 begin
499 RngOut:= ItemPtr(j);
500 if RngOut^.Rule=Rng^.Rule then
501 if RngOut^.Active[Ed.EditorIndex] then
502 if (ComparePoints(RngOut^.Pos1, Rng^.Pos1)<=0) and
503 (ComparePoints(RngOut^.Pos2, Rng^.Pos2)>=0) then
504 RngOut^.Active[Ed.EditorIndex]:= false;
505 end;
506 end;
507 end;
508
509 destructor TATSortedRanges.Destroy;
510 begin
511 Clear;
512 if Assigned(FBoundTokensIndexer) then
513 FreeAndNil(FBoundTokensIndexer);
514 inherited;
515 end;
516
517 procedure TATSortedRanges.Clear;
518 begin
519 ClearBoundIndexer;
520 ClearLineIndexer;
521 inherited Clear;
522 end;
523
524 procedure TATSortedRanges.ClearBoundIndexer;
525 begin
526 if Assigned(FBoundTokensIndexer) then
527 FBoundTokensIndexer.Clear;
528 end;
529
530 procedure TATSortedRanges.ClearLineIndexer;
531 var
532 iLine: integer;
533 begin
534 for iLine:= High(FLineIndexer) downto 0 do
535 SetLength(FLineIndexer[iLine], 0);
536 SetLength(FLineIndexer, 0);
537 end;
538
539 end.
540
541