PageRenderTime 128ms CodeModel.GetById 21ms app.highlight 99ms RepoModel.GetById 1ms app.codeStats 0ms

/debugger/callstackdlg.pp

http://github.com/graemeg/lazarus
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