1 {
2 /***************************************************************************
3 SourceMarks.pas
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 Author: Mattias Gaertner
28
29 Abstract:
30 All source editor marks, except the bookmarks, are managed by the
31 SourceEditorMarks. It extends the TSynEditMark and combines all marks of
32 all editors.
33 }
34 unit SourceMarks;
35
36 {$mode objfpc}{$H+}
37
38 interface
39
40 uses
41 Classes, SysUtils, Laz_AVL_Tree,
42 // LCL
43 Graphics, Controls,
44 // LazUtils
45 LazMethodList, LazTracer, LazUtilities,
46 // SynEdit
47 SynEdit, SynEditMarks, SynEditMarkupGutterMark,
48 // IdeIntf
49 MenuIntf, SrcEditorIntf, IDEExternToolIntf, IDEImagesIntf,
50 // IDE
51 etSrcEditMarks, ImgList;
52
53 type
54 TAdditionalHilightAttribute =
55 (ahaNone, ahaTextBlock, ahaExecutionPoint,
56 ahaEnabledBreakpoint, ahaDisabledBreakpoint, ahaInvalidBreakpoint,
57 ahaUnknownBreakpoint, ahaErrorLine, ahaIncrementalSearch,
58 ahaHighlightAll, ahaBracketMatch, ahaMouseLink,
59 ahaLineNumber, ahaLineHighlight, ahaModifiedLine,
60 ahaCodeFoldingTree, ahaHighlightWord, ahaFoldedCode,
61 ahaFoldedCodeLine, ahaHiddenCodeLine,
62 ahaWordGroup, ahaTemplateEditCur, ahaTemplateEditSync,
63 ahaTemplateEditOther, ahaSyncroEditCur, ahaSyncroEditSync,
64 ahaSyncroEditOther, ahaSyncroEditArea, ahaGutterSeparator,
65 ahaGutter, ahaRightMargin, ahaSpecialVisibleChars,
66 ahaTopInfoHint, ahaCaretColor, ahaOverviewGutter,
67 ahaIfDefBlockInactive, ahaIfDefBlockActive, ahaIfDefBlockTmpActive,
68 ahaIfDefNodeInactive, ahaIfDefNodeActive, ahaIfDefNodeTmpActive,
69 ahaIdentComplWindow, ahaIdentComplWindowBorder, ahaIdentComplWindowSelection, ahaIdentComplWindowHighlight,
70 ahaOutlineLevel1Color, ahaOutlineLevel2Color, ahaOutlineLevel3Color, ahaOutlineLevel4Color, ahaOutlineLevel5Color, ahaOutlineLevel6Color, ahaOutlineLevel7Color, ahaOutlineLevel8Color, ahaOutlineLevel9Color, ahaOutlineLevel10Color
71 );
72
73 TAhaGroupName = (
74 agnDefault, agnLanguage, agnText, agnLine, agnGutter, agnTemplateMode, agnSyncronMode,
75 agnIfDef, agnIdentComplWindow, agnOutlineColors
76 );
77
78 TSourceEditorBase = class;
79
80 { TSourceEditorSharedValuesBase }
81
82 TSourceEditorSharedValuesBase = class
83 protected
GetSharedEditorsBasenull84 function GetSharedEditorsBase(Index: Integer): TSourceEditorBase; virtual abstract;
SharedEditorCountnull85 function SharedEditorCount: Integer; virtual; abstract;
Filenamenull86 function Filename: string; virtual; abstract;
87 end;
88
89 { TSourceEditorBase }
90
91 TSourceEditorBase = class(TSourceEditorInterface)
92 protected
GetSharedValuesnull93 function GetSharedValues: TSourceEditorSharedValuesBase; virtual; abstract;
94 end;
95
96 { *** }
97
98 TSourceMarks = class;
99 TSourceMark = class;
100
101 TGetSourceMarkHintEvent =
102 procedure(SenderMark: TSourceMark; var Hint: string) of object;
103 TCreateSourceMarkPopupMenuEvent =
104 procedure(SenderMark: TSourceMark;
105 const AddMenuItem: TAddMenuItemProc) of object;
SourceEditornull106 TGetFilenameEvent = function(ASourceEditor: TObject): string of object;
107
108 TSourceMarkHandler = (
109 smhPositionChanged,
110 smhBeforeFree,
111 smhGetHint,
112 smhCreatePopupMenu
113 );
114
115 TMarksAction = (maAdded, maRemoved, maChanged);
116 TMarksActionEvent = procedure(AMark: TSourceMark; Action: TMarksAction) of object;
117
118
119 { TSourceMark }
120
121 TSourceMark = class(TSynEditMarkupMark)
122 private
123 FData: TObject;
124 FSourceMarks: TSourceMarks;
125 FSourceEditorID: TSourceEditorSharedValuesBase;
126 FHandlers: array[TSourceMarkHandler] of TMethodList;
GetSourceEditornull127 function GetSourceEditor: TSourceEditorBase;
128 procedure SetSourceMarks(const AValue: TSourceMarks);
129 procedure Changed;
130 private
131 FIsBreakPoint: boolean;
132 FLineColorAttrib: TAdditionalHilightAttribute;
133 FLineColorBackGround: TColor;
134 FLineColorForeGround: TColor;
135 protected
136 procedure DoChange(AChanges: TSynEditMarkChangeReasons); override;
137 procedure AddHandler(HandlerType: TSourceMarkHandler;
138 const Handler: TMethod);
139 procedure DoPositionChanged; virtual;
140 procedure DoLineUpdate; virtual;
141
142 procedure SetData(const AValue: TObject); virtual;
143 procedure SetIsBreakPoint(const AValue: boolean); virtual;
144 procedure SetLineColorAttrib(const AValue: TAdditionalHilightAttribute); virtual;
145 procedure SetLineColorBackGround(const AValue: TColor); virtual;
146 procedure SetLineColorForeGround(const AValue: TColor); virtual;
147
148 procedure SetColumn(const Value: Integer); override;
149 procedure SetLine(const Value: Integer); override;
150 public
151 constructor Create(TheOwner: TSourceEditorBase; TheData: TObject);
152 destructor Destroy; override;
Comparenull153 function Compare(OtherMark: TSourceMark): integer;
CompareEditorAndLinenull154 function CompareEditorAndLine(ASrcEditID: TObject;
155 ALine: integer): integer;
GetFilenamenull156 function GetFilename: string;
GetHintnull157 function GetHint: string; virtual;
158 procedure CreatePopupMenuItems(const AddMenuItemProc: TAddMenuItemProc);
159 public // handlers
160 procedure RemoveAllHandlersForObject(HandlerObject: TObject);
161 procedure AddPositionChangedHandler(OnPositionChanged: TNotifyEvent);
162 procedure RemovePositionChangedHandler(OnPositionChanged: TNotifyEvent);
163 procedure AddBeforeFreeHandler(OnBeforeFree: TNotifyEvent);
164 procedure RemoveBeforeFreeHandler(OnBeforeFree: TNotifyEvent);
165 procedure AddGetHintHandler(OnGetHint: TGetSourceMarkHintEvent);
166 procedure RemoveGetHintHandler(OnGetHint: TGetSourceMarkHintEvent);
167 procedure AddCreatePopupMenuHandler(
168 OnCreatePopupMenu: TCreateSourceMarkPopupMenuEvent);
169 procedure RemoveCreatePopupMenuHandler(
170 OnCreatePopupMenu: TCreateSourceMarkPopupMenuEvent);
171 public
172 // properties
173 property Data: TObject read FData write SetData;
174 property SourceMarks: TSourceMarks read FSourceMarks write SetSourceMarks;
175 property SourceEditor: TSourceEditorBase read GetSourceEditor;
176 property SourceEditorID: TSourceEditorSharedValuesBase read FSourceEditorID;
177 public
178 property LineColorAttrib: TAdditionalHilightAttribute read FLineColorAttrib
179 write SetLineColorAttrib;
180 property LineColorForeGround: TColor read FLineColorForeGround
181 write SetLineColorForeGround;
182 property LineColorBackGround: TColor read FLineColorBackGround
183 write SetLineColorBackGround;
184 public
185 property IsBreakPoint: boolean read FIsBreakPoint write SetIsBreakPoint;
186 end;
187
188 TSourceMarkClass = class of TSourceMark;
189 PSourceMark = ^TSourceMark;
190
191
192 { TSourceMarks }
193
194 TSourceMarks = class(TComponent)
195 private
196 fActiveBreakPointImg: Integer;
197 FCurrentLineBreakPointImg: Integer;
198 FCurrentLineImg: Integer;
199 FCurrentLineDisabledBreakPointImg: Integer;
200 FExtToolsMarks: TETMarks;
201 fPendingBreakPointImg: Integer;
202 FSourceLineImg: Integer;
203 FImgList: TLCLGlyphs;
204 fInactiveBreakPointImg: Integer;
205 fInvalidBreakPointImg: Integer;
206 fInvalidDisabledBreakPointImg: Integer;
207 fItems: TList;// list of TSourceMark
208 fMultiBreakPointImg: Integer;
209 FOnAction: TMarksActionEvent;
210 fSortedItems: TAVLTree;// tree of TSourceMark
211 fUnknownBreakPointImg: Integer;
212 fUnknownDisabledBreakPointImg: Integer;
GetItemsnull213 function GetItems(Index: integer): TSourceMark;
214 procedure CreateImageList;
215 protected
FindFirstMarkNodenull216 function FindFirstMarkNode(ASrcEditID: TObject; ALine: integer): TAVLTreeNode;
217 public
218 constructor Create(TheOwner: TComponent); override;
219 destructor Destroy; override;
Countnull220 function Count: integer;
Addnull221 function Add(AMark: TSourceMark): integer;
Addnull222 function Add(ASrcEdit: TSourceEditorBase; ALine: integer): TSourceMark;
AddCustomMarknull223 function AddCustomMark(TheOwner: TSourceEditorBase; Data: TObject;
224 MarkClass: TSourceMarkClass): TSourceMark;
AddImagenull225 function AddImage(const ResName: string): integer;
226 procedure Clear;
227 procedure Delete(Index: integer);
228 procedure Remove(AMark: TSourceMark);
229 procedure DeleteAllForEditor(ASrcEdit: TSourceEditorBase);
230 procedure DeleteAllForEditorID(ASrcEditID: TSourceEditorSharedValuesBase);
FindFirstMarknull231 function FindFirstMark(ASrcEdit: TSourceEditorBase;
232 ALine: integer): TSourceMark;
FindBreakPointMarknull233 function FindBreakPointMark(ASrcEdit: TSourceEditorBase;
234 ALine: integer): TSourceMark;
235 procedure GetMarksForLine(ASrcEdit: TSourceEditorBase; ALine: integer;
236 out Marks: PSourceMark; out MarkCount: integer);
237 public
238 property ImgList: TLCLGlyphs read FImgList;
239 property Items[Index: integer]: TSourceMark read GetItems; default;
240 property OnAction: TMarksActionEvent read FOnAction write FOnAction;
241 property ExtToolsMarks: TETMarks read FExtToolsMarks;
242 public
243 // icon index
244 property ActiveBreakPointImg: Integer read fActiveBreakPointImg;
245 property InactiveBreakPointImg: Integer read fInactiveBreakPointImg;
246 property InvalidBreakPointImg: Integer read fInvalidBreakPointImg;
247 property InvalidDisabledBreakPointImg: Integer read fInvalidDisabledBreakPointImg;
248 property PendingBreakPointImg: Integer read fPendingBreakPointImg;
249 property MultiBreakPointImg: Integer read fMultiBreakPointImg;
250 property UnknownBreakPointImg: Integer read fUnknownBreakPointImg;
251 property UnknownDisabledBreakPointImg: Integer read fUnknownDisabledBreakPointImg;
252 property CurrentLineImg: Integer read FCurrentLineImg;
253 property CurrentLineBreakPointImg: Integer read FCurrentLineBreakPointImg;
254 property CurrentLineDisabledBreakPointImg: Integer read FCurrentLineDisabledBreakPointImg;
255 property SourceLineImg: Integer read FSourceLineImg;
256 end;
257
258 var
259 SourceEditorMarks: TSourceMarks = nil;
260
261 implementation
262
263 type
264 TEditorIDAndLine = record
265 EditorID: TObject;
266 Line: integer;
267 end;
268 PEditorAndLine = ^TEditorIDAndLine;
269
CompareSourceMarksnull270 function CompareSourceMarks(Data1, Data2: Pointer): integer;
271 var
272 Mark1: TSourceMark absolute Data1;
273 Mark2: TSourceMark absolute Data2;
274 begin
275 Result := Mark1.Compare(Mark2);
276 end;
277
CompareEditorIDAndLineWithMarknull278 function CompareEditorIDAndLineWithMark(Key, Data: Pointer): integer;
279 var
280 EditorAndLine: PEditorAndLine absolute Key;
281 AMark: TSourceMark absolute Data;
282 begin
283 Result := -AMark.CompareEditorAndLine(EditorAndLine^.EditorID, EditorAndLine^.Line);
284 end;
285
286 { TSourceMark }
287
288 procedure TSourceMark.SetSourceMarks(const AValue: TSourceMarks);
289 begin
290 if FSourceMarks=AValue then exit;
291 if FSourceMarks<>nil then
292 FSourceMarks.Remove(Self);
293 FSourceMarks := AValue;
294 if AValue<>nil then
295 AValue.Add(Self);
296 end;
297
TSourceMark.GetSourceEditornull298 function TSourceMark.GetSourceEditor: TSourceEditorBase;
299 begin
300 if (FSourceEditorID <> nil) and (FSourceEditorID.SharedEditorCount > 0) then
301 Result := FSourceEditorID.GetSharedEditorsBase(0)
302 else
303 Result := nil;
304 end;
305
306 procedure TSourceMark.Changed;
307 begin
308 if Assigned(FSourceMarks) and Assigned(FSourceMarks.OnAction) then
309 FSourceMarks.OnAction(Self, maChanged);
310 end;
311
312 procedure TSourceMark.DoChange(AChanges: TSynEditMarkChangeReasons);
313 begin
314 inherited DoChange(AChanges);
315 if AChanges * [smcrLine, smcrColumn] <> [] then
316 DoPositionChanged;
317 Changed;
318 end;
319
320 procedure TSourceMark.SetLineColorBackGround(const AValue: TColor);
321 begin
322 if FLineColorBackGround=AValue then exit;
323 FLineColorBackGround:=AValue;
324 DoLineUpdate;
325 Changed;
326 end;
327
328 procedure TSourceMark.SetLineColorForeGround(const AValue: TColor);
329 begin
330 if FLineColorForeGround=AValue then exit;
331 FLineColorForeGround:=AValue;
332 DoLineUpdate;
333 Changed;
334 end;
335
336 procedure TSourceMark.SetLineColorAttrib(
337 const AValue: TAdditionalHilightAttribute);
338 begin
339 if FLineColorAttrib=AValue then exit;
340 FLineColorAttrib:=AValue;
341 DoLineUpdate;
342 Changed;
343 end;
344
345 procedure TSourceMark.SetIsBreakPoint(const AValue: boolean);
346 begin
347 if FIsBreakPoint=AValue then exit;
348 FIsBreakPoint:=AValue;
349 DoLineUpdate;
350 Changed;
351 end;
352
353 procedure TSourceMark.DoPositionChanged;
354 var
355 i: Integer;
356 begin
357 i:=FHandlers[smhPositionChanged].Count;
358 while FHandlers[smhPositionChanged].NextDownIndex(i) do
359 TNotifyEvent(FHandlers[smhPositionChanged][i])(Self);
360 end;
361
362 procedure TSourceMark.DoLineUpdate;
363 begin
364 if (Line <= 0) or (not Visible) then Exit;
365 DoChange([smcrChanged]);
366 end;
367
368 procedure TSourceMark.SetData(const AValue: TObject);
369 begin
370 if FData=AValue then exit;
371 FData:=AValue;
372 end;
373
374 procedure TSourceMark.AddHandler(HandlerType: TSourceMarkHandler;
375 const Handler: TMethod);
376 begin
377 if Handler.Code=nil then RaiseGDBException('TSourceMark.AddHandler');
378 if FHandlers[HandlerType]=nil then
379 FHandlers[HandlerType]:=TMethodList.Create;
380 FHandlers[HandlerType].Add(Handler);
381 end;
382
383 procedure TSourceMark.SetColumn(const Value: Integer);
384 begin
385 if Column=Value then exit;
386 IncChangeLock;
387 if FSourceMarks<>nil then
388 FSourceMarks.fSortedItems.Remove(Self);
389 inherited;
390 if FSourceMarks<>nil then
391 FSourceMarks.fSortedItems.Add(Self);
392 DecChangeLock;
393 end;
394
395 procedure TSourceMark.SetLine(const Value: Integer);
396 begin
397 if Line=Value then exit;
398 IncChangeLock;
399 if FSourceMarks<>nil then
400 FSourceMarks.fSortedItems.Remove(Self);
401 inherited;
402 if FSourceMarks<>nil then
403 FSourceMarks.fSortedItems.Add(Self);
404 DecChangeLock;
405 end;
406
407 constructor TSourceMark.Create(TheOwner: TSourceEditorBase; TheData: TObject);
408 begin
409 FSourceEditorID := TheOwner.GetSharedValues;
410 inherited Create(TSynEdit(TheOwner.EditorControl));
411 FData:=TheData;
412 FLineColorAttrib:=ahaNone;
413 FLineColorBackGround:=clNone;
414 FLineColorForeGround:=clNone;
415 TSynEdit(TheOwner.EditorControl).Marks.Add(Self);
416 end;
417
418 destructor TSourceMark.Destroy;
419 var
420 HandlerType: TSourceMarkHandler;
421 i: Integer;
422 begin
423 // notify all who wants to know
424 i:=FHandlers[smhBeforeFree].Count;
425 while FHandlers[smhBeforeFree].NextDownIndex(i) do
426 TNotifyEvent(FHandlers[smhBeforeFree][i])(Self);
427 // remove from source marks
428 SourceMarks := nil;
429 FSourceEditorID := nil;
430
431 // free handler lists
432 for HandlerType:=Low(TSourceMarkHandler) to high(TSourceMarkHandler) do
433 FreeThenNil(FHandlers[HandlerType]);
434
435 inherited Destroy;
436 end;
437
Comparenull438 function TSourceMark.Compare(OtherMark: TSourceMark): integer;
439 begin
440 Result:=ComparePointers(Pointer(SourceEditorID), Pointer(OtherMark.SourceEditorID));
441 if Result<>0 then exit;
442 Result:=Line-OtherMark.Line;
443 if Result<>0 then exit;
444 Result:=Column-OtherMark.Column;
445 if Result <> 0 then exit;
446 Result:=Priority-OtherMark.Priority;
447 if Result <> 0 then exit;
448 Result := ComparePointers(Self,OtherMark);
449 end;
450
CompareEditorAndLinenull451 function TSourceMark.CompareEditorAndLine(ASrcEditID: TObject;
452 ALine: integer): integer;
453 begin
454 Result := ComparePointers(SourceEditorID,ASrcEditID);
455 if Result <> 0 then Exit;
456 Result := Line - ALine;
457 end;
458
TSourceMark.GetFilenamenull459 function TSourceMark.GetFilename: string;
460 begin
461 Result:=FSourceEditorID.Filename;
462 end;
463
GetHintnull464 function TSourceMark.GetHint: string;
465 var
466 i: Integer;
467 begin
468 Result:='';
469 i:=FHandlers[smhGetHint].Count;
470 while FHandlers[smhGetHint].NextDownIndex(i) do
471 TGetSourceMarkHintEvent(FHandlers[smhGetHint][i])(Self,Result);
472 end;
473
474 procedure TSourceMark.CreatePopupMenuItems(
475 const AddMenuItemProc: TAddMenuItemProc);
476 var
477 i: Integer;
478 begin
479 i:=FHandlers[smhCreatePopupMenu].Count;
480 while FHandlers[smhCreatePopupMenu].NextDownIndex(i) do
481 TCreateSourceMarkPopupMenuEvent(FHandlers[smhCreatePopupMenu][i])
482 (Self,AddMenuItemProc);
483 end;
484
485 procedure TSourceMark.RemoveAllHandlersForObject(HandlerObject: TObject);
486 var
487 HandlerType: TSourceMarkHandler;
488 begin
489 for HandlerType:=Low(TSourceMarkHandler) to High(TSourceMarkHandler) do
490 if FHandlers[HandlerType]<>nil then
491 FHandlers[HandlerType].RemoveAllMethodsOfObject(HandlerObject);
492 end;
493
494 procedure TSourceMark.AddPositionChangedHandler(OnPositionChanged: TNotifyEvent);
495 begin
496 AddHandler(smhPositionChanged,TMethod(OnPositionChanged));
497 end;
498
499 procedure TSourceMark.RemovePositionChangedHandler(
500 OnPositionChanged: TNotifyEvent);
501 begin
502 FHandlers[smhPositionChanged].Remove(TMethod(OnPositionChanged));
503 end;
504
505 procedure TSourceMark.AddBeforeFreeHandler(OnBeforeFree: TNotifyEvent);
506 begin
507 AddHandler(smhBeforeFree,TMethod(OnBeforeFree));
508 end;
509
510 procedure TSourceMark.RemoveBeforeFreeHandler(OnBeforeFree: TNotifyEvent);
511 begin
512 FHandlers[smhBeforeFree].Remove(TMethod(OnBeforeFree));
513 end;
514
515 procedure TSourceMark.AddGetHintHandler(OnGetHint: TGetSourceMarkHintEvent);
516 begin
517 AddHandler(smhGetHint,TMethod(OnGetHint));
518 end;
519
520 procedure TSourceMark.RemoveGetHintHandler(OnGetHint: TGetSourceMarkHintEvent);
521 begin
522 FHandlers[smhGetHint].Remove(TMethod(OnGetHint));
523 end;
524
525 procedure TSourceMark.AddCreatePopupMenuHandler(
526 OnCreatePopupMenu: TCreateSourceMarkPopupMenuEvent);
527 begin
528 AddHandler(smhCreatePopupMenu,TMethod(OnCreatePopupMenu));
529 end;
530
531 procedure TSourceMark.RemoveCreatePopupMenuHandler(
532 OnCreatePopupMenu: TCreateSourceMarkPopupMenuEvent);
533 begin
534 FHandlers[smhCreatePopupMenu].Remove(TMethod(OnCreatePopupMenu));
535 end;
536
537 { TSourceMarks }
538
TSourceMarks.GetItemsnull539 function TSourceMarks.GetItems(Index: integer): TSourceMark;
540 begin
541 Result:=TSourceMark(FItems[Index]);
542 end;
543
544 procedure TSourceMarks.CreateImageList;
545 var
546 i: Integer;
547 ImgIDFatal: Integer;
548 ImgIDError: Integer;
549 ImgIDWarning: Integer;
550 ImgIDNote: Integer;
551 ImgIDHint: Integer;
552 begin
553 // create default mark icons
554 FImgList:=TLCLGlyphs.Create(Self);
555 FImgList.Width := 11;
556 FImgList.Height := 11;
557 FImgList.RegisterResolutions([11, 16, 22, 33], [100, 150, 200, 300]);
558
559 // synedit expects the first 10 icons for the bookmarks
560 for i in TBookmarkNumRange do
561 AddImage('bookmark'+IntToStr(i));
562
563 // load active breakpoint image
564 fActiveBreakPointImg:=AddImage('ActiveBreakPoint');
565 // load disabled breakpoint image
566 fInactiveBreakPointImg:=AddImage('InactiveBreakPoint');
567 // load invalid breakpoint image
568 fInvalidBreakPointImg:=AddImage('InvalidBreakPoint');
569 // load invalid disabled breakpoint image
570 fInvalidDisabledBreakPointImg := AddImage('InvalidDisabledBreakPoint');
571 // load pending active breakpoint image
572 fPendingBreakPointImg := AddImage('PendingBreakPoint');
573 // load unknown breakpoint image
574 fUnknownBreakPointImg:=AddImage('UnknownBreakPoint');
575 // load unknown disabled breakpoint image
576 fUnknownDisabledBreakPointImg := AddImage('UnknownDisabledBreakPoint');
577 // load multi mixed breakpoint image
578 fMultiBreakPointImg:=AddImage('MultiBreakPoint');
579 // load current line image
580 FCurrentLineImg:=AddImage('debugger_current_line');
581 // load current line + breakpoint image
582 FCurrentLineBreakPointImg:=AddImage('debugger_current_line_breakpoint');
583 // load current line + disabled breakpoint image
584 FCurrentLineDisabledBreakPointImg := AddImage('debugger_current_line_disabled_breakpoint');
585 // load source line
586 FSourceLineImg:=AddImage('debugger_source_line');
587
588 FImgList.RegisterResolutions([11, 16, 22, 33], [69, 100, 150, 200]);
589
590 ImgIDFatal:=AddImage('state_fatal');
591 ImgIDError:=AddImage('state_error');
592 ImgIDWarning:=AddImage('state_warning');
593 ImgIDNote:=AddImage('state_note');
594 ImgIDHint:=AddImage('state_hint');
595
596 ExtToolsMarks.ImageList:=ImgList;
597 ExtToolsMarks.MarkStyles[mluNone].ImageIndex:=-1;
598 ExtToolsMarks.MarkStyles[mluProgress].ImageIndex:=-1;
599 ExtToolsMarks.MarkStyles[mluDebug].ImageIndex:=-1;
600 ExtToolsMarks.MarkStyles[mluVerbose3].ImageIndex:=-1;
601 ExtToolsMarks.MarkStyles[mluVerbose2].ImageIndex:=-1;
602 ExtToolsMarks.MarkStyles[mluVerbose].ImageIndex:=-1;
603 ExtToolsMarks.MarkStyles[mluHint].ImageIndex:=ImgIDHint;
604 ExtToolsMarks.MarkStyles[mluNote].ImageIndex:=ImgIDNote;
605 ExtToolsMarks.MarkStyles[mluWarning].ImageIndex:=ImgIDWarning;
606 ExtToolsMarks.MarkStyles[mluImportant].ImageIndex:=-1;
607 ExtToolsMarks.MarkStyles[mluError].ImageIndex:=ImgIDError;
608 ExtToolsMarks.MarkStyles[mluFatal].ImageIndex:=ImgIDFatal;
609 ExtToolsMarks.MarkStyles[mluPanic].ImageIndex:=ImgIDFatal;
610 end;
611
TSourceMarks.FindFirstMarkNodenull612 function TSourceMarks.FindFirstMarkNode(ASrcEditID: TObject; ALine: integer
613 ): TAVLTreeNode;
614 var
615 LeftNode: TAVLTreeNode;
616 EditorIDAndLine: TEditorIDAndLine;
617 begin
618 EditorIDAndLine.EditorID := ASrcEditID;
619 EditorIDAndLine.Line := ALine;
620 Result := fSortedItems.FindKey(@EditorIDAndLine, @CompareEditorIDAndLineWithMark);
621 while Result <> nil do
622 begin
623 LeftNode := fSortedItems.FindPrecessor(Result);
624 if (LeftNode = nil) or
625 (CompareEditorIDAndLineWithMark(@EditorIDAndLine, LeftNode.Data) <> 0) then break;
626 Result := LeftNode;
627 end;
628 end;
629
630 constructor TSourceMarks.Create(TheOwner: TComponent);
631 begin
632 inherited Create(TheOwner);
633 fItems:=TList.Create;
634 fSortedItems:=TAVLTree.Create(@CompareSourceMarks);
635 FExtToolsMarks:=TETMarks.Create(nil);
636 CreateImageList;
637 end;
638
639 destructor TSourceMarks.Destroy;
640 begin
641 if SourceEditorMarks=Self then
642 SourceEditorMarks:=nil;
643 Clear;
644 FreeAndNil(FExtToolsMarks);
645 FreeThenNil(FItems);
646 FreeThenNil(fSortedItems);
647 inherited Destroy;
648 end;
649
TSourceMarks.Countnull650 function TSourceMarks.Count: integer;
651 begin
652 Result:=fItems.Count;
653 end;
654
655 procedure TSourceMarks.Clear;
656 begin
657 while fItems.Count>0 do Delete(fItems.Count-1);
658 end;
659
Addnull660 function TSourceMarks.Add(AMark: TSourceMark): integer;
661 begin
662 if AMark=nil then exit(-1);
663 AMark.FSourceMarks:=Self;
664 Result:=fItems.Add(AMark);
665 fSortedItems.Add(AMark);
666 if Assigned(FOnAction) then
667 FOnAction(AMark, maAdded);
668 end;
669
Addnull670 function TSourceMarks.Add(ASrcEdit: TSourceEditorBase; ALine: integer): TSourceMark;
671 begin
672 Result:=TSourceMark.Create(ASrcEdit, nil);
673 Result.Line := ALine;
674 Add(Result);
675 end;
676
AddCustomMarknull677 function TSourceMarks.AddCustomMark(TheOwner: TSourceEditorBase; Data: TObject;
678 MarkClass: TSourceMarkClass): TSourceMark;
679 begin
680 if MarkClass=nil then MarkClass:=TSourceMark;
681 Result:=MarkClass.Create(TheOwner,Data);
682 Add(Result);
683 end;
684
685 procedure TSourceMarks.Delete(Index: integer);
686 var
687 AMark: TSourceMark;
688 begin
689 AMark:=Items[Index];
690 AMark.fSourceMarks:=nil;
691 fItems.Delete(Index);
692 fSortedItems.Remove(AMark);
693 if Assigned(FOnAction) then
694 FOnAction(AMark, maRemoved);
695 AMark.Free;
696 end;
697
698 procedure TSourceMarks.Remove(AMark: TSourceMark);
699 var
700 i: Integer;
701 begin
702 if (AMark=nil) or (AMark.SourceMarks<>Self) then exit;
703 i:=fItems.IndexOf(AMark);
704 if i<0 then exit;
705 fItems.Delete(i);
706 fSortedItems.Remove(AMark);
707 AMark.fSourceMarks:=nil;
708 if Assigned(FOnAction) then
709 FOnAction(AMark, maRemoved);
710 end;
711
712 procedure TSourceMarks.DeleteAllForEditor(ASrcEdit: TSourceEditorBase);
713 begin
714 DeleteAllForEditorID(ASrcEdit.GetSharedValues);
715 end;
716
717 procedure TSourceMarks.DeleteAllForEditorID(ASrcEditID: TSourceEditorSharedValuesBase);
718 var
719 i: Integer;
720 begin
721 if ASrcEditID = nil then
722 exit;
723 i:=fItems.Count-1;
724 while i>=0 do begin
725 if Items[i].SourceEditorID = ASrcEditID then
726 Delete(i);
727 dec(i);
728 end;
729 end;
730
TSourceMarks.FindFirstMarknull731 function TSourceMarks.FindFirstMark(ASrcEdit: TSourceEditorBase; ALine: integer): TSourceMark;
732 var
733 AVLNode: TAVLTreeNode;
734 SrcEditorID: TSourceEditorSharedValuesBase;
735 begin
736 Result := nil;
737 SrcEditorID := ASrcEdit.GetSharedValues;
738 if SrcEditorID = nil then
739 exit;
740 AVLNode:=FindFirstMarkNode(SrcEditorID, ALine);
741 if AVLNode<>nil then
742 Result:=TSourceMark(AVLNode.Data);
743 end;
744
TSourceMarks.FindBreakPointMarknull745 function TSourceMarks.FindBreakPointMark(ASrcEdit: TSourceEditorBase;
746 ALine: integer): TSourceMark;
747 var
748 AVLNode: TAVLTreeNode;
749 EditorIDAndLine: TEditorIDAndLine;
750 CurMark: TSourceMark;
751 SrcEditorID: TSourceEditorSharedValuesBase;
752 begin
753 Result := nil;
754 SrcEditorID := ASrcEdit.GetSharedValues;
755 if SrcEditorID = nil then
756 exit;
757
758 EditorIDAndLine.EditorID := SrcEditorID;
759 EditorIDAndLine.Line := ALine;
760 AVLNode := FindFirstMarkNode(EditorIDAndLine.EditorID, ALine);
761 while (AVLNode <> nil) do
762 begin
763 CurMark := TSourceMark(AVLNode.Data);
764 if CompareEditorIDAndLineWithMark(@EditorIDAndLine, CurMark) <> 0 then break;
765 if CurMark.IsBreakPoint then
766 begin
767 Result := CurMark;
768 Exit;
769 end;
770 AVLNode := fSortedItems.FindSuccessor(AVLNode);
771 end;
772 end;
773
774 procedure TSourceMarks.GetMarksForLine(ASrcEdit: TSourceEditorBase;
775 ALine: integer; out Marks: PSourceMark; out MarkCount: integer);
776 var
777 i, Capacity: integer;
778 AVLNode: TAVLTreeNode;
779 EditorIDAndLine: TEditorIDAndLine;
780 CurMark: TSourceMark;
781 HasChange: Boolean;
782 SrcEditorID: TSourceEditorSharedValuesBase;
783 begin
784 MarkCount := 0;
785 Marks := nil;
786 SrcEditorID := ASrcEdit.GetSharedValues;
787 if SrcEditorID = nil then
788 exit;
789
790 Capacity := 0;
791 EditorIDAndLine.EditorID := SrcEditorID;
792 EditorIDAndLine.Line := ALine;
793 AVLNode := FindFirstMarkNode(EditorIDAndLine.EditorID, ALine);
794 while (AVLNode <> nil) do
795 begin
796 CurMark := TSourceMark(AVLNode.Data);
797 if CompareEditorIDAndLineWithMark(@EditorIDAndLine, CurMark) <> 0 then break;
798 if Capacity <= MarkCount then
799 begin
800 inc(Capacity, Capacity + 4);
801 ReAllocMem(Marks, Capacity * SizeOf(Pointer));
802 end;
803 Marks[MarkCount] := CurMark;
804 inc(MarkCount);
805 AVLNode := fSortedItems.FindSuccessor(AVLNode);
806 end;
807 HasChange := MarkCount > 1;
808 // easy popup sort by priority
809 while HasChange do
810 begin
811 HasChange := False;
812 for i := 0 to MarkCount - 2 do
813 if Marks[i].Priority < Marks[i+1].Priority then
814 begin
815 CurMark := Marks[i];
816 Marks[i] := Marks[i+1];
817 Marks[i+1] := CurMark;
818 HasChange := True;
819 end;
820 end;
821 end;
822
TSourceMarks.AddImagenull823 function TSourceMarks.AddImage(const ResName: string): integer;
824 begin
825 Result := FImgList.GetImageIndex(Resname);
826 end;
827
828 end.
829
830