/debugger/callstackdlg.pp
Pascal | 876 lines | 730 code | 99 blank | 47 comment | 95 complexity | 4d66bdcbee73bdbd67526f48e3aa136b MD5 | raw file
1{ $Id$ } 2{ ---------------------------------------------- 3 callstackdlg.pp - Overview of the callstack 4 ---------------------------------------------- 5 6 @created(Sun Apr 28th WET 2002) 7 @lastmod($Date$) 8 @author(Marc Weustink <marc@@dommelstein.net>) 9 10 This unit contains the Call Stack debugger dialog. 11 12 13 *************************************************************************** 14 * * 15 * This source is free software; you can redistribute it and/or modify * 16 * it under the terms of the GNU General Public License as published by * 17 * the Free Software Foundation; either version 2 of the License, or * 18 * (at your option) any later version. * 19 * * 20 * This code is distributed in the hope that it will be useful, but * 21 * WITHOUT ANY WARRANTY; without even the implied warranty of * 22 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 23 * General Public License for more details. * 24 * * 25 * A copy of the GNU General Public License is available on the World * 26 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 27 * obtain it by writing to the Free Software Foundation, * 28 * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * 29 * * 30 *************************************************************************** 31} 32unit CallStackDlg; 33 34{$mode objfpc}{$H+} 35 36interface 37 38uses 39 SysUtils, Classes, Controls, Forms, LCLProc, LazLoggerBase, 40 IDEWindowIntf, DebuggerStrConst, 41 ComCtrls, Debugger, DebuggerDlg, Menus, ClipBrd, ExtCtrls, StdCtrls, 42 ActnList, IDEImagesIntf, IDECommands, EnvironmentOpts; 43 44type 45 46 { TCallStackDlg } 47 48 TCallStackDlg = class(TDebuggerDlg) 49 aclActions: TActionList; 50 actCopyAll: TAction; 51 actShowDisass: TAction; 52 actToggleBreakPoint: TAction; 53 actViewBottom: TAction; 54 actViewTop: TAction; 55 actViewLimit: TAction; 56 actViewGoto: TAction; 57 actViewMore: TAction; 58 actSetCurrent: TAction; 59 actShow: TAction; 60 popShowDisass: TMenuItem; 61 popToggle: TMenuItem; 62 ToolButtonPower: TToolButton; 63 ToolButton2: TToolButton; 64 ToolButtonTop: TToolButton; 65 ToolButtonBottom: TToolButton; 66 ToolButtonCopyAll: TToolButton; 67 ToolButton8: TToolButton; 68 ToolButton9: TToolButton; 69 txtGoto: TEdit; 70 lvCallStack: TListView; 71 Panel1: TPanel; 72 popLimit50: TMenuItem; 73 popLimit25: TMenuItem; 74 popLimit10: TMenuItem; 75 popCopyAll: TMenuItem; 76 N1: TMenuItem; 77 popSetAsCurrent: TMenuItem; 78 popShow: TMenuItem; 79 mnuPopup: TPopupMenu; 80 mnuLimit: TPopupMenu; 81 ToolBar1: TToolBar; 82 ToolButtonShow: TToolButton; 83 ToolButtonCurrent: TToolButton; 84 ToolButton4: TToolButton; 85 ToolButtonMore: TToolButton; 86 ToolButtonMax: TToolButton; 87 ToolButtonGoto: TToolButton; 88 procedure actShowDisassExecute(Sender: TObject); 89 procedure actToggleBreakPointExecute(Sender: TObject); 90 procedure actViewBottomExecute(Sender: TObject); 91 procedure actViewGotoExecute(Sender: TObject); 92 procedure actViewMoreExecute(Sender: TObject); 93 procedure actViewLimitExecute(Sender: TObject); 94 procedure actViewTopExecute(Sender: TObject); 95 procedure FormCreate(Sender: TObject); 96 procedure lvCallStackClick(Sender: TObject); 97 procedure popCountClick(Sender: TObject); 98 procedure ToolButtonPowerClick(Sender: TObject); 99 procedure txtGotoKeyPress(Sender: TObject; var Key: char); 100 procedure lvCallStackDBLCLICK(Sender: TObject); 101 procedure actCopyAllClick(Sender: TObject); 102 procedure actSetAsCurrentClick(Sender : TObject); 103 procedure actShowClick(Sender: TObject); 104 private 105 FViewCount: Integer; 106 FViewLimit: Integer; 107 FViewStart: Integer; 108 FPowerImgIdx, FPowerImgIdxGrey: Integer; 109 FInUpdateView: Boolean; 110 FUpdateFlags: set of (ufNeedUpdating); 111 function GetImageIndex(Entry: TIdeCallStackEntry): Integer; 112 procedure SetViewLimit(const AValue: Integer); 113 procedure SetViewStart(AStart: Integer); 114 procedure SetViewMax; 115 procedure GotoIndex(AIndex: Integer); 116 function GetCurrentEntry: TIdeCallStackEntry; 117 function GetFunction(const Entry: TIdeCallStackEntry): string; 118 procedure UpdateView; 119 procedure JumpToSource; 120 procedure CopyToClipBoard; 121 procedure ToggleBreakpoint(Item: TListItem); 122 protected 123 procedure DoBeginUpdate; override; 124 procedure DoEndUpdate; override; 125 procedure DisableAllActions; 126 procedure EnableAllActions; 127 function GetSelectedSnapshot: TSnapshot; 128 function GetSelectedThreads(Snap: TSnapshot): TIdeThreads; 129 function GetSelectedCallstack: TIdeCallStack; 130 procedure DoBreakPointsChanged; override; 131 procedure BreakPointChanged(const ASender: TIDEBreakPoints; const {%H-}ABreakpoint: TIDEBreakPoint); 132 procedure CallStackChanged(Sender: TObject); 133 procedure CallStackCurrent(Sender: TObject); 134 function ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean; 135 procedure ColSizeSetter(AColId: Integer; ASize: Integer); 136 public 137 constructor Create(AOwner: TComponent); override; 138 property BreakPoints; 139 property CallStackMonitor; 140 property ThreadsMonitor; 141 property SnapshotManager; 142 property ViewLimit: Integer read FViewLimit write SetViewLimit; 143 end; 144 145 146implementation 147 148{$R *.lfm} 149 150uses 151 BaseDebugManager, LazarusIDEStrConsts; 152 153var 154 DBG_DATA_MONITORS: PLazLoggerLogGroup; 155 imgSourceLine: Integer; 156 imgNoSourceLine: Integer; 157 158 CallStackDlgWindowCreator: TIDEWindowCreator; 159 160const 161 COL_STACK_BRKPOINT = 1; 162 COL_STACK_INDEX = 2; 163 COL_STACK_SOURCE = 3; 164 COL_STACK_LINE = 4; 165 COL_STACK_FUNC = 5; 166 COL_WIDTHS: Array[0..4] of integer = ( 50, 0, 150, 50, 280); 167 168function CallStackDlgColSizeGetter(AForm: TCustomForm; AColId: Integer; var ASize: Integer): Boolean; 169begin 170 Result := AForm is TCallStackDlg; 171 if Result then 172 Result := TCallStackDlg(AForm).ColSizeGetter(AColId, ASize); 173end; 174 175procedure CallStackDlgColSizeSetter(AForm: TCustomForm; AColId: Integer; ASize: Integer); 176begin 177 if AForm is TCallStackDlg then 178 TCallStackDlg(AForm).ColSizeSetter(AColId, ASize); 179end; 180 181{ TCallStackDlg } 182 183constructor TCallStackDlg.Create(AOwner: TComponent); 184var 185 i: Integer; 186begin 187 inherited Create(AOwner); 188 CallStackNotification.OnChange := @CallStackChanged; 189 CallStackNotification.OnCurrent := @CallStackCurrent; 190 BreakpointsNotification.OnAdd := @BreakPointChanged; 191 BreakpointsNotification.OnUpdate := @BreakPointChanged; 192 BreakpointsNotification.OnRemove := @BreakPointChanged; 193 ThreadsNotification.OnCurrent := @CallStackChanged; 194 SnapshotNotification.OnCurrent := @CallStackChanged; 195 196 actToggleBreakPoint.ShortCut := IDECommandList.FindIDECommand(ecToggleBreakPoint).AsShortCut; 197 198 for i := low(COL_WIDTHS) to high(COL_WIDTHS) do 199 if COL_WIDTHS[i] > 0 then 200 lvCallStack.Column[i].Width := COL_WIDTHS[i] 201 else 202 lvCallStack.Column[i].AutoSize := True; 203end; 204 205procedure TCallStackDlg.CallStackChanged(Sender: TObject); 206begin 207 DebugLn(DBG_DATA_MONITORS, ['DebugDataWindow: TCallStackDlg.CallStackChanged from ', DbgSName(Sender), ' Upd:', IsUpdating]); 208 if (not ToolButtonPower.Down) or FInUpdateView then exit; 209 if FViewStart = 0 210 then UpdateView 211 else SetViewStart(0); 212 SetViewMax; 213end; 214 215procedure TCallStackDlg.CallStackCurrent(Sender: TObject); 216begin 217 DebugLn(DBG_DATA_MONITORS, ['DebugDataWindow: TCallStackDlg.CallStackCurrent from ', DbgSName(Sender), ' Upd:', IsUpdating]); 218 if not ToolButtonPower.Down then exit; 219 UpdateView; 220end; 221 222function TCallStackDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean; 223begin 224 if (AColId - 1 >= 0) and (AColId - 1 < lvCallStack.ColumnCount) then begin 225 ASize := lvCallStack.Column[AColId - 1].Width; 226 Result := (ASize <> COL_WIDTHS[AColId - 1]) and (not lvCallStack.Column[AColId - 1].AutoSize); 227 end 228 else 229 Result := False; 230end; 231 232procedure TCallStackDlg.ColSizeSetter(AColId: Integer; ASize: Integer); 233begin 234 case AColId of 235 COL_STACK_BRKPOINT: lvCallStack.Column[0].Width := TWidth(ASize); 236 COL_STACK_INDEX: lvCallStack.Column[1].Width := TWidth(ASize); 237 COL_STACK_SOURCE: lvCallStack.Column[2].Width := TWidth(ASize); 238 COL_STACK_LINE: lvCallStack.Column[3].Width := TWidth(ASize); 239 COL_STACK_FUNC: lvCallStack.Column[4].Width := TWidth(ASize); 240 end; 241end; 242 243function TCallStackDlg.GetImageIndex(Entry: TIdeCallStackEntry): Integer; 244 245 function GetBreakPoint(Entry: TIdeCallStackEntry): TIDEBreakPoint; inline; 246 var 247 FileName: String; 248 begin 249 Result := nil; 250 if BreakPoints = nil then Exit; 251 if DebugBoss.GetFullFilename(Entry.UnitInfo, FileName, False) 252 then Result := BreakPoints.Find(FileName, Entry.Line); 253 end; 254 255begin 256 Result := GetBreakPointImageIndex(GetBreakPoint(Entry), Entry.IsCurrent); 257 if Result >= 0 258 then exit; 259 260 if Entry.Source = '' 261 then Result := imgNoSourceLine 262 else Result := imgSourceLine; 263end; 264 265procedure TCallStackDlg.UpdateView; 266 function LastDelimPos(const FileName: string): Integer; 267 begin 268 Result := Length(FileName); 269 if FileName[Result] in ['/', '\'] then 270 exit(-1); 271 while (Result > 0) and not (FileName[Result] in ['/', '\']) do 272 Dec(Result); 273 end; 274var 275 i, n: Integer; 276 Item: TListItem; 277 Entry: TIdeCallStackEntry; 278 First, Count, MaxCnt: Integer; 279 Source: String; 280 Snap: TSnapshot; 281 CStack: TIdeCallStack; 282begin 283 if (not ToolButtonPower.Down) or FInUpdateView then exit; 284 if IsUpdating then begin 285 DebugLn(DBG_DATA_MONITORS, ['DebugDataWindow: TCallStackDlg.UpdateView in IsUpdating']); 286 Include(FUpdateFlags, ufNeedUpdating); 287 exit; 288 end; 289 try DebugLnEnter(DBG_DATA_MONITORS, ['DebugDataWindow: >>ENTER: TCallStackDlg.UpdateView']); 290 Exclude(FUpdateFlags, ufNeedUpdating); 291 292 293 BeginUpdate; 294 lvCallStack.BeginUpdate; 295 try 296 Snap := GetSelectedSnapshot; 297 if Snap <> nil 298 then Caption:= lisMenuViewCallStack + ' (' + Snap.LocationAsText + ')' 299 else Caption:= lisMenuViewCallStack; 300 301 FInUpdateView := True; // ignore change triggered by count, if there is a change event, then Count will be updated already 302 CStack := GetSelectedCallstack; 303 MaxCnt := FViewStart + FViewLimit + 1; 304 if CStack <> nil then CStack.CountLimited(MaxCnt); // trigger the update-notification, if executed immediately 305 FInUpdateView := False; 306 // TODO: must make CStack ref-counted 307 if CStack <> GetSelectedCallstack then exit; // Something changed, maybe debugger stopped 308 309 310 if (CStack = nil) or ((Snap <> nil) and (CStack.CountLimited(MaxCnt) = 0)) then begin 311 lvCallStack.Items.Clear; 312 Item := lvCallStack.Items.Add; 313 Item.SubItems.Add(''); 314 Item.SubItems.Add(lisCallStackNotEvaluated); 315 Item.SubItems.Add(''); 316 Item.SubItems.Add(''); 317 exit; 318 end; 319 320 if (CStack.CountLimited(MaxCnt)=0) 321 then begin 322 txtGoto.Text:= '0'; 323 lvCallStack.Items.Clear; 324 exit; 325 end; 326 327 328 if Snap <> nil then begin 329 First := 0; 330 Count := CStack.CountLimited(MaxCnt); 331 end else begin 332 First := FViewStart; 333 if First + FViewLimit <= CStack.CountLimited(MaxCnt) 334 then Count := FViewLimit 335 else Count := CStack.Count - First; 336 end; 337 338 // Reuse entries, so add and remove only 339 // Remove unneded 340 for n := lvCallStack.Items.Count - 1 downto Count do 341 lvCallStack.Items.Delete(n); 342 343 // Add needed 344 for n := lvCallStack.Items.Count to Count - 1 do 345 begin 346 Item := lvCallStack.Items.Add; 347 Item.SubItems.Add(''); 348 Item.SubItems.Add(''); 349 Item.SubItems.Add(''); 350 Item.SubItems.Add(''); 351 end; 352 353 FInUpdateView := True; 354 CStack.PrepareRange(First, Count); 355 // TODO: must make CStack ref-counted 356 FInUpdateView := False; 357 if CStack <> GetSelectedCallstack then exit; // Something changed, maybe debugger stopped 358 for n := 0 to Count - 1 do 359 begin 360 Item := lvCallStack.Items[n]; 361 Entry := CStack.Entries[First + n]; 362 if Entry = nil 363 then begin 364 Item.Caption := ''; 365 Item.ImageIndex := imgNoSourceLine; 366 Item.SubItems[0] := '????'; 367 Item.SubItems[1] := ''; 368 Item.SubItems[2] := ''; 369 Item.SubItems[3] := ''; 370 end 371 else begin 372 Item.ImageIndex := GetImageIndex(Entry); 373 Item.SubItems[0] := IntToStr(Entry.Index); 374 Source := Entry.Source; 375 if (Source = '') and (Entry.UnitInfo <> nil) and (Entry.UnitInfo.LocationFullFile <> '') then 376 Source := Entry.UnitInfo.LocationFullFile; 377 if Source = '' then // we do not have a source file => just show an adress 378 Source := ':' + IntToHex(Entry.Address, 8) 379 else begin 380 i := LastDelimPos(Source); 381 if i > 1 then 382 Source := copy(Source, i+1, length(Source)) + ' (' + copy(Source, 1, i) + ')' 383 end; 384 Item.SubItems[1] := Source; 385 if (Entry.Line = 0) and (Entry.UnitInfo <> nil) and (Entry.UnitInfo.SrcLine > 0) then 386 Item.SubItems[2] := '~'+IntToStr(Entry.UnitInfo.SrcLine) 387 else 388 if Entry.Line > 0 then 389 Item.SubItems[2] := IntToStr(Entry.Line) // TODO: if editor is open, map line SrcEdit.DebugToSourceLine 390 else 391 Item.SubItems[2] := '-'; 392 Item.SubItems[3] := GetFunction(Entry); 393 end; 394 end; 395 396 finally 397 FInUpdateView := False; 398 lvCallStack.EndUpdate; 399 EndUpdate; 400 end; 401 finally DebugLnExit(DBG_DATA_MONITORS, ['DebugDataWindow: <<EXIT: TCallStackDlg.UpdateView']); end; 402end; 403 404procedure TCallStackDlg.DoBeginUpdate; 405begin 406 DisableAllActions; 407 lvCallStack.BeginUpdate; 408end; 409 410procedure TCallStackDlg.DoEndUpdate; 411begin 412 if ufNeedUpdating in FUpdateFlags then UpdateView; 413 lvCallStack.EndUpdate; 414 EnableAllActions; 415end; 416 417procedure TCallStackDlg.DisableAllActions; 418var 419 i: Integer; 420begin 421 for i := 0 to aclActions.ActionCount - 1 do 422 (aclActions.Actions[i] as TAction).Enabled := False; 423end; 424 425procedure TCallStackDlg.EnableAllActions; 426var 427 i: Integer; 428 Snap: TSnapshot; 429begin 430 for i := 0 to aclActions.ActionCount - 1 do 431 (aclActions.Actions[i] as TAction).Enabled := True; 432 Snap := GetSelectedSnapshot; 433 if snap <> nil then begin 434 actViewLimit.Enabled := False; 435 actViewMore.Enabled := False; 436 end; 437 ToolButtonPower.Enabled := Snap = nil; 438end; 439 440function TCallStackDlg.GetSelectedSnapshot: TSnapshot; 441begin 442 Result := nil; 443 if (SnapshotManager <> nil) and (SnapshotManager.SelectedEntry <> nil) 444 then Result := SnapshotManager.SelectedEntry; 445end; 446 447function TCallStackDlg.GetSelectedThreads(Snap: TSnapshot): TIdeThreads; 448begin 449 if ThreadsMonitor = nil then exit(nil); 450 if Snap = nil 451 then Result := ThreadsMonitor.CurrentThreads 452 else Result := ThreadsMonitor.Snapshots[Snap]; 453end; 454 455function TCallStackDlg.GetSelectedCallstack: TIdeCallStack; 456var 457 Snap: TSnapshot; 458 Threads: TIdeThreads; 459 tid: LongInt; 460begin 461 if (CallStackMonitor = nil) or (ThreadsMonitor = nil) 462 then begin 463 Result := nil; 464 exit; 465 end; 466 467 Snap := GetSelectedSnapshot; 468 Threads := GetSelectedThreads(Snap); 469 // There should always be a thread object 470 Assert(Threads<>nil, 'TCallStackDlg.GetSelectedCallstack missing thread object'); 471 if Threads <> nil 472 then tid := Threads.CurrentThreadId 473 else tid := 1; 474 475 if (Snap <> nil) 476 then Result := CallStackMonitor.Snapshots[Snap].EntriesForThreads[tid] 477 else Result := CallStackMonitor.CurrentCallStackList.EntriesForThreads[tid]; 478end; 479 480function TCallStackDlg.GetCurrentEntry: TIdeCallStackEntry; 481var 482 CurItem: TListItem; 483 idx: Integer; 484begin 485 Result := nil; 486 if GetSelectedCallstack = nil then Exit; 487 488 CurItem := lvCallStack.Selected; 489 if CurItem = nil then Exit; 490 491 idx := FViewStart + CurItem.Index; 492 if idx >= GetSelectedCallstack.CountLimited(idx+1) then Exit; 493 494 Result := GetSelectedCallstack.Entries[idx]; 495end; 496 497procedure TCallStackDlg.JumpToSource; 498var 499 Entry: TIdeCallStackEntry; 500begin 501 Entry := GetCurrentEntry; 502 if Entry = nil then Exit; 503 504 JumpToUnitSource(Entry.UnitInfo, Entry.Line); 505end; 506 507procedure TCallStackDlg.CopyToClipBoard; 508var 509 n: integer; 510 Entry: TIdeCallStackEntry; 511 S: String; 512begin 513 Clipboard.Clear; 514 515 if (GetSelectedCallstack=nil) or (GetSelectedCallstack.Count=0) then exit; 516 517 S := ''; 518 // GetSelectedCallstack.PrepareRange(); 519 for n:= 0 to GetSelectedCallstack.Count-1 do 520 begin 521 Entry:=GetSelectedCallstack.Entries[n]; 522 if Entry <> nil 523 then S := S + format('#%d %s at %s:%d', [n, GetFunction(Entry), Entry.Source, Entry.Line]) 524 else S := S + format('#%d ????', [n]); 525 S := S + LineEnding; 526 end; 527 ClipBoard.AsText := S; 528end; 529 530procedure TCallStackDlg.ToggleBreakpoint(Item: TListItem); 531var 532 idx: Integer; 533 Entry: TIdeCallStackEntry; 534 BreakPoint: TIDEBreakPoint; 535 FileName: String; 536 Ctrl: Boolean; 537begin 538 Ctrl := ssCtrl in GetKeyShiftState; 539 540 try 541 DisableAllActions; 542 if (Item <> nil) and (BreakPoints <> nil) then 543 begin 544 GetSelectedCallstack.CountLimited(FViewStart + FViewLimit + 1); // get max limit 545 idx := FViewStart + Item.Index; 546 if idx >= GetSelectedCallstack.CountLimited(idx+1) then Exit; 547 Entry := GetSelectedCallstack.Entries[idx]; 548 if Entry.Line <= 0 then exit; 549 if not DebugBoss.GetFullFilename(Entry.UnitInfo, FileName, False) then 550 Exit; 551 BreakPoint := BreakPoints.Find(FileName, Entry.Line); 552 if BreakPoint <> nil then begin 553 if Ctrl 554 then BreakPoint.Enabled := not BreakPoint.Enabled 555 else DebugBoss.DoDeleteBreakPoint(BreakPoint.Source, BreakPoint.Line) 556 end else begin 557 DebugBoss.LockCommandProcessing; 558 try 559 DebugBoss.DoCreateBreakPoint(FileName, Entry.Line, False, BreakPoint); 560 if Ctrl and (BreakPoint <> nil) 561 then BreakPoint.Enabled := False; 562 finally 563 DebugBoss.UnLockCommandProcessing; 564 end; 565 end; 566 end; 567 finally 568 EnableAllActions; 569 end; 570end; 571 572procedure TCallStackDlg.DoBreakPointsChanged; 573begin 574 UpdateView; 575end; 576 577procedure TCallStackDlg.lvCallStackDBLCLICK(Sender: TObject); 578begin 579 JumpToSource; 580end; 581 582procedure TCallStackDlg.popCountClick(Sender: TObject); 583begin 584 if FViewCount = TMenuItem(Sender).Tag then Exit; 585 FViewCount := TMenuItem(Sender).Tag; 586 ViewLimit := FViewCount; 587 EnvironmentOptions.DebuggerConfig.DlgCallStackConfig.ViewCount := FViewCount; 588 actViewLimit.Caption := TMenuItem(Sender).Caption; 589end; 590 591procedure TCallStackDlg.ToolButtonPowerClick(Sender: TObject); 592begin 593 if ToolButtonPower.Down 594 then begin 595 ToolButtonPower.ImageIndex := FPowerImgIdx; 596 UpdateView; 597 end 598 else ToolButtonPower.ImageIndex := FPowerImgIdxGrey; 599end; 600 601procedure TCallStackDlg.txtGotoKeyPress(Sender: TObject; var Key: char); 602begin 603 case Key of 604 '0'..'9', #8 : ; 605 #13 : SetViewStart(StrToIntDef(txtGoto.Text, 0)); 606 else 607 Key := #0; 608 end; 609end; 610 611procedure TCallStackDlg.actCopyAllClick(Sender: TObject); 612begin 613 CopyToClipBoard; 614end; 615 616procedure TCallStackDlg.actSetAsCurrentClick(Sender : TObject); 617var 618 Entry: TIdeCallStackEntry; 619begin 620 try 621 DisableAllActions; 622 Entry := GetCurrentEntry; 623 if Entry = nil then Exit; 624 625 GetSelectedCallstack.ChangeCurrentIndex(Entry.Index); 626 if GetSelectedSnapshot <> nil 627 then CallStackMonitor.NotifyCurrent; // TODO: move to snapshot callstack object 628 finally 629 EnableAllActions; 630 end; 631end; 632 633procedure TCallStackDlg.actShowClick(Sender: TObject); 634begin 635 JumpToSource; 636end; 637 638procedure TCallStackDlg.actViewBottomExecute(Sender: TObject); 639begin 640 try 641 DisableAllActions; 642 if GetSelectedCallstack <> nil 643 then SetViewStart(GetSelectedCallstack.Count - FViewLimit) 644 else SetViewStart(0); 645 finally 646 EnableAllActions; 647 end; 648end; 649 650procedure TCallStackDlg.actToggleBreakPointExecute(Sender: TObject); 651begin 652 ToggleBreakpoint(lvCallStack.Selected); 653end; 654 655procedure TCallStackDlg.actShowDisassExecute(Sender: TObject); 656var 657 Entry: TIdeCallStackEntry; 658begin 659 Entry := GetCurrentEntry; 660 if (Entry = nil) or (Entry.Address = 0) then Exit; 661 DebugBoss.ViewDisassembler(Entry.Address); 662end; 663 664procedure TCallStackDlg.actViewGotoExecute(Sender: TObject); 665begin 666 try 667 DisableAllActions; 668 SetViewStart(StrToIntDef(txtGoto.Text, 0)); 669 finally 670 EnableAllActions; 671 end; 672end; 673 674procedure TCallStackDlg.actViewMoreExecute(Sender: TObject); 675begin 676 try 677 DisableAllActions; 678 ToolButtonPower.Down := True; 679 ToolButtonPowerClick(nil); 680 ViewLimit := ViewLimit + FViewCount; 681 finally 682 EnableAllActions; 683 end; 684end; 685 686procedure TCallStackDlg.actViewTopExecute(Sender: TObject); 687begin 688 try 689 DisableAllActions; 690 ToolButtonPower.Down := True; 691 ToolButtonPowerClick(nil); 692 SetViewStart(0); 693 finally 694 EnableAllActions; 695 end; 696end; 697 698procedure TCallStackDlg.BreakPointChanged(const ASender: TIDEBreakPoints; 699 const ABreakpoint: TIDEBreakPoint); 700var 701 i, idx: Integer; 702 Entry: TIdeCallStackEntry; 703 Stack: TIdeCallStack; 704begin 705 DebugLn(DBG_DATA_MONITORS, ['DebugDataWindow: TCallStackDlg.BreakPointChanged ', DbgSName(ASender), ' Upd:', IsUpdating]); 706 Stack := GetSelectedCallstack; 707 if (BreakPoints = nil) or (Stack = nil) then 708 Exit; 709 710 Stack.CountLimited(FViewStart + FViewLimit + 1); 711 for i := 0 to lvCallStack.Items.Count - 1 do 712 begin 713 idx := FViewStart + lvCallStack.Items[i].Index; 714 if idx >= Stack.CountLimited(idx+1) then 715 Continue; 716 Entry := Stack.Entries[idx]; 717 if Entry <> nil then 718 lvCallStack.Items[i].ImageIndex := GetImageIndex(Entry) 719 else 720 lvCallStack.Items[i].ImageIndex := imgNoSourceLine; 721 end; 722end; 723 724procedure TCallStackDlg.FormCreate(Sender: TObject); 725var 726 i: integer; 727 curPopLimit: TMenuItem; 728begin 729 Caption := lisMenuViewCallStack; 730 ToolButtonPower.Caption := lisDbgWinPower; 731 ToolButtonPower.Hint := lisDbgWinPowerHint; 732 for i:= 0 to mnuLimit.Items.Count-1 do 733 mnuLimit.Items[i].Caption:= Format(lisMaxS, [mnuLimit.Items[i].Tag]); 734 actViewMore.Caption := lisMore; 735 actViewTop.Caption := lisCSTop; 736 actViewBottom.Caption := lisCSBottom; 737 actViewGoto.Caption := lisGotoSelected; 738 actShow.Caption := lisViewSource; 739 actShowDisass.Caption := lisViewSourceDisass; 740 actToggleBreakPoint.Caption := uemToggleBreakpoint; 741 actSetCurrent.Caption := lisCurrent; 742 actCopyAll.Caption := lisCopyAll; 743 744 FViewCount := EnvironmentOptions.DebuggerConfig.DlgCallStackConfig.ViewCount; 745 curPopLimit := nil; 746 for i := 0 to mnuLimit.Items.Count-1 do 747 if mnuLimit.Items[i].Tag = FViewCount then 748 begin 749 curPopLimit := mnuLimit.Items[i]; 750 Break; 751 end; 752 if curPopLimit=nil then 753 curPopLimit := popLimit10; 754 FViewCount := curPopLimit.Tag; 755 FViewLimit := FViewCount; 756 FViewStart := 0; 757 FInUpdateView := False; 758 actViewLimit.Caption := curPopLimit.Caption; 759 ToolButtonMax.Caption := actViewLimit.Caption; 760 761 lvCallStack.Columns[1].Caption:= lisIndex; 762 lvCallStack.Columns[2].Caption:= histdlgColumnLoc; 763 lvCallStack.Columns[3].Caption:= dlgAddHiAttrGroupLine; 764 lvCallStack.Columns[4].Caption:= lisFunction; 765 766 ToolBar1.Images := IDEImages.Images_16; 767 ToolButtonShow.ImageIndex := IDEImages.LoadImage(16, 'callstack_show'); 768 ToolButtonMore.ImageIndex := IDEImages.LoadImage(16, 'callstack_more'); 769 ToolButtonTop.ImageIndex := IDEImages.LoadImage(16, 'callstack_top'); 770 ToolButtonBottom.ImageIndex := IDEImages.LoadImage(16, 'callstack_bottom'); 771 ToolButtonGoto.ImageIndex := IDEImages.LoadImage(16, 'callstack_goto'); 772 ToolButtonCopyAll.ImageIndex := IDEImages.LoadImage(16, 'laz_copy'); 773 FPowerImgIdx := IDEImages.LoadImage(16, 'debugger_power'); 774 FPowerImgIdxGrey := IDEImages.LoadImage(16, 'debugger_power_grey'); 775 ToolButtonPower.ImageIndex := FPowerImgIdx; 776 777 lvCallStack.SmallImages := IDEImages.Images_16; 778 imgSourceLine := IDEImages.LoadImage(16, 'debugger_source_line'); 779 imgNoSourceLine := IDEImages.LoadImage(16, 'debugger_nosource_line'); 780 781end; 782 783procedure TCallStackDlg.lvCallStackClick(Sender: TObject); 784var 785 P: TPoint; 786 Item: TListItem; 787begin 788 // toggle breakpoint 789 P := lvCallStack.ScreenToClient(Mouse.CursorPos); 790 Item := lvCallStack.GetItemAt(P.X, P.Y); 791 // if clicked on the first column of a valid item 792 if (Item <> nil) and (P.X <= lvCallStack.Column[0].Width) then 793 ToggleBreakPoint(Item); 794end; 795 796procedure TCallStackDlg.actViewLimitExecute(Sender: TObject); 797begin 798 try 799 DisableAllActions; 800 ToolButtonPower.Down := True; 801 ToolButtonPowerClick(nil); 802 ViewLimit := FViewCount; 803 finally 804 EnableAllActions; 805 end; 806end; 807 808procedure TCallStackDlg.SetViewStart(AStart: Integer); 809begin 810 if GetSelectedCallstack = nil then Exit; 811 ToolButtonPower.Down := True; 812 ToolButtonPowerClick(nil); 813 814 if (AStart > GetSelectedCallstack.CountLimited(AStart+FViewLimit+1) - FViewLimit) 815 then AStart := GetSelectedCallstack.Count - FViewLimit; 816 if AStart < 0 then AStart := 0; 817 if FViewStart = AStart then Exit; 818 819 FViewStart:= AStart; 820 txtGoto.Text:= IntToStr(AStart); 821 UpdateView; 822end; 823 824procedure TCallStackDlg.SetViewMax; 825begin 826// If GetSelectedCallstack = nil 827// then lblViewCnt.Caption:= '0' 828// else lblViewCnt.Caption:= IntToStr(GetSelectedCallstack.Count); 829end; 830 831procedure TCallStackDlg.SetViewLimit(const AValue: Integer); 832begin 833 ToolButtonPower.Down := True; 834 ToolButtonPowerClick(nil); 835 if FViewLimit = AValue then Exit; 836 if (GetSelectedCallstack <> nil) 837 and (FViewStart + FViewLimit >= GetSelectedCallstack.CountLimited(FViewStart + FViewLimit+1)) 838 and (AValue > FViewLimit) 839 then begin 840 FViewStart := GetSelectedCallstack.Count - AValue; 841 if FViewStart < 0 then FViewStart := 0; 842 end; 843 FViewLimit := AValue; 844 UpdateView; 845end; 846 847function TCallStackDlg.GetFunction(const Entry: TIdeCallStackEntry): string; 848begin 849 Result := Entry.GetFunctionWithArg; 850end; 851 852procedure TCallStackDlg.GotoIndex(AIndex: Integer); 853begin 854 if AIndex < 0 then Exit; 855 if AIndex >= GetSelectedCallstack.CountLimited(AIndex+1) then Exit; 856 857 858end; 859 860initialization 861 862 CallStackDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtCallStack]); 863 CallStackDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog; 864 CallStackDlgWindowCreator.OnSetDividerSize := @CallStackDlgColSizeSetter; 865 CallStackDlgWindowCreator.OnGetDividerSize := @CallStackDlgColSizeGetter; 866 CallStackDlgWindowCreator.DividerTemplate.Add('ColumnCStackBrkPoint', COL_STACK_BRKPOINT, @drsColWidthBrkPointImg); 867 CallStackDlgWindowCreator.DividerTemplate.Add('ColumnCStackIndex', COL_STACK_INDEX, @drsColWidthIndex); 868 CallStackDlgWindowCreator.DividerTemplate.Add('ColumnCStackSource', COL_STACK_SOURCE, @drsColWidthSource); 869 CallStackDlgWindowCreator.DividerTemplate.Add('ColumnCStackLine', COL_STACK_LINE, @drsColWidthLine); 870 CallStackDlgWindowCreator.DividerTemplate.Add('ColumnCStackFunc', COL_STACK_FUNC, @drsColWidthFunc); 871 CallStackDlgWindowCreator.CreateSimpleLayout; 872 873 DBG_DATA_MONITORS := DebugLogger.FindOrRegisterLogGroup('DBG_DATA_MONITORS' {$IFDEF DBG_DATA_MONITORS} , True {$ENDIF} ); 874 875end. 876