1{ $Id: callstackdlg.pp 55545 2017-07-20 13:56:50Z juha $ } 2{ ---------------------------------------------- 3 callstackdlg.pp - Overview of the callstack 4 ---------------------------------------------- 5 6 @created(Sun Apr 28th WET 2002) 7 @lastmod($Date: 2017-07-20 15:56:50 +0200 (Do, 20 Jul 2017) $) 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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, 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 BeginUpdate; 293 lvCallStack.BeginUpdate; 294 try 295 Snap := GetSelectedSnapshot; 296 if Snap <> nil 297 then Caption:= lisMenuViewCallStack + ' (' + Snap.LocationAsText + ')' 298 else Caption:= lisMenuViewCallStack; 299 300 FInUpdateView := True; // ignore change triggered by count, if there is a change event, then Count will be updated already 301 CStack := GetSelectedCallstack; 302 MaxCnt := FViewStart + FViewLimit + 1; 303 if CStack <> nil then CStack.CountLimited(MaxCnt); // trigger the update-notification, if executed immediately 304 FInUpdateView := False; 305 // TODO: must make CStack ref-counted 306 if CStack <> GetSelectedCallstack then exit; // Something changed, maybe debugger stopped 307 308 if (CStack = nil) or ((Snap <> nil) and (CStack.CountLimited(MaxCnt) = 0)) then begin 309 lvCallStack.Items.Clear; 310 Item := lvCallStack.Items.Add; 311 Item.SubItems.Add(''); 312 Item.SubItems.Add(lisCallStackNotEvaluated); 313 Item.SubItems.Add(''); 314 Item.SubItems.Add(''); 315 exit; 316 end; 317 318 if (CStack.CountLimited(MaxCnt)=0) 319 then begin 320 txtGoto.Text:= '0'; 321 lvCallStack.Items.Clear; 322 exit; 323 end; 324 325 if Snap <> nil then begin 326 First := 0; 327 Count := CStack.CountLimited(MaxCnt); 328 end else begin 329 First := FViewStart; 330 if First + FViewLimit <= CStack.CountLimited(MaxCnt) 331 then Count := FViewLimit 332 else Count := CStack.Count - First; 333 end; 334 335 // Reuse entries, so add and remove only 336 // Remove unneded 337 for n := lvCallStack.Items.Count - 1 downto Count do 338 lvCallStack.Items.Delete(n); 339 340 // Add needed 341 for n := lvCallStack.Items.Count to Count - 1 do 342 begin 343 Item := lvCallStack.Items.Add; 344 Item.SubItems.Add(''); 345 Item.SubItems.Add(''); 346 Item.SubItems.Add(''); 347 Item.SubItems.Add(''); 348 end; 349 350 FInUpdateView := True; 351 CStack.PrepareRange(First, Count); 352 // TODO: must make CStack ref-counted 353 FInUpdateView := False; 354 if CStack <> GetSelectedCallstack then exit; // Something changed, maybe debugger stopped 355 for n := 0 to Count - 1 do 356 begin 357 Item := lvCallStack.Items[n]; 358 Entry := CStack.Entries[First + n]; 359 if Entry = nil 360 then begin 361 Item.Caption := ''; 362 Item.ImageIndex := imgNoSourceLine; 363 Item.SubItems[0] := '????'; 364 Item.SubItems[1] := ''; 365 Item.SubItems[2] := ''; 366 Item.SubItems[3] := ''; 367 end 368 else begin 369 Item.ImageIndex := GetImageIndex(Entry); 370 Item.SubItems[0] := IntToStr(Entry.Index); 371 Source := Entry.Source; 372 if (Source = '') and (Entry.UnitInfo <> nil) and (Entry.UnitInfo.LocationFullFile <> '') then 373 Source := Entry.UnitInfo.LocationFullFile; 374 if Source = '' then // we do not have a source file => just show an adress 375 Source := ':' + IntToHex(Entry.Address, 8) 376 else begin 377 i := LastDelimPos(Source); 378 if i > 1 then 379 Source := copy(Source, i+1, length(Source)) + ' (' + copy(Source, 1, i) + ')' 380 end; 381 Item.SubItems[1] := Source; 382 if (Entry.Line = 0) and (Entry.UnitInfo <> nil) and (Entry.UnitInfo.SrcLine > 0) then 383 Item.SubItems[2] := '~'+IntToStr(Entry.UnitInfo.SrcLine) 384 else 385 if Entry.Line > 0 then 386 Item.SubItems[2] := IntToStr(Entry.Line) // TODO: if editor is open, map line SrcEdit.DebugToSourceLine 387 else 388 Item.SubItems[2] := '-'; 389 Item.SubItems[3] := GetFunction(Entry); 390 end; 391 end; 392 393 finally 394 FInUpdateView := False; 395 lvCallStack.EndUpdate; 396 EndUpdate; 397 end; 398 finally DebugLnExit(DBG_DATA_MONITORS, ['DebugDataWindow: <<EXIT: TCallStackDlg.UpdateView']); end; 399end; 400 401procedure TCallStackDlg.DoBeginUpdate; 402begin 403 DisableAllActions; 404 lvCallStack.BeginUpdate; 405end; 406 407procedure TCallStackDlg.DoEndUpdate; 408begin 409 if ufNeedUpdating in FUpdateFlags then UpdateView; 410 lvCallStack.EndUpdate; 411 EnableAllActions; 412end; 413 414procedure TCallStackDlg.DisableAllActions; 415var 416 i: Integer; 417begin 418 for i := 0 to aclActions.ActionCount - 1 do 419 (aclActions.Actions[i] as TAction).Enabled := False; 420end; 421 422procedure TCallStackDlg.EnableAllActions; 423var 424 i: Integer; 425 Snap: TSnapshot; 426begin 427 for i := 0 to aclActions.ActionCount - 1 do 428 (aclActions.Actions[i] as TAction).Enabled := True; 429 Snap := GetSelectedSnapshot; 430 if snap <> nil then begin 431 actViewLimit.Enabled := False; 432 actViewMore.Enabled := False; 433 end; 434 ToolButtonPower.Enabled := Snap = nil; 435end; 436 437function TCallStackDlg.GetSelectedSnapshot: TSnapshot; 438begin 439 Result := nil; 440 if (SnapshotManager <> nil) and (SnapshotManager.SelectedEntry <> nil) 441 then Result := SnapshotManager.SelectedEntry; 442end; 443 444function TCallStackDlg.GetSelectedThreads(Snap: TSnapshot): TIdeThreads; 445begin 446 if ThreadsMonitor = nil then exit(nil); 447 if Snap = nil 448 then Result := ThreadsMonitor.CurrentThreads 449 else Result := ThreadsMonitor.Snapshots[Snap]; 450end; 451 452function TCallStackDlg.GetSelectedCallstack: TIdeCallStack; 453var 454 Snap: TSnapshot; 455 Threads: TIdeThreads; 456 tid: LongInt; 457begin 458 if (CallStackMonitor = nil) or (ThreadsMonitor = nil) 459 then begin 460 Result := nil; 461 exit; 462 end; 463 464 Snap := GetSelectedSnapshot; 465 Threads := GetSelectedThreads(Snap); 466 // There should always be a thread object 467 Assert(Threads<>nil, 'TCallStackDlg.GetSelectedCallstack missing thread object'); 468 if Threads <> nil 469 then tid := Threads.CurrentThreadId 470 else tid := 1; 471 472 if (Snap <> nil) 473 then Result := CallStackMonitor.Snapshots[Snap].EntriesForThreads[tid] 474 else Result := CallStackMonitor.CurrentCallStackList.EntriesForThreads[tid]; 475end; 476 477function TCallStackDlg.GetCurrentEntry: TIdeCallStackEntry; 478var 479 CurItem: TListItem; 480 idx: Integer; 481begin 482 Result := nil; 483 if GetSelectedCallstack = nil then Exit; 484 485 CurItem := lvCallStack.Selected; 486 if CurItem = nil then Exit; 487 488 idx := FViewStart + CurItem.Index; 489 if idx >= GetSelectedCallstack.CountLimited(idx+1) then Exit; 490 491 Result := GetSelectedCallstack.Entries[idx]; 492end; 493 494procedure TCallStackDlg.JumpToSource; 495var 496 Entry: TIdeCallStackEntry; 497begin 498 Entry := GetCurrentEntry; 499 if Entry = nil then Exit; 500 501 JumpToUnitSource(Entry.UnitInfo, Entry.Line); 502end; 503 504procedure TCallStackDlg.CopyToClipBoard; 505var 506 n: integer; 507 Entry: TIdeCallStackEntry; 508 S: String; 509begin 510 Clipboard.Clear; 511 512 if (GetSelectedCallstack=nil) or (GetSelectedCallstack.Count=0) then exit; 513 514 S := ''; 515 // GetSelectedCallstack.PrepareRange(); 516 for n:= 0 to GetSelectedCallstack.Count-1 do 517 begin 518 Entry:=GetSelectedCallstack.Entries[n]; 519 if Entry <> nil 520 then S := S + format('#%d %s at %s:%d', [n, GetFunction(Entry), Entry.Source, Entry.Line]) 521 else S := S + format('#%d ????', [n]); 522 S := S + LineEnding; 523 end; 524 ClipBoard.AsText := S; 525end; 526 527procedure TCallStackDlg.ToggleBreakpoint(Item: TListItem); 528var 529 idx: Integer; 530 Entry: TIdeCallStackEntry; 531 BreakPoint: TIDEBreakPoint; 532 FileName: String; 533 Ctrl: Boolean; 534begin 535 Ctrl := ssCtrl in GetKeyShiftState; 536 537 try 538 DisableAllActions; 539 if (Item <> nil) and (BreakPoints <> nil) then 540 begin 541 GetSelectedCallstack.CountLimited(FViewStart + FViewLimit + 1); // get max limit 542 idx := FViewStart + Item.Index; 543 if idx >= GetSelectedCallstack.CountLimited(idx+1) then Exit; 544 Entry := GetSelectedCallstack.Entries[idx]; 545 if Entry.Line <= 0 then exit; 546 if not DebugBoss.GetFullFilename(Entry.UnitInfo, FileName, False) then 547 Exit; 548 BreakPoint := BreakPoints.Find(FileName, Entry.Line); 549 if BreakPoint <> nil then begin 550 if Ctrl 551 then BreakPoint.Enabled := not BreakPoint.Enabled 552 else DebugBoss.DoDeleteBreakPoint(BreakPoint.Source, BreakPoint.Line) 553 end else begin 554 DebugBoss.LockCommandProcessing; 555 try 556 DebugBoss.DoCreateBreakPoint(FileName, Entry.Line, False, BreakPoint); 557 if Ctrl and (BreakPoint <> nil) 558 then BreakPoint.Enabled := False; 559 finally 560 DebugBoss.UnLockCommandProcessing; 561 end; 562 end; 563 end; 564 finally 565 EnableAllActions; 566 end; 567end; 568 569procedure TCallStackDlg.DoBreakPointsChanged; 570begin 571 UpdateView; 572end; 573 574procedure TCallStackDlg.lvCallStackDBLCLICK(Sender: TObject); 575begin 576 JumpToSource; 577end; 578 579procedure TCallStackDlg.popCountClick(Sender: TObject); 580begin 581 if FViewCount = TMenuItem(Sender).Tag then Exit; 582 FViewCount := TMenuItem(Sender).Tag; 583 ViewLimit := FViewCount; 584 EnvironmentOptions.DebuggerConfig.DlgCallStackConfig.ViewCount := FViewCount; 585 actViewLimit.Caption := TMenuItem(Sender).Caption; 586end; 587 588procedure TCallStackDlg.ToolButtonPowerClick(Sender: TObject); 589begin 590 if ToolButtonPower.Down 591 then begin 592 ToolButtonPower.ImageIndex := FPowerImgIdx; 593 UpdateView; 594 end 595 else ToolButtonPower.ImageIndex := FPowerImgIdxGrey; 596end; 597 598procedure TCallStackDlg.txtGotoKeyPress(Sender: TObject; var Key: char); 599begin 600 case Key of 601 '0'..'9', #8 : ; 602 #13 : SetViewStart(StrToIntDef(txtGoto.Text, 0)); 603 else 604 Key := #0; 605 end; 606end; 607 608procedure TCallStackDlg.actCopyAllClick(Sender: TObject); 609begin 610 CopyToClipBoard; 611end; 612 613procedure TCallStackDlg.actSetAsCurrentClick(Sender : TObject); 614var 615 Entry: TIdeCallStackEntry; 616begin 617 try 618 DisableAllActions; 619 Entry := GetCurrentEntry; 620 if Entry = nil then Exit; 621 622 GetSelectedCallstack.ChangeCurrentIndex(Entry.Index); 623 if GetSelectedSnapshot <> nil 624 then CallStackMonitor.NotifyCurrent; // TODO: move to snapshot callstack object 625 finally 626 EnableAllActions; 627 end; 628end; 629 630procedure TCallStackDlg.actShowClick(Sender: TObject); 631begin 632 JumpToSource; 633end; 634 635procedure TCallStackDlg.actViewBottomExecute(Sender: TObject); 636begin 637 try 638 DisableAllActions; 639 if GetSelectedCallstack <> nil 640 then SetViewStart(GetSelectedCallstack.Count - FViewLimit) 641 else SetViewStart(0); 642 finally 643 EnableAllActions; 644 end; 645end; 646 647procedure TCallStackDlg.actToggleBreakPointExecute(Sender: TObject); 648begin 649 ToggleBreakpoint(lvCallStack.Selected); 650end; 651 652procedure TCallStackDlg.actShowDisassExecute(Sender: TObject); 653var 654 Entry: TIdeCallStackEntry; 655begin 656 Entry := GetCurrentEntry; 657 if (Entry = nil) or (Entry.Address = 0) then Exit; 658 DebugBoss.ViewDisassembler(Entry.Address); 659end; 660 661procedure TCallStackDlg.actViewGotoExecute(Sender: TObject); 662begin 663 try 664 DisableAllActions; 665 SetViewStart(StrToIntDef(txtGoto.Text, 0)); 666 finally 667 EnableAllActions; 668 end; 669end; 670 671procedure TCallStackDlg.actViewMoreExecute(Sender: TObject); 672begin 673 try 674 DisableAllActions; 675 ToolButtonPower.Down := True; 676 ToolButtonPowerClick(nil); 677 ViewLimit := ViewLimit + FViewCount; 678 finally 679 EnableAllActions; 680 end; 681end; 682 683procedure TCallStackDlg.actViewTopExecute(Sender: TObject); 684begin 685 try 686 DisableAllActions; 687 ToolButtonPower.Down := True; 688 ToolButtonPowerClick(nil); 689 SetViewStart(0); 690 finally 691 EnableAllActions; 692 end; 693end; 694 695procedure TCallStackDlg.BreakPointChanged(const ASender: TIDEBreakPoints; 696 const ABreakpoint: TIDEBreakPoint); 697var 698 i, idx: Integer; 699 Entry: TIdeCallStackEntry; 700 Stack: TIdeCallStack; 701begin 702 DebugLn(DBG_DATA_MONITORS, ['DebugDataWindow: TCallStackDlg.BreakPointChanged ', DbgSName(ASender), ' Upd:', IsUpdating]); 703 Stack := GetSelectedCallstack; 704 if (BreakPoints = nil) or (Stack = nil) then 705 Exit; 706 707 Stack.CountLimited(FViewStart + FViewLimit + 1); 708 for i := 0 to lvCallStack.Items.Count - 1 do 709 begin 710 idx := FViewStart + lvCallStack.Items[i].Index; 711 if idx >= Stack.CountLimited(idx+1) then 712 Continue; 713 Entry := Stack.Entries[idx]; 714 if Entry <> nil then 715 lvCallStack.Items[i].ImageIndex := GetImageIndex(Entry) 716 else 717 lvCallStack.Items[i].ImageIndex := imgNoSourceLine; 718 end; 719end; 720 721procedure TCallStackDlg.FormCreate(Sender: TObject); 722var 723 i: integer; 724 curPopLimit: TMenuItem; 725begin 726 Caption := lisMenuViewCallStack; 727 ToolButtonPower.Caption := lisDbgWinPower; 728 ToolButtonPower.Hint := lisDbgWinPowerHint; 729 for i:= 0 to mnuLimit.Items.Count-1 do 730 mnuLimit.Items[i].Caption:= Format(lisMaxS, [mnuLimit.Items[i].Tag]); 731 actViewMore.Caption := lisMore; 732 actViewTop.Caption := lisCSTop; 733 actViewBottom.Caption := lisCSBottom; 734 actViewGoto.Caption := lisGotoSelected; 735 actShow.Caption := lisViewSource; 736 actShowDisass.Caption := lisViewSourceDisass; 737 actToggleBreakPoint.Caption := uemToggleBreakpoint; 738 actSetCurrent.Caption := lisCurrent; 739 actCopyAll.Caption := lisCopyAll; 740 741 FViewCount := EnvironmentOptions.DebuggerConfig.DlgCallStackConfig.ViewCount; 742 curPopLimit := nil; 743 for i := 0 to mnuLimit.Items.Count-1 do 744 if mnuLimit.Items[i].Tag = FViewCount then 745 begin 746 curPopLimit := mnuLimit.Items[i]; 747 Break; 748 end; 749 if curPopLimit=nil then 750 curPopLimit := popLimit10; 751 FViewCount := curPopLimit.Tag; 752 FViewLimit := FViewCount; 753 FViewStart := 0; 754 FInUpdateView := False; 755 actViewLimit.Caption := curPopLimit.Caption; 756 ToolButtonMax.Caption := actViewLimit.Caption; 757 758 lvCallStack.Columns[1].Caption:= lisIndex; 759 lvCallStack.Columns[2].Caption:= histdlgColumnLoc; 760 lvCallStack.Columns[3].Caption:= dlgAddHiAttrGroupLine; 761 lvCallStack.Columns[4].Caption:= lisFunction; 762 763 ToolBar1.Images := IDEImages.Images_16; 764 ToolButtonShow.ImageIndex := IDEImages.LoadImage('callstack_show'); 765 ToolButtonMore.ImageIndex := IDEImages.LoadImage('callstack_more'); 766 ToolButtonTop.ImageIndex := IDEImages.LoadImage('callstack_top'); 767 ToolButtonBottom.ImageIndex := IDEImages.LoadImage('callstack_bottom'); 768 ToolButtonGoto.ImageIndex := IDEImages.LoadImage('callstack_goto'); 769 ToolButtonCopyAll.ImageIndex := IDEImages.LoadImage('laz_copy'); 770 FPowerImgIdx := IDEImages.LoadImage('debugger_power'); 771 FPowerImgIdxGrey := IDEImages.LoadImage('debugger_power_grey'); 772 ToolButtonPower.ImageIndex := FPowerImgIdx; 773 774 lvCallStack.SmallImages := IDEImages.Images_16; 775 imgSourceLine := IDEImages.LoadImage('debugger_source_line'); 776 imgNoSourceLine := IDEImages.LoadImage('debugger_nosource_line'); 777 778end; 779 780procedure TCallStackDlg.lvCallStackClick(Sender: TObject); 781var 782 P: TPoint; 783 Item: TListItem; 784begin 785 // toggle breakpoint 786 P := lvCallStack.ScreenToClient(Mouse.CursorPos); 787 Item := lvCallStack.GetItemAt(P.X, P.Y); 788 // if clicked on the first column of a valid item 789 if (Item <> nil) and (P.X <= lvCallStack.Column[0].Width) then 790 ToggleBreakPoint(Item); 791end; 792 793procedure TCallStackDlg.actViewLimitExecute(Sender: TObject); 794begin 795 try 796 DisableAllActions; 797 ToolButtonPower.Down := True; 798 ToolButtonPowerClick(nil); 799 ViewLimit := FViewCount; 800 finally 801 EnableAllActions; 802 end; 803end; 804 805procedure TCallStackDlg.SetViewStart(AStart: Integer); 806begin 807 if GetSelectedCallstack = nil then Exit; 808 ToolButtonPower.Down := True; 809 ToolButtonPowerClick(nil); 810 811 if (AStart > GetSelectedCallstack.CountLimited(AStart+FViewLimit+1) - FViewLimit) 812 then AStart := GetSelectedCallstack.Count - FViewLimit; 813 if AStart < 0 then AStart := 0; 814 if FViewStart = AStart then Exit; 815 816 FViewStart:= AStart; 817 txtGoto.Text:= IntToStr(AStart); 818 UpdateView; 819end; 820 821procedure TCallStackDlg.SetViewMax; 822begin 823// If GetSelectedCallstack = nil 824// then lblViewCnt.Caption:= '0' 825// else lblViewCnt.Caption:= IntToStr(GetSelectedCallstack.Count); 826end; 827 828procedure TCallStackDlg.SetViewLimit(const AValue: Integer); 829begin 830 ToolButtonPower.Down := True; 831 ToolButtonPowerClick(nil); 832 if FViewLimit = AValue then Exit; 833 if (GetSelectedCallstack <> nil) 834 and (FViewStart + FViewLimit >= GetSelectedCallstack.CountLimited(FViewStart + FViewLimit+1)) 835 and (AValue > FViewLimit) 836 then begin 837 FViewStart := GetSelectedCallstack.Count - AValue; 838 if FViewStart < 0 then FViewStart := 0; 839 end; 840 FViewLimit := AValue; 841 UpdateView; 842end; 843 844function TCallStackDlg.GetFunction(const Entry: TIdeCallStackEntry): string; 845begin 846 Result := Entry.GetFunctionWithArg; 847end; 848 849procedure TCallStackDlg.GotoIndex(AIndex: Integer); 850begin 851 if AIndex < 0 then Exit; 852 if AIndex >= GetSelectedCallstack.CountLimited(AIndex+1) then Exit; 853 854 855end; 856 857initialization 858 859 CallStackDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtCallStack]); 860 CallStackDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog; 861 CallStackDlgWindowCreator.OnSetDividerSize := @CallStackDlgColSizeSetter; 862 CallStackDlgWindowCreator.OnGetDividerSize := @CallStackDlgColSizeGetter; 863 CallStackDlgWindowCreator.DividerTemplate.Add('ColumnCStackBrkPoint', COL_STACK_BRKPOINT, @drsColWidthBrkPointImg); 864 CallStackDlgWindowCreator.DividerTemplate.Add('ColumnCStackIndex', COL_STACK_INDEX, @drsColWidthIndex); 865 CallStackDlgWindowCreator.DividerTemplate.Add('ColumnCStackSource', COL_STACK_SOURCE, @drsColWidthSource); 866 CallStackDlgWindowCreator.DividerTemplate.Add('ColumnCStackLine', COL_STACK_LINE, @drsColWidthLine); 867 CallStackDlgWindowCreator.DividerTemplate.Add('ColumnCStackFunc', COL_STACK_FUNC, @drsColWidthFunc); 868 CallStackDlgWindowCreator.CreateSimpleLayout; 869 870 DBG_DATA_MONITORS := DebugLogger.FindOrRegisterLogGroup('DBG_DATA_MONITORS' {$IFDEF DBG_DATA_MONITORS} , True {$ENDIF} ); 871 872end. 873 874