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