1 {
2 Copyright (C) Alexey Torgashin, uvviewsoft.com
3 License: MPL 2.0 or LGPL
4 }
5 unit ATSynEdit_Adapter_EControl;
6
7 {$mode objfpc}{$H+}
8
9 interface
10
11 uses
12 Classes, SysUtils, Graphics, ExtCtrls, ComCtrls,
13 Forms, Dialogs,
14 syncobjs,
15 ATSynEdit,
16 ATSynEdit_LineParts,
17 ATSynEdit_Adapters,
18 ATSynEdit_Carets,
19 ATSynEdit_Ranges,
20 ATSynEdit_SortedRange,
21 ATStringProc,
22 ATStringProc_Separator,
23 ATStringProc_TextBuffer,
24 ATStrings,
25 ec_syntax_format,
26 ec_SyntAnal;
27
28 type
29 { TATRangeInCodeTree }
30
31 TATRangeInCodeTree = class
32 public
33 PosBegin: TPoint;
34 PosEnd: TPoint;
35 DataString: string; //for CudaText plugins
36 procedure Assign(Src: TATRangeInCodeTree);
37 end;
38
39 type
40 TATEditorEvent = procedure(Sender: TATSynEdit) of object;
41
42 type
43 { TATAdapterEControl }
44
45 TATAdapterEControl = class(TATAdapterHilite)
46 private type
47 TATAdapterProgressKind = (epkFirst, epkSecond, epkBoth);
48 private
49 EdList: TFPList;
50 Buffer: TATStringBuffer;
51 FRangesColored: TATSortedRanges;
52 FRangesColoredBounds: TATSortedRanges;
53 FRangesSublexer: TATSortedRanges;
54 FEnabledLineSeparators: boolean;
55 FEnabledSublexerTreeNodes: boolean;
56 FBusyTreeUpdate: boolean;
57 FStopTreeUpdate: boolean;
58 FTimeParseBegin: QWORD;
59 FTimeParseElapsed: integer;
60 FOnLexerChange: TATEditorEvent;
61 FOnParseBegin: TNotifyEvent;
62 FOnParseDone: TNotifyEvent;
63 procedure DebugIntegersWithPointers(L: TATIntegersWithPointers);
64 procedure DebugRangesColored;
65 procedure DoCheckEditorList; inline;
66 procedure ClearFoldIndexers;
67 procedure DoFoldAdd(AX, AY, AY2: integer; AStaple: boolean; const AHint: string);
68 procedure DoCalcParts(var AParts: TATLineParts; ALine, AX, ALen: integer;
69 AColorFont, AColorBG: TColor; var AColorAfter: TColor; AEditorIndex: integer);
70 procedure ClearRanges;
DoFindTokennull71 function DoFindToken(APos: TPoint; AExactPos: boolean = false): integer;
GetTokenColor_FromBoundRangesnull72 function GetTokenColor_FromBoundRanges(ATokenIndex, AEditorIndex: integer): TecSyntaxFormat;
73 procedure DoFoldFromLinesHidden;
74 procedure DoChangeLog(Sender: TObject; ALine: integer);
75 procedure ParseBegin;
76 procedure ParseDone(Sender: TObject);
77 procedure ProgressFirst(Sender: TObject);
78 procedure ProgressSecond(Sender: TObject);
79 procedure ProgressBoth(Sender: TObject);
GetRangeParentnull80 function GetRangeParent(const R: TecTextRange): TecTextRange;
GetTokenColorBG_FromColoredRangesnull81 function GetTokenColorBG_FromColoredRanges(const APos: TPoint; ADefColor: TColor;
82 AEditorIndex: integer): TColor;
GetTokenColorBG_FromMultiLineTokensnull83 function GetTokenColorBG_FromMultiLineTokens(APos: TPoint;
84 ADefColor: TColor; AEditorIndex: integer): TColor;
EditorRunningCommandnull85 function EditorRunningCommand: boolean;
86 procedure UpdateBuffer(ABuffer: TATStringBuffer);
87 procedure UpdatePublicDataNeedTo;
88 procedure UpdateRanges;
89 procedure UpdateRangesActive(AEdit: TATSynEdit);
90 procedure UpdateRangesActiveAll;
91 procedure UpdateRangesSublex;
92 procedure UpdateEditors(AKind: TATAdapterProgressKind);
GetLexernull93 function GetLexer: TecSyntAnalyzer;
94 procedure SetLexer(AAnalizer: TecSyntAnalyzer);
GetLexerSuportsDynamicHilitenull95 function GetLexerSuportsDynamicHilite: boolean;
IsDynamicHiliteEnablednull96 function IsDynamicHiliteEnabled: boolean;
97 public
98 AnClient: TecClientSyntAnalyzer;
99 //
100 constructor Create(AOwner: TComponent); override;
101 destructor Destroy; override;
102 //
103 procedure AddEditor(AEditor: TComponent);
104 property Lexer: TecSyntAnalyzer read GetLexer write SetLexer;
105 property LexerParsingElapsed: integer read FTimeParseElapsed;
LexerAtPosnull106 function LexerAtPos(Pnt: TPoint): TecSyntAnalyzer;
107 property EnabledSublexerTreeNodes: boolean read FEnabledSublexerTreeNodes write FEnabledSublexerTreeNodes default false;
108 procedure ParseFromLine(ALine: integer; AWait: boolean);
109 procedure Stop;
Editornull110 function Editor: TATSynEdit;
111 procedure StopTreeUpdate;
IsParsingBusynull112 function IsParsingBusy: boolean;
DebugStringnull113 function DebugString: string;
114 procedure UpdateRangesFoldAndColored;
115
116 //tokens
117 procedure __GetTokenWithIndex(AIndex: integer; out APntFrom, APntTo: TPoint;
118 out ATokenString, ATokenStyle: string; out ATokenKind: TATTokenKind);
119 procedure __GetTokenAtPos(APos: TPoint; out APntFrom, APntTo: TPoint;
120 out ATokenString, ATokenStyle: string; out ATokenKind: TATTokenKind);
GetTokenKindAtPosnull121 function GetTokenKindAtPos(APos: TPoint): TATTokenKind;
GetTokenStringnull122 function GetTokenString(const token: PecSyntToken): string;
123 procedure GetTokenProps(const token: PecSyntToken; out APntFrom, APntTo: TPoint;
124 out ATokenString, ATokenStyle: string; out ATokenKind: TATTokenKind);
125
126 //support for syntax-tree
127 property TreeBusy: boolean read FBusyTreeUpdate;
128 procedure TreeFill(ATree: TTreeView);
129 procedure __TreeGetPositionOfRange_EC(const R: TecTextRange; out APosBegin, APosEnd: TPoint);
__TreeGetRangeOfPositionnull130 function __TreeGetRangeOfPosition(APos: TPoint): TecTextRange; //unused function
131
132 //sublexers
133 function SublexerRangeCount: integer;
SublexerRangePropsnull134 function SublexerRangeProps(AIndex: integer; out AStart, AEnd: TPoint; out
135 ALexerName: string): boolean;
136
137 public
138 procedure OnEditorScroll(Sender: TObject); override;
139 procedure OnEditorCaretMove(Sender: TObject); override;
140 procedure OnEditorChangeEx(Sender: TObject; AChange: TATLineChangeKind; ALine, AItemCount: integer); override;
141 procedure OnEditorCalcHilite(Sender: TObject;
142 var AParts: TATLineParts;
143 ALineIndex, ACharIndex, ALineLen: integer;
144 var AColorAfterEol: TColor;
145 AMainText: boolean); override;
146 procedure OnEditorCalcPosColor(Sender: TObject;
147 AX, AY: integer; var AColor: TColor); override;
IsParsedAtLeastPartiallynull148 function IsParsedAtLeastPartially: boolean; override;
GetLexerNamenull149 function GetLexerName: string; override;
IsDataReadynull150 function IsDataReady: boolean; override;
IsDataReadyPartiallynull151 function IsDataReadyPartially: boolean; override;
152
153 published
154 property OnLexerChange: TATEditorEvent read FOnLexerChange write FOnLexerChange;
155 property OnParseBegin: TNotifyEvent read FOnParseBegin write FOnParseBegin;
156 property OnParseDone: TNotifyEvent read FOnParseDone write FOnParseDone;
157 end;
158
159 procedure ApplyPartStyleFromEcontrolStyle(var part: TATLinePart; st: TecSyntaxFormat);
160
CodetreeFindItemForPositionnull161 function CodetreeFindItemForPosition(ATree: TTreeView; APosX, APosY: integer): TTreeNode;
162 procedure CodetreeSelectItemForPosition(ATree: TTreeView; APosX, APosY: integer);
163
164 implementation
165
166 uses Math;
167
168 const
169 cBorderEc: array[TecBorderLineType] of TATLineStyle = (
170 cLineStyleNone,
171 cLineStyleSolid,
172 cLineStyleDash,
173 cLineStyleDash,
174 cLineStyleDash,
175 cLineStyleDash,
176 cLineStyleSolid2px,
177 cLineStyleSolid2px,
178 cLineStyleWave,
179 cLineStyleDotted
180 );
181
182 procedure ApplyPartStyleFromEcontrolStyle(var part: TATLinePart; st: TecSyntaxFormat); inline;
183 var
184 NStyles: byte;
185 begin
186 if st.FormatType in [ftCustomFont, ftFontAttr, ftColor, ftBackGround] then
187 begin
188 if st.BgColor<>clNone then
189 part.ColorBG:= st.BgColor;
190 end;
191
192 if Assigned(st.Font) then
193 begin
194 if st.FormatType in [ftCustomFont, ftFontAttr, ftColor] then
195 begin
196 if st.Font.Color<>clNone then
197 part.ColorFont:= st.Font.Color;
198 end;
199 if st.FormatType in [ftCustomFont, ftFontAttr] then
200 begin
201 NStyles:= 0;
202 if fsBold in st.Font.Style then
203 NStyles:= NStyles or afsFontBold;
204 if fsItalic in st.Font.Style then
205 NStyles:= NStyles or afsFontItalic;
206 if fsStrikeOut in st.Font.Style then
207 NStyles:= NStyles or afsFontCrossed;
208 part.FontStyles:= NStyles;
209 end;
210 end;
211
212 part.ColorBorder:= st.BorderColorBottom;
213 part.BorderUp:= cBorderEc[st.BorderTypeTop];
214 part.BorderDown:= cBorderEc[st.BorderTypeBottom];
215 part.BorderLeft:= cBorderEc[st.BorderTypeLeft];
216 part.BorderRight:= cBorderEc[st.BorderTypeRight];
217 end;
218
219 { TATRangeInCodeTree }
220
221 procedure TATRangeInCodeTree.Assign(Src: TATRangeInCodeTree);
222 begin
223 PosBegin:= Src.PosBegin;
224 PosEnd:= Src.PosEnd;
225 DataString:= Src.DataString;
226 end;
227
228
229 { TATAdapterEControl }
230
231 procedure TATAdapterEControl.DoCheckEditorList; inline;
232 begin
233 if EdList.Count=0 then
234 raise Exception.Create('Adapter: Empty editor list');
235 end;
236
237 procedure TATAdapterEControl.OnEditorCalcHilite(Sender: TObject;
238 var AParts: TATLineParts; ALineIndex, ACharIndex, ALineLen: integer;
239 var AColorAfterEol: TColor; AMainText: boolean);
240 var
241 Ed: TATSynEdit;
242 begin
243 if AnClient=nil then Exit;
244 DoCheckEditorList;
245 Ed:= TATSynEdit(Sender);
246
247 AnClient.CriSecForData.Enter;
248 try
249 AColorAfterEol:= clNone;
250 DoCalcParts(AParts, ALineIndex, ACharIndex-1, ALineLen,
251 Ed.Colors.TextFont,
252 clNone,
253 AColorAfterEol,
254 Ed.EditorIndex);
255 finally
256 AnClient.CriSecForData.Leave;
257 end;
258 end;
259
260 procedure TATAdapterEControl.OnEditorCalcPosColor(Sender: TObject; AX,
261 AY: integer; var AColor: TColor);
262 var
263 Ed: TATSynEdit;
264 NColor: TColor;
265 begin
266 if AnClient=nil then exit;
267 Ed:= Sender as TATSynEdit;
268
269 //this is for lexer "ranges" with BG color
270 NColor:= GetTokenColorBG_FromColoredRanges(Point(AX, AY), clNone, Ed.EditorIndex);
271 if NColor<>clNone then
272 begin
273 AColor:= NColor;
274 exit;
275 end;
276
277 AnClient.CriSecForData.Enter;
278 try
279 //this is for multi-line tokens with BG color
280 //example: code-blocks in reST lexer
281 NColor:= GetTokenColorBG_FromMultiLineTokens(Point(AX, AY), clNone, Ed.EditorIndex);
282 if NColor<>clNone then
283 begin
284 AColor:= NColor;
285 exit;
286 end;
287 finally
288 AnClient.CriSecForData.Leave;
289 end;
290 end;
291
TATAdapterEControl.IsParsedAtLeastPartiallynull292 function TATAdapterEControl.IsParsedAtLeastPartially: boolean;
293 begin
294 if Assigned(AnClient) then
295 Result:= AnClient.PublicData.FinishedPartially
296 else
297 Result:= true; //return 'true' for none-lexer
298 end;
299
TATAdapterEControl.GetLexerNamenull300 function TATAdapterEControl.GetLexerName: string;
301 begin
302 if Assigned(AnClient) then
303 Result:= AnClient.Owner.LexerName
304 else
305 Result:= '-';
306 end;
307
TATAdapterEControl.GetTokenColorBG_FromMultiLineTokensnull308 function TATAdapterEControl.GetTokenColorBG_FromMultiLineTokens(APos: TPoint;
309 ADefColor: TColor; AEditorIndex: integer): TColor;
310 //all calls of this func must be guarded by CriSecForData.Enter/Leave
311 var
312 Token: PecSyntToken;
313 NToken: integer;
314 begin
315 Result:= ADefColor;
316 if AnClient=nil then exit;
317 NToken:= DoFindToken(APos);
318 if NToken<0 then exit;
319 if not AnClient.PublicData.Tokens.IsIndexValid(NToken) then exit;
320
321 Token:= AnClient.PublicData.Tokens._GetItemPtr(NToken);
322 if IsPosInRange(
323 APos.X, APos.Y,
324 Token^.Range.PointStart.X, Token^.Range.PointStart.Y,
325 Token^.Range.PointEnd.X, Token^.Range.PointEnd.Y) = cRelateInside then
326 if Token^.Style<>nil then
327 Result:= Token^.Style.BgColor;
328 end;
329
330
331 procedure TATAdapterEControl.DebugRangesColored;
332 var
333 Rng: PATSortedRange;
334 begin
335 if FRangesColored.Count>0 then
336 begin
337 Rng:= FRangesColored.ItemPtr(0);
338 Application.MainForm.Caption:= Format('RngColored: (%d,%d..%d,%d)',
339 [Rng^.Pos1.X, Rng^.Pos1.Y, Rng^.Pos2.X, Rng^.Pos2.Y]);
340 end;
341 end;
342
TATAdapterEControl.GetTokenColorBG_FromColoredRangesnull343 function TATAdapterEControl.GetTokenColorBG_FromColoredRanges(const APos: TPoint;
344 ADefColor: TColor; AEditorIndex: integer): TColor;
345 var
346 Rng: PATSortedRange;
347 N: integer;
348 begin
349 Result:= ADefColor;
350
351 //cannot use binary search (Find) here, because of nested ranges
352 N:= FRangesColored.FindByLineIndexer(APos, AEditorIndex, true);
353 if N>=0 then
354 exit(FRangesColored.ItemPtr(N)^.Color);
355
356 N:= FRangesSublexer.FindByLineIndexer(APos, AEditorIndex, false);
357 if N>=0 then
358 begin
359 Rng:= FRangesSublexer.ItemPtr(N);
360 if Rng^.IsPosInside(APos) then
361 exit(Rng^.Color);
362 end;
363 end;
364
365 procedure TATAdapterEControl.UpdateRangesActive(AEdit: TATSynEdit);
366 begin
367 if not IsDynamicHiliteEnabled then Exit;
368
369 FRangesColored.UpdateRangesActive(AEdit);
370 FRangesColoredBounds.UpdateRangesActive(AEdit);
371
372 FRangesColored.DeactivateNotMinimalRanges(AEdit);
373 FRangesColoredBounds.DeactivateNotMinimalRanges(AEdit);
374 end;
375
376
377 procedure TATAdapterEControl.DoCalcParts(var AParts: TATLineParts; ALine, AX,
378 ALen: integer; AColorFont, AColorBG: TColor; var AColorAfter: TColor; AEditorIndex: integer);
379 //all calls of this proc must be guarded by CriSecForData.Enter/Leave
380 var
381 partindex: integer;
382 //
383 procedure AddMissingPart(AOffset, ALen: integer); inline;
384 var
385 part: PATLinePart;
386 begin
387 if ALen<=0 then Exit;
388 part:= @AParts[partindex];
389 FillChar(part^, SizeOf(TATLinePart), 0);
390
391 part^.Offset:= AOffset;
392 part^.Len:= ALen;
393
394 (*
395 ////cannot make this code OK for test Markdown file with long wrapped lines,
396 ////some text chars have clNone, like white
397
398 //check that part's last char is space (ie it's space part),
399 //and set for it clNone
400 if Strings.LineCharAt(ALine, AOffset+ALen+AX-1)=' ' then
401 part^.ColorFont:= clNone
402 else
403 *)
404 part^.ColorFont:= AColorFont;
405
406 part^.ColorBG:= GetTokenColorBG_FromColoredRanges(
407 Point(AX+AOffset, ALine),
408 AColorBG,
409 AEditorIndex);
410
411 Inc(partindex);
412 end;
413 //
414 var
415 tokenStart, tokenEnd, TestPoint: TPoint;
416 startindex, mustOffset: integer;
417 token: PecSyntToken;
418 tokenStyle, tokenStyle2: TecSyntaxFormat;
419 part: TATLinePart;
420 nColor: TColor;
421 i: integer;
422 begin
423 partindex:= 0;
424
425 if ALine<=High(AnClient.PublicData.TokenIndexer) then
426 startindex:= AnClient.PublicData.TokenIndexer[ALine]
427 else
428 startindex:= -1;
429
430 {
431 //don't exit, need more work for AColorAfter
432 if startindex<0 then
433 exit;
434 }
435
436 FillChar(part{%H-}, SizeOf(part), 0);
437
438 if startindex>=0 then
439 for i:= startindex to AnClient.PublicData.Tokens.Count-1 do
440 begin
441 token:= AnClient.PublicData.Tokens._GetItemPtr(i);
442 tokenStart:= token^.Range.PointStart;
443 tokenEnd:= token^.Range.PointEnd;
444
445 Dec(tokenStart.x, AX);
446 Dec(tokenEnd.x, AX);
447
448 if (tokenStart.y>ALine) then Break;
449 if (tokenStart.y>ALine) or (tokenEnd.y<ALine) then Continue;
450 if (tokenEnd.y<=ALine) and (tokenEnd.x<0) then Continue;
451 if (tokenStart.y>=ALine) and (tokenStart.x>=ALen) then Continue;
452
453 FillChar(part{%H-}, SizeOf(part), 0);
454 if (tokenStart.y<ALine) or (tokenStart.x<0) then
455 part.Offset:= 0
456 else
457 part.Offset:= tokenStart.X;
458
459 if (tokenEnd.y>ALine) or (tokenEnd.x>=ALen) then
460 part.Len:= ALen-part.Offset
461 else
462 part.Len:= tokenEnd.X-part.Offset;
463
464 part.ColorFont:= AColorFont;
465 part.ColorBG:= GetTokenColorBG_FromColoredRanges(token^.Range.PointStart, AColorBG, AEditorIndex);
466
467 tokenStyle:= token^.Style;
468 tokenStyle2:= GetTokenColor_FromBoundRanges(i, AEditorIndex);
469 if tokenStyle2<>nil then
470 tokenStyle:= tokenStyle2;
471 if tokenStyle<>nil then
472 ApplyPartStyleFromEcontrolStyle(part, tokenStyle);
473
474 //add missing part
475 if partindex=0 then
476 mustOffset:= 0
477 else
478 with AParts[partindex-1] do
479 mustOffset:= Offset+Len;
480
481 if part.Offset>mustOffset then
482 begin
483 AddMissingPart(mustOffset, part.Offset-mustOffset);
484 if partindex>=High(AParts) then Exit;
485 end;
486
487 //add calculated part
488 if part.Len>0 then
489 begin
490 AParts[partindex]:= part;
491 Inc(partindex);
492 if partindex>=High(AParts) then Exit;
493 end;
494 end;
495
496 //application.MainForm.Caption:= 'startindex '+inttostr(startindex)+' count-tokens '+inttostr(count);
497
498 //add ending missing part
499 //(not only if part.Len>0)
500 mustOffset:= part.Offset+part.Len;
501 if mustOffset<ALen then
502 AddMissingPart(mustOffset, ALen-mustOffset);
503
504 //calc AColorAfter
505 TestPoint:= Point(AX+ALen, ALine);
506
507 //a) calc it from colored-ranges
508 nColor:= GetTokenColorBG_FromColoredRanges(TestPoint, clNone, AEditorIndex);
509 //if (nColor=clNone) and (ALen>0) then
510 // nColor:= GetTokenColorBG_FromColoredRanges(mustOffset-1, clNone, AEditorIndex);
511
512 //b) calc it from multi-line tokens (with bg-color)
513 if (nColor=clNone) then
514 nColor:= GetTokenColorBG_FromMultiLineTokens(TestPoint, clNone, AEditorIndex);
515
516 if (nColor=clNone) then
517 nColor:= AColorAfter;
518 AColorAfter:= nColor;
519 end;
520
521 procedure TATAdapterEControl.ClearRanges;
522 var
523 j: integer;
524 Ed: TATSynEdit;
525 begin
526 FRangesColored.Clear;
527 FRangesColoredBounds.Clear;
528 FRangesSublexer.Clear;
529
530 for j:= 0 to EdList.Count-1 do
531 begin
532 Ed:= TATSynEdit(EdList[j]);
533
534 //Tag=-1 means persistent range from command "Fold selection"
535 if Ed.Fold.HasTagPersist then
536 Ed.Fold.DeleteAllExceptTag(cTagPersistentFoldRange)
537 else
538 Ed.Fold.Clear;
539
540 //Ed.Strings.ClearSeparators; //separators are not used in this adapter
541 end;
542 end;
543
544 (*
545 procedure TATAdapterEControl.DoClearRanges_OnlySimple;
546 var
547 Ed: TATSynEdit;
548 R: TATSynRange;
549 i, j: integer;
550 begin
551 for j:= 0 to EdList.Count-1 do
552 begin
553 Ed:= TATSynEdit(EdList[j]);
554 for i:= Ed.Fold.Count-1 downto 0 do
555 begin
556 R:= Ed.Fold.Items[i];
557 if R.IsSimple then
558 Ed.Fold.Delete(i);
559 end;
560 end;
561 end;
562 *)
563
564 constructor TATAdapterEControl.Create(AOwner: TComponent);
565 begin
566 inherited;
567
568 EdList:= TFPList.Create;
569 AnClient:= nil;
570 Buffer:= TATStringBuffer.Create;
571 FRangesColored:= TATSortedRanges.Create;
572 FRangesColoredBounds:= TATSortedRanges.Create;
573 FRangesSublexer:= TATSortedRanges.Create;
574 FEnabledLineSeparators:= false;
575 FEnabledSublexerTreeNodes:= false;
576 end;
577
578 destructor TATAdapterEControl.Destroy;
579 begin
580 AddEditor(nil);
581
582 if Assigned(AnClient) then
583 FreeAndNil(AnClient);
584
585 FreeAndNil(FRangesSublexer);
586 FreeAndNil(FRangesColoredBounds);
587 FreeAndNil(FRangesColored);
588
589 FreeAndNil(Buffer);
590 FreeAndNil(EdList);
591
592 inherited;
593 end;
594
595 procedure TATAdapterEControl.AddEditor(AEditor: TComponent);
596 // not nil: adapter adds this editor object to his editors list,
597 // and should setup editor's OnLog
598 // nil: adapter forgets about all editors
599 var
600 i: integer;
601 begin
602 if AEditor=nil then
603 begin
604 for i:= 0 to EdList.Count-1 do
605 TATSynEdit(EdList[i]).AdapterForHilite:= nil;
606 EdList.Clear;
607 end
608 else
609 begin
610 if EdList.IndexOf(AEditor)<0 then
611 begin
612 EdList.Add(AEditor);
613 TATSynEdit(AEditor).OnChangeLog:= @DoChangeLog;
614 TATSynEdit(AEditor).AdapterForHilite:= Self;
615 end;
616 end;
617 end;
618
LexerAtPosnull619 function TATAdapterEControl.LexerAtPos(Pnt: TPoint): TecSyntAnalyzer;
620 begin
621 Result:= nil;
622 if Assigned(AnClient) then
623 Result:= AnClient.AnalyzerAtPos(
624 Buffer.CaretToStr(Pnt),
625 AnClient.PublicData.SublexRanges);
626 end;
627
628 procedure TATAdapterEControl.StopTreeUpdate;
629 begin
630 FStopTreeUpdate:= true;
631 end;
632
IsParsingBusynull633 function TATAdapterEControl.IsParsingBusy: boolean;
634 var
635 EvResult: TWaitResult;
636 begin
637 if Assigned(AnClient) then
638 begin
639 EvResult:= AnClient.EventParseIdle.WaitFor(0);
640 Result:= EvResult<>wrSignaled;
641 end
642 else
643 Result:= false;
644 end;
645
646 procedure TATAdapterEControl.Stop;
647 begin
648 if not Application.Terminated then
649 begin
650 if FBusyTreeUpdate then
651 begin
652 Sleep(100);
653 //Application.ProcessMessages;
654 end;
655 end;
656
657 if Assigned(AnClient) then
658 AnClient.Stop;
659 end;
660
Editornull661 function TATAdapterEControl.Editor: TATSynEdit;
662 begin
663 if EdList.Count=0 then
664 Result:= nil
665 else
666 Result:= TATSynEdit(EdList[0]);
667 end;
668
669
GetTokenStringnull670 function TATAdapterEControl.GetTokenString(const token: PecSyntToken): string;
671 begin
672 if Assigned(Buffer) then
673 Result:= Utf8Encode(Buffer.SubString(token^.Range.StartPos+1, token^.Range.EndPos-token^.Range.StartPos))
674 else
675 Result:= '';
676 end;
677
678 procedure TATAdapterEControl.GetTokenProps(const token: PecSyntToken;
679 out APntFrom, APntTo: TPoint; out ATokenString, ATokenStyle: string;
680 out ATokenKind: TATTokenKind);
681 begin
682 APntFrom:= token^.Range.PointStart;
683 APntTo:= token^.Range.PointEnd;
684 ATokenString:= GetTokenString(token);
685 if Assigned(token^.Style) then
686 begin
687 ATokenStyle:= token^.Style.DisplayName;
688 ATokenKind:= TATTokenKind(token^.Style.TokenKind);
689 end
690 else
691 begin
692 ATokenStyle:= '';
693 ATokenKind:= atkOther;
694 end;
695 end;
696
697 //function is not used in CudaText
698 procedure TATAdapterEControl.__GetTokenWithIndex(AIndex: integer;
699 out APntFrom, APntTo: TPoint;
700 out ATokenString, ATokenStyle: string;
701 out ATokenKind: TATTokenKind);
702 begin
703 APntFrom:= Point(-1, -1);
704 APntTo:= Point(-1, -1);
705 ATokenString:= '';
706 ATokenStyle:= '';
707 ATokenKind:= atkOther;
708
709 if AnClient=nil then exit;
710 if Buffer=nil then exit;
711
712 if AnClient.PublicData.Tokens.IsIndexValid(AIndex) then
713 GetTokenProps(
714 AnClient.PublicData.Tokens._GetItemPtr(AIndex),
715 APntFrom,
716 APntTo,
717 ATokenString,
718 ATokenStyle,
719 ATokenKind);
720 end;
721
722 //function is not used in CudaText
723 procedure TATAdapterEControl.__GetTokenAtPos(APos: TPoint;
724 out APntFrom, APntTo: TPoint;
725 out ATokenString, ATokenStyle: string;
726 out ATokenKind: TATTokenKind);
727 var
728 n: integer;
729 begin
730 APntFrom:= Point(-1, -1);
731 APntTo:= Point(-1, -1);
732 ATokenString:= '';
733 ATokenStyle:= '';
734 ATokenKind:= atkOther;
735
736 if AnClient=nil then exit;
737 if Buffer=nil then exit;
738
739 n:= DoFindToken(APos);
740 if n>=0 then
741 GetTokenProps(
742 AnClient.PublicData.Tokens._GetItemPtr(n),
743 APntFrom,
744 APntTo,
745 ATokenString,
746 ATokenStyle,
747 ATokenKind);
748 end;
749
750
GetTokenKindAtPosnull751 function TATAdapterEControl.GetTokenKindAtPos(APos: TPoint): TATTokenKind;
752 var
753 Style: TecSyntaxFormat;
754 n: integer;
755 begin
756 Result:= atkOther;
757
758 if AnClient=nil then exit;
759 if Buffer=nil then exit;
760
761 n:= DoFindToken(APos, true{AExactPos});
762 if n<0 then exit;
763
764 AnClient.CriSecForData.Enter;
765 try
766 if not AnClient.PublicData.Tokens.IsIndexValid(n) then exit;
767 Style:= AnClient.PublicData.Tokens._GetItemPtr(n)^.Style;
768 if Assigned(Style) then
769 Result:= TATTokenKind(Style.TokenKind);
770 finally
771 AnClient.CriSecForData.Leave;
772 end;
773 end;
774
GetRangeParentnull775 function TATAdapterEControl.GetRangeParent(const R: TecTextRange): TecTextRange;
776 //cannot use R.Parent!
777 //
778 //this is called from TreeFill, so calls are guarded by CriticalSection.Enter/Leave
779 // https://github.com/Alexey-T/CudaText/issues/3074
780 var
781 RTest: TecTextRange;
782 NLast, i: integer;
783 begin
784 Result:= nil;
785 NLast := AnClient.PublicData.FoldRanges.Count - 1;
786 for i:= Min(NLast, R.Index-1) downto 0 do
787 begin
788 RTest:= TecTextRange(AnClient.PublicData.FoldRanges[i]);
789 if (RTest.StartIdx<=R.StartIdx) and
790 (RTest.EndIdx>=R.EndIdx) and
791 (RTest.Level<R.Level) then
792 begin
793 Result:= RTest;
794 Exit
795 end;
796 end;
797 end;
798
799 function TreeFindNode(ATree: TTreeView; ANode: TTreeNode; const ANodeText: string): TTreeNode;
800 var
801 N: TTreeNode;
802 begin
803 Result:= nil;
804 if ATree.Items.Count=0 then exit;
805 if ANode<>nil then
806 N:= ANode.GetFirstChild
807 else
808 N:= ATree.Items[0];
809 repeat
810 if N=nil then exit;
811 if N.Text=ANodeText then Exit(N);
812 N:= N.GetNextSibling;
813 until false;
814 end;
815
816 procedure TATAdapterEControl.TreeFill(ATree: TTreeView);
817 var
818 R, RangeParent: TecTextRange;
819 NodeParent, NodeGroup: TTreeNode;
820 NodeText, NodeTextGroup, SItem: string;
821 NameRule, NameLexer: string;
822 NodeData: pointer;
823 RangeNew: TATRangeInCodeTree;
824 Sep: TATStringSeparator;
825 i: integer;
826 begin
827 if AnClient=nil then exit;
828 AnClient.CriSecForData.Enter;
829 FStopTreeUpdate:= false;
830 FBusyTreeUpdate:= true;
831
832 //ATree.Items.BeginUpdate;
833
834 try
835 ATree.Items.Clear;
836 NameLexer:= AnClient.Owner.LexerName;
837
838 for i:= 0 to AnClient.PublicData.FoldRanges.Count-1 do
839 begin
840 if FStopTreeUpdate then exit;
841 if Application.Terminated then exit;
842
843 R:= TecTextRange(AnClient.PublicData.FoldRanges[i]);
844 if R.Rule=nil then Continue;
845 if not R.Rule.DisplayInTree then Continue;
846
847 if not FEnabledSublexerTreeNodes then
848 begin
849 NameRule:= R.Rule.SyntOwner.LexerName;
850 //must allow lexer name "PHP_" if main lexer is "PHP"
851 if NameRule[Length(NameRule)]='_' then
852 SetLength(NameRule, Length(NameRule)-1);
853 if NameRule<>NameLexer then Continue;
854 end;
855
856 NodeText:= Trim(Utf8Encode(AnClient.GetRangeName(R, AnClient.PublicData.Tokens)));
857 NodeTextGroup:= Trim(Utf8Encode(AnClient.GetRangeGroup(R)));
858 NodeData:= R;
859 NodeParent:= nil;
860 NodeGroup:= nil;
861
862 //strip tree items from #10
863 SDeleteFromEol(NodeText);
864 SDeleteFromEol(NodeTextGroup);
865
866 RangeParent:= GetRangeParent(R);
867 while (RangeParent<>nil) and (not RangeParent.Rule.DisplayInTree) do
868 RangeParent:= GetRangeParent(RangeParent);
869 if RangeParent<>nil then
870 NodeParent:= ATree.Items.FindNodeWithData(RangeParent);
871
872 if NodeTextGroup<>'' then
873 begin
874 Sep.Init(NodeTextGroup, '\');
875 repeat
876 if not Sep.GetItemStr(SItem) then Break;
877
878 if SItem='' then
879 NodeGroup:= nil
880 else
881 begin
882 NodeGroup:= TreeFindNode(ATree, NodeParent, SItem);
883 if NodeGroup=nil then
884 begin
885 NodeGroup:= ATree.Items.AddChild(NodeParent, SItem);
886 NodeGroup.ImageIndex:= R.Rule.TreeGroupImage;
887 NodeGroup.SelectedIndex:= NodeGroup.ImageIndex;
888 end;
889 end;
890 NodeParent:= NodeGroup;
891 until false;
892 end;
893
894 NodeParent:= ATree.Items.AddChildObject(NodeParent, NodeText, NodeData);
895 NodeParent.ImageIndex:= R.Rule.TreeItemImage;
896 NodeParent.SelectedIndex:= NodeParent.ImageIndex;
897 end;
898
899 //tree filled with Data as TecTextRange
900 //now replace all Data to TATRangeInCodetree
901 for i:= 0 to ATree.Items.Count-1 do
902 begin
903 NodeParent:= ATree.Items[i];
904 if NodeParent.Data=nil then Continue;
905 R:= TecTextRange(NodeParent.Data);
906
907 RangeNew:= TATRangeInCodeTree.Create;
908
909 if R.StartIdx>=0 then
910 RangeNew.PosBegin:= AnClient.PublicData.Tokens._GetItemPtr(R.StartIdx)^.Range.PointStart
911 else
912 RangeNew.PosBegin:= Point(-1, -1);
913
914 if R.EndIdx>=0 then
915 RangeNew.PosEnd:= AnClient.PublicData.Tokens._GetItemPtr(R.EndIdx)^.Range.PointEnd
916 else
917 RangeNew.PosEnd:= Point(-1, -1);
918
919 NodeParent.Data:= RangeNew;
920 end;
921
922 finally
923 //ATree.Items.EndUpdate;
924 ATree.Invalidate;
925 FBusyTreeUpdate:= false;
926 AnClient.CriSecForData.Leave;
927 end;
928 end;
929
930 procedure TATAdapterEControl.__TreeGetPositionOfRange_EC(const R: TecTextRange;
931 out APosBegin, APosEnd: TPoint);
932 begin
933 APosBegin:= Point(-1, -1);
934 APosEnd:= Point(-1, -1);
935 if R=nil then exit;
936 if AnClient=nil then exit;
937
938 if R.StartIdx>=0 then
939 APosBegin:= AnClient.PublicData.Tokens._GetItemPtr(R.StartIdx)^.Range.PointStart;
940
941 if R.EndIdx>=0 then
942 APosEnd:= AnClient.PublicData.Tokens._GetItemPtr(R.EndIdx)^.Range.PointEnd;
943 end;
944
945 //unused function
__TreeGetRangeOfPositionnull946 function TATAdapterEControl.__TreeGetRangeOfPosition(APos: TPoint): TecTextRange;
947 var
948 R: TecTextRange;
949 NTokenOrig: integer;
950 i: integer;
951 begin
952 Result:= nil;
953 if AnClient=nil then exit;
954
955 NTokenOrig:= DoFindToken(APos);
956 if NTokenOrig<0 then exit;
957
958 //find last range, which contains our token
959 for i:= AnClient.PublicData.FoldRanges.Count-1 downto 0 do
960 begin
961 R:= TecTextRange(AnClient.PublicData.FoldRanges[i]);
962 if not R.Rule.DisplayInTree then Continue;
963
964 if (R.StartIdx<=NTokenOrig) and
965 (R.EndIdx>=NTokenOrig) then
966 exit(R);
967 end;
968 end;
969
SublexerRangeCountnull970 function TATAdapterEControl.SublexerRangeCount: integer;
971 begin
972 if Assigned(AnClient) then
973 Result:= AnClient.PublicData.SublexRanges.Count
974 else
975 Result:= 0;
976 end;
977
SublexerRangePropsnull978 function TATAdapterEControl.SublexerRangeProps(AIndex: integer;
979 out AStart, AEnd: TPoint; out ALexerName: string): boolean;
980 //this func must be guarded with CriSecForData.Enter/Leave
981 var
982 Range: TecSubLexerRange;
983 begin
984 Result:= false;
985 AStart:= Point(0, 0);
986 AEnd:= Point(0, 0);
987 ALexerName:= '';
988
989 if AnClient=nil then exit;
990 if Buffer=nil then exit;
991
992 Result:= (AIndex>=0) and (AIndex<SublexerRangeCount);
993 if Result then
994 begin
995 Range:= AnClient.PublicData.SublexRanges[AIndex];
996 if Range.Range.StartPos<0 then exit;
997 AStart:= Range.Range.PointStart;
998 AEnd:= Range.Range.PointEnd;
999 if Assigned(Range.Rule) and Assigned(Range.Rule.SyntAnalyzer) then
1000 ALexerName:= Range.Rule.SyntAnalyzer.LexerName;
1001 end;
1002 end;
1003
1004 procedure TATAdapterEControl.OnEditorScroll(Sender: TObject);
1005 begin
1006 UpdatePublicDataNeedTo;
1007 end;
1008
1009 procedure TATAdapterEControl.UpdatePublicDataNeedTo;
1010 var
1011 Ed: TATSynEdit;
1012 NLine1, NLine2: integer;
1013 begin
1014 if AnClient=nil then exit;
1015 if EdList.Count=0 then exit;
1016
1017 Ed:= TATSynEdit(EdList[0]);
1018 NLine1:= Ed.LineBottom+1;
1019
1020 if EdList.Count>1 then
1021 begin
1022 Ed:= TATSynEdit(EdList[1]);
1023 if Ed.Visible then
1024 NLine2:= Ed.LineBottom+1
1025 else
1026 NLine2:= 0;
1027 end
1028 else
1029 NLine2:= 0;
1030
1031 if (NLine2>0) and (Abs(NLine1-NLine2)<50) then
1032 begin
1033 NLine1:= Max(NLine1, NLine2);
1034 NLine2:= NLine1;
1035 end;
1036
1037 AnClient.PublicDataNeedTo:= NLine1;
1038 AnClient.PublicDataNeedTo2:= NLine2;
1039 end;
1040
1041
1042 function CodetreeFindItemForPosition(ATree: TTreeView; APosX, APosY: integer): TTreeNode;
1043 var
1044 Node, NodeNear: TTreeNode;
1045 Range: TATRangeInCodeTree;
1046 Pos1, Pos2: TPoint;
1047 i: integer;
1048 begin
1049 Result:= nil;
1050 NodeNear:= nil;
1051
1052 //ranges are sorted only by start position, but are nested, cannot use binary search
1053 //we find _last_ range which includes APos
1054 for i:= ATree.Items.Count-1 downto 0 do
1055 begin
1056 Node:= ATree.Items[i];
1057 if Node.Data<>nil then
1058 if TObject(Node.Data) is TATRangeInCodeTree then
1059 begin
1060 Range:= TATRangeInCodeTree(Node.Data);
1061 Pos1:= Range.PosBegin;
1062 Pos2:= Range.PosEnd;
1063
1064 //remember first node above APos (ignore X to speedup)
1065 //it we won't find node which includes APos, we'll take NodeNear
1066 if NodeNear=nil then
1067 if (Pos1.Y=APosY) or //node start at the same line
1068 ((Pos1.Y<APosY) and (Pos1.Y<>Pos2.Y)) then //node starts above and is not one-liner
1069 NodeNear:= Node;
1070
1071 //found node which includes APos
1072 if IsPosInRange(
1073 APosX, APosY,
1074 Pos1.X, Pos1.Y,
1075 Pos2.X, Pos2.Y,
1076 true) = cRelateInside then
1077 begin
1078 Result:= Node;
1079 Break;
1080 end;
1081 end;
1082 end;
1083
1084 if Result=nil then
1085 if NodeNear<>nil then
1086 Result:= NodeNear;
1087 end;
1088
1089
1090 procedure CodetreeSelectItemForPosition(ATree: TTreeView; APosX, APosY: integer);
1091 var
1092 Node: TTreeNode;
1093 begin
1094 Node:= CodetreeFindItemForPosition(ATree, APosX, APosY);
1095 if Assigned(Node) then
1096 begin
1097 Node.MakeVisible;
1098 ATree.Selected:= Node;
1099 end;
1100 end;
1101
1102 procedure TATAdapterEControl.OnEditorCaretMove(Sender: TObject);
1103 begin
1104 UpdateRangesActive(Sender as TATSynEdit);
1105 end;
1106
1107
1108 procedure TATAdapterEControl.SetLexer(AAnalizer: TecSyntAnalyzer);
1109 begin
1110 if IsParsingBusy then exit;
1111
1112 ClearRanges;
1113
1114 if Assigned(AnClient) then
1115 FreeAndNil(AnClient);
1116
1117 ParseBegin;
1118
1119 if Assigned(AAnalizer) then
1120 begin
1121 UpdateBuffer(Buffer);
1122 UpdatePublicDataNeedTo;
1123
1124 AnClient:= TecClientSyntAnalyzer.Create(AAnalizer, Buffer);
1125 if EdList.Count>0 then
1126 AnClient.FileName:= ExtractFileName(Editor.FileName);
1127 AnClient.OnParseDone:= @ParseDone;
1128 AnClient.OnProgressFirst:= @ProgressFirst;
1129 AnClient.OnProgressSecond:= @ProgressSecond;
1130 AnClient.OnProgressBoth:= @ProgressBoth;
1131 end;
1132
1133 if Assigned(FOnLexerChange) then
1134 FOnLexerChange(Editor);
1135
1136 DynamicHiliteSupportedInCurrentSyntax:= GetLexerSuportsDynamicHilite;
1137 end;
1138
1139 procedure TATAdapterEControl.OnEditorChangeEx(Sender: TObject; AChange: TATLineChangeKind; ALine,
1140 AItemCount: integer);
1141 begin
1142 FRangesColored.UpdateOnChange(AChange, ALine, AItemCount);
1143 FRangesColoredBounds.UpdateOnChange(AChange, ALine, AItemCount);
1144 FRangesSublexer.UpdateOnChange(AChange, ALine, AItemCount);
1145 end;
1146
1147 procedure TATAdapterEControl.UpdateBuffer(ABuffer: TATStringBuffer);
1148 var
1149 Ed: TATSynEdit;
1150 Lens: array of integer;
1151 Str: TATStrings;
1152 i: integer;
1153 begin
1154 Ed:= Editor;
1155 if Ed=nil then exit;
1156 Str:= Ed.Strings;
1157 SetLength(Lens{%H-}, Str.Count);
1158 for i:= 0 to Length(Lens)-1 do
1159 Lens[i]:= Str.LinesLen[i];
1160 ABuffer.Setup(Str.TextString_Unicode(Ed.OptMaxLineLenToTokenize), Lens);
1161 end;
1162
1163 procedure TATAdapterEControl.UpdateRanges;
1164 begin
1165 ClearRanges;
1166
1167 if AnClient=nil then exit;
1168 AnClient.CriSecForData.Enter;
1169 try
1170 UpdateRangesFoldAndColored;
1171 UpdateRangesSublex; //sublexer ranges last
1172 finally
1173 AnClient.CriSecForData.Leave;
1174 end;
1175
1176 UpdateRangesActiveAll;
1177 end;
1178
1179 procedure TATAdapterEControl.UpdateRangesActiveAll;
1180 var
1181 i: integer;
1182 begin
1183 for i:= 0 to EdList.Count-1 do
1184 UpdateRangesActive(TATSynEdit(EdList[i]));
1185 end;
1186
EditorRunningCommandnull1187 function TATAdapterEControl.EditorRunningCommand: boolean;
1188 var
1189 i: integer;
1190 begin
1191 Result:= false;
1192 if EdList.Count>0 then
1193 for i:= 0 to EdList.Count-1 do
1194 if TATSynEdit(EdList[i]).IsRunningCommand then
1195 exit(true);
1196 end;
1197
1198 procedure TATAdapterEControl.ClearFoldIndexers;
1199 var
1200 Ed: TATSynEdit;
1201 i: integer;
1202 begin
1203 for i:= 0 to EdList.Count-1 do
1204 begin
1205 Ed:= TATSynEdit(EdList[i]);
1206 Ed.Fold.ClearLineIndexer(Ed.Strings.Count);
1207 end;
1208 end;
1209
1210 procedure TATAdapterEControl.DoFoldAdd(AX, AY, AY2: integer; AStaple: boolean; const AHint: string);
1211 var
1212 i: integer;
1213 begin
1214 for i:= 0 to EdList.Count-1 do
1215 TATSynEdit(EdList[i]).Fold.Add(AX, AY, AY2, AStaple, AHint);
1216 end;
1217
1218
1219 procedure TATAdapterEControl.UpdateEditors(AKind: TATAdapterProgressKind);
1220 //const
1221 // cStrProgress: array[TATAdapterProgressKind] of string = ('1st', '2nd', 'both');
1222 var
1223 Ed: TATSynEdit;
1224 begin
1225 //Application.MainForm.Caption:= TimeToStr(Now)+', update '+cStrProgress[AKind];
1226
1227 if EdList.Count>0 then
1228 if AKind in [epkFirst, epkBoth] then
1229 begin
1230 Ed:= TATSynEdit(EdList[0]);
1231 Ed.Update;
1232 end;
1233
1234 if AKind in [epkSecond, epkBoth] then
1235 if EdList.Count>1 then
1236 begin
1237 Ed:= TATSynEdit(EdList[1]);
1238 if Ed.Visible then
1239 Ed.Update;
1240 end;
1241 end;
1242
1243
1244 procedure TATAdapterEControl.DoFoldFromLinesHidden;
1245 var
1246 Ed: TATSynEdit;
1247 i: integer;
1248 begin
1249 for i:= 0 to EdList.Count-1 do
1250 begin
1251 Ed:= TATSynEdit(EdList[i]);
1252 Ed.UpdateFoldedFromLinesHidden;
1253 end;
1254 end;
1255
1256
1257 procedure TATAdapterEControl.UpdateRangesFoldAndColored;
1258 //all calls of this procedure must be guarded with CriSecForData.Enter/Leave
1259 var
1260 Ed: TATSynEdit;
1261 R: TecTextRange;
1262 Pnt1, Pnt2, Pnt1Wide, Pnt2Wide: TPoint;
1263 Style: TecSyntaxFormat;
1264 SHint: string;
1265 tokenStart, tokenEnd: PecSyntToken;
1266 ColoredRange: TATSortedRange;
1267 i: integer;
1268 begin
1269 if AnClient=nil then Exit;
1270
1271 //check folding enabled
1272 Ed:= Editor;
1273 if Ed=nil then exit;
1274 if not Ed.OptFoldEnabled then exit;
1275
1276 //init Ed.Fold.LineIndexer's
1277 ClearFoldIndexers;
1278
1279 for i:= 0 to AnClient.PublicData.FoldRanges.Count-1 do
1280 begin
1281 if Application.Terminated then exit;
1282
1283 R:= TecTextRange(AnClient.PublicData.FoldRanges[i]);
1284 if R.Rule=nil then Continue;
1285 if R.Rule.BlockType<>btRangeStart then Continue;
1286
1287 /////issue: rules in C# with 'parent' set give wrong ranges;
beginnull1288 //rule "function begin", "prop begin";
1289 //e.g. range from } bracket to some token before "else"
1290 //temp workard: skip rule with 'parent'
1291 {$ifdef skip_some_rules}
1292 if R.Rule.NotParent then Continue;
1293 {$endif}
1294
1295 if not AnClient.PublicData.Tokens.IsIndexValid(R.StartIdx) then Continue;
1296 if not AnClient.PublicData.Tokens.IsIndexValid(R.EndIdx) then Continue;
1297
1298 tokenStart:= AnClient.PublicData.Tokens._GetItemPtr(R.StartIdx);
1299 tokenEnd:= AnClient.PublicData.Tokens._GetItemPtr(R.EndIdx);
1300 Pnt1:= tokenStart^.Range.PointStart;
1301 Pnt2:= tokenEnd^.Range.PointEnd;
1302 if Pnt1.Y<0 then Continue;
1303 if Pnt2.Y<0 then Continue;
1304
1305 //fill fold ranges
1306 if not R.Rule.NotCollapsed then
1307 begin
1308 SHint:= UTF8Encode(AnClient.GetCollapsedText(R)); //+'/'+R.Rule.GetNamePath;
1309 DoFoldAdd(Pnt1.X+1, Pnt1.Y, Pnt2.Y, R.Rule.DrawStaple, SHint);
1310 end;
1311
1312 //fill FRangesColored
1313 //not only if DymamicHilite enabled (e.g. AutoIt has always hilited blocks)
1314 if R.Rule.DynHighlight<>dhNone then
1315 begin
1316 Style:= R.Rule.Style;
1317 if Style<>nil then
1318 if Style.BgColor<>clNone then
1319 begin
1320 Pnt1Wide:= Pnt1;
1321 Pnt2Wide:= Pnt2;
1322 //support lexer opt "Highlight lines of block"
1323 if R.Rule.Highlight then
1324 begin
1325 Pnt1Wide.X:= 0;
1326 Pnt2Wide.X:= Buffer.LineLength(Pnt2.Y) + 1;
1327 //+1 to make range longer, to hilite line to screen end
1328 end;
1329
1330 ColoredRange.Init(
1331 Pnt1,
1332 Pnt2,
1333 Pnt1Wide,
1334 Pnt2Wide,
1335 R.StartIdx,
1336 R.EndIdx,
1337 Style.BgColor,
1338 R.Rule,
1339 (R.Rule.HighlightPos=cpAny)
1340 );
1341
1342 if R.Rule.DynHighlight=dhBound then
1343 FRangesColoredBounds.Add(ColoredRange)
1344 else
1345 FRangesColored.Add(ColoredRange);
1346 end;
1347 end;
1348 end;
1349
1350 //ShowMessage(Ed.Fold.MessageLineIndexer); //debug
1351
1352 //this list is not sorted so create internal indexer
1353 FRangesColoredBounds.UpdateBoundIndexer;
1354
1355 FRangesColored.UpdateLineIndexer(Ed.Strings.Count);
1356 //FRangesColored.DebugLineIndexer;
1357
1358 //keep folded blks that were folded
1359 DoFoldFromLinesHidden;
1360 end;
1361
1362 procedure TATAdapterEControl.DebugIntegersWithPointers(L: TATIntegersWithPointers);
1363 var
1364 i: integer;
1365 s: string;
1366 begin
1367 if L.Count=0 then exit;
1368 s:= '';
1369 for i:= 0 to Min(30, L.Count-1) do
1370 s+= IntToStr(L[i].Value)+#10;
1371 ShowMessage(s);
1372 end;
1373
1374 procedure TATAdapterEControl.UpdateRangesSublex;
1375 //all calls of this proc must be guarded by CriSecForData.Enter/Leave
1376 var
1377 Ed: TATSynEdit;
1378 R: TecSubLexerRange;
1379 Style: TecSyntaxFormat;
1380 Range: TATSortedRange;
1381 i: integer;
1382 begin
1383 for i:= 0 to AnClient.PublicData.SublexRanges.Count-1 do
1384 begin
1385 if Application.Terminated then exit;
1386
1387 R:= AnClient.PublicData.SublexRanges[i];
1388 if R.Rule=nil then Continue;
1389 if R.Range.StartPos<0 then Continue;
1390 if R.Range.EndPos<0 then Continue;
1391
1392 Style:= R.Rule.Style;
1393 if Style=nil then Continue;
1394 if Style.BgColor<>clNone then
1395 begin
1396 Range.Init(
1397 R.Range.PointStart,
1398 R.Range.PointEnd,
1399 R.Range.PointStart,
1400 R.Range.PointEnd,
1401 -1,
1402 -1,
1403 Style.BgColor,
1404 nil,
1405 true
1406 );
1407 FRangesSublexer.Add(Range);
1408 end;
1409 end;
1410
1411 Ed:= Editor;
1412 if Assigned(Ed) then
1413 FRangesSublexer.UpdateLineIndexer(Ed.Strings.Count);
1414 end;
1415
1416
TATAdapterEControl.DoFindTokennull1417 function TATAdapterEControl.DoFindToken(APos: TPoint; AExactPos: boolean = false): integer;
1418 begin
1419 if AnClient=nil then //real use case
1420 exit(-1);
1421 if APos.X=0 then
1422 begin
1423 if APos.Y<=High(AnClient.PublicData.TokenIndexer) then
1424 Result:= AnClient.PublicData.TokenIndexer[APos.Y]
1425 else
1426 Result:= -1;
1427 end
1428 else
1429 if AExactPos then
1430 Result:= AnClient.PublicData.Tokens.FindAt(AnClient.Buffer.CaretToStr(APos))
1431 else
1432 Result:= AnClient.PublicData.Tokens.PriorAt(AnClient.Buffer.CaretToStr(APos));
1433 end;
1434
TATAdapterEControl.GetLexernull1435 function TATAdapterEControl.GetLexer: TecSyntAnalyzer;
1436 begin
1437 if Assigned(AnClient) then
1438 Result:= AnClient.Owner
1439 else
1440 Result:= nil;
1441 end;
1442
1443 procedure TATAdapterEControl.DoChangeLog(Sender: TObject; ALine: integer);
1444 begin
1445 if AnClient=nil then Exit;
1446 AnClient.Stop; //stop parsing before slow UpdateBuffer()
1447 UpdateBuffer(Buffer);
1448 UpdatePublicDataNeedTo;
1449 AnClient.TextChangedOnLine(ALine);
1450 end;
1451
GetTokenColor_FromBoundRangesnull1452 function TATAdapterEControl.GetTokenColor_FromBoundRanges(ATokenIndex, AEditorIndex: integer): TecSyntaxFormat;
1453 begin
1454 Result:= nil;
1455 if not IsDynamicHiliteEnabled then exit;
1456
1457 //Cannot use FRangesColoredBounds.Find, because it has overlapping ranges,
1458 //so Find will miss some tokens
1459 Result:= FRangesColoredBounds.FindStyleByTokenIndex(ATokenIndex, AEditorIndex);
1460 end;
1461
GetLexerSuportsDynamicHilitenull1462 function TATAdapterEControl.GetLexerSuportsDynamicHilite: boolean;
1463 var
1464 An: TecSyntAnalyzer;
1465 Rule: TecTagBlockCondition;
1466 i: integer;
1467 begin
1468 Result:= false;
1469 if AnClient=nil then exit;
1470 An:= AnClient.Owner;
1471 for i:= 0 to An.BlockRules.Count-1 do
1472 begin
1473 Rule:= An.BlockRules[i];
1474 if Assigned(Rule) and
1475 (Rule.HighlightPos in [cpBound, cpRange, cpOutOfRange]) and
1476 (Rule.DynHighlight in [dhRange, dhRangeNoBound, dhBound]) then exit(true);
1477 end;
1478 end;
1479
TATAdapterEControl.IsDynamicHiliteEnablednull1480 function TATAdapterEControl.IsDynamicHiliteEnabled: boolean;
1481 var
1482 Ed: TATSynEdit;
1483 begin
1484 Ed:= Editor;
1485 if Assigned(Ed) then
1486 Result:= DynamicHiliteActiveNow(Ed.Strings.Count)
1487 else
1488 Result:= false;
1489 end;
1490
1491 procedure TATAdapterEControl.ParseBegin;
1492 begin
1493 if Assigned(FOnParseBegin) then
1494 FOnParseBegin(Self);
1495 FStopTreeUpdate:= false;
1496 FTimeParseBegin:= GetTickCount64;
1497 end;
1498
1499 procedure TATAdapterEControl.ParseDone(Sender: TObject);
1500 begin
1501 //UpdateRanges call needed for small files, which are parsed to end by one IdleAppend call,
1502 //and timer didn't tick
1503 UpdateRanges;
1504
1505 FTimeParseElapsed:= GetTickCount64-FTimeParseBegin;
1506
1507 if Assigned(FOnParseDone) then
1508 FOnParseDone(Self);
1509
1510 UpdateEditors(epkBoth);
1511 end;
1512
1513 procedure TATAdapterEControl.ProgressFirst(Sender: TObject);
1514 begin
1515 UpdateEditors(epkFirst);
1516 end;
1517
1518 procedure TATAdapterEControl.ProgressSecond(Sender: TObject);
1519 begin
1520 UpdateEditors(epkSecond);
1521 end;
1522
1523 procedure TATAdapterEControl.ProgressBoth(Sender: TObject);
1524 begin
1525 UpdateEditors(epkBoth);
1526 end;
1527
1528 procedure TATAdapterEControl.ParseFromLine(ALine: integer; AWait: boolean);
1529 begin
1530 if AnClient=nil then exit;
1531 ParseBegin;
1532 AnClient.TextChangedOnLine(ALine);
1533
1534 if AWait then
1535 begin
1536 //this method gives too small duration time, like 40 microsec
1537 //AnClient.EventParseIdle.WaitFor(INFINITE);
1538
1539 //this method gives ok duration times, like 140ms
1540 repeat
1541 Sleep(60);
1542 Application.ProcessMessages;
1543 until AnClient.IsFinished or Application.Terminated;
1544 end;
1545 end;
1546
DebugStringnull1547 function TATAdapterEControl.DebugString: string;
1548 var
1549 i: integer;
1550 begin
1551 Result:= '';
1552 for i:= 0 to EdList.Count-1 do
1553 Result+= '"'+ExtractFileName(TATSynEdit(EdList[i]).FileName)+'" ';
1554 if Lexer<>nil then
1555 Result+= '- '+Lexer.LexerName;
1556 end;
1557
IsDataReadynull1558 function TATAdapterEControl.IsDataReady: boolean;
1559 begin
1560 if Assigned(AnClient) then
1561 Result:= AnClient.PublicData.Finished
1562 else
1563 Result:= true;
1564 end;
1565
IsDataReadyPartiallynull1566 function TATAdapterEControl.IsDataReadyPartially: boolean;
1567 begin
1568 if Assigned(AnClient) then
1569 Result:= AnClient.PublicData.FinishedPartially
1570 else
1571 Result:= true;
1572 end;
1573
1574 end.
1575
1576