1 {
2 /***************************************************************************
3 SourceSynEditor
4 -------------------
5
6 ***************************************************************************/
7
8 ***************************************************************************
9 * *
10 * This source is free software; you can redistribute it and/or modify *
11 * it under the terms of the GNU General Public License as published by *
12 * the Free Software Foundation; either version 2 of the License, or *
13 * (at your option) any later version. *
14 * *
15 * This code is distributed in the hope that it will be useful, but *
16 * WITHOUT ANY WARRANTY; without even the implied warranty of *
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
18 * General Public License for more details. *
19 * *
20 * A copy of the GNU General Public License is available on the World *
21 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
22 * obtain it by writing to the Free Software Foundation, *
23 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
24 * *
25 ***************************************************************************
26
27 Abstract:
28 SynEdit extensions for the IDE
29 - DebugMarks: Mark lines with debug info
30 }
31 unit SourceSynEditor;
32
33 {$mode objfpc}{$H+}
34
35 interface
36
37 {$IFDEF Windows}
38 {$IFnDEF WithoutWinIME}
39 {$DEFINE WinIME}
40 {$ENDIF}
41 {$ENDIF}
42
43 {$I ide.inc}
44
45 uses
46 LazSynIMMBase,
47 {$IFDEF WinIME}
48 LazSynIMM,
49 {$ENDIF}
50 Classes, SysUtils,
51 // LCL
52 Controls, LCLProc, LCLType, Graphics, Menus, ImgList,
53 // synedit
54 SynEdit, SynEditMiscClasses, SynGutter, SynGutterBase, SynEditMarks,
55 SynEditTypes, SynGutterLineNumber, SynGutterCodeFolding, SynGutterMarks,
56 SynGutterChanges, SynGutterLineOverview, SynEditMarkup,
57 SynEditMarkupGutterMark, SynEditMarkupSpecialLine, SynEditTextBuffer,
58 SynEditFoldedView, SynTextDrawer, SynEditTextBase, LazSynEditText,
59 SynPluginTemplateEdit, SynPluginSyncroEdit, LazSynTextArea,
60 SynEditHighlighter, SynEditHighlighterFoldBase, SynHighlighterPas,
61 SynEditMarkupHighAll, SynEditKeyCmds, SynEditMarkupIfDef, SynEditMiscProcs,
62 SynPluginMultiCaret, SynEditPointClasses,
63 SynEditMarkupFoldColoring, SynEditTextTabExpander,
64 etSrcEditMarks, LazarusIDEStrConsts;
65
66 type
67
68 TIDESynGutterMarks = class;
69 {$IFDEF WithSynDebugGutter}
70 TIDESynGutterDebugHL = class;
71 {$ENDIF}
72
73 { TSourceLazSynTopInfoView }
74
75 TSourceLazSynTopInfoView = class(TLazSynDisplayViewEx)
76 private
77 FLineMapCount: integer;
78 FLineMap: array of integer;
GetLineMapnull79 function GetLineMap(Index: Integer): Integer;
80 procedure SetLineMap(Index: Integer; AValue: Integer);
81 procedure SetLineMapCount(AValue: integer);
82 public
83 procedure SetHighlighterTokensLine(ALine: TLineIdx; out ARealLine: TLineIdx; out AStartBytePos, ALineByteLen: Integer); override;
GetLinesCountnull84 function GetLinesCount: Integer; override;
TextToViewIndexnull85 function TextToViewIndex(AIndex: TLineIdx): TLineRange; override;
ViewToTextIndexnull86 function ViewToTextIndex(AIndex: TLineIdx): TLineIdx; override;
87 public
88 constructor Create;
89 property LineMapCount: integer read FLineMapCount write SetLineMapCount;
90 property LineMap[Index: Integer]: Integer read GetLineMap write SetLineMap;
91 end;
92
93 { TSourceLazSynSurfaceGutter }
94
95 TSourceLazSynSurfaceGutter = class(TLazSynGutterArea)
96 private
97 procedure TextSizeChanged(Sender: TObject);
98 protected
99 procedure DoPaint(ACanvas: TCanvas; AClip: TRect); override;
100 procedure SetTextArea(ATextArea: TLazSynTextArea); override;
101 end;
102
103 { TSourceLazSynSurfaceManager }
104
105 TSourceLazSynSurfaceManager = class(TLazSynSurfaceManager)
106 private
107 FExtraManager: TLazSynSurfaceManager;
108 FOriginalManager: TLazSynSurfaceManager;
109 FTopLineCount: Integer;
110 procedure SetTopLineCount(AValue: Integer);
111 protected
GetLeftGutterAreanull112 function GetLeftGutterArea: TLazSynSurfaceWithText; override;
GetRightGutterAreanull113 function GetRightGutterArea: TLazSynSurfaceWithText; override;
GetTextAreanull114 function GetTextArea: TLazSynTextArea; override;
115 protected
116 procedure SetBackgroundColor(AValue: TColor); override;
117 procedure SetExtraCharSpacing(AValue: integer); override;
118 procedure SetExtraLineSpacing(AValue: integer); override;
119 procedure SetForegroundColor(AValue: TColor); override;
120 procedure SetPadding(Side: TLazSynBorderSide; AValue: integer); override;
121 procedure SetRightEdgeColor(AValue: TColor); override;
122 procedure SetRightEdgeColumn(AValue: integer); override;
123 procedure SetRightEdgeVisible(AValue: boolean); override;
124 procedure SetVisibleSpecialChars(AValue: TSynVisibleSpecialChars); override;
125 procedure SetHighlighter(AValue: TSynCustomHighlighter); override;
126 protected
127 procedure DoPaint(ACanvas: TCanvas; AClip: TRect); override;
128 procedure DoDisplayViewChanged; override;
129 procedure BoundsChanged; override;
130 public
131 constructor Create(AOwner: TWinControl; AnOriginalManager: TLazSynSurfaceManager);
132 destructor Destroy; override;
133 procedure InvalidateLines(FirstTextLine, LastTextLine: TLineIdx); override;
134 procedure InvalidateTextLines(FirstTextLine, LastTextLine: TLineIdx); override;
135 procedure InvalidateGutterLines(FirstTextLine, LastTextLine: TLineIdx); override;
136 property ExtraManager: TLazSynSurfaceManager read FExtraManager write FExtraManager;
137 property OriginalManager: TLazSynSurfaceManager read FOriginalManager write FOriginalManager;
138 property TopLineCount: Integer read FTopLineCount write SetTopLineCount;
139 end;
140
141 { TSourceSynSearchTermList }
142
143 TSourceSynSearchTermList = class(TSynSearchTermList)
144 public
FindMatchFornull145 function FindMatchFor(ATerm: String; ACasesSensitive: Boolean;
146 ABoundaries: TSynSearchTermOptsBounds;
147 AStartAtIndex: Integer = 0;
148 AIgnoreIndex: Integer = -1): Integer;
FindSimilarMatchFornull149 function FindSimilarMatchFor(ATerm: String; ACasesSensitive: Boolean;
150 ABoundaries: TSynSearchTermOptsBounds;
151 AEnabled: Boolean;
152 AStartAtIndex: Integer = 0;
153 AIgnoreIndex: Integer = -1;
154 AnOnlyWeakerOrEqual: Boolean = False;
155 AnSkipDisabled: Boolean = False): Integer; // weaker = matches less (subset of stronger)
FindSimilarMatchFornull156 function FindSimilarMatchFor(ATerm: TSynSearchTerm;
157 AStartAtIndex: Integer = 0;
158 AIgnoreIndex: Integer = -1;
159 AnOnlyWeakerOrEqual: Boolean = False;
160 AnSkipDisabled: Boolean = False): Integer; // weaker = matches less (subset of stronger)
161 procedure ClearSimilarMatches;
162 end;
163
164 { TSourceSynSearchTermDict }
165
166 TSourceSynSearchTermDict = class(TSynSearchTermDict)
167 private
168 FModifiedTerms: TSynSearchTermList;
169 FAddedByKeyWords: TSynSearchTermList;
170 FFirstLocal: Integer;
GetTermsnull171 function GetTerms: TSourceSynSearchTermList;
AddSearchTermnull172 function AddSearchTerm(ATerm: String): Integer;
173 public
174 constructor Create(ATermListClass: TSynSearchTermListClass);
175 destructor Destroy; override;
176 procedure AddTermByKey(ATerm: String; ACaseSensitive: Boolean;
177 ABounds: TSynSearchTermOptsBounds);
178 procedure RemoveTermByKey(RemoveIdx: Integer);
179 procedure RestoreLocalChanges;
180 property Terms: TSourceSynSearchTermList read GetTerms;
181 end;
182
183 { TSourceSynEditMarkupHighlightAllMulti }
184
185 TSourceSynEditMarkupHighlightAllMulti = class(TSynEditMarkupHighlightAllMulti)
186 private
187 FAddTermCmd: TSynEditorCommand;
188 FKeyAddCase: Boolean;
189 FKeyAddSelectBoundMaxLen: Integer;
190 FKeyAddSelectSmart: Boolean;
191 FKeyAddWordBoundMaxLen: Integer;
192 FKeyAddTermBounds: TSynSearchTermOptsBounds;
193 FRemoveTermCmd: TSynEditorCommand;
194 FToggleTermCmd: TSynEditorCommand;
195
196 procedure ProcessSynCommand(Sender: TObject; {%H-}AfterProcessing: boolean;
197 var Handled: boolean; var Command: TSynEditorCommand;
198 var {%H-}AChar: TUTF8Char; {%H-}Data: pointer; {%H-}HandlerData: pointer);
199 protected
CreateTermsListnull200 function CreateTermsList: TSynSearchTermDict; override;
201 public
202 constructor Create(ASynEdit: TSynEditBase);
203 destructor Destroy; override;
204 procedure RestoreLocalChanges;
205 property AddTermCmd: TSynEditorCommand read FAddTermCmd write FAddTermCmd;
206 property RemoveTermCmd: TSynEditorCommand read FRemoveTermCmd write FRemoveTermCmd;
207 property ToggleTermCmd: TSynEditorCommand read FToggleTermCmd write FToggleTermCmd;
208 property KeyAddTermBounds: TSynSearchTermOptsBounds read FKeyAddTermBounds write FKeyAddTermBounds;
209 property KeyAddCase: Boolean read FKeyAddCase write FKeyAddCase;
210 property KeyAddWordBoundMaxLen: Integer read FKeyAddWordBoundMaxLen write FKeyAddWordBoundMaxLen;
211 property KeyAddSelectBoundMaxLen: Integer read FKeyAddSelectBoundMaxLen write FKeyAddSelectBoundMaxLen;
212 property KeyAddSelectSmart: Boolean read FKeyAddSelectSmart write FKeyAddSelectSmart;
213 end;
214
215 TSourceSynEditMarkupIfDef = class(TSynEditMarkupIfDef)
216 public
217 property IfDefTree;
218 end;
219
220 TSynMarkupIdentComplWindow = class // don't inherit from TSynEditMarkup, no regular markup
221 private
222 FBackgroundSelectedColor: TColor;
223 FBorderColor: TColor;
224 FHighlightColor: TColor;
225 FTextColor: TColor;
226 FTextSelectedColor: TColor;
227 FWindowColor: TColor;
228 public
229 constructor Create;
230 public
231 property WindowColor: TColor read FWindowColor write FWindowColor;
232 property TextColor: TColor read FTextColor write FTextColor;
233 property BorderColor: TColor read FBorderColor write FBorderColor;
234 property HighlightColor: TColor read FHighlightColor write FHighlightColor;
235 property TextSelectedColor: TColor read FTextSelectedColor write FTextSelectedColor;
236 property BackgroundSelectedColor: TColor read FBackgroundSelectedColor write FBackgroundSelectedColor;
237 end;
238
239 { TIDESynEditor }
240
241 TIDESynEditor = class(TSynEdit)
242 private
243 FCaretColor: TColor;
244 FCaretStamp: Int64;
245 FMarkupIdentComplWindow: TSynMarkupIdentComplWindow;
246 FShowTopInfo: boolean;
247 FFoldView: TSynEditFoldedView;
248 FTopInfoNestList: TLazSynEditNestedFoldsList;
249 FSyncroEdit: TSynPluginSyncroEdit;
250 FTemplateEdit: TSynPluginTemplateEdit;
251 FMultiCaret: TSynPluginMultiCaret;
252 FMarkupForGutterMark: TSynEditMarkupGutterMark;
253 FOnIfdefNodeStateRequest: TSynMarkupIfdefStateRequest;
254 FMarkupIfDef: TSourceSynEditMarkupIfDef;
255 FTopInfoDisplay: TSourceLazSynTopInfoView;
256 FTopInfoLastTopLine: Integer;
257 FSrcSynCaretChangedLock, FSrcSynCaretChangedNeeded: boolean;
258 FExtraMarkupLine: TSynEditMarkupSpecialLine;
259 FExtraMarkupMgr: TSynEditMarkupManager;
260 FTopInfoMarkup: TSynSelectedColor;
261 FUserWordsList: TFPList;
262
263 function DoIfDefNodeStateRequest(Sender: TObject; LinePos,
264 XStartPos: Integer; CurrentState: TSynMarkupIfdefNodeStateEx): TSynMarkupIfdefNodeState;
265 function GetHighlightUserWordCount: Integer;
266 function GetHighlightUserWords(AIndex: Integer): TSourceSynEditMarkupHighlightAllMulti;
267 function GetIDEGutterMarks: TIDESynGutterMarks;
268 function GetIsInMultiCaretMainExecution: Boolean;
269 function GetIsInMultiCaretRepeatExecution: Boolean;
270 function GetOnMultiCaretBeforeCommand: TSynMultiCaretBeforeCommand;
271 procedure GetTopInfoMarkupForLine(Sender: TObject; {%H-}Line: integer; var Special: boolean;
272 aMarkup: TSynSelectedColor);
273 procedure SetCaretColor(AValue: TColor);
274 procedure SetHighlightUserWordCount(AValue: Integer);
275 procedure SetOnMultiCaretBeforeCommand(AValue: TSynMultiCaretBeforeCommand);
276 procedure SetShowTopInfo(AValue: boolean);
277 procedure SetTopInfoMarkup(AValue: TSynSelectedColor);
278 procedure DoHighlightChanged(Sender: TSynEditStrings; {%H-}AIndex, {%H-}ACount : Integer);
279 procedure SrcSynCaretChanged(Sender: TObject);
280 function GetHighlighter: TSynCustomFoldHighlighter;
281 protected
282 procedure DoOnStatusChange(Changes: TSynStatusChanges); override;
283 function CreateGutter(AOwner : TSynEditBase; ASide: TSynGutterSide;
284 ATextDrawer: TheTextDrawer): TSynGutter; override;
285 procedure SetHighlighter(const Value: TSynCustomHighlighter); override;
286 public
287 constructor Create(AOwner: TComponent); override;
288 destructor Destroy; override;
289 function TextIndexToViewPos(aTextIndex : Integer) : Integer;
290 property IDEGutterMarks: TIDESynGutterMarks read GetIDEGutterMarks;
291 property TopView;
292 property TextBuffer;
293 property ViewedTextBuffer;
294 property TemplateEdit: TSynPluginTemplateEdit read FTemplateEdit;
295 property SyncroEdit: TSynPluginSyncroEdit read FSyncroEdit;
296 property MultiCaret: TSynPluginMultiCaret read FMultiCaret;
297 //////
298 property TopInfoMarkup: TSynSelectedColor read FTopInfoMarkup write SetTopInfoMarkup;
299 property ShowTopInfo: boolean read FShowTopInfo write SetShowTopInfo;
300 {$IFDEF WinIME}
301 procedure CreateMinimumIme;
302 procedure CreateFullIme;
303 {$ENDIF}
304 property HighlightUserWordCount: Integer read GetHighlightUserWordCount write SetHighlightUserWordCount;
305 property HighlightUserWords[AIndex: Integer]: TSourceSynEditMarkupHighlightAllMulti read GetHighlightUserWords;
306 property MarkupMgr;
307 function IsIfdefMarkupActive: Boolean;
308 procedure InvalidateAllIfdefNodes;
309 procedure SetIfdefNodeState(ALinePos, AstartPos: Integer; AState: TSynMarkupIfdefNodeState);
310 property OnIfdefNodeStateRequest: TSynMarkupIfdefStateRequest read FOnIfdefNodeStateRequest write FOnIfdefNodeStateRequest;
311 property MarkupIfDef: TSourceSynEditMarkupIfDef read FMarkupIfDef;
312 property MarkupIdentComplWindow: TSynMarkupIdentComplWindow read FMarkupIdentComplWindow;
313 property IsInMultiCaretMainExecution: Boolean read GetIsInMultiCaretMainExecution;
314 property IsInMultiCaretRepeatExecution: Boolean read GetIsInMultiCaretRepeatExecution;
315 property OnMultiCaretBeforeCommand: TSynMultiCaretBeforeCommand read GetOnMultiCaretBeforeCommand write SetOnMultiCaretBeforeCommand;
316 property CaretStamp: Int64 read FCaretStamp;
317 property CaretColor: TColor read FCaretColor write SetCaretColor;
318 end;
319
320 TIDESynHighlighterPasRangeList = class(TSynHighlighterPasRangeList)
321 protected
322 FInterfaceLine, FImplementationLine,
323 FInitializationLine, FFinalizationLine: Integer;
324 end;
325
326 { TIDESynPasSyn }
327
328 TIDESynPasSyn = class(TSynPasSyn)
329 private
330 function GetFinalizationLine: Integer;
331 function GetImplementationLine: Integer;
332 function GetInitializationLine: Integer;
333 function GetInterfaceLine: Integer;
334 protected
335 function CreateRangeList({%H-}ALines: TSynEditStringsBase): TSynHighlighterRangeList; override;
336 function StartCodeFoldBlock(ABlockType: Pointer = nil;
337 IncreaseLevel: Boolean = true; ForceDisabled: Boolean = False
338 ): TSynCustomCodeFoldBlock; override;
339 public
340 procedure SetLine({$IFDEF FPC}const {$ENDIF}NewValue: string;
341 LineNumber: Integer); override;
342 property InterfaceLine: Integer read GetInterfaceLine;
343 property ImplementationLine: Integer read GetImplementationLine;
344 property InitializationLine: Integer read GetInitializationLine;
345 property FinalizationLine: Integer read GetFinalizationLine;
346 end;
347
348 { TIDESynFreePasSyn }
349
350 TIDESynFreePasSyn = class(TIDESynPasSyn)
351 public
352 constructor Create(AOwner: TComponent); override;
353 procedure ResetRange; override;
354 end;
355
356 { TIDESynGutterLOvProviderPascal }
357
358 TIDESynGutterLOvProviderPascal = class(TSynGutterLineOverviewProvider)
359 private
360 FColor2: TColor;
361 FInterfaceLine, FImplementationLine,
362 FInitializationLine, FFinalizationLine: Integer;
363 FPixInterfaceLine, FPixImplementationLine,
364 FPixInitializationLine, FPixFinalizationLine: Integer;
365 FPixEndInterfaceLine, FPixEndImplementationLine,
366 FPixEndInitializationLine, FPixEndFinalizationLine: Integer;
367 FSingleLine: Boolean;
368 FRGBColor2: TColorRef;
369 procedure SetColor2(const AValue: TColor);
370 procedure SetSingleLine(const AValue: Boolean);
371 protected
372 procedure BufferChanged(Sender: TObject);
373 procedure HighlightChanged(Sender: TSynEditStrings; {%H-}AIndex, {%H-}ACount : Integer);
374 procedure ReCalc; override;
375
376 procedure Paint(Canvas: TCanvas; AClip: TRect; TopOffset: integer); override;
377 public
378 constructor Create(AOwner: TComponent); override;
379 destructor Destroy; override;
380 published
381 property SingleLine: Boolean read FSingleLine write SetSingleLine;
382 property Color2: TColor read FColor2 write SetColor2;
383 end;
384
385 { TIDESynGutterLOvProviderIDEMarks }
386
387 TIDESynGutterLOvProviderIDEMarks = class(TSynGutterLOvProviderBookmarks)
388 // Bookmarks and breakpoints
389 private
390 FBreakColor: TColor;
391 FBreakDisabledColor: TColor;
392 FExecLineColor: TColor;
393 FRGBBreakColor: TColorRef;
394 FRGBBreakDisabledColor: TColor;
395 FRGBExecLineColor: TColor;
396 procedure SetBreakColor(const AValue: TColor);
397 procedure SetBreakDisabledColor(AValue: TColor);
398 procedure SetExecLineColor(AValue: TColor);
399 protected
400 procedure AdjustColorForMark(AMark: TSynEditMark; var AColor: TColor; var APriority: Integer); override;
401 public
402 constructor Create(AOwner: TComponent); override;
403 published
404 property BreakColor: TColor read FBreakColor write SetBreakColor;
405 property BreakDisabledColor: TColor read FBreakDisabledColor write SetBreakDisabledColor;
406 property ExecLineColor: TColor read FExecLineColor write SetExecLineColor;
407 end;
408
409 { TIDESynGutter }
410
411 TIDESynGutter = class(TSynGutter)
412 protected
413 procedure CreateDefaultGutterParts; override;
414 public
415 {$IFDEF WithSynDebugGutter}
416 DebugGutter: TIDESynGutterDebugHL;
417 {$ENDIF}
418 end;
419
420 { TIDESynDebugMarkInfo }
421
422 TIDESynDebugMarkInfo = class(TSynManagedStorageMem)
423 private
424 FRefCount: Integer;
425 function GetSrcLineToMarkLine(SrcIndex: Integer): Integer;
426 procedure SetSrcLineToMarkLine(SrcIndex: Integer; const AValue: Integer);
427 public
428 constructor Create;
429 procedure IncRefCount;
430 procedure DecRefCount;
431 // Index is the Current line-index (0 based) in editor (including source modification)
432 // Result is the original Line-pos (1 based) as known by the debugger
433 property SrcLineToMarkLine[SrcIndex: Integer]: Integer
434 read GetSrcLineToMarkLine write SetSrcLineToMarkLine; default;
435 property RefCount: Integer read FRefCount;
436 end;
437
438 { TIDESynGutterMarks }
439
440 TIDESynGutterMarks = class(TSynGutterMarks)
441 private
442 FDebugMarkInfo: TIDESynDebugMarkInfo;
443 FMarkInfoTextBuffer: TSynEditStrings;
444 protected
445 procedure CheckTextBuffer; // Todo: Add a notification, when TextBuffer Changes
446 Procedure PaintLine(aScreenLine: Integer; Canvas : TCanvas; AClip : TRect); override;
447 function PreferedWidthAtCurrentPPI: Integer; override;
448
449 function GetImgListRes(const ACanvas: TCanvas;
450 const AImages: TCustomImageList): TScaledImageListResolution; override;
451 public
452 destructor Destroy; override;
453 procedure BeginSetDebugMarks;
454 procedure EndSetDebugMarks;
455 procedure SetDebugMarks(AFirstLinePos, ALastLinePos: Integer);
456 procedure ClearDebugMarks;
457 function HasDebugMarks: Boolean;
458 function DebugLineToSourceLine(aLinePos: Integer): Integer;
459 function SourceLineToDebugLine(aLinePos: Integer; AdjustOnError: Boolean = False): Integer;
460 end;
461
462 { TIDESynGutterCodeFolding }
463
464 TIDESynGutterCodeFolding = class(TSynGutterCodeFolding)
465 protected
466 procedure UnFoldIfdef(AInclDisabled, AInclEnabled: Boolean);
467 procedure FoldIfdef(AInclTemp: Boolean);
468
469 procedure PopClickedUnfoldAll(Sender: TObject);
470 procedure PopClickedUnfoldComment(Sender: TObject);
471 procedure PopClickedFoldComment(Sender: TObject);
472 procedure PopClickedHideComment(Sender: TObject);
473 procedure PopClickedFoldIfdef(Sender: TObject);
474 procedure PopClickedFoldIfdefNoMixed(Sender: TObject);
475 procedure PopClickedUnfoldIfdefActive(Sender: TObject);
476 procedure PopClickedUnfolDIfdefAll(Sender: TObject);
477 procedure PopClickedUnfoldIfdefInactiv(Sender: TObject);
478 procedure CreatePopUpMenuEntries(var APopUp: TPopupMenu; ALine: Integer); override;
479 end;
480
481 {$IFDEF WithSynDebugGutter}
482 { TIDESynGutterDebugHL }
483
484 TIDESynGutterDebugHL = class(TSynGutterPartBase)
485 procedure PopContentClicked(Sender: TObject);
486 procedure PopSizeClicked(Sender: TObject);
487 private
488 FTheLinesView: TSynEditStrings;
489 FPopUp: TPopupMenu;
490 FContent: Integer;
491 protected
492 function PreferedWidth: Integer; override;
493 function MaybeHandleMouseAction(var AnInfo: TSynEditMouseActionInfo;
494 HandleActionProc: TSynEditMouseActionHandler): Boolean; override;
495 procedure PaintFoldLvl(Canvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer);
496 procedure PaintCharWidths(Canvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer);
497 public
498 constructor Create(AOwner: TComponent); override;
499 procedure Paint(Canvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer);
500 override;
501 property TheLinesView: TSynEditStrings read FTheLinesView write FTheLinesView;
502 end;
503 {$ENDIF}
504
505 implementation
506
507 uses SourceMarks;
508
509 { TSynMarkupIdentComplWindow }
510
511 constructor TSynMarkupIdentComplWindow.Create;
512 begin
513 inherited Create;
514
515 FBackgroundSelectedColor := clNone;
516 FBorderColor := clNone;
517 FHighlightColor := clNone;
518 FTextColor := clNone;
519 FTextSelectedColor := clNone;
520 FWindowColor := clNone;
521 end;
522
523 { TSourceSynSearchTermDict }
524
GetTermsnull525 function TSourceSynSearchTermDict.GetTerms: TSourceSynSearchTermList;
526 begin
527 Result := TSourceSynSearchTermList(inherited Terms);
528 end;
529
AddSearchTermnull530 function TSourceSynSearchTermDict.AddSearchTerm(ATerm: String): Integer;
531 var
532 Itm: TSynSearchTerm;
533 begin
534 Itm := Terms.Add;
535 Itm.SearchTerm := ATerm;
536 Result := Itm.Index;
537 end;
538
539 constructor TSourceSynSearchTermDict.Create(ATermListClass: TSynSearchTermListClass);
540 begin
541 inherited Create(ATermListClass);
542 FModifiedTerms := TSynSearchTermList.Create;
543 FAddedByKeyWords := TSynSearchTermList.Create;
544 end;
545
546 destructor TSourceSynSearchTermDict.Destroy;
547 begin
548 inherited Destroy;
549 FreeAndNil(FModifiedTerms);
550 FreeAndNil(FAddedByKeyWords);
551 end;
552
553 procedure TSourceSynSearchTermDict.AddTermByKey(ATerm: String; ACaseSensitive: Boolean;
554 ABounds: TSynSearchTermOptsBounds);
555 var
556 i, j, PresetIdx: Integer;
557 begin
558 // check for pre-defined, compare text only
559 PresetIdx := Terms.IndexOfSearchTerm(ATerm, False);
560 if PresetIdx >= FFirstLocal then
561 PresetIdx := -1;
562
563 // Disable or remove weaker terms
564 i := Terms.FindSimilarMatchFor(ATerm, ACaseSensitive, ABounds, True, 0, -1, True, True);
565 while i >= 0 do begin
566 if i >= FFirstLocal then begin
567 j := FAddedByKeyWords.IndexOfSearchTerm(Terms[i]);
568 Terms.Delete(i);
569 if j >= 0 then
570 FAddedByKeyWords.Delete(j);
571 end
572 else begin
573 Terms[i].Enabled := False;
574 j := FModifiedTerms.IndexOfSearchTerm(Terms[i]);
575 if j < 0 then
576 FModifiedTerms.Add.Assign(Terms[i])
577 else
578 FModifiedTerms[j].Assign(Terms[i]);
579 end;
580 i := Terms.FindSimilarMatchFor(ATerm, ACaseSensitive, ABounds, True, 0, -1, True, True);
581 end;
582
583 if PresetIdx >= 0 then begin
584 while PresetIdx >= 0 do begin
585 Terms[PresetIdx].Enabled := True;
586 j := FModifiedTerms.IndexOfSearchTerm(Terms[PresetIdx]);
587 if j < 0 then
588 FModifiedTerms.Add.Assign(Terms[PresetIdx])
589 else
590 FModifiedTerms[j].Assign(Terms[PresetIdx]);
591 PresetIdx := Terms.IndexOfSearchTerm(ATerm, False, PresetIdx+1);
592 if PresetIdx >= FFirstLocal then
593 PresetIdx := -1;
594 end;
595 end
596 else begin
597 // Could be adding selection that is not at bounds, but forcing bounds
598 if Terms.FindMatchFor(ATerm, ACaseSensitive, ABounds) >= FFirstLocal then
599 exit;
600 i := AddSearchTerm(ATerm);
601 Terms[i].MatchCase := ACaseSensitive;
602 Terms[i].MatchWordBounds := ABounds;
603 FAddedByKeyWords.Add.Assign(Terms[i]);
604 end;
605 end;
606
607 procedure TSourceSynSearchTermDict.RemoveTermByKey(RemoveIdx: Integer);
608 var
609 i: Integer;
610 begin
611 if RemoveIdx >= FFirstLocal then begin
612 i := FAddedByKeyWords.IndexOfSearchTerm(Terms[RemoveIdx]);
613 Assert(i >= 0, 'FAddedByKeyWords.IndexOfSearchTerm(Terms[RemoveIdx])');
614 FAddedByKeyWords.Delete(i);
615 Terms.Delete(RemoveIdx);
616 end
617 else begin
618 Terms[RemoveIdx].Enabled := False;
619 i := FModifiedTerms.IndexOfSearchTerm(Terms[RemoveIdx]);
620 if i < 0 then
621 FModifiedTerms.Add.Assign(Terms[RemoveIdx])
622 else
623 FModifiedTerms[i].Assign(Terms[RemoveIdx]);
624 end;
625 end;
626
627 procedure TSourceSynSearchTermDict.RestoreLocalChanges;
628 var
629 i, j, k: Integer;
630 begin
631 FFirstLocal := Terms.Count;
632 IncChangeNotifyLock;
633 try
634
635 for i := FModifiedTerms.Count - 1 downto 0 do begin
636 j := Terms.IndexOfSearchTerm(FModifiedTerms[i]);
637 if (j < 0) or (Terms[j].Enabled = FModifiedTerms[i].Enabled) then
638 FModifiedTerms.Delete(i)
639 else
640 Terms[j].Enabled := FModifiedTerms[i].Enabled;
641 end;
642
643 for i := 0 to FAddedByKeyWords.Count - 1 do begin
644 // disable global (there may be new globals)
645 j := Terms.FindSimilarMatchFor(FAddedByKeyWords[i], 0, -1, True, True);
646 while j >= 0 do begin
647 Assert(j < FFirstLocal, 'DISABLE preset in RESTORE j < FFirstLocal');
648 if j < FFirstLocal then begin // should always be true
649 DebugLn(['DISABLE preset in RESTORE ',j]);
650 Terms[j].Enabled := False;
651 k := FModifiedTerms.IndexOfSearchTerm(Terms[j]);
652 if k < 0 then
653 FModifiedTerms.Add.Assign(Terms[j])
654 else
655 FModifiedTerms[k].Assign(Terms[j]);
656 end;
657 j := Terms.FindSimilarMatchFor(FAddedByKeyWords[i], 0, -1, True, True);
658 end;
659
660 Terms.Add.Assign(FAddedByKeyWords[i]);
661 end;
662
663 finally
664 DecChangeNotifyLock;
665 end;
666 end;
667
668 { TSourceSynSearchTermList }
669
FindMatchFornull670 function TSourceSynSearchTermList.FindMatchFor(ATerm: String; ACasesSensitive: Boolean;
671 ABoundaries: TSynSearchTermOptsBounds; AStartAtIndex: Integer;
672 AIgnoreIndex: Integer): Integer;
673 var
674 c: Integer;
675 Entry: TSynSearchTerm;
676 begin
677 Result := AStartAtIndex - 1;
678 c := Count - 1;
679 while Result < c do begin
680 inc(Result);
681 if Result = AIgnoreIndex then
682 continue;
683
684 Entry := Items[Result];
685 if (ATerm = Entry.SearchTerm) and
686 (ACasesSensitive = Entry.MatchCase) and
687 (ABoundaries = Entry.MatchWordBounds)
688 then
689 exit;
690 end;
691 Result := -1;
692 end;
693
FindSimilarMatchFornull694 function TSourceSynSearchTermList.FindSimilarMatchFor(ATerm: String; ACasesSensitive: Boolean;
695 ABoundaries: TSynSearchTermOptsBounds; AEnabled: Boolean; AStartAtIndex: Integer;
696 AIgnoreIndex: Integer; AnOnlyWeakerOrEqual: Boolean; AnSkipDisabled: Boolean): Integer;
697 var
698 c: Integer;
699 Entry: TSynSearchTerm;
700 WeakerByEnabled, WeakerByCase, WeakerByBounds: (wParam, wEntry, wEqual);
701 begin
702 Result := AStartAtIndex - 1;
703 c := Count - 1;
704 while Result < c do begin
705 inc(Result);
706 if Result = AIgnoreIndex then
707 continue;
708
709 Entry := Items[Result];
710 (* if one has soBoundsAtStart, and the other has soBoundsAtEnd then they
711 match 2 different sets, which may overlap
712 In all other cases, one will match a subset of the other
713 *)
714 if [ABoundaries, Entry.MatchWordBounds] = [soBoundsAtStart, soBoundsAtEnd] then
715 Continue; // Match different sets
716 if AnSkipDisabled and not Entry.Enabled then
717 Continue;
718
719 WeakerByEnabled := wEqual;
720 if (not Entry.Enabled) and AEnabled then WeakerByEnabled := wEntry;
721 if Entry.Enabled and (not AEnabled) then WeakerByEnabled := wParam;
722
723 if AnOnlyWeakerOrEqual and (WeakerByEnabled = wParam) then // Entry can not be weaker
724 continue;
725
726 if (ATerm <> Entry.SearchTerm) and
727 ( (ACasesSensitive and Entry.MatchCase) or
728 (CompareText(ATerm, Entry.SearchTerm) <> 0)
729 )
730 then
731 continue;
732
733 // which one is weakerByCase?
734 WeakerByCase := wEqual;
735 if (ACasesSensitive) and (not Entry.MatchCase) then
736 WeakerByCase := wParam // param matches a sub-set of entry
737 else
738 if (not ACasesSensitive) and (Entry.MatchCase) then
739 WeakerByCase := wEntry; // Entry matches a sub-set of param
740
741 if AnOnlyWeakerOrEqual and (WeakerByCase = wParam) then // Entry can not be weaker
742 continue;
743
744 WeakerByBounds := wEqual;
745 case ABoundaries of
746 soNoBounds: begin
747 if Entry.MatchWordBounds <> soNoBounds then
748 WeakerByBounds := wEntry; // Entry matches less
749 end;
750 soBoundsAtStart, soBoundsAtEnd: begin // Combination of one at Start, other at End has already been filtered
751 if Entry.MatchWordBounds = soNoBounds then
752 WeakerByBounds := wParam
753 else
754 if Entry.MatchWordBounds = soBothBounds then
755 WeakerByBounds := wEntry;
756 end;
757 soBothBounds: begin
758 if Entry.MatchWordBounds <> soBothBounds then
759 WeakerByBounds := wParam;
760 end;
761 end;
762
763 if AnOnlyWeakerOrEqual and (WeakerByBounds = wParam) then // Entry can not be weaker
764 continue;
765
766 if ( ([WeakerByEnabled, WeakerByBounds, WeakerByCase] - [wEqual] = [wEntry]) or
767 ([WeakerByEnabled, WeakerByBounds, WeakerByCase] - [wEqual] = [wParam]) or
768 ([WeakerByEnabled, WeakerByBounds, WeakerByCase] = [wEqual])
769 )
770 then
771 exit;
772
773 end;
774 Result := -1;
775 end;
776
FindSimilarMatchFornull777 function TSourceSynSearchTermList.FindSimilarMatchFor(ATerm: TSynSearchTerm;
778 AStartAtIndex: Integer; AIgnoreIndex: Integer; AnOnlyWeakerOrEqual: Boolean;
779 AnSkipDisabled: Boolean): Integer;
780 begin
781 Result := FindSimilarMatchFor(ATerm.SearchTerm, ATerm.MatchCase, ATerm.MatchWordBounds,
782 ATerm.Enabled, AStartAtIndex, AIgnoreIndex, AnOnlyWeakerOrEqual, AnSkipDisabled);
783 end;
784
785 procedure TSourceSynSearchTermList.ClearSimilarMatches;
786 var
787 i, j: Integer;
788 begin
789 i := 0;
790 while (i < Count) do begin
791 j := FindSimilarMatchFor(Items[i].SearchTerm,
792 Items[i].MatchCase, Items[i].MatchWordBounds, Items[i].Enabled,
793 0, i, True);
794 if (j >= 0) then begin
795 Delete(j);
796 if j < i then // May have more than one weaker duplicate
797 dec(i);
798 end
799 else
800 inc(i);
801 end;
802 end;
803
804 { TSourceSynEditMarkupHighlightAllMulti }
805
806 procedure TSourceSynEditMarkupHighlightAllMulti.ProcessSynCommand(Sender: TObject;
807 AfterProcessing: boolean; var Handled: boolean; var Command: TSynEditorCommand;
808 var AChar: TUTF8Char; Data: pointer; HandlerData: pointer);
809 var
810 syn: TIDESynEditor;
811 TermDict: TSourceSynSearchTermDict;
812
813 function FindTermAtCaret: Integer;
814 var
815 i, y, x, x1, x2: Integer;
816 s: string;
817 b1, b2: Boolean;
818 t: TSynSearchTerm;
819 begin
820 Result := -1;
821 y := syn.CaretY;
822 i := Matches.IndexOfFirstMatchForLine(y);
823 if i < 0 then exit;
824 x := syn.LogicalCaretXY.x;
825 while (i < Matches.Count) and (Matches[i].StartPoint.y <= y) do begin
826 if ((Matches[i].StartPoint.y < y) or (Matches[i].StartPoint.x <= x)) and
827 ((Matches[i].EndPoint.y > y) or (Matches[i].EndPoint.x >= x))
828 then
829 break;
830 inc(i);
831 end;
832 if (i >= Matches.Count) or (Matches[i].StartPoint.y > y) or (Matches[i].StartPoint.x > x) then
833 exit;
834
835 x1 := Matches[i].StartPoint.x;
836 x2 := Matches[i].EndPoint.x;
837 //if Matches[i].StartPoint.y < y then x1 := 1; // only one liners allowed
838 s := syn.ViewedTextBuffer[y-1];
839 b1 := (x1 = 1) or (s[x1-1] in WordBreakChars);
840 b2 := (x2 > length(s)) or (s[x2] in WordBreakChars);
841 s := copy(s, x1, x2-x1);
842
843 Result := 0;
844 while Result < Terms.Count do begin
845 t := Terms[Result];
846 if t.Enabled and
847 ( (t.SearchTerm = s) or
848 ( (not t.MatchCase) and (CompareText(t.SearchTerm,s)=0) ) ) and
849 ( (t.MatchWordBounds = soNoBounds) or
850 ( (t.MatchWordBounds = soBoundsAtStart) and b1 ) or
851 ( (t.MatchWordBounds = soBoundsAtEnd) and b2 ) or
852 ( (t.MatchWordBounds = soBothBounds) and b1 and b2 )
853 )
854 then
855 exit;
856 inc(Result);
857 end;
858
859 assert(false, 'TSourceSynEditMarkupHighlightAllMulti match not found');
860 Result := -1; // Should never reach
861 end;
862
863 procedure AddTermByKey;
864 var
865 NewTerm, LineTxt: String;
866 B1, B2: Boolean;
867 NewBounds: TSynSearchTermOptsBounds;
868 begin
869 NewTerm := '';
870 B1 := False;
871 B2 := False;
872 if syn.SelAvail and (syn.BlockBegin.y = syn.BlockEnd.y) then begin
873 NewTerm := syn.SelText;
874 LineTxt := syn.Lines[syn.CaretY-1];
875 B1 := (KeyAddTermBounds in [soBoundsAtStart, soBothBounds]) and
876 ( (KeyAddSelectBoundMaxLen < 1) or (length(NewTerm) <= KeyAddSelectBoundMaxLen) ) and
877 ( (not KeyAddSelectSmart) or
878 ( (Syn.BlockBegin.X <= 1) or (LineTxt[Syn.BlockBegin.X-1] in WordBreakChars) )
879 );
880 B2 := (KeyAddTermBounds in [soBoundsAtEnd, soBothBounds]) and
881 ( (KeyAddSelectBoundMaxLen < 1) or (length(NewTerm) <= KeyAddSelectBoundMaxLen) ) and
882 ( (not KeyAddSelectSmart) or
883 ( (Syn.BlockEnd.X > length(LineTxt)) or (LineTxt[Syn.BlockEnd.X] in WordBreakChars) )
884 );
885 end
886 else
887 if not syn.SelAvail then begin
888 NewTerm := syn.GetWordAtRowCol(syn.LogicalCaretXY);
889 if NewTerm <> '' then begin
890 B1 := (KeyAddTermBounds in [soBoundsAtStart, soBothBounds]) and
891 ( (KeyAddWordBoundMaxLen < 1) or (length(NewTerm) <= KeyAddWordBoundMaxLen) );
892 B2 := (KeyAddTermBounds in [soBoundsAtEnd, soBothBounds]) and
893 ( (KeyAddWordBoundMaxLen < 1) or (length(NewTerm) <= KeyAddWordBoundMaxLen) );
894 end;
895 end;
896
897 if B1 and B2 then NewBounds := soBothBounds
898 else if B1 then NewBounds := soBoundsAtStart
899 else if B2 then NewBounds := soBoundsAtEnd
900 else NewBounds := soNoBounds;
901
902 TermDict.AddTermByKey(NewTerm, FKeyAddCase, NewBounds);
903 end;
904
905 var
906 i: Integer;
907 begin
908 if Handled then
909 exit;
910 syn := TIDESynEditor(SynEdit);
911 TermDict := (Terms as TSourceSynSearchTermDict);
912 TermDict.IncChangeNotifyLock;
913 try
914
915 if Command = FAddTermCmd then begin
916 AddTermByKey;
917 Handled := True;
918 end;
919
920 if Command = FRemoveTermCmd then begin
921 i := FindTermAtCaret;
922 if i >= 0 then
923 TermDict.RemoveTermByKey(i);
924 Handled := True;
925 end;
926
927 if Command = FToggleTermCmd then begin
928 i := FindTermAtCaret;
929 if i >= 0 then
930 TermDict.RemoveTermByKey(i)
931 else
932 AddTermByKey;
933 Handled := True;
934 end;
935
936 finally
937 TermDict.DecChangeNotifyLock;
938 end;
939 end;
940
CreateTermsListnull941 function TSourceSynEditMarkupHighlightAllMulti.CreateTermsList: TSynSearchTermDict;
942 begin
943 Result := TSourceSynSearchTermDict.Create(TSourceSynSearchTermList);
944 end;
945
946 constructor TSourceSynEditMarkupHighlightAllMulti.Create(ASynEdit: TSynEditBase);
947 begin
948 inherited Create(ASynEdit);
949 TCustomSynEdit(SynEdit).RegisterCommandHandler(@ProcessSynCommand, nil, [hcfInit]);
950 end;
951
952 destructor TSourceSynEditMarkupHighlightAllMulti.Destroy;
953 begin
954 inherited Destroy;
955 TCustomSynEdit(SynEdit).UnregisterCommandHandler(@ProcessSynCommand);
956 end;
957
958 procedure TSourceSynEditMarkupHighlightAllMulti.RestoreLocalChanges;
959 begin
960 (Terms as TSourceSynSearchTermDict).RestoreLocalChanges;
961 end;
962
963 {$IFDEF WithSynDebugGutter}
964 { TIDESynGutterDebugHL }
965
966 procedure TIDESynGutterDebugHL.PopContentClicked(Sender: TObject);
967 begin
968 FContent := TMenuItem(Sender).Tag;
969 SynEdit.Invalidate;
970 end;
971
972 procedure TIDESynGutterDebugHL.PopSizeClicked(Sender: TObject);
973 begin
974 Width := TMenuItem(Sender).Tag;
975 end;
976
PreferedWidthnull977 function TIDESynGutterDebugHL.PreferedWidth: Integer;
978 begin
979 Result := 15; // Gutter.TextDrawer.CharWidth * 15;
980 end;
981
MaybeHandleMouseActionnull982 function TIDESynGutterDebugHL.MaybeHandleMouseAction(var AnInfo: TSynEditMouseActionInfo;
983 HandleActionProc: TSynEditMouseActionHandler): Boolean;
984 begin
985 Result := False;
986 if (AnInfo.Button <> mbXRight) then exit;
987 Result := True;
988 if (AnInfo.Dir = cdUp) then begin
989 FPopUp.PopUp;
990 end;
991 end;
992
993 procedure TIDESynGutterDebugHL.PaintFoldLvl(Canvas: TCanvas; AClip: TRect; FirstLine,
994 LastLine: integer);
995 var
996 TextDrawer: TheTextDrawer;
997 c, i, iLine, LineHeight: Integer;
998 rcLine: TRect;
999 dc: HDC;
1000 s: String;
1001 RngLst: TSynHighlighterRangeList;
1002 r: TSynPasSynRange;
1003 begin
1004 if TCustomSynEdit(SynEdit).Highlighter = nil then exit;
1005 if not(TCustomSynEdit(SynEdit).Highlighter is TSynPasSyn) then exit;
1006 TCustomSynEdit(SynEdit).Highlighter.CurrentLines := TheLinesView;
1007 TextDrawer := Gutter.TextDrawer;
1008 dc := Canvas.Handle;
1009 //TSynHighlighterPasRangeList
1010 RngLst := TSynHighlighterRangeList(TheLinesView.Ranges[TCustomSynEdit(SynEdit).Highlighter]);
1011
1012 // Clear all
1013 TextDrawer.BeginDrawing(dc);
1014 try
1015 TextDrawer.SetBackColor(Gutter.Color);
1016 TextDrawer.SetForeColor(TCustomSynEdit(SynEdit).Font.Color);
1017 TextDrawer.SetFrameColor(clNone);
1018 with AClip do
1019 TextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, AClip, nil, 0);
1020
1021 rcLine := AClip;
1022 rcLine.Bottom := AClip.Top;
1023 LineHeight := TCustomSynEdit(SynEdit).LineHeight;
1024 c := TCustomSynEdit(SynEdit).Lines.Count;
1025 for i := FirstLine to LastLine do
1026 begin
1027 iLine := FoldView.DisplayNumber[i];
1028 if (iLine < 0) or (iLine >= c) then break;
1029 // next line rect
1030 rcLine.Top := rcLine.Bottom;
1031 rcLine.Bottom := rcLine.Bottom + LineHeight;
1032
1033 if i > 0 then begin
1034 r := TSynPasSynRange(RngLst.Range[iLine-1]);
1035 s:= format('%2d %2d %2d %2d %2d %2d ',
1036 [r.PasFoldEndLevel, r.PasFoldMinLevel, r.PasFoldFixLevel,
1037 r.CodeFoldStackSize, r.MinimumCodeFoldBlockLevel, r.LastLineCodeFoldLevelFix
1038 ]
1039 );
1040 end
1041 else
1042 s:= '';
1043
1044 TextDrawer.ExtTextOut(rcLine.Left, rcLine.Top, ETO_OPAQUE or ETO_CLIPPED, rcLine,
1045 PChar(Pointer(S)),Length(S));
1046 end;
1047
1048 finally
1049 TextDrawer.EndDrawing;
1050 end;
1051 end;
1052
1053 procedure TIDESynGutterDebugHL.PaintCharWidths(Canvas: TCanvas; AClip: TRect; FirstLine,
1054 LastLine: integer);
1055 var
1056 TextDrawer: TheTextDrawer;
1057 c, i, iLine, LineHeight: Integer;
1058 rcLine: TRect;
1059 dc: HDC;
1060 s, s2: String;
1061 CW: TPhysicalCharWidths;
1062 j: Integer;
1063 begin
1064 TextDrawer := Gutter.TextDrawer;
1065 dc := Canvas.Handle;
1066 TextDrawer.BeginDrawing(dc);
1067 try
1068 TextDrawer.SetBackColor(Gutter.Color);
1069 TextDrawer.SetForeColor(TCustomSynEdit(SynEdit).Font.Color);
1070 TextDrawer.SetFrameColor(clNone);
1071 with AClip do
1072 TextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, AClip, nil, 0);
1073
1074 rcLine := AClip;
1075 rcLine.Bottom := AClip.Top;
1076 LineHeight := TCustomSynEdit(SynEdit).LineHeight;
1077 c := TCustomSynEdit(SynEdit).Lines.Count;
1078 for i := FirstLine to LastLine do
1079 begin
1080 iLine := FoldView.DisplayNumber[i];
1081 if (iLine < 0) or (iLine >= c) then break;
1082 // next line rect
1083 rcLine.Top := rcLine.Bottom;
1084 rcLine.Bottom := rcLine.Bottom + LineHeight;
1085
1086 if i >= 0 then begin
1087 CW := FTheLinesView.GetPhysicalCharWidths(iLine-1);
1088 s2 := FTheLinesView.Strings[iLine-1];
1089 s := '';
1090 for j := 0 to length(CW) - 1 do begin
1091 case FContent of
1092 1: s := s + IntToStr(CW[j]) + ',';
1093 2: s := s + IntToHex(ord(s2[j+1]),2) + ',';
1094 3: s := s + IntToHex(ord(s2[j+1]),2) + '(' + IntToStr(CW[j]) + '),';
1095 end;
1096 if (j+1 < length(s2)) and (s2[j+2] in [#$00..#$7f,#$C0..#$FF]) then
1097 s := s + ' ';
1098 end;
1099 end
1100 else
1101 s:= '';
1102
1103 TextDrawer.ExtTextOut(rcLine.Left, rcLine.Top, ETO_OPAQUE or ETO_CLIPPED, rcLine,
1104 PChar(Pointer(S)),Length(S));
1105 end;
1106
1107 finally
1108 TextDrawer.EndDrawing;
1109 end;
1110 end;
1111
1112 constructor TIDESynGutterDebugHL.Create(AOwner: TComponent);
1113 var
1114 Item: TMenuItem;
1115 begin
1116 inherited Create(AOwner);
1117 FPopUp := TPopupMenu.Create(Self);
1118 AutoSize := False;
1119 Width := PreferedWidth;
1120 FContent := 0;
1121
1122 Item := TMenuItem.Create(FPopUp);
1123 Item.OnClick := @PopSizeClicked;
1124 Item.Caption := 'Size 15';
1125 Item.Tag := 15;
1126 FPopUp.Items.Add(Item);
1127
1128 Item := TMenuItem.Create(FPopUp);
1129 Item.OnClick := @PopSizeClicked;
1130 Item.Caption := 'Size 100';
1131 Item.Tag := 100;
1132 FPopUp.Items.Add(Item);
1133
1134 Item := TMenuItem.Create(FPopUp);
1135 Item.OnClick := @PopSizeClicked;
1136 Item.Caption := 'Size 250';
1137 Item.Tag := 240;
1138 FPopUp.Items.Add(Item);
1139
1140 Item := TMenuItem.Create(FPopUp);
1141 Item.OnClick := @PopSizeClicked;
1142 Item.Caption := 'Size 500';
1143 Item.Tag := 500;
1144 FPopUp.Items.Add(Item);
1145
1146 Item := TMenuItem.Create(FPopUp);
1147 Item.Caption := '-';
1148 FPopUp.Items.Add(Item);
1149
1150 Item := TMenuItem.Create(FPopUp);
1151 Item.OnClick := @PopContentClicked;
1152 Item.Caption := 'Content: Fold Level';
1153 Item.Tag := 0;
1154 FPopUp.Items.Add(Item);
1155
1156 Item := TMenuItem.Create(FPopUp);
1157 Item.OnClick := @PopContentClicked;
1158 Item.Caption := 'Content: CharWidths';
1159 Item.Tag := 1;
1160 FPopUp.Items.Add(Item);
1161
1162 Item := TMenuItem.Create(FPopUp);
1163 Item.OnClick := @PopContentClicked;
1164 Item.Caption := 'Content: Hex';
1165 Item.Tag := 2;
1166 FPopUp.Items.Add(Item);
1167
1168 Item := TMenuItem.Create(FPopUp);
1169 Item.OnClick := @PopContentClicked;
1170 Item.Caption := 'Content: CharWidths + hex';
1171 Item.Tag := 3;
1172 FPopUp.Items.Add(Item);
1173
1174
1175 end;
1176
1177 procedure TIDESynGutterDebugHL.Paint(Canvas: TCanvas; AClip: TRect; FirstLine,
1178 LastLine: integer);
1179 begin
1180 case FContent of
1181 0: PaintFoldLvl(Canvas, AClip, FirstLine, LastLine);
1182 1,2,3: PaintCharWidths(Canvas, AClip, FirstLine, LastLine);
1183 end;
1184 end;
1185 {$ENDIF}
1186
1187 { TSourceLazSynTopInfoView }
1188
GetLineMapnull1189 function TSourceLazSynTopInfoView.GetLineMap(Index: Integer): Integer;
1190 begin
1191 Result := FLineMap[Index];
1192 end;
1193
1194 procedure TSourceLazSynTopInfoView.SetLineMap(Index: Integer; AValue: Integer);
1195 begin
1196 FLineMap[Index] := AValue;
1197 end;
1198
1199 procedure TSourceLazSynTopInfoView.SetLineMapCount(AValue: integer);
1200 begin
1201 if FLineMapCount = AValue then Exit;
1202 FLineMapCount := AValue;
1203 SetLength(FLineMap, AValue);
1204 end;
1205
1206 procedure TSourceLazSynTopInfoView.SetHighlighterTokensLine(ALine: TLineIdx;
1207 out ARealLine: TLineIdx; out AStartBytePos, ALineByteLen: Integer);
1208 begin
1209 CurrentTokenLine := ALine;
1210 inherited SetHighlighterTokensLine(FLineMap[ALine], ARealLine, AStartBytePos, ALineByteLen);
1211 end;
1212
GetLinesCountnull1213 function TSourceLazSynTopInfoView.GetLinesCount: Integer;
1214 begin
1215 Result := LineMapCount;
1216 end;
1217
TextToViewIndexnull1218 function TSourceLazSynTopInfoView.TextToViewIndex(AIndex: TLineIdx): TLineRange;
1219 var
1220 i: Integer;
1221 r: TLineRange;
1222 begin
1223 Result.Top := -1;
1224 Result.Bottom := -1;
1225 r := inherited TextToViewIndex(AIndex);
1226 for i := 0 to LineMapCount - 1 do begin
1227 if LineMap[i] = r.Top then Result.Top := i;
1228 if LineMap[i] = r.Bottom then Result.Bottom := i;
1229 end;
1230 if Result.Bottom < Result.Top then
1231 Result.Bottom := Result.Top;
1232 end;
1233
ViewToTextIndexnull1234 function TSourceLazSynTopInfoView.ViewToTextIndex(AIndex: TLineIdx): TLineIdx;
1235 begin
1236 Result := inherited ViewToTextIndex(AIndex);
1237 end;
1238
1239 constructor TSourceLazSynTopInfoView.Create;
1240 begin
1241 LineMapCount := 0;
1242 end;
1243
1244 { TSourceLazSynSurfaceGutter }
1245
1246 procedure TSourceLazSynSurfaceGutter.DoPaint(ACanvas: TCanvas; AClip: TRect);
1247 begin
1248 // prevent output
1249 Gutter.Paint(ACanvas, Self, AClip, 0, -1);
1250 end;
1251
1252 procedure TSourceLazSynSurfaceGutter.SetTextArea(ATextArea: TLazSynTextArea);
1253 begin
1254 inherited SetTextArea(ATextArea);
1255 ATextArea.AddTextSizeChangeHandler(@TextSizeChanged);
1256 end;
1257
1258 procedure TSourceLazSynSurfaceGutter.TextSizeChanged(Sender: TObject);
1259 begin
1260 Gutter.DoAutoSize;
1261 end;
1262
1263 { TSourceLazSynSurfaceManager }
1264
1265 procedure TSourceLazSynSurfaceManager.SetTopLineCount(AValue: Integer);
1266 begin
1267 if FTopLineCount = AValue then Exit;
1268 FTopLineCount := AValue;
1269 BoundsChanged;
1270 end;
1271
GetLeftGutterAreanull1272 function TSourceLazSynSurfaceManager.GetLeftGutterArea: TLazSynSurfaceWithText;
1273 begin
1274 Result := FOriginalManager.LeftGutterArea;
1275 end;
1276
GetRightGutterAreanull1277 function TSourceLazSynSurfaceManager.GetRightGutterArea: TLazSynSurfaceWithText;
1278 begin
1279 Result := FOriginalManager.RightGutterArea;
1280 end;
1281
GetTextAreanull1282 function TSourceLazSynSurfaceManager.GetTextArea: TLazSynTextArea;
1283 begin
1284 Result := FOriginalManager.TextArea;
1285 end;
1286
1287 procedure TSourceLazSynSurfaceManager.SetBackgroundColor(AValue: TColor);
1288 begin
1289 FOriginalManager.BackgroundColor := AValue;
1290 FExtraManager.BackgroundColor := AValue;
1291 end;
1292
1293 procedure TSourceLazSynSurfaceManager.SetExtraCharSpacing(AValue: integer);
1294 begin
1295 FOriginalManager.ExtraCharSpacing := AValue;
1296 FExtraManager.ExtraCharSpacing := AValue;
1297 end;
1298
1299 procedure TSourceLazSynSurfaceManager.SetExtraLineSpacing(AValue: integer);
1300 begin
1301 FOriginalManager.ExtraLineSpacing := AValue;
1302 FExtraManager.ExtraLineSpacing := AValue;
1303 BoundsChanged;
1304 end;
1305
1306 procedure TSourceLazSynSurfaceManager.SetForegroundColor(AValue: TColor);
1307 begin
1308 FOriginalManager.ForegroundColor := AValue;
1309 FExtraManager.ForegroundColor := AValue;
1310 end;
1311
1312 procedure TSourceLazSynSurfaceManager.SetPadding(Side: TLazSynBorderSide; AValue: integer);
1313 begin
1314 FOriginalManager.Padding[Side] := AValue;
1315 FExtraManager.Padding[Side] := AValue;
1316 end;
1317
1318 procedure TSourceLazSynSurfaceManager.SetRightEdgeColor(AValue: TColor);
1319 begin
1320 FOriginalManager.RightEdgeColor := AValue;
1321 FExtraManager.RightEdgeColor := AValue;
1322 end;
1323
1324 procedure TSourceLazSynSurfaceManager.SetRightEdgeColumn(AValue: integer);
1325 begin
1326 FOriginalManager.RightEdgeColumn := AValue;
1327 FExtraManager.RightEdgeColumn := AValue;
1328 end;
1329
1330 procedure TSourceLazSynSurfaceManager.SetRightEdgeVisible(AValue: boolean);
1331 begin
1332 FOriginalManager.RightEdgeVisible := AValue;
1333 FExtraManager.RightEdgeVisible := AValue;
1334 end;
1335
1336 procedure TSourceLazSynSurfaceManager.SetVisibleSpecialChars(AValue: TSynVisibleSpecialChars);
1337 begin
1338 FOriginalManager.VisibleSpecialChars := AValue;
1339 FExtraManager.VisibleSpecialChars := AValue;
1340 end;
1341
1342 procedure TSourceLazSynSurfaceManager.SetHighlighter(AValue: TSynCustomHighlighter);
1343 begin
1344 FOriginalManager.Highlighter := AValue;
1345 FExtraManager.Highlighter := AValue;
1346 end;
1347
1348 procedure TSourceLazSynSurfaceManager.DoPaint(ACanvas: TCanvas; AClip: TRect);
1349 begin
1350 FOriginalManager.Paint(ACanvas, AClip);
1351 FExtraManager.Paint(ACanvas, AClip);
1352 end;
1353
1354 procedure TSourceLazSynSurfaceManager.DoDisplayViewChanged;
1355 begin
1356 FOriginalManager.DisplayView := DisplayView;
1357 end;
1358
1359 procedure TSourceLazSynSurfaceManager.BoundsChanged;
1360 var
1361 t: Integer;
1362 begin
1363 FExtraManager.LeftGutterWidth := LeftGutterWidth;
1364 FExtraManager.RightGutterWidth := RightGutterWidth;
1365 FOriginalManager.LeftGutterWidth := LeftGutterWidth;
1366 FOriginalManager.RightGutterWidth := RightGutterWidth;
1367
1368 t := Min(Top + FTopLineCount * FExtraManager.TextArea.LineHeight,
1369 Max(Top, Bottom - FOriginalManager.TextArea.LineHeight)
1370 );
1371 FExtraManager.SetBounds(Top, Left, t, Right);
1372 FOriginalManager.SetBounds(t, Left, Bottom, Right);
1373 end;
1374
1375 constructor TSourceLazSynSurfaceManager.Create(AOwner: TWinControl; AnOriginalManager: TLazSynSurfaceManager);
1376 var
1377 txt: TLazSynTextArea;
1378 lgutter, rgutter: TLazSynGutterArea;
1379 begin
1380 inherited Create(AOwner);
1381 FTopLineCount := 0;
1382 FOriginalManager := AnOriginalManager;
1383
1384 txt := TLazSynTextArea.Create(AOwner, FOriginalManager.TextArea.TextDrawer);
1385 txt.Assign(FOriginalManager.TextArea);
1386 txt.TopLine := 1;
1387 txt.LeftChar := 1;
1388
1389 lgutter:= TSourceLazSynSurfaceGutter.Create(AOwner);
1390 lgutter.Assign(FOriginalManager.LeftGutterArea);
1391 lgutter.TextArea := txt;
1392
1393 rgutter:= TSourceLazSynSurfaceGutter.Create(AOwner);
1394 rgutter.Assign(FOriginalManager.RightGutterArea);
1395 rgutter.TextArea := txt;
1396
1397 FExtraManager := TLazSynSurfaceManager.Create(AOwner);
1398 FExtraManager.TextArea := txt;
1399 FExtraManager.LeftGutterArea := lgutter;
1400 FExtraManager.RightGutterArea := rgutter;
1401 end;
1402
1403 destructor TSourceLazSynSurfaceManager.Destroy;
1404 begin
1405 inherited Destroy;
1406 FExtraManager.LeftGutterArea.Free;
1407 FExtraManager.RightGutterArea.Free;
1408 FExtraManager.TextArea.Free;
1409 FExtraManager.Free;
1410 FOriginalManager.Free;
1411 end;
1412
1413 procedure TSourceLazSynSurfaceManager.InvalidateLines(FirstTextLine, LastTextLine: TLineIdx);
1414 begin
1415 FOriginalManager.InvalidateLines(FirstTextLine, LastTextLine);
1416 FExtraManager.InvalidateLines(FirstTextLine, LastTextLine);
1417 end;
1418
1419 procedure TSourceLazSynSurfaceManager.InvalidateTextLines(FirstTextLine, LastTextLine: TLineIdx);
1420 begin
1421 FOriginalManager.InvalidateTextLines(FirstTextLine, LastTextLine);
1422 FExtraManager.InvalidateTextLines(FirstTextLine, LastTextLine);
1423 end;
1424
1425 procedure TSourceLazSynSurfaceManager.InvalidateGutterLines(FirstTextLine, LastTextLine: TLineIdx);
1426 begin
1427 FOriginalManager.InvalidateGutterLines(FirstTextLine, LastTextLine);
1428 FExtraManager.InvalidateGutterLines(FirstTextLine, LastTextLine);
1429 end;
1430
1431 { TIDESynEditor }
1432
1433 procedure TIDESynEditor.DoHighlightChanged(Sender: TSynEditStrings; AIndex, ACount: Integer);
1434 begin
1435 FTopInfoNestList.Clear;
1436 if FSrcSynCaretChangedNeeded then
1437 SrcSynCaretChanged(nil);
1438 end;
1439
1440 procedure TIDESynEditor.SrcSynCaretChanged(Sender: TObject);
1441 function RealTopLine: Integer;
1442 begin
1443 Result := TopLine - TSourceLazSynSurfaceManager(FPaintArea).TopLineCount;
1444 end;
1445 var
1446 InfCnt, i, t, ListCnt: Integer;
1447 InfList: array [0..1] of
1448 record
1449 LineIndex: Integer;
1450 FoldType: TPascalCodeFoldBlockType;
1451 end;
1452 NodeFoldType: TPascalCodeFoldBlockType;
1453 begin
1454 if (not FShowTopInfo) or (not HandleAllocated) or (FFoldView.HighLighter = nil) then exit;
1455 if FSrcSynCaretChangedLock or not(FFoldView.HighLighter is TSynPasSyn) then exit;
1456
1457 if FFoldView.HighLighter.NeedScan then begin
1458 FSrcSynCaretChangedNeeded := True;
1459 exit;
1460 end;
1461 FSrcSynCaretChangedNeeded := False;
1462
1463 FSrcSynCaretChangedLock := True;
1464 try
1465 ListCnt := 0;
1466
1467 if CaretY >= RealTopLine then begin
1468 FTopInfoNestList.Lines := TextBuffer; // in case it changed
1469 FTopInfoNestList.Line := CaretY-1;
1470 FTopInfoNestList := FTopInfoNestList;
1471
1472 InfCnt := FTopInfoNestList.Count;
1473 for i := InfCnt-1 downto 0 do begin
1474 NodeFoldType := TPascalCodeFoldBlockType({%H-}PtrUInt(FTopInfoNestList.NodeFoldType[i]));
1475 if not(NodeFoldType in
1476 [cfbtClass, cfbtClassSection, cfbtProcedure])
1477 then
1478 continue;
1479
1480 if (NodeFoldType in [cfbtClassSection]) and (ListCnt = 0) then begin
1481 InfList[ListCnt].LineIndex := FTopInfoNestList.NodeLine[i];
1482 InfList[ListCnt].FoldType := NodeFoldType;
1483 inc(ListCnt);
1484 end;
1485
1486 if (NodeFoldType in [cfbtClass]) and (ListCnt < 2) then begin
1487 InfList[ListCnt].LineIndex := FTopInfoNestList.NodeLine[i];
1488 InfList[ListCnt].FoldType := NodeFoldType;
1489 inc(ListCnt);
1490 end;
1491
1492 if (NodeFoldType in [cfbtProcedure]) and (ListCnt < 2) then begin
1493 InfList[ListCnt].LineIndex := FTopInfoNestList.NodeLine[i];
1494 InfList[ListCnt].FoldType := NodeFoldType;
1495 inc(ListCnt);
1496 end;
1497 if (NodeFoldType in [cfbtProcedure]) and (ListCnt = 2) and
1498 (InfList[ListCnt-1].FoldType = cfbtProcedure)
1499 then begin
1500 InfList[ListCnt-1].LineIndex := FTopInfoNestList.NodeLine[i];
1501 InfList[ListCnt-1].FoldType := NodeFoldType;
1502 end;
1503 end;
1504 end;
1505
1506 if TopLine <> FTopInfoLastTopLine then // if Sender = nil;
1507 ListCnt := Min(ListCnt, Max(0, CaretY - RealTopLine));
1508
1509 t := TopLine + ListCnt - TSourceLazSynSurfaceManager(FPaintArea).TopLineCount;
1510 if (CaretY >= TopLine) and (CaretY < t) then
1511 t := CaretY;
1512
1513 while ListCnt > 0 do begin
1514 if InfList[0].LineIndex + 1 >= t-1 then begin
1515 InfList[0] := InfList[1];
1516 dec(ListCnt);
1517 t := TopLine + ListCnt - TSourceLazSynSurfaceManager(FPaintArea).TopLineCount;
1518 if (CaretY >= TopLine) and (CaretY < t) then
1519 t := CaretY;
1520 end
1521 else
1522 break;
1523 end;
1524
1525 FTopInfoDisplay.LineMapCount := ListCnt;
1526
1527 if ListCnt <> TSourceLazSynSurfaceManager(FPaintArea).TopLineCount then begin
1528 TopLine := t;
1529 TSourceLazSynSurfaceManager(FPaintArea).TopLineCount := ListCnt;
1530 SizeOrFontChanged(FALSE);
1531 Invalidate; // TODO: move to PaintArea
1532 end;
1533
1534 for i := 0 to ListCnt - 1 do begin
1535 if FTopInfoDisplay.LineMap[ListCnt-1-i] <> InfList[i].LineIndex then
1536 TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.InvalidateLines(ListCnt-1-i, ListCnt-1-i);
1537 FTopInfoDisplay.LineMap[ListCnt-1-i] := InfList[i].LineIndex;
1538 end;
1539
1540 finally
1541 FSrcSynCaretChangedLock := False;
1542 FTopInfoLastTopLine := TopLine;
1543 end;
1544 end;
1545
GetHighlighternull1546 function TIDESynEditor.GetHighlighter: TSynCustomFoldHighlighter;
1547 begin
1548 if Highlighter is TSynCustomFoldHighlighter then
1549 Result := TSynCustomFoldHighlighter(Highlighter)
1550 else
1551 Result := nil;
1552 end;
1553
1554 procedure TIDESynEditor.DoOnStatusChange(Changes: TSynStatusChanges);
1555 begin
1556 inherited DoOnStatusChange(Changes);
1557 if Changes * [scTopLine, scLinesInWindow] <> []then
1558 SrcSynCaretChanged(nil);
1559 {$push}{$R-} // range check off
1560 if Changes * [scCaretX, scCaretY, scSelection] <> []then
1561 Inc(FCaretStamp);
1562 {$pop}
1563 end;
1564
1565 procedure TIDESynEditor.GetTopInfoMarkupForLine(Sender: TObject; Line: integer;
1566 var Special: boolean; aMarkup: TSynSelectedColor);
1567 begin
1568 Special := True;
1569 aMarkup.Assign(FTopInfoMarkup);
1570 end;
1571
1572 procedure TIDESynEditor.SetCaretColor(AValue: TColor);
1573 begin
1574 if FCaretColor = AValue then Exit;
1575 FCaretColor := AValue;
1576 if (AValue = clDefault) or (AValue = clNone) then begin
1577 FScreenCaretPainterClass{%H-} := TSynEditScreenCaretPainterSystem;
1578 if ScreenCaret.Painter.ClassType <> TSynEditScreenCaretPainterSystem then begin
1579 MultiCaret.ActiveMode := mcmNoCarets; // clear all carets, before changing the caret class
1580 ScreenCaret.ChangePainter(TSynEditScreenCaretPainterSystem);
1581 end;
1582 end
1583 else begin
1584 FScreenCaretPainterClass{%H-} := TSynEditScreenCaretPainterInternal;
1585 if ScreenCaret.Painter.ClassType <> TSynEditScreenCaretPainterInternal then begin
1586 MultiCaret.ActiveMode := mcmNoCarets; // clear all carets, before changing the caret class
1587 ScreenCaret.ChangePainter(TSynEditScreenCaretPainterInternal);
1588 end;
1589 TSynEditScreenCaretPainterInternal(ScreenCaret.Painter).Color := AValue;
1590 end;
1591 end;
1592
1593 procedure TIDESynEditor.SetHighlightUserWordCount(AValue: Integer);
1594 var
1595 m: TSourceSynEditMarkupHighlightAllMulti;
1596 begin
1597 if AValue = FUserWordsList.Count then
1598 exit;
1599
1600 while FUserWordsList.Count > AValue do begin
1601 TSynEditMarkupManager(MarkupMgr).RemoveMarkUp(TSourceSynEditMarkupHighlightAllMulti(FUserWordsList[AValue]));
1602 TSourceSynEditMarkupHighlightAllMulti(FUserWordsList[AValue]).Free;
1603 FUserWordsList.Delete(AValue);
1604 end;
1605
1606 while AValue > FUserWordsList.Count do begin
1607 m := TSourceSynEditMarkupHighlightAllMulti.Create(self);
1608 if PaintLock > 0 then
1609 m.IncPaintLock;
1610 if Highlighter <> nil then
1611 m.WordBreakChars := Highlighter.WordBreakChars + TSynWhiteChars;
1612 FUserWordsList.Add(m);
1613 TSynEditMarkupManager(MarkupMgr).AddMarkUp(m);
1614 end;
1615 end;
1616
1617 procedure TIDESynEditor.SetOnMultiCaretBeforeCommand(AValue: TSynMultiCaretBeforeCommand);
1618 begin
1619 FMultiCaret.OnBeforeCommand := AValue;
1620 end;
1621
1622 procedure TIDESynEditor.SetShowTopInfo(AValue: boolean);
1623 begin
1624 if FShowTopInfo = AValue then Exit;
1625 FShowTopInfo := AValue;
1626 if FShowTopInfo then begin
1627 SrcSynCaretChanged(nil)
1628 end
1629 else
1630 if TSourceLazSynSurfaceManager(FPaintArea).TopLineCount <> 0 then begin
1631 TSourceLazSynSurfaceManager(FPaintArea).TopLineCount := 0;
1632 Invalidate; // TODO: move to PaintArea
1633 end;
1634 end;
1635
1636 procedure TIDESynEditor.SetTopInfoMarkup(AValue: TSynSelectedColor);
1637 begin
1638 if FTopInfoMarkup = AValue then Exit;
1639 FTopInfoMarkup.Assign(AValue);
1640 end;
1641
GetIDEGutterMarksnull1642 function TIDESynEditor.GetIDEGutterMarks: TIDESynGutterMarks;
1643 begin
1644 Result := TIDESynGutterMarks(Gutter.Parts.ByClass[TIDESynGutterMarks, 0]);
1645 end;
1646
GetIsInMultiCaretMainExecutionnull1647 function TIDESynEditor.GetIsInMultiCaretMainExecution: Boolean;
1648 begin
1649 Result := FMultiCaret.IsInMainExecution;
1650 end;
1651
GetIsInMultiCaretRepeatExecutionnull1652 function TIDESynEditor.GetIsInMultiCaretRepeatExecution: Boolean;
1653 begin
1654 Result := FMultiCaret.IsInRepeatExecution;
1655 end;
1656
GetOnMultiCaretBeforeCommandnull1657 function TIDESynEditor.GetOnMultiCaretBeforeCommand: TSynMultiCaretBeforeCommand;
1658 begin
1659 Result := FMultiCaret.OnBeforeCommand;
1660 end;
1661
IsIfdefMarkupActivenull1662 function TIDESynEditor.IsIfdefMarkupActive: Boolean;
1663 begin
1664 Result := FMarkupIfDef.RealEnabled;
1665 end;
1666
DoIfDefNodeStateRequestnull1667 function TIDESynEditor.DoIfDefNodeStateRequest(Sender: TObject; LinePos,
1668 XStartPos: Integer; CurrentState: TSynMarkupIfdefNodeStateEx): TSynMarkupIfdefNodeState;
1669 begin
1670 //debugln(['TIDESynEditor.DoIfDefNodeStateRequest x=',XStartPos,' y=',LinePos,' ',DbgSName(Sender)]);
1671 if FOnIfdefNodeStateRequest <> nil then
1672 Result := FOnIfdefNodeStateRequest(Self, LinePos, XStartPos, CurrentState)
1673 else
1674 Result := idnInvalid;
1675 end;
1676
1677 procedure TIDESynEditor.InvalidateAllIfdefNodes;
1678 begin
1679 FMarkupIfDef.InvalidateAll;
1680 end;
1681
1682 procedure TIDESynEditor.SetIfdefNodeState(ALinePos, AstartPos: Integer;
1683 AState: TSynMarkupIfdefNodeState);
1684 begin
1685 FMarkupIfDef.SetNodeState(ALinePos, AstartPos, AState);
1686 end;
1687
GetHighlightUserWordCountnull1688 function TIDESynEditor.GetHighlightUserWordCount: Integer;
1689 begin
1690 Result := FUserWordsList.Count;
1691 end;
1692
GetHighlightUserWordsnull1693 function TIDESynEditor.GetHighlightUserWords(AIndex: Integer): TSourceSynEditMarkupHighlightAllMulti;
1694 begin
1695 Result := TSourceSynEditMarkupHighlightAllMulti(FUserWordsList[AIndex])
1696 end;
1697
CreateGutternull1698 function TIDESynEditor.CreateGutter(AOwner: TSynEditBase; ASide: TSynGutterSide;
1699 ATextDrawer: TheTextDrawer): TSynGutter;
1700 begin
1701 Result := TIDESynGutter.Create(AOwner, ASide, ATextDrawer);
1702 end;
1703
1704 procedure TIDESynEditor.SetHighlighter(const Value: TSynCustomHighlighter);
1705 var
1706 i: Integer;
1707 begin
1708 if Value = Highlighter then begin
1709 inherited SetHighlighter(Value);
1710 exit
1711 end;
1712
1713 IncPaintLock;
1714 try
1715 FMarkupIfDef.Highlighter := nil;
1716
1717 inherited SetHighlighter(Value);
1718
1719 //TSynEditMarkupFoldColors(MarkupByClass[TSynEditMarkupFoldColors]).Highlighter := Highlighter; // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
1720 if Highlighter is TSynPasSyn then
1721 FMarkupIfDef.Highlighter := TSynPasSyn(Highlighter)
1722 else
1723 FMarkupIfDef.Highlighter := nil;
1724
1725 if Highlighter is TSynCustomFoldHighlighter then
1726 FTopInfoNestList.Highlighter := TSynCustomFoldHighlighter(Highlighter)
1727 else
1728 FTopInfoNestList.Highlighter := nil;
1729
1730 if FUserWordsList = nil then
1731 exit;
1732 if Highlighter <> nil then
1733 for i := 0 to FUserWordsList.Count - 1 do
1734 HighlightUserWords[i].WordBreakChars := Highlighter.WordBreakChars + TSynWhiteChars
1735 else
1736 for i := 0 to FUserWordsList.Count - 1 do
1737 HighlightUserWords[i].ResetWordBreaks;
1738 finally
1739 DecPaintLock;
1740 end;
1741 end;
1742
1743 constructor TIDESynEditor.Create(AOwner: TComponent);
1744 var
1745 MarkupFoldColors: TSynEditMarkupFoldColors;
1746 begin
1747 inherited Create(AOwner);
1748 FFoldView := TSynEditFoldedView(TextViewsManager.SynTextViewByClass[TSynEditFoldedView]);
1749 FCaretColor := clNone;
1750 FUserWordsList := TFPList.Create;
1751 FTemplateEdit:=TSynPluginTemplateEdit.Create(Self);
1752 FSyncroEdit := TSynPluginSyncroEdit.Create(Self);
1753 FMultiCaret := TSynPluginMultiCaret.Create(Self);
1754 FMultiCaret.MouseActions.Clear; // will be added to SynEdit
1755 FMultiCaret.KeyStrokes.Clear;
1756 FMultiCaret.SetCaretTypeSize(ctVerticalLine, 2, 1024, -1, 0, [ccsRelativeHeight]);
1757 FMultiCaret.SetCaretTypeSize(ctBlock, 1024, 1024, 0, 0, [ccsRelativeWidth, ccsRelativeHeight]);
1758 FMultiCaret.Color := $606060;
1759
1760 FMarkupForGutterMark := TSynEditMarkupGutterMark.Create(Self, FWordBreaker);
1761 TSynEditMarkupManager(MarkupMgr).AddMarkUp(FMarkupForGutterMark);
1762
1763 MarkupFoldColors := TSynEditMarkupFoldColors.Create(Self);
1764 //MarkupFoldColors.DefaultGroup := 0;
1765 TSynEditMarkupManager(MarkupMgr).AddMarkUp(MarkupFoldColors);
1766
1767 FMarkupIfDef := TSourceSynEditMarkupIfDef.Create(Self);
1768 FMarkupIfDef.FoldView := TSynEditFoldedView(FoldedTextBuffer);
1769 //FMarkupIfDef.OnNodeStateRequest := @DoIfDefNodeStateRequest;
1770 TSynEditMarkupManager(MarkupMgr).AddMarkUp(FMarkupIfDef);
1771
1772 FMarkupIdentComplWindow := TSynMarkupIdentComplWindow.Create;
1773
1774 FPaintArea := TSourceLazSynSurfaceManager.Create(Self, FPaintArea);
1775 GetCaretObj.AddChangeHandler(@SrcSynCaretChanged);
1776
1777 FTopInfoDisplay := TSourceLazSynTopInfoView.Create;
1778 FTopInfoDisplay.NextView := TextViewsManager.SynTextViewByClass[TSynEditStringTabExpander].DisplayView;
1779 TSourceLazSynSurfaceManager(FPaintArea).TopLineCount := 0;
1780 // TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.TextArea.BackgroundColor := clSilver;
1781 TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.DisplayView := FTopInfoDisplay;
1782
1783 FTopInfoNestList := TLazSynEditNestedFoldsList.Create(TextBuffer);
1784 FTopInfoNestList.ResetFilter;
1785 FTopInfoNestList.FoldGroup := FOLDGROUP_PASCAL;
1786 FTopInfoNestList.FoldFlags := [sfbIncludeDisabled];
1787 FTopInfoNestList.IncludeOpeningOnLine := False;
1788 FTopInfoMarkup := TSynSelectedColor.Create;
1789 FTopInfoMarkup.Clear;
1790
1791 ViewedTextBuffer.AddChangeHandler(senrHighlightChanged, @DoHighlightChanged);
1792
1793 // Markup for top info hint
1794 FExtraMarkupLine := TSynEditMarkupSpecialLine.Create(Self);
1795 FExtraMarkupLine.OnSpecialLineMarkup := @GetTopInfoMarkupForLine;
1796 FExtraMarkupMgr := TSynEditMarkupManager.Create(Self);
1797 FExtraMarkupMgr.AddMarkUp(TSynEditMarkup(MarkupMgr));
1798 FExtraMarkupMgr.AddMarkUp(FExtraMarkupLine);
1799 FExtraMarkupMgr.Lines := ViewedTextBuffer;
1800 FExtraMarkupMgr.Caret := GetCaretObj;
1801 FExtraMarkupMgr.InvalidateLinesMethod := @InvalidateLines;
1802
1803 TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.TextArea.MarkupManager :=
1804 FExtraMarkupMgr;
1805 {$IFDEF WithSynDebugGutter}
1806 TIDESynGutter(RightGutter).DebugGutter.TheLinesView := ViewedTextBuffer;
1807 {$ENDIF}
1808 end;
1809
1810 destructor TIDESynEditor.Destroy;
1811 begin
1812 HighlightUserWordCount := 0;
1813 Highlighter := nil;
1814 FreeAndNil(FUserWordsList);
1815 FExtraMarkupMgr.RemoveMarkUp(TSynEditMarkup(MarkupMgr));
1816 FreeAndNil(FTopInfoDisplay);
1817 FreeAndNil(FExtraMarkupMgr);
1818 FreeAndNil(FTopInfoMarkup);
1819 FreeAndNil(FTopInfoNestList);
1820 FreeAndNil(FMarkupIdentComplWindow);
1821 inherited Destroy;
1822 end;
1823
TextIndexToViewPosnull1824 function TIDESynEditor.TextIndexToViewPos(aTextIndex: Integer): Integer;
1825 begin
1826 Result := ToPos(TextView.TextToViewIndex(ToIdx(aTextIndex)));
1827 end;
1828
1829 {$IFDEF WinIME}
1830 procedure TIDESynEditor.CreateMinimumIme;
1831 var
1832 Ime: LazSynIme;
1833 begin
1834 if ImeHandler is LazSynImeSimple then exit;
1835 Ime := LazSynImeSimple.Create(Self);
1836 LazSynImeSimple(Ime).TextDrawer := TextDrawer;
1837 Ime.InvalidateLinesMethod := @InvalidateLines;
1838 ImeHandler := Ime;
1839 end;
1840
1841 procedure TIDESynEditor.CreateFullIme;
1842 var
1843 Ime: LazSynIme;
1844 begin
1845 if ImeHandler is LazSynImeFull then exit;
1846 Ime := LazSynImeFull.Create(Self);
1847 Ime.InvalidateLinesMethod := @InvalidateLines;
1848 ImeHandler := Ime;
1849 end;
1850
1851 {$ENDIF}
1852
1853 { TIDESynPasSyn }
1854
GetFinalizationLinenull1855 function TIDESynPasSyn.GetFinalizationLine: Integer;
1856 begin
1857 Result := TIDESynHighlighterPasRangeList(CurrentRanges).FFinalizationLine;
1858 end;
1859
GetImplementationLinenull1860 function TIDESynPasSyn.GetImplementationLine: Integer;
1861 begin
1862 Result := TIDESynHighlighterPasRangeList(CurrentRanges).FImplementationLine;
1863 end;
1864
GetInitializationLinenull1865 function TIDESynPasSyn.GetInitializationLine: Integer;
1866 begin
1867 Result := TIDESynHighlighterPasRangeList(CurrentRanges).FInitializationLine;
1868 end;
1869
GetInterfaceLinenull1870 function TIDESynPasSyn.GetInterfaceLine: Integer;
1871 begin
1872 Result := TIDESynHighlighterPasRangeList(CurrentRanges).FInterfaceLine;
1873 end;
1874
CreateRangeListnull1875 function TIDESynPasSyn.CreateRangeList(ALines: TSynEditStringsBase): TSynHighlighterRangeList;
1876 begin
1877 Result := TIDESynHighlighterPasRangeList.Create;
1878 TIDESynHighlighterPasRangeList(Result).FInterfaceLine := -1;
1879 TIDESynHighlighterPasRangeList(Result).FImplementationLine := -1;
1880 TIDESynHighlighterPasRangeList(Result).FInitializationLine := -1;
1881 TIDESynHighlighterPasRangeList(Result).FFinalizationLine := -1;
1882 end;
1883
StartCodeFoldBlocknull1884 function TIDESynPasSyn.StartCodeFoldBlock(ABlockType: Pointer;
1885 IncreaseLevel: Boolean; ForceDisabled: Boolean): TSynCustomCodeFoldBlock;
1886 begin
1887 if (ABlockType = Pointer(PtrUInt(cfbtUnitSection))) or
1888 (ABlockType = Pointer(PtrUInt(cfbtUnitSection)) + {%H-}PtrUInt(CountPascalCodeFoldBlockOffset))
1889 then begin
1890 if KeyComp('Interface') then
1891 TIDESynHighlighterPasRangeList(CurrentRanges).FInterfaceLine := LineIndex + 1;
1892 if KeyComp('Implementation') then
1893 TIDESynHighlighterPasRangeList(CurrentRanges).FImplementationLine := LineIndex + 1;
1894 if KeyComp('Initialization') then
1895 TIDESynHighlighterPasRangeList(CurrentRanges).FInitializationLine := LineIndex + 1;
1896 if KeyComp('Finalization') then
1897 TIDESynHighlighterPasRangeList(CurrentRanges).FFinalizationLine := LineIndex + 1;
1898 end;
1899 Result := inherited;
1900 end;
1901
1902 procedure TIDESynPasSyn.SetLine(const NewValue: string; LineNumber: Integer);
1903 begin
1904 if assigned(CurrentRanges) then begin
1905 if TIDESynHighlighterPasRangeList(CurrentRanges).FInterfaceLine = LineNumber + 1 then
1906 TIDESynHighlighterPasRangeList(CurrentRanges).FInterfaceLine := -1;
1907 if TIDESynHighlighterPasRangeList(CurrentRanges).FImplementationLine = LineNumber + 1 then
1908 TIDESynHighlighterPasRangeList(CurrentRanges).FImplementationLine := -1;
1909 if TIDESynHighlighterPasRangeList(CurrentRanges).FInitializationLine = LineNumber + 1 then
1910 TIDESynHighlighterPasRangeList(CurrentRanges).FInitializationLine := -1;
1911 if TIDESynHighlighterPasRangeList(CurrentRanges).FFinalizationLine = LineNumber + 1 then
1912 TIDESynHighlighterPasRangeList(CurrentRanges).FFinalizationLine := -1;
1913 end;
1914 inherited SetLine(NewValue, LineNumber);
1915 end;
1916
1917 { TIDESynFreePasSyn }
1918
1919 constructor TIDESynFreePasSyn.Create(AOwner: TComponent);
1920 begin
1921 inherited Create(AOwner);
1922 CompilerMode:=pcmObjFPC;
1923 end;
1924
1925 procedure TIDESynFreePasSyn.ResetRange;
1926 begin
1927 inherited ResetRange;
1928 CompilerMode:=pcmObjFPC;
1929 end;
1930
1931 { TIDESynGutterLOvProviderPascal }
1932
1933 procedure TIDESynGutterLOvProviderPascal.SetSingleLine(const AValue: Boolean);
1934 begin
1935 if FSingleLine = AValue then exit;
1936 FSingleLine := AValue;
1937 InvalidatePixelLines(0, Height);
1938 end;
1939
1940 procedure TIDESynGutterLOvProviderPascal.SetColor2(const AValue: TColor);
1941 begin
1942 if FColor2 = AValue then exit;
1943 FColor2 := AValue;
1944 FRGBColor2 := ColorToRGB(AValue);
1945 DoChange(Self);
1946 end;
1947
1948 procedure TIDESynGutterLOvProviderPascal.BufferChanged(Sender: TObject);
1949 begin
1950 //LineCountChanged(nil, 0, 0);
1951 HighlightChanged(nil,-1,-1);
1952 end;
1953
1954 procedure TIDESynGutterLOvProviderPascal.HighlightChanged(Sender: TSynEditStrings; AIndex,
1955 ACount: Integer);
1956 var
1957 hl: TIDESynPasSyn;
1958 procedure Update(var TheVal: Integer; NewVal: Integer);
1959 begin
1960 if TheVal = NewVal then exit;
1961 if FSingleLine then begin
1962 InvalidatePixelLines(TheVal, TheVal);
1963 InvalidatePixelLines(NewVal, NewVal);
1964 end else begin
1965 InvalidatePixelLines(Min(TheVal, NewVal), Height);
1966 end;
1967
1968 TheVal := NewVal;
1969 end;
1970 var i1,i1e,i2,i2e,i3,i3e,i4,i4e: Integer;
1971 begin
1972 i1 := FPixInterfaceLine;
1973 i1e := FPixEndInterfaceLine;
1974 i2 := FPixImplementationLine;
1975 i2e := FPixEndImplementationLine;
1976 i3 := FPixInitializationLine;
1977 i3e := FPixEndInitializationLine;
1978 i4 := FPixFinalizationLine;
1979 i4e := FPixEndFinalizationLine;
1980 if not(TSynEdit(SynEdit).Highlighter is TIDESynPasSyn) then begin
1981 FInterfaceLine := -1;
1982 FImplementationLine := -1;
1983 FInitializationLine := -1;
1984 FFinalizationLine := -1;
1985 end else begin
1986 hl := TSynEdit(SynEdit).Highlighter as TIDESynPasSyn;
1987 if hl.CurrentLines = nil then exit;
1988 FInterfaceLine := hl.InterfaceLine;
1989 FImplementationLine := hl.ImplementationLine;
1990 FInitializationLine := hl.InitializationLine;
1991 FFinalizationLine := hl.FinalizationLine;
1992 end;
1993
1994 ReCalc;
1995
1996 if (i1 <> FPixInterfaceLine) or (i1e <> FPixEndInterfaceLine) then begin
1997 InvalidatePixelLines(i1,i1e);
1998 InvalidatePixelLines(FPixInterfaceLine, FPixEndInterfaceLine);
1999 end;
2000 if (i2 <> FPixImplementationLine) or (i2e <> FPixEndImplementationLine) then begin
2001 InvalidatePixelLines(i2,i2e);
2002 InvalidatePixelLines(FPixImplementationLine, FPixEndImplementationLine);
2003 end;
2004 if (i3 <> FPixInitializationLine) or (i3e <> FPixEndInitializationLine) then begin
2005 InvalidatePixelLines(i3,i3e);
2006 InvalidatePixelLines(FPixInitializationLine, FPixEndInitializationLine);
2007 end;
2008 if (i4 <> FPixFinalizationLine) or (i4e <> FPixEndFinalizationLine) then begin
2009 InvalidatePixelLines(i4,i4e);
2010 InvalidatePixelLines(FPixFinalizationLine, FPixEndFinalizationLine);
2011 end;
2012 end;
2013
2014 procedure TIDESynGutterLOvProviderPascal.ReCalc;
2015 begin
2016 FPixInterfaceLine := TextLineToPixel(FInterfaceLine);
2017 FPixImplementationLine := TextLineToPixel(FImplementationLine);
2018 FPixInitializationLine := TextLineToPixel(FInitializationLine);
2019 FPixFinalizationLine := TextLineToPixel(FFinalizationLine);
2020
2021 if SingleLine then begin
2022 if FPixInterfaceLine < 0 then
2023 FPixEndInterfaceLine := -1
2024 else
2025 FPixEndInterfaceLine := TextLineToPixelEnd(FInterfaceLine) + 1;
2026
2027 if FPixImplementationLine < 0 then
2028 FPixEndImplementationLine := -1
2029 else
2030 FPixEndImplementationLine := TextLineToPixelEnd(FImplementationLine) + 1;
2031
2032 if FPixInitializationLine < 0 then
2033 FPixEndInitializationLine := -1
2034 else
2035 FPixEndInitializationLine := TextLineToPixelEnd(FInitializationLine) + 1;
2036
2037 if FPixFinalizationLine < 0 then
2038 FPixEndFinalizationLine := -1
2039 else
2040 FPixEndFinalizationLine := TextLineToPixelEnd(FFinalizationLine) + 1;
2041 end else begin
2042 if FPixInterfaceLine < 0 then
2043 FPixEndInterfaceLine := -1
2044 else if FPixImplementationLine >= 0 then
2045 FPixEndInterfaceLine := FPixImplementationLine - 1
2046 else if FPixInitializationLine >= 0 then
2047 FPixEndInterfaceLine := FPixInitializationLine - 1
2048 else if FPixFinalizationLine >= 0 then
2049 FPixEndInterfaceLine := FPixFinalizationLine - 1
2050 else
2051 FPixEndInterfaceLine := Height - 1;
2052
2053 if FPixImplementationLine < 0 then
2054 FPixEndImplementationLine := -1
2055 else if FPixInitializationLine >= 0 then
2056 FPixEndImplementationLine := FPixInitializationLine - 1
2057 else if FPixFinalizationLine >= 0 then
2058 FPixEndImplementationLine := FPixFinalizationLine - 1
2059 else
2060 FPixEndImplementationLine := Height - 1;
2061
2062 if FPixInitializationLine < 0 then
2063 FPixEndInitializationLine := -1
2064 else if FPixFinalizationLine >= 0 then
2065 FPixEndInitializationLine := FPixFinalizationLine - 1
2066 else
2067 FPixEndInitializationLine := Height - 1;
2068
2069 if FPixFinalizationLine < 0 then
2070 FPixEndFinalizationLine := -1
2071 else
2072 FPixEndFinalizationLine := Height - 1;
2073 end;
2074 end;
2075
2076 procedure TIDESynGutterLOvProviderPascal.Paint(Canvas: TCanvas; AClip: TRect;
2077 TopOffset: integer);
2078 procedure DrawArea(AStartLine, AEndLine: Integer; C: TColor);
2079 var r: TRect;
2080 begin
2081 if (C = clNone) and SingleLine then
2082 c := Color;
2083 if (C = clNone) then
2084 exit;
2085
2086 if (AStartLine + TopOffset > AClip.Bottom) or
2087 (AEndLine + TopOffset < AClip.Top)
2088 then
2089 exit;
2090 r := AClip;
2091 r.Top := Max(r.Top, AStartLine + TopOffset);
2092 r.Bottom := Min(r.Bottom, AEndLine + 1 + TopOffset);
2093 Canvas.Brush.Color := C;
2094 Canvas.FillRect(r);
2095 end;
2096 var
2097 C2, C3: TColor;
2098 begin
2099 if FPixInterfaceLine >= 0 then
2100 DrawArea(FPixInterfaceLine, FPixEndInterfaceLine, Color);
2101
2102 if FPixImplementationLine >= 0 then
2103 DrawArea(FPixImplementationLine, FPixEndImplementationLine, Color2);
2104
2105 C2 := Color;
2106 C3 := Color2;
2107 if FPixImplementationLine < 0 then begin
2108 C2 := Color2;
2109 if FPixInitializationLine >= 0 then
2110 C3 := Color;
2111 end;
2112
2113 if FPixInitializationLine >= 0 then
2114 DrawArea(FPixInitializationLine, FPixEndInitializationLine, C2);
2115
2116 if FPixFinalizationLine >= 0 then
2117 DrawArea(FPixFinalizationLine, FPixEndFinalizationLine, C3);
2118 end;
2119
2120 constructor TIDESynGutterLOvProviderPascal.Create(AOwner: TComponent);
2121 begin
2122 inherited Create(AOwner);
2123 SingleLine := False;
2124 Color := $D4D4D4;
2125 Color2 := $E8E8E8;
2126 ViewedTextBuffer.AddChangeHandler(senrHighlightChanged,
2127 @HighlightChanged);
2128 ViewedTextBuffer.AddNotifyHandler(senrTextBufferChanged,
2129 @BufferChanged);
2130 end;
2131
2132 destructor TIDESynGutterLOvProviderPascal.Destroy;
2133 begin
2134 ViewedTextBuffer.RemoveHanlders(self);
2135 inherited Destroy;
2136 end;
2137
2138 { TIDESynGutterLOvProviderIDEMarks }
2139
2140 procedure TIDESynGutterLOvProviderIDEMarks.SetBreakColor(const AValue: TColor);
2141 begin
2142 if FBreakColor = AValue then exit;
2143 FBreakColor := AValue;
2144 FRGBBreakColor := ColorToRGB(AValue);
2145 DoChange(Self);
2146 end;
2147
2148 procedure TIDESynGutterLOvProviderIDEMarks.SetBreakDisabledColor(AValue: TColor);
2149 begin
2150 if FBreakDisabledColor = AValue then Exit;
2151 FBreakDisabledColor := AValue;
2152 FRGBBreakDisabledColor := ColorToRGB(AValue);
2153 DoChange(Self);
2154 end;
2155
2156 procedure TIDESynGutterLOvProviderIDEMarks.SetExecLineColor(AValue: TColor);
2157 begin
2158 if FExecLineColor = AValue then Exit;
2159 FExecLineColor := AValue;
2160 FRGBExecLineColor := ColorToRGB(AValue);
2161 DoChange(Self);
2162 end;
2163
2164 procedure TIDESynGutterLOvProviderIDEMarks.AdjustColorForMark(AMark: TSynEditMark;
2165 var AColor: TColor; var APriority: Integer);
2166 var
2167 i: Integer;
2168 ETMark: TETMark;
2169 begin
2170 if (AMark is TETMark) then begin
2171 ETMark:=TETMark(AMark);
2172 AColor:=ETMark.SourceMarks.MarkStyles[ETMark.Urgency].Color;
2173 end else begin
2174 inc(APriority, 1);
2175 if not AMark.IsBookmark then begin
2176 //if (AMark.ImageList = SourceEditorMarks.ImgList) then begin
2177 i := AMark.ImageIndex;
2178 if (i = SourceEditorMarks.CurrentLineImg) or
2179 (i = SourceEditorMarks.CurrentLineBreakPointImg) or
2180 (i = SourceEditorMarks.CurrentLineDisabledBreakPointImg)
2181 then begin
2182 dec(APriority, 1);
2183 AColor := TColor(FRGBExecLineColor);
2184 end
2185 else
2186 if (i = SourceEditorMarks.InactiveBreakPointImg) or
2187 (i = SourceEditorMarks.InvalidDisabledBreakPointImg) or
2188 (i = SourceEditorMarks.UnknownDisabledBreakPointImg)
2189 then begin
2190 inc(APriority, 2);
2191 AColor := TColor(FRGBBreakDisabledColor);
2192 end
2193 else begin
2194 AColor := TColor(FRGBBreakColor);
2195 inc(APriority, 1);
2196 end;
2197 end;
2198 end;
2199 inherited AdjustColorForMark(AMark, AColor, APriority);
2200 end;
2201
2202 constructor TIDESynGutterLOvProviderIDEMarks.Create(AOwner: TComponent);
2203 begin
2204 inherited Create(AOwner);
2205 BreakColor := $0080C8;
2206 BreakDisabledColor := $00D000;
2207 ExecLineColor := $F000D0;
2208 end;
2209
2210 { TIDESynGutter }
2211
2212 procedure TIDESynGutter.CreateDefaultGutterParts;
2213 begin
2214 IncChangeLock;
2215 try
2216 if Side = gsLeft then begin
2217 with TIDESynGutterMarks.Create(Parts) do
2218 Name := 'SynGutterMarks1';
2219 with TSynGutterLineNumber.Create(Parts) do
2220 Name := 'SynGutterLineNumber1';
2221 with TSynGutterChanges.Create(Parts) do
2222 Name := 'SynGutterChanges1';
2223 with TSynGutterSeparator.Create(Parts) do
2224 Name := 'SynGutterSeparator1';
2225 with TIDESynGutterCodeFolding.Create(Parts) do
2226 Name := 'SynGutterCodeFolding1';
2227 end
2228 else begin
2229 {$IFDEF WithSynDebugGutter}
2230 with TSynGutterSeparator.Create(Parts) do
2231 Name := 'SynGutterSeparatorR1';
2232 DebugGutter := TIDESynGutterDebugHL.Create(Parts);
2233 with DebugGutter do
2234 Name := 'TIDESynGutterDebugHL';
2235 {$ENDIF}
2236 with TSynGutterSeparator.Create(Parts) do
2237 Name := 'SynGutterSeparatorR2';
2238 with TSynGutterLineOverview.Create(Parts) do begin
2239 Name := 'SynGutterLineOverview1';
2240 with TIDESynGutterLOvProviderIDEMarks.Create(Providers) do
2241 Priority := 20;
2242 with TSynGutterLOvProviderModifiedLines.Create(Providers) do
2243 Priority := 9;
2244 with TSynGutterLOvProviderCurrentPage.Create(Providers) do
2245 Priority := 1;
2246 with TIDESynGutterLOvProviderPascal.Create(Providers) do
2247 Priority := 0;
2248 end;
2249 with TSynGutterSeparator.Create(Parts) do begin
2250 Name := 'SynGutterSeparatorR3';
2251 AutoSize := False;
2252 Width := 1;
2253 LineWidth := 0;
2254 end;
2255 end;
2256 finally
2257 DecChangeLock;
2258 end;
2259 end;
2260
2261 { TIDESynGutterMarks }
2262
2263 procedure TIDESynGutterMarks.CheckTextBuffer;
2264 begin
2265 if (FMarkInfoTextBuffer <> nil) and
2266 (FMarkInfoTextBuffer <> TIDESynEditor(SynEdit).TextBuffer)
2267 then begin
2268 FMarkInfoTextBuffer := nil;
2269 if FDebugMarkInfo <> nil then FDebugMarkInfo.DecRefCount;
2270 if (FDebugMarkInfo <> nil) and (FDebugMarkInfo.RefCount = 0) then
2271 FreeAndNil(FDebugMarkInfo);
2272 end;
2273 end;
2274
2275 procedure TIDESynGutterMarks.PaintLine(aScreenLine: Integer; Canvas: TCanvas; AClip: TRect);
2276 var
2277 aGutterOffs, TxtIdx: Integer;
2278 HasAnyMark: Boolean;
2279 iRange: TLineRange;
2280
2281 procedure DrawDebugMark(Line: Integer);
2282 var
2283 itop : Longint;
2284 LineHeight: LongInt;
2285 img: TScaledImageListResolution;
2286 begin
2287 if Line < 0 then Exit;
2288 if Assigned(FBookMarkOpt.BookmarkImages) and
2289 (DebugMarksImageIndex <= FBookMarkOpt.BookmarkImages.Count) and
2290 (DebugMarksImageIndex >= 0) then
2291 begin
2292 LineHeight := TSynEdit(SynEdit).LineHeight;
2293 img := GetImgListRes(Canvas, FBookMarkOpt.BookmarkImages);
2294 iTop := 0;
2295 if LineHeight > img.Height then
2296 iTop := (LineHeight - img.Height) div 2;
2297
2298 img.Draw
2299 (Canvas, AClip.Left + LeftMarginAtCurrentPPI + aGutterOffs * ColumnWidth,
2300 AClip.Top + iTop, DebugMarksImageIndex, True);
2301 end
2302 end;
2303
2304 begin
2305 CheckTextBuffer;
2306 aGutterOffs := 0;
2307 HasAnyMark := PaintMarks(aScreenLine, Canvas, AClip, aGutterOffs);
2308 aScreenLine := aScreenLine + ToIdx(GutterArea.TextArea.TopLine);
2309 TxtIdx:= ViewedTextBuffer.DisplayView.ViewToTextIndexEx(aScreenLine, iRange);
2310 if aScreenLine <> iRange.Top then
2311 exit;
2312 if (TxtIdx < 0) or (TxtIdx >= TSynEdit(SynEdit).Lines.Count) then
2313 exit;
2314 if (not HasAnyMark) and (HasDebugMarks) and (TxtIdx < FDebugMarkInfo.Count) and
2315 (FDebugMarkInfo.SrcLineToMarkLine[TxtIdx] > 0)
2316 then
2317 DrawDebugMark(aScreenLine);
2318 end;
2319
PreferedWidthAtCurrentPPInull2320 function TIDESynGutterMarks.PreferedWidthAtCurrentPPI: Integer;
2321 var
2322 img: TScaledImageListResolution;
2323 begin
2324 if Assigned(SourceEditorMarks) and Assigned(SourceEditorMarks.ImgList) then
2325 begin
2326 img := GetImgListRes(nil, SourceEditorMarks.ImgList);
2327 // + 1 => right margin
2328 Result := img.Width * 2 + LeftMarginAtCurrentPPI + Scale96ToFont(1);
2329 end else
2330 Result := inherited PreferedWidthAtCurrentPPI;
2331 end;
2332
2333 destructor TIDESynGutterMarks.Destroy;
2334 begin
2335 ClearDebugMarks;
2336 inherited;
2337 end;
2338
2339 procedure TIDESynGutterMarks.BeginSetDebugMarks;
2340 begin
2341 CheckTextBuffer;
2342
2343 if FDebugMarkInfo = nil then begin
2344 FDebugMarkInfo := TIDESynDebugMarkInfo(TIDESynEditor(SynEdit).TextBuffer.Ranges[ClassType]);
2345 if FDebugMarkInfo = nil then begin
2346 FDebugMarkInfo := TIDESynDebugMarkInfo.Create;
2347 // Todo: Add a notification, when TextBuffer Changes
2348 FMarkInfoTextBuffer := TIDESynEditor(SynEdit).TextBuffer;
2349 TIDESynEditor(SynEdit).TextBuffer.Ranges[ClassType] := FDebugMarkInfo;
2350 end
2351 else
2352 FDebugMarkInfo.IncRefCount;
2353 end;
2354 end;
2355
2356 procedure TIDESynGutterMarks.EndSetDebugMarks;
2357 begin
2358 TSynEdit(SynEdit).InvalidateGutter;
2359 end;
2360
GetImgListResnull2361 function TIDESynGutterMarks.GetImgListRes(const ACanvas: TCanvas;
2362 const AImages: TCustomImageList): TScaledImageListResolution;
2363 const
2364 AllowedHeights: array[0..7] of Integer = (5, 7, 9, 11, 16, 22, 33, 44);
2365 var
2366 Scale: Double;
2367 PPI, LineHeight, I, ImageHeight: Integer;
2368 begin
2369 // image height must be equal to width
2370 if AImages.Width<>AImages.Height then
2371 raise Exception.Create('Internal error: AImages.Width<>AImages.Height');
2372
2373 Scale := 1;
2374 PPI := 96;
2375 if SynEdit is TSynEdit then
2376 begin
2377 LineHeight := TSynEdit(SynEdit).LineHeight;
2378 if LineHeight - Max(0, TSynEdit(SynEdit).ExtraLineSpacing) > 11 then
2379 LineHeight := LineHeight - Max(0, TSynEdit(SynEdit).ExtraLineSpacing);
2380 if LineHeight > 22 then
2381 I := LineHeight div 8
2382 else
2383 I := 1;
2384 If LineHeight - I >= 11 then
2385 LineHeight := LineHeight - I;
2386 if LineHeight < 11 then begin
2387 LineHeight := TSynEdit(SynEdit).LineHeight;
2388 if LineHeight > 11 then
2389 LineHeight := LineHeight - 1;
2390 end;
2391 ImageHeight := AllowedHeights[0];
2392 for I := High(AllowedHeights) downto Low(AllowedHeights) do
2393 if AllowedHeights[I] <= LineHeight then
2394 begin
2395 ImageHeight := AllowedHeights[I];
2396 break;
2397 end;
2398 // don't set PPI here -> we don't want to scale the image anymore
2399 end else
2400 begin
2401 ImageHeight := AImages.Height;
2402 if ACanvas is TControlCanvas then
2403 PPI := TControlCanvas(ACanvas).Control.Font.PixelsPerInch;
2404 end;
2405
2406 if ACanvas is TControlCanvas then
2407 Scale := TControlCanvas(ACanvas).Control.GetCanvasScaleFactor;
2408 Result := AImages.ResolutionForPPI[ImageHeight, PPI, Scale];
2409 end;
2410
2411 procedure TIDESynGutterMarks.SetDebugMarks(AFirstLinePos, ALastLinePos: Integer);
2412 var
2413 i: LongInt;
2414 begin
2415 CheckTextBuffer;
2416
2417 if ALastLinePos > FDebugMarkInfo.Count then begin
2418 //debugln(['Request to set debug-mark out of range: max-count=',FDebugMarkInfo.Count,' Marks=',AFirstLinePos,' to=',ALastLinePos]);
2419 ALastLinePos := FDebugMarkInfo.Count;
2420 end;
2421 if AFirstLinePos < 1 then begin
2422 //debugln(['Request to set debug-mark out of range: max-count=',FDebugMarkInfo.Count,' Marks=',AFirstLinePos,' to=',ALastLinePos]);
2423 AFirstLinePos := 1;
2424 end;
2425 for i := AFirstLinePos - 1 to ALastLinePos - 1 do
2426 FDebugMarkInfo[i] := i + 1;
2427 end;
2428
2429 procedure TIDESynGutterMarks.ClearDebugMarks;
2430 begin
2431 CheckTextBuffer;
2432
2433 if FDebugMarkInfo = nil then exit;
2434 FDebugMarkInfo.DecRefCount;
2435 if FDebugMarkInfo.RefCount = 0 then begin
2436 TIDESynEditor(SynEdit).TextBuffer.Ranges[ClassType] := nil;
2437 FreeAndNil(FDebugMarkInfo);
2438 end;
2439 FDebugMarkInfo := nil;
2440 FMarkInfoTextBuffer := nil;
2441 TSynEdit(SynEdit).InvalidateGutter;
2442 end;
2443
HasDebugMarksnull2444 function TIDESynGutterMarks.HasDebugMarks: Boolean;
2445 begin
2446 CheckTextBuffer;
2447 if FDebugMarkInfo = nil then begin
2448 FDebugMarkInfo := TIDESynDebugMarkInfo(TIDESynEditor(SynEdit).TextBuffer.Ranges[ClassType]);
2449 if FDebugMarkInfo <> nil then begin
2450 FDebugMarkInfo.IncRefCount;
2451 TSynEdit(SynEdit).InvalidateGutter;
2452 end;
2453 end;
2454 Result := FDebugMarkInfo <> nil;
2455 end;
2456
DebugLineToSourceLinenull2457 function TIDESynGutterMarks.DebugLineToSourceLine(aLinePos: Integer): Integer;
2458 var
2459 i, c: LongInt;
2460 MaxCnt: Integer;
2461 begin
2462 CheckTextBuffer;
2463 if (aLinePos < 1) or (not HasDebugMarks) then exit(aLinePos);
2464 Result := aLinePos - 1; // 0 based
2465 MaxCnt := FDebugMarkInfo.Count;
2466 Result := MinMax(Result, 0, MaxCnt - 1);
2467 if (FDebugMarkInfo[Result] = 0) or (FDebugMarkInfo[Result] > aLinePos) then begin
2468 i := Result;
2469 repeat
2470 dec(i);
2471 while (i >= 0) and (FDebugMarkInfo[i] = 0) do dec(i);
2472 if (i < 0) or (FDebugMarkInfo[i] < aLinePos) then break;
2473 Result := i;
2474 until FDebugMarkInfo[Result] = aLinePos;
2475 if (FDebugMarkInfo[Result] > aLinePos) and // line not found
2476 (Result > 0) and (FDebugMarkInfo[Result - 1] = 0)
2477 then
2478 dec(Result);
2479 end;
2480 if (FDebugMarkInfo[Result] = 0) or (FDebugMarkInfo[Result] < aLinePos) then begin
2481 c := FDebugMarkInfo.Count;
2482 i := Result;
2483 repeat
2484 inc(i);
2485 while (i < c) and (FDebugMarkInfo[i] = 0) do inc(i);
2486 if (i >= c) or (FDebugMarkInfo[i] > aLinePos) then break;
2487 Result := i;
2488 until FDebugMarkInfo[Result] = aLinePos;
2489 if (FDebugMarkInfo[Result] < aLinePos) and // line not found
2490 (Result < c-1) and (FDebugMarkInfo[Result + 1] = 0)
2491 then
2492 inc(Result);
2493 end;
2494 inc(Result); // 1 based
2495 end;
2496
SourceLineToDebugLinenull2497 function TIDESynGutterMarks.SourceLineToDebugLine(aLinePos: Integer;
2498 AdjustOnError: Boolean): Integer;
2499 begin
2500 CheckTextBuffer;
2501 if (aLinePos < 1) or (not HasDebugMarks) or (aLinePos >= FDebugMarkInfo.Count) then
2502 exit(aLinePos);
2503 Result := FDebugMarkInfo[aLinePos - 1];
2504 while (Result = 0) and AdjustOnError and (aLinePos < FDebugMarkInfo.Count-1) do begin
2505 inc(aLinePos);
2506 Result := FDebugMarkInfo[aLinePos - 1];
2507 end;
2508 end;
2509
2510 { TIDESynDebugMarkInfo }
2511
GetSrcLineToMarkLinenull2512 function TIDESynDebugMarkInfo.GetSrcLineToMarkLine(SrcIndex: Integer): Integer;
2513 begin
2514 Result := Integer(ItemPointer[SrcIndex]^);
2515 end;
2516
2517 procedure TIDESynDebugMarkInfo.SetSrcLineToMarkLine(SrcIndex: Integer; const AValue: Integer);
2518 begin
2519 Integer(ItemPointer[SrcIndex]^) := AValue;
2520 end;
2521
2522 constructor TIDESynDebugMarkInfo.Create;
2523 begin
2524 Inherited;
2525 ItemSize := SizeOf(Integer);
2526 FRefCount := 1;
2527 end;
2528
2529 procedure TIDESynDebugMarkInfo.IncRefCount;
2530 begin
2531 inc(FRefCount);
2532 end;
2533
2534 procedure TIDESynDebugMarkInfo.DecRefCount;
2535 begin
2536 dec(FRefCount);
2537 end;
2538
2539 { TIDESynGutterCodeFolding }
2540
2541 procedure TIDESynGutterCodeFolding.PopClickedFoldIfdef(Sender: TObject);
2542 begin
2543 FoldIfdef(True);
2544 end;
2545
2546 procedure TIDESynGutterCodeFolding.PopClickedFoldIfdefNoMixed(Sender: TObject);
2547 begin
2548 FoldIfdef(False);
2549 end;
2550
2551 procedure TIDESynGutterCodeFolding.PopClickedUnfoldIfdefActive(Sender: TObject);
2552 begin
2553 UnFoldIfdef(False, True);
2554 end;
2555
2556 procedure TIDESynGutterCodeFolding.PopClickedUnfolDIfdefAll(Sender: TObject);
2557 begin
2558 UnFoldIfdef(True, True);
2559 end;
2560
2561 procedure TIDESynGutterCodeFolding.PopClickedUnfoldIfdefInactiv(Sender: TObject);
2562 begin
2563 UnFoldIfdef(True, False);
2564 end;
2565
2566 procedure TIDESynGutterCodeFolding.UnFoldIfdef(AInclDisabled, AInclEnabled: Boolean);
2567 var
2568 i, j, k, y1, y2: Integer;
2569 FldInf: TSynFoldNodeInfo;
2570 Tree: TSynMarkupHighIfDefLinesTree;
2571 IfLineNode: TSynMarkupHighIfDefLinesNodeInfo;
2572 IsDisabled: Boolean;
2573 begin
2574 if TSynEdit(SynEdit).SelAvail then begin
2575 y1 := TSynEdit(SynEdit).BlockBegin.Y;
2576 y2 := TSynEdit(SynEdit).BlockEnd.Y;
2577 if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
2578 end
2579 else begin
2580 y1 := 1;
2581 y2 := TSynEdit(SynEdit).Lines.Count - 1;
2582 end;
2583 Tree := TIDESynEditor(SynEdit).FMarkupIfDef.IfDefTree;
2584
2585 if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
2586 for i := y1-1 to y2-1 do begin
2587 j := FoldView.FoldProvider.FoldOpenCount(i);
2588 while j > 0 do begin
2589 dec(j);
2590 if FoldView.IsFoldedAtTextIndex(i,j) then begin
2591 FldInf := FoldView.FoldProvider.FoldOpenInfo(i, j);
2592 if TPascalCodeFoldBlockType({%H-}PtrUInt(FldInf.FoldType)) in [cfbtIfDef]
2593 then begin
2594 if AInclDisabled and AInclEnabled then begin
2595 FoldView.UnFoldAtTextIndex(i, j, 1, False, 1);
2596 end
2597 else begin
2598 IfLineNode := Tree.FindNodeAtPosition(ToPos(i), afmNil);
2599 k := IfLineNode.EntryCount - 1;
2600 while (k >= 0) and (IfLineNode.Entry[k].StartColumn <> FldInf.LogXStart) do
2601 dec(k);
2602 IsDisabled := (k >= 0) and (IfLineNode.Entry[k].IsDisabled);
2603 if (AInclDisabled and IsDisabled) or (AInclEnabled and not IsDisabled) then
2604 FoldView.UnFoldAtTextIndex(i, j, 1, False, 1);
2605 end;
2606 end;
2607 end; //FoldView.IsFoldedAtTextIndex(i,j)
2608 end;
2609 end;
2610 end;
2611
2612 procedure TIDESynGutterCodeFolding.FoldIfdef(AInclTemp: Boolean);
2613 var
2614 i, j, k, y1, y2: Integer;
2615 FldInf: TSynFoldNodeInfo;
2616 Tree: TSynMarkupHighIfDefLinesTree;
2617 IfLineNode: TSynMarkupHighIfDefLinesNodeInfo;
2618 begin
2619 if TSynEdit(SynEdit).SelAvail then begin
2620 y1 := TSynEdit(SynEdit).BlockBegin.Y;
2621 y2 := TSynEdit(SynEdit).BlockEnd.Y;
2622 if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
2623 end
2624 else begin
2625 y1 := 1;
2626 y2 := TSynEdit(SynEdit).Lines.Count - 1;
2627 end;
2628 Tree := TIDESynEditor(SynEdit).FMarkupIfDef.IfDefTree;
2629 if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
2630 for i := y1-1 to y2-1 do begin
2631 j := FoldView.FoldProvider.FoldOpenCount(i);
2632 while j > 0 do begin
2633 dec(j);
2634 FldInf := FoldView.FoldProvider.FoldOpenInfo(i, j);
2635 if (TPascalCodeFoldBlockType({%H-}PtrUInt(FldInf.FoldType)) in [cfbtIfDef]) and
2636 (sfaFoldFold in FldInf.FoldAction)
2637 then begin
2638 IfLineNode := Tree.FindNodeAtPosition(ToPos(i), afmNil);
2639 k := IfLineNode.EntryCount - 1;
2640 while (k >= 0) and (IfLineNode.Entry[k].StartColumn <> FldInf.LogXStart) do
2641 dec(k);
2642 if (k >= 0) and (IfLineNode.Entry[k].IsDisabled) and
2643 ( (not (IfLineNode.Entry[k].IsTemp)) or AInclTemp )
2644 then
2645 FoldView.FoldAtTextIndex(i, j, 1, False, 1);
2646 end;
2647 end;
2648 end;
2649 end;
2650
2651 procedure TIDESynGutterCodeFolding.PopClickedUnfoldAll(Sender: TObject);
2652 var
2653 i, y1, y2: Integer;
2654 begin
2655 if not TSynEdit(SynEdit).SelAvail then begin
2656 FoldView.UnfoldAll;
2657 exit;
2658 end;
2659 y1 := TSynEdit(SynEdit).BlockBegin.Y;
2660 y2 := TSynEdit(SynEdit).BlockEnd.Y;
2661 if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
2662 for i := y1-1 to y2-1 do
2663 FoldView.UnFoldAtTextIndex(i);
2664 end;
2665
2666 procedure TIDESynGutterCodeFolding.PopClickedUnfoldComment(Sender: TObject);
2667 var
2668 i, j, y1, y2: Integer;
2669 FldInf: TSynFoldNodeInfo;
2670 begin
2671 if TSynEdit(SynEdit).SelAvail then begin
2672 y1 := TSynEdit(SynEdit).BlockBegin.Y;
2673 y2 := TSynEdit(SynEdit).BlockEnd.Y;
2674 if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
2675 end
2676 else begin
2677 y1 := 1;
2678 y2 := TSynEdit(SynEdit).Lines.Count - 1;
2679 end;
2680
2681 for i := y1-1 to y2-1 do begin
2682 j := FoldView.FoldProvider.FoldOpenCount(i);
2683 while j > 0 do begin
2684 dec(j);
2685 if FoldView.IsFoldedAtTextIndex(i,j) then begin
2686 FldInf := FoldView.FoldProvider.FoldOpenInfo(i, j);
2687 if TPascalCodeFoldBlockType({%H-}PtrUInt(FldInf.FoldType)) in
2688 [cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]
2689 then begin
2690 FoldView.UnFoldAtTextIndex(i, j, 1, False, 0);
2691 FoldView.UnFoldAtTextIndex(i, j, 1, False, 1);
2692 end;
2693 end;
2694 end;
2695 end;
2696 end;
2697
2698 procedure TIDESynGutterCodeFolding.PopClickedFoldComment(Sender: TObject);
2699 var
2700 i, j, y1, y2: Integer;
2701 FldInf: TSynFoldNodeInfo;
2702 begin
2703 if TSynEdit(SynEdit).SelAvail then begin
2704 y1 := TSynEdit(SynEdit).BlockBegin.Y;
2705 y2 := TSynEdit(SynEdit).BlockEnd.Y;
2706 if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
2707 end
2708 else begin
2709 y1 := 1;
2710 y2 := TSynEdit(SynEdit).Lines.Count - 1;
2711 end;
2712
2713 for i := y1-1 to y2-1 do begin
2714 j := FoldView.FoldProvider.FoldOpenCount(i);
2715 while j > 0 do begin
2716 dec(j);
2717 FldInf := FoldView.FoldProvider.FoldOpenInfo(i, j);
2718 if (TPascalCodeFoldBlockType({%H-}PtrUInt(FldInf.FoldType)) in
2719 [cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) and
2720 (sfaFoldFold in FldInf.FoldAction)
2721 then begin
2722 FoldView.FoldAtTextIndex(i, j, 1, False, 1);
2723 end;
2724 end;
2725 end;
2726 end;
2727
2728 procedure TIDESynGutterCodeFolding.PopClickedHideComment(Sender: TObject);
2729 var
2730 i, j, y1, y2: Integer;
2731 FldInf: TSynFoldNodeInfo;
2732 begin
2733 if TSynEdit(SynEdit).SelAvail then begin
2734 y1 := TSynEdit(SynEdit).BlockBegin.Y;
2735 y2 := TSynEdit(SynEdit).BlockEnd.Y;
2736 if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
2737 end
2738 else begin
2739 y1 := 1;
2740 y2 := TSynEdit(SynEdit).Lines.Count - 1;
2741 end;
2742
2743 for i := y1-1 to y2-1 do begin
2744 j := FoldView.FoldProvider.FoldOpenCount(i);
2745 while j > 0 do begin
2746 dec(j);
2747 FldInf := FoldView.FoldProvider.FoldOpenInfo(i, j);
2748 if (TPascalCodeFoldBlockType({%H-}PtrUInt(FldInf.FoldType)) in
2749 [cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) and
2750 (sfaFoldHide in FldInf.FoldAction)
2751 then begin
2752 FoldView.FoldAtTextIndex(i, j, 1, False, 0);
2753 end;
2754 end;
2755 end;
2756 end;
2757
2758 procedure TIDESynGutterCodeFolding.CreatePopUpMenuEntries(var APopUp: TPopupMenu; ALine: Integer);
2759 var
2760 i, j, k, y1, y2: Integer;
2761 HasFolds, HasHideableComments, HasFoldableComments, HasCollapsedComments: Boolean;
2762 ft: TPascalCodeFoldBlockType;
2763 Foldable, HideAble: TPascalCodeFoldBlockTypes;
2764 lc: TSynEditFoldLineCapabilities;
2765 HasFoldableDisabledIfDef, HasFoldableTempDisabledIfDef,
2766 HasCollapsedActiveIfDef, HasCollapsedDisabledIfDef: Boolean; // HasCollapsedActiveIfDef includes all NOT disabled
2767 Tree: TSynMarkupHighIfDefLinesTree;
2768 IfLineNode: TSynMarkupHighIfDefLinesNodeInfo;
2769 FProv: TSynEditFoldProvider;
2770 inf: TSynFoldNodeInfo;
2771 HasComments, HasIfdef: Boolean;
2772
2773 procedure CheckFoldConf(Val: TPascalCodeFoldBlockType);
2774 begin
2775 if not TSynPasSyn(FoldView.HighLighter).FoldConfig[ord(Val)].Enabled then
2776 exit;
2777 if fmFold in TSynPasSyn(FoldView.HighLighter).FoldConfig[ord(Val)].Modes then
2778 include(Foldable, Val);
2779 if fmHide in TSynPasSyn(FoldView.HighLighter).FoldConfig[ord(Val)].Modes then
2780 include(HideAble, Val);
2781 end;
2782
2783 function AddPopUpItem(const ACaption: String): TMenuItem;
2784 begin
2785 Result := TMenuItem.Create(APopUp);
2786 Result.Caption := ACaption;
2787 APopUp.Items.Add(Result);
2788 end;
2789
2790
2791 begin
2792 inherited CreatePopUpMenuEntries(APopUp, ALine);
2793
2794 if not (FoldView.HighLighter is TSynPasSyn) then
2795 exit;
2796
2797 Foldable := [];
2798 HideAble := [];
2799 CheckFoldConf(cfbtAnsiComment);
2800 CheckFoldConf(cfbtBorCommand);
2801 CheckFoldConf(cfbtSlashComment);
2802 if TIDESynEditor(SynEdit).IsIfdefMarkupActive then
2803 CheckFoldConf(cfbtIfDef);
2804
2805 if (Foldable = []) and (HideAble = []) then
2806 exit;
2807
2808 HasHideableComments := False;
2809 HasFoldableComments := False;
2810 HasCollapsedComments := False;
2811 HasFoldableDisabledIfDef := False;
2812 HasFoldableTempDisabledIfDef := False;
2813 HasCollapsedActiveIfDef := False;
2814 HasCollapsedDisabledIfDef := False;
2815
2816 HasComments := (Foldable*[cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment] <> []) or
2817 (HideAble*[cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment] <> []);
2818 HasIfdef := (Foldable*[cfbtIfDef] <> []);
2819
2820 if TSynEdit(SynEdit).SelAvail then begin
2821 y1 := TSynEdit(SynEdit).BlockBegin.Y;
2822 y2 := TSynEdit(SynEdit).BlockEnd.Y;
2823 if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
2824 end
2825 else begin
2826 y1 := 1;
2827 y2 := TSynEdit(SynEdit).Lines.Count - 1;
2828 end;
2829
2830
2831 HasFolds := FoldView.TextToViewIndex(y2) - FoldView.TextToViewIndex(y1) <> y2 - y1;
2832 //debugln(['*** HasFolds=', HasFolds, ' y1=',y1, ' y2=',y2, ' VP1=',FoldView.TextToViewIndex(y1), ' VP2=',FoldView.TextToViewIndex(y2)]);
2833
2834 FProv := FoldView.FoldProvider;
2835 Tree := TIDESynEditor(SynEdit).FMarkupIfDef.IfDefTree;
2836 IfLineNode.ClearInfo;
2837
2838 i := ToIdx(y1);
2839 while i < y2 do begin // lines in selection
2840 lc := FProv.LineCapabilities[i];
2841 j := FProv.FoldOpenCount(i);
2842
2843 while j > 0 do begin // foldnodes on line
2844 dec(j);
2845 inf := FProv.FoldOpenInfo(i, j);
2846 ft := TPascalCodeFoldBlockType({%H-}PtrUInt(inf.FoldType));
2847 if not ((ft in Foldable) or (ft in HideAble)) then
2848 continue;
2849
2850 if ft = cfbtIfDef then begin
2851 if IfLineNode.StartLine <> ToPos(i) then
2852 IfLineNode := Tree.FindNodeAtPosition(ToPos(i), afmNil);
2853 k := IfLineNode.EntryCount - 1; // -1 if no node
2854 while (k >= 0) and (IfLineNode.Entry[k].StartColumn <> inf.LogXStart) do
2855 dec(k);
2856 if FoldView.IsFoldedAtTextIndex(i,j) then begin
2857 if (k >= 0) and (IfLineNode.Entry[k].IsDisabled) then
2858 HasCollapsedDisabledIfDef := True
2859 else
2860 HasCollapsedActiveIfDef := True;
2861 end
2862 else // IFDEF is only Fold-able, not hide-able
2863 if (k >= 0) and (IfLineNode.Entry[k].IsDisabled) then begin
2864 if IfLineNode.Entry[k].IsTemp then
2865 HasFoldableTempDisabledIfDef := True
2866 else
2867 HasFoldableDisabledIfDef := True;
2868 end;
2869
2870 end
2871 else begin
2872 // comment
2873 if FoldView.IsFoldedAtTextIndex(i,j) then begin
2874 HasCollapsedComments := True;
2875 end
2876 else begin
2877 if (ft in Foldable) and (cfFoldStart in lc) then
2878 HasFoldableComments := True;
2879 if (ft in HideAble) and (cfHideStart in lc) then
2880 HasHideableComments := True;
2881 end;
2882 end;
2883 end;
2884
2885 if (not HasComments) or
2886 ( (HasFoldableComments and HasHideableComments) and
2887 ((not HasFolds) or (HasCollapsedComments))
2888 )
2889 then begin
2890 // found all comment info
2891 if (not HasIfdef) or
2892 ( (HasFoldableDisabledIfDef and HasFoldableTempDisabledIfDef) and
2893 ((not HasFolds) or (HasCollapsedActiveIfDef and HasCollapsedDisabledIfDef))
2894 )
2895 then
2896 break;
2897 // only Ifdef needed
2898 if IfLineNode.HasNode and (IfLineNode.StartLine = ToPos(i)) then
2899 IfLineNode := IfLineNode.Successor
2900 else
2901 IfLineNode := Tree.FindNodeAtPosition(ToPos(i)+1, afmNext);
2902 if not IfLineNode.HasNode then
2903 break;
2904 i := ToIdx(IfLineNode.StartLine);
2905 end
2906 else
2907 inc(i);
2908 end;
2909
2910 if (HasFolds) and (APopUp.Items.Count > 0) then
2911 AddPopUpItem(cLineCaption);
2912 If HasFolds then
2913 if TSynEdit(SynEdit).SelAvail
2914 then AddPopUpItem(synfUnfoldAllInSelection).OnClick := @PopClickedUnfoldAll
2915 else AddPopUpItem(synfUnfoldAll).OnClick := @PopClickedUnfoldAll;
2916
2917
2918 if (HasCollapsedComments or HasFoldableComments or HasHideableComments) and
2919 (APopUp.Items.Count > 0)
2920 then
2921 AddPopUpItem(cLineCaption);
2922
2923 If HasCollapsedComments then
2924 if TSynEdit(SynEdit).SelAvail
2925 then AddPopUpItem(synfUnfoldCommentsInSelection).OnClick := @PopClickedUnfoldComment
2926 else AddPopUpItem(synfUnfoldComments).OnClick := @PopClickedUnfoldComment;
2927 If HasFoldableComments then
2928 if TSynEdit(SynEdit).SelAvail
2929 then AddPopUpItem(synfFoldCommentsInSelection).OnClick := @PopClickedFoldComment
2930 else AddPopUpItem(synfFoldComments).OnClick := @PopClickedFoldComment;
2931 If HasHideableComments then
2932 if TSynEdit(SynEdit).SelAvail
2933 then AddPopUpItem(synfHideCommentsInSelection).OnClick := @PopClickedHideComment
2934 else AddPopUpItem(synfHideComments).OnClick := @PopClickedHideComment;
2935
2936
2937 if (HasFoldableDisabledIfDef or HasCollapsedDisabledIfDef or
2938 HasCollapsedDisabledIfDef or HasCollapsedActiveIfDef) and
2939 (APopUp.Items.Count > 0)
2940 then
2941 AddPopUpItem(cLineCaption);
2942
2943 If HasCollapsedActiveIfDef and HasCollapsedDisabledIfDef then
2944 if TSynEdit(SynEdit).SelAvail
2945 then AddPopUpItem(synfUnfoldAllIfdefInSelection).OnClick := @PopClickedUnfolDIfdefAll
2946 else AddPopUpItem(synfUnfoldAllIfdef).OnClick := @PopClickedUnfolDIfdefAll;
2947 If HasCollapsedActiveIfDef then
2948 if TSynEdit(SynEdit).SelAvail
2949 then AddPopUpItem(synfUnfoldActiveIfdefInSelection).OnClick := @PopClickedUnfoldIfdefActive
2950 else AddPopUpItem(synfUnfoldActiveIfdef).OnClick := @PopClickedUnfoldIfdefActive;
2951 If HasCollapsedDisabledIfDef then
2952 if TSynEdit(SynEdit).SelAvail
2953 then AddPopUpItem(synfUnfoldInactiveIfdefInSelection).OnClick := @PopClickedUnfoldIfdefInactiv
2954 else AddPopUpItem(synfUnfoldInactiveIfdef).OnClick := @PopClickedUnfoldIfdefInactiv;
2955
2956 If HasFoldableDisabledIfDef or HasFoldableTempDisabledIfDef then
2957 if TSynEdit(SynEdit).SelAvail
2958 then AddPopUpItem(synfFoldInactiveIfdefInSelection).OnClick := @PopClickedFoldIfdef
2959 else AddPopUpItem(synfFoldInactiveIfdef).OnClick := @PopClickedFoldIfdef;
2960 If HasFoldableDisabledIfDef and HasFoldableTempDisabledIfDef then
2961 if TSynEdit(SynEdit).SelAvail
2962 then AddPopUpItem(synfFoldInactiveIfdefInSelectionExcludeMixedState).OnClick := @PopClickedFoldIfdefNoMixed
2963 else AddPopUpItem(synfFoldInactiveIfdefExcludeMixedState).OnClick := @PopClickedFoldIfdefNoMixed;
2964 end;
2965
2966 end.
2967
2968