1{ $Id$ }
2{                    ----------------------------------------
3                       DebuggerDlg.pp  -  Base class for all
4                         debugger related forms
5                     ----------------------------------------
6
7 @created(Wed Mar 16st WET 2001)
8 @lastmod($Date$)
9 @author(Marc Weustink <marc@@dommelstein.net>)
10
11 This unit contains the base class for all debugger related dialogs.
12 All common info needed for the IDE is found in this class
13
14 ***************************************************************************
15 *                                                                         *
16 *   This source is free software; you can redistribute it and/or modify   *
17 *   it under the terms of the GNU General Public License as published by  *
18 *   the Free Software Foundation; either version 2 of the License, or     *
19 *   (at your option) any later version.                                   *
20 *                                                                         *
21 *   This code is distributed in the hope that it will be useful, but      *
22 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
23 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
24 *   General Public License for more details.                              *
25 *                                                                         *
26 *   A copy of the GNU General Public License is available on the World    *
27 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
28 *   obtain it by writing to the Free Software Foundation,                 *
29 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
30 *                                                                         *
31 ***************************************************************************
32}
33unit DebuggerDlg;
34
35{$mode objfpc}{$H+}
36
37interface
38
39uses
40  Classes,
41  // LCL
42  Forms, Controls, LCLProc,
43  // LazUtils
44  LazFileUtils, LazLoggerBase,
45  // IdeIntf
46  IDEImagesIntf, IDECommands,
47  // DebuggerIntf
48  DbgIntfDebuggerBase, DbgIntfMiscClasses,
49  // IDE
50  MainIntf, EditorOptions, BaseDebugManager, Debugger;
51
52type
53
54  { TDebuggerDlg }
55
56  TDebuggerDlg = class(TForm)
57  private
58    FUpdateCount: integer;
59  protected
60    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
61    procedure DoClose(var CloseAction: TCloseAction); override;
62    procedure DoBeginUpdate; virtual;
63    procedure DoEndUpdate; virtual;
64  public
65    procedure BeginUpdate;
66    procedure EndUpdate;
67    function UpdateCount: integer;
68    function IsUpdating: Boolean;
69  private (* provide some common properties *)
70    FSnapshotManager: TSnapshotManager;
71    FSnapshotNotification: TSnapshotNotification;
72    FThreadsMonitor: TIdeThreadsMonitor;
73    FThreadsNotification: TThreadsNotification;
74    FCallStackMonitor: TIdeCallStackMonitor;
75    FCallStackNotification: TCallStackNotification;
76    FLocalsMonitor: TIdeLocalsMonitor;
77    FLocalsNotification: TLocalsNotification;
78    FWatchesMonitor: TIdeWatchesMonitor;
79    FWatchesNotification: TWatchesNotification;
80    FRegistersMonitor: TIdeRegistersMonitor;
81    FRegistersNotification: TRegistersNotification;
82    FBreakPoints: TIDEBreakPoints;
83    FBreakpointsNotification: TIDEBreakPointsNotification;
84    function  GetSnapshotNotification: TSnapshotNotification;
85    function  GetThreadsNotification: TThreadsNotification;
86    function  GetCallStackNotification: TCallStackNotification;
87    function  GetLocalsNotification: TLocalsNotification;
88    function  GetWatchesNotification: TWatchesNotification;
89    function  GetRegistersNotification: TRegistersNotification;
90    function  GetBreakpointsNotification: TIDEBreakPointsNotification;
91    procedure SetSnapshotManager(const AValue: TSnapshotManager);
92    procedure SetThreadsMonitor(const AValue: TIdeThreadsMonitor);
93    procedure SetCallStackMonitor(const AValue: TIdeCallStackMonitor);
94    procedure SetLocalsMonitor(const AValue: TIdeLocalsMonitor);
95    procedure SetWatchesMonitor(const AValue: TIdeWatchesMonitor);
96    procedure SetRegistersMonitor(AValue: TIdeRegistersMonitor);
97    procedure SetBreakPoints(const AValue: TIDEBreakPoints);
98  protected
99    procedure JumpToUnitSource(AnUnitInfo: TDebuggerUnitInfo; ALine: Integer);
100    procedure DoWatchesChanged; virtual; // called if the WatchesMonitor object was changed
101    procedure DoRegistersChanged; virtual; // called if the WatchesMonitor object was changed
102    procedure DoBreakPointsChanged; virtual; // called if the BreakPoint(Monitor) object was changed
103    function GetBreakPointImageIndex(ABreakPoint: TIDEBreakPoint; AIsCurLine: Boolean = False): Integer;
104    property SnapshotNotification:    TSnapshotNotification  read GetSnapshotNotification;
105    property ThreadsNotification:     TThreadsNotification   read GetThreadsNotification;
106    property CallStackNotification:   TCallStackNotification read GetCallStackNotification;
107    property LocalsNotification:      TLocalsNotification    read GetLocalsNotification;
108    property WatchesNotification:     TWatchesNotification   read GetWatchesNotification;
109    property RegistersNotification:   TRegistersNotification read GetRegistersNotification;
110    property BreakpointsNotification: TIDEBreakPointsNotification read GetBreakpointsNotification;
111  protected
112    // publish as needed
113    property SnapshotManager:  TSnapshotManager  read FSnapshotManager  write SetSnapshotManager;
114    property ThreadsMonitor:   TIdeThreadsMonitor   read FThreadsMonitor   write SetThreadsMonitor;
115    property CallStackMonitor: TIdeCallStackMonitor read FCallStackMonitor write SetCallStackMonitor;
116    property LocalsMonitor:    TIdeLocalsMonitor    read FLocalsMonitor    write SetLocalsMonitor;
117    property WatchesMonitor:   TIdeWatchesMonitor   read FWatchesMonitor   write SetWatchesMonitor;
118    property RegistersMonitor: TIdeRegistersMonitor read FRegistersMonitor write SetRegistersMonitor;
119    property BreakPoints:      TIDEBreakPoints   read FBreakPoints      write SetBreakPoints;
120  public
121    destructor  Destroy; override;
122  end;
123  TDebuggerDlgClass = class of TDebuggerDlg;
124
125var
126  OnProcessCommand: procedure(Sender: TObject; Command: word; var Handled: boolean) of object;
127
128procedure CreateDebugDialog(Sender: TObject; aFormName: string;
129                            var AForm: TCustomForm; DoDisableAutoSizing: boolean);
130
131implementation
132
133var
134  DBG_LOCATION_INFO: PLazLoggerLogGroup;
135  BrkImgIdxInitialized: Boolean;
136  ImgBreakPoints: Array [0..10] of Integer;
137
138procedure CreateDebugDialog(Sender: TObject; aFormName: string; var AForm: TCustomForm;
139  DoDisableAutoSizing: boolean);
140begin
141  DebugBoss.CreateDebugDialog(Sender, aFormName, AForm, DoDisableAutoSizing);
142end;
143
144{ TDebuggerDlg }
145
146procedure TDebuggerDlg.BeginUpdate;
147begin
148  Inc(FUpdateCount);
149  if FUpdateCount = 1 then DoBeginUpdate;
150end;
151
152procedure TDebuggerDlg.EndUpdate;
153begin
154  if FUpdateCount < 1 then RaiseGDBException('TDebuggerDlg.EndUpdate');
155  Dec(FUpdateCount);
156  if FUpdateCount = 0 then DoEndUpdate;
157end;
158
159function TDebuggerDlg.UpdateCount: integer;
160begin
161  Result := FUpdateCount;
162end;
163
164function TDebuggerDlg.IsUpdating: Boolean;
165begin
166  Result := FUpdateCount > 0;
167end;
168
169function TDebuggerDlg.GetSnapshotNotification: TSnapshotNotification;
170begin
171  If FSnapshotNotification = nil then begin
172    FSnapshotNotification := TSnapshotNotification.Create;
173    FSnapshotNotification.AddReference;
174    if (FSnapshotManager <> nil)
175    then FSnapshotManager.AddNotification(FSnapshotNotification);
176  end;
177  Result := FSnapshotNotification;
178end;
179
180function TDebuggerDlg.GetRegistersNotification: TRegistersNotification;
181begin
182  If FRegistersNotification = nil then begin
183    FRegistersNotification := TRegistersNotification.Create;
184    FRegistersNotification.AddReference;
185    if (FRegistersMonitor <> nil)
186    then FRegistersMonitor.AddNotification(FRegistersNotification);
187  end;
188  Result := FRegistersNotification;
189end;
190
191function TDebuggerDlg.GetThreadsNotification: TThreadsNotification;
192begin
193  if FThreadsNotification = nil then begin
194    FThreadsNotification := TThreadsNotification.Create;
195    FThreadsNotification.AddReference;
196    if (FThreadsMonitor <> nil)
197    then FThreadsMonitor.AddNotification(FThreadsNotification);
198  end;
199  Result := FThreadsNotification;
200end;
201
202function TDebuggerDlg.GetCallStackNotification: TCallStackNotification;
203begin
204  if FCallStackNotification = nil then begin
205    FCallStackNotification := TCallStackNotification.Create;
206    FCallStackNotification.AddReference;
207    if (FCallStackMonitor <> nil)
208    then FCallStackMonitor.AddNotification(FCallStackNotification);
209  end;
210  Result := FCallStackNotification;
211end;
212
213function TDebuggerDlg.GetLocalsNotification: TLocalsNotification;
214begin
215  If FLocalsNotification = nil then begin
216    FLocalsNotification := TLocalsNotification.Create;
217    FLocalsNotification.AddReference;
218    if (FLocalsMonitor <> nil)
219    then FLocalsMonitor.AddNotification(FLocalsNotification);
220  end;
221  Result := FLocalsNotification;
222end;
223
224function TDebuggerDlg.GetWatchesNotification: TWatchesNotification;
225begin
226  If FWatchesNotification = nil then begin
227    FWatchesNotification := TWatchesNotification.Create;
228    FWatchesNotification.AddReference;
229    if (FWatchesMonitor <> nil)
230    then FWatchesMonitor.AddNotification(FWatchesNotification);
231  end;
232  Result := FWatchesNotification;
233end;
234
235function TDebuggerDlg.GetBreakpointsNotification: TIDEBreakPointsNotification;
236begin
237  If FBreakpointsNotification = nil then begin
238    FBreakpointsNotification := TIDEBreakPointsNotification.Create;
239    FBreakpointsNotification.AddReference;
240    if (FBreakPoints <> nil)
241    then FBreakPoints.AddNotification(FBreakpointsNotification);
242  end;
243  Result := FBreakpointsNotification;
244end;
245
246procedure TDebuggerDlg.SetRegistersMonitor(AValue: TIdeRegistersMonitor);
247begin
248  if FRegistersMonitor = AValue then exit;
249  BeginUpdate;
250  try
251    if (FRegistersMonitor <> nil) and (FRegistersNotification <> nil)
252    then FRegistersMonitor.RemoveNotification(FRegistersNotification);
253    FRegistersMonitor := AValue;
254    if (FRegistersMonitor <> nil) and (FRegistersNotification <> nil)
255    then FRegistersMonitor.AddNotification(FRegistersNotification);
256    DoRegistersChanged;
257  finally
258    EndUpdate;
259  end;
260end;
261
262procedure TDebuggerDlg.SetSnapshotManager(const AValue: TSnapshotManager);
263begin
264  if FSnapshotManager = AValue then exit;
265  BeginUpdate;
266  try
267    if (FSnapshotManager <> nil) and (FSnapshotNotification <> nil)
268    then FSnapshotManager.RemoveNotification(FSnapshotNotification);
269    FSnapshotManager := AValue;
270    if (FSnapshotManager <> nil) and (FSnapshotNotification <> nil)
271    then FSnapshotManager.AddNotification(FSnapshotNotification);
272    if assigned(FSnapshotNotification.OnChange) then FSnapshotNotification.OnChange(nil);
273    if assigned(FSnapshotNotification.OnCurrent) then FSnapshotNotification.OnCurrent(nil);
274  finally
275    EndUpdate;
276  end;
277end;
278
279procedure TDebuggerDlg.SetThreadsMonitor(const AValue: TIdeThreadsMonitor);
280begin
281  if FThreadsMonitor = AValue then exit;
282  BeginUpdate;
283  try
284    if (FThreadsMonitor <> nil) and (FThreadsNotification <> nil)
285    then FThreadsMonitor.RemoveNotification(FThreadsNotification);
286    FThreadsMonitor := AValue;
287    if (FThreadsMonitor <> nil) and (FThreadsNotification <> nil)
288    then FThreadsMonitor.AddNotification(FThreadsNotification);
289    if assigned(FThreadsNotification.OnChange) then FThreadsNotification.OnChange(nil);
290    if assigned(FThreadsNotification.OnCurrent) then FThreadsNotification.OnCurrent(nil);
291  finally
292    EndUpdate;
293  end;
294end;
295
296procedure TDebuggerDlg.SetCallStackMonitor(const AValue: TIdeCallStackMonitor);
297begin
298  if FCallStackMonitor = AValue then exit;
299  BeginUpdate;
300  try
301    if (FCallStackMonitor <> nil) and (FCallStackNotification <> nil)
302    then FCallStackMonitor.RemoveNotification(FCallStackNotification);
303    FCallStackMonitor := AValue;
304    if (FCallStackMonitor <> nil) and (FCallStackNotification <> nil)
305    then FCallStackMonitor.AddNotification(FCallStackNotification);
306    if assigned(FCallStackNotification.OnChange) then FCallStackNotification.OnChange(nil);
307    if assigned(FCallStackNotification.OnCurrent) then FCallStackNotification.OnCurrent(nil);
308  finally
309    EndUpdate;
310  end;
311end;
312
313procedure TDebuggerDlg.SetLocalsMonitor(const AValue: TIdeLocalsMonitor);
314begin
315  if FLocalsMonitor = AValue then exit;
316  BeginUpdate;
317  try
318    if (FLocalsMonitor <> nil) and (FLocalsNotification <> nil)
319    then FLocalsMonitor.RemoveNotification(FLocalsNotification);
320    FLocalsMonitor := AValue;
321    if (FLocalsMonitor <> nil) and (FLocalsNotification <> nil)
322    then FLocalsMonitor.AddNotification(FLocalsNotification);
323    if assigned(FLocalsNotification.OnChange) then FLocalsNotification.OnChange(nil);
324  finally
325    EndUpdate;
326  end;
327end;
328
329procedure TDebuggerDlg.SetWatchesMonitor(const AValue: TIdeWatchesMonitor);
330begin
331  if FWatchesMonitor = AValue then exit;
332  BeginUpdate;
333  try
334    if (FWatchesMonitor <> nil) and (FWatchesNotification <> nil)
335    then FWatchesMonitor.RemoveNotification(FWatchesNotification);
336    FWatchesMonitor := AValue;
337    if (FWatchesMonitor <> nil) and (FWatchesNotification <> nil)
338    then FWatchesMonitor.AddNotification(FWatchesNotification);
339    DoWatchesChanged;
340  finally
341    EndUpdate;
342  end;
343end;
344
345procedure TDebuggerDlg.SetBreakPoints(const AValue: TIDEBreakPoints);
346begin
347  if FBreakPoints = AValue then exit;
348  BeginUpdate;
349  try
350    if (FBreakPoints <> nil) and (FBreakpointsNotification <> nil)
351    then FBreakPoints.RemoveNotification(FBreakpointsNotification);
352    FBreakPoints := AValue;
353    if (FBreakPoints <> nil) and (FBreakpointsNotification <> nil)
354    then FBreakPoints.AddNotification(FBreakpointsNotification);
355    DoBreakPointsChanged;
356  finally
357    EndUpdate;
358  end;
359end;
360
361procedure TDebuggerDlg.JumpToUnitSource(AnUnitInfo: TDebuggerUnitInfo; ALine: Integer);
362const
363  JmpFlags: TJumpToCodePosFlags =
364    [jfAddJumpPoint, jfFocusEditor, jfMarkLine, jfMapLineFromDebug, jfSearchVirtualFullPath];
365var
366  Filename: String;
367  ok: Boolean;
368begin
369  if AnUnitInfo = nil then exit;
370  debugln(DBG_LOCATION_INFO, ['JumpToUnitSource AnUnitInfo=', AnUnitInfo.DebugText ]);
371  // avoid any process-messages, so this proc can not be re-entered (avoid opening one files many times)
372  DebugBoss.LockCommandProcessing;
373  try
374  (* Maybe trim the filename here and use jfDoNotExpandFilename
375     ExpandFilename works with the current IDE path, and may be wrong
376  *)
377  // TODO: better detection of unsaved project files
378    if DebugBoss.GetFullFilename(AnUnitInfo, Filename, False) then
379    begin
380      ok := false;
381      if ALine <= 0 then
382        ALine := AnUnitInfo.SrcLine;
383      if FilenameIsAbsolute(Filename) then
384        ok := MainIDEInterface.DoJumpToSourcePosition(Filename, 0, ALine, 0, JmpFlags) = mrOK;
385      if not ok then
386        MainIDEInterface.DoJumpToSourcePosition(Filename, 0, ALine, 0, JmpFlags+[jfDoNotExpandFilename]);
387    end;
388  finally
389    DebugBoss.UnLockCommandProcessing;
390  end;
391end;
392
393procedure TDebuggerDlg.DoWatchesChanged;
394begin
395  //
396end;
397
398procedure TDebuggerDlg.DoRegistersChanged;
399begin
400  //
401end;
402
403procedure TDebuggerDlg.DoBreakPointsChanged;
404begin
405  //
406end;
407
408function TDebuggerDlg.GetBreakPointImageIndex(ABreakPoint: TIDEBreakPoint;
409  AIsCurLine: Boolean = False): Integer;
410var
411  i: Integer;
412begin
413  Result := -1;
414
415  if not BrkImgIdxInitialized then begin
416    ImgBreakPoints[0] := IDEImages.LoadImage('ActiveBreakPoint');  // red dot
417    ImgBreakPoints[1] := IDEImages.LoadImage('InvalidBreakPoint'); // red dot "X"
418    ImgBreakPoints[2] := IDEImages.LoadImage('UnknownBreakPoint'); // red dot "?"
419    ImgBreakPoints[3] := IDEImages.LoadImage('PendingBreakPoint'); // red dot "||"
420
421
422    ImgBreakPoints[4] := IDEImages.LoadImage('InactiveBreakPoint');// green dot
423    ImgBreakPoints[5] := IDEImages.LoadImage('InvalidDisabledBreakPoint');// green dot "X"
424    ImgBreakPoints[6] := IDEImages.LoadImage('UnknownDisabledBreakPoint');// green dot "?"
425    ImgBreakPoints[7] := IDEImages.LoadImage('InactiveBreakPoint');// green dot
426
427    ImgBreakPoints[8] := IDEImages.LoadImage('debugger_current_line');
428    ImgBreakPoints[9] := IDEImages.LoadImage('debugger_current_line_breakpoint');
429    ImgBreakPoints[10] := IDEImages.LoadImage('debugger_current_line_disabled_breakpoint');
430
431    BrkImgIdxInitialized := True;
432  end;
433
434  if AIsCurLine
435  then begin
436    if ABreakPoint = nil
437    then Result := ImgBreakPoints[8]
438    else if ABreakPoint.Enabled
439    then Result := ImgBreakPoints[9]
440    else Result := ImgBreakPoints[10];
441  end
442  else
443  if (ABreakPoint <> nil)
444  then begin
445    if ABreakPoint.Enabled
446    then i := 0
447    else i := 4;
448    case ABreakPoint.Valid of
449      vsValid:   i := i + 0;
450      vsInvalid: i := i + 1;
451      vsUnknown: i := i + 2;
452      vsPending: i := i + 3; // TODO
453    end;
454    Result := ImgBreakPoints[i];
455  end;
456end;
457
458destructor TDebuggerDlg.Destroy;
459begin
460  if FSnapshotNotification <> nil then begin;
461    FSnapshotNotification.OnChange := nil;
462    FSnapshotNotification.OnCurrent := nil;
463  end;
464  SetSnapshotManager(nil);
465  ReleaseRefAndNil(FSnapshotNotification);
466
467  if FThreadsNotification <> nil then begin;
468    FThreadsNotification.OnChange := nil;
469    FThreadsNotification.OnCurrent := nil;
470  end;
471  SetThreadsMonitor(nil);
472  ReleaseRefAndNil(FThreadsNotification);
473
474  if FCallStackNotification <> nil then begin;
475    FCallStackNotification.OnChange := nil;
476    FCallStackNotification.OnCurrent := nil;
477  end;
478  SetCallStackMonitor(nil);
479  ReleaseRefAndNil(FCallStackNotification);
480
481  if FLocalsNotification <> nil then begin;
482    FLocalsNotification.OnChange := nil;
483  end;
484  SetLocalsMonitor(nil);
485  ReleaseRefAndNil(FLocalsNotification);
486
487  if FWatchesNotification <> nil then begin;
488    FWatchesNotification.OnAdd := nil;
489    FWatchesNotification.OnRemove := nil;
490    FWatchesNotification.OnUpdate := nil;
491  end;
492  SetWatchesMonitor(nil);
493  ReleaseRefAndNil(FWatchesNotification);
494
495  if FRegistersNotification <> nil then begin;
496    FRegistersNotification.OnChange := nil;
497  end;
498  SetRegistersMonitor(nil);
499  ReleaseRefAndNil(FRegistersNotification);
500
501  if FBreakpointsNotification <> nil then begin;
502    FBreakpointsNotification.OnAdd := nil;
503    FBreakpointsNotification.OnRemove := nil;
504    FBreakpointsNotification.OnUpdate := nil;
505  end;
506  SetBreakPoints(nil);
507  ReleaseRefAndNil(FBreakpointsNotification);
508
509  inherited Destroy;
510end;
511
512procedure TDebuggerDlg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
513var
514  Command: Word;
515  Handled: Boolean;
516begin
517  Command := EditorOpts.KeyMap.TranslateKey(Key,Shift,TDebuggerDlg);
518
519  if Assigned(OnProcessCommand) and (Command <> ecNone) and
520     (Command <> ecContextHelp) and(Command <> ecEditContextHelp)
521  then begin
522    Handled:=false;
523    OnProcessCommand(Self,Command,Handled);
524    Key := 0;
525  end;
526end;
527
528(*
529procedure TDebuggerDlg.SetDebugger(const ADebugger: TDebugger);
530begin
531  FDebugger := ADebugger;
532end;
533*)
534procedure TDebuggerDlg.DoClose(var CloseAction: TCloseAction);
535begin
536  CloseAction := caFree; // we default to free
537  inherited DoClose(CloseAction);
538end;
539
540procedure TDebuggerDlg.DoBeginUpdate;
541begin
542end;
543
544procedure TDebuggerDlg.DoEndUpdate;
545begin
546end;
547
548initialization
549  DBG_LOCATION_INFO := DebugLogger.FindOrRegisterLogGroup('DBG_LOCATION_INFO' {$IFDEF DBG_LOCATION_INFO} , True {$ENDIF} );
550
551end.
552