mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-02 03:19:36 +01:00
* implemented limited callstackview based on patch from Martin Friebe
git-svn-id: trunk@13896 -
This commit is contained in:
marc
parent
5d986dae61
commit
7183882ba2
@ -1,23 +1,28 @@
|
||||
inherited CallStackDlg: TCallStackDlg
|
||||
Left = 553
|
||||
Height = 200
|
||||
Top = 318
|
||||
Width = 567
|
||||
HorzScrollBar.Page = 566
|
||||
VertScrollBar.Page = 199
|
||||
Left = 424
|
||||
Height = 246
|
||||
Top = 241
|
||||
Width = 562
|
||||
HorzScrollBar.Page = 561
|
||||
VertScrollBar.Page = 245
|
||||
ActiveControl = lvCallStack
|
||||
Caption = 'CallStack'
|
||||
ClientHeight = 200
|
||||
ClientWidth = 567
|
||||
ClientHeight = 246
|
||||
ClientWidth = 562
|
||||
Visible = True
|
||||
object lvCallStack: TListView
|
||||
Height = 200
|
||||
Width = 567
|
||||
Height = 204
|
||||
Top = 42
|
||||
Width = 562
|
||||
Align = alClient
|
||||
Columns = <
|
||||
item
|
||||
Width = 20
|
||||
end
|
||||
item
|
||||
Caption = 'Index'
|
||||
Width = 35
|
||||
end
|
||||
item
|
||||
Caption = 'Source'
|
||||
Width = 150
|
||||
@ -35,25 +40,174 @@ inherited CallStackDlg: TCallStackDlg
|
||||
ViewStyle = vsReport
|
||||
OnDblClick = lvCallStackDBLCLICK
|
||||
end
|
||||
object ToolBar1: TToolBar
|
||||
Height = 42
|
||||
Width = 562
|
||||
ButtonHeight = 40
|
||||
ButtonWidth = 50
|
||||
Caption = 'tbButtons'
|
||||
EdgeBorders = []
|
||||
Flat = True
|
||||
ShowCaptions = True
|
||||
TabOrder = 1
|
||||
object ToolButton1: TToolButton
|
||||
Left = 1
|
||||
Action = actShow
|
||||
end
|
||||
object ToolButton2: TToolButton
|
||||
Left = 51
|
||||
Action = actSetCurrent
|
||||
end
|
||||
object ToolButton4: TToolButton
|
||||
Left = 101
|
||||
Width = 3
|
||||
Caption = 'ToolButton4'
|
||||
Style = tbsSeparator
|
||||
end
|
||||
object ToolButton5: TToolButton
|
||||
Left = 166
|
||||
Action = actViewMore
|
||||
end
|
||||
object ToolButton6: TToolButton
|
||||
Left = 104
|
||||
Action = actViewLimit
|
||||
Caption = 'Max 10'
|
||||
DropdownMenu = mnuLimit
|
||||
Style = tbsDropDown
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 319
|
||||
Height = 40
|
||||
Width = 50
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 40
|
||||
ClientWidth = 50
|
||||
TabOrder = 5
|
||||
object txtGoto: TEdit
|
||||
Left = 2
|
||||
Height = 22
|
||||
Top = 8
|
||||
Width = 46
|
||||
OnKeyPress = txtGotoKeyPress
|
||||
TabOrder = 0
|
||||
Text = '0'
|
||||
end
|
||||
end
|
||||
object ToolButton7: TToolButton
|
||||
Left = 369
|
||||
Action = actViewGoto
|
||||
end
|
||||
object ToolButton3: TToolButton
|
||||
Left = 422
|
||||
Action = actCopyAll
|
||||
end
|
||||
object ToolButton8: TToolButton
|
||||
Left = 419
|
||||
Width = 3
|
||||
Caption = 'ToolButton8'
|
||||
Style = tbsSeparator
|
||||
end
|
||||
object ToolButton9: TToolButton
|
||||
Left = 216
|
||||
Width = 3
|
||||
Caption = 'ToolButton9'
|
||||
Style = tbsSeparator
|
||||
end
|
||||
object ToolButton10: TToolButton
|
||||
Left = 219
|
||||
Action = actViewTop
|
||||
end
|
||||
object ToolButton11: TToolButton
|
||||
Left = 269
|
||||
Action = actViewBottom
|
||||
end
|
||||
end
|
||||
object mnuPopup: TPopupMenu
|
||||
left = 66
|
||||
top = 88
|
||||
object popShow: TMenuItem
|
||||
Caption = 'Show'
|
||||
Action = actShow
|
||||
Default = True
|
||||
OnClick = popShowClick
|
||||
OnClick = actShowClick
|
||||
end
|
||||
object N1: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object popSetAsCurrent: TMenuItem
|
||||
Caption = 'Set as current'
|
||||
OnClick = popSetAsCurrentClick
|
||||
Action = actSetCurrent
|
||||
OnClick = actSetAsCurrentClick
|
||||
end
|
||||
object popCopyAll: TMenuItem
|
||||
Caption = 'Copy all'
|
||||
ShortCut = 16451
|
||||
OnClick = popCopyAllClick
|
||||
Action = actCopyAll
|
||||
OnClick = actCopyAllClick
|
||||
end
|
||||
end
|
||||
object aclActions: TActionList
|
||||
left = 128
|
||||
top = 104
|
||||
object actShow: TAction
|
||||
Caption = 'Show'
|
||||
DisableIfNoHandler = True
|
||||
OnExecute = actShowClick
|
||||
end
|
||||
object actSetCurrent: TAction
|
||||
Caption = 'Current'
|
||||
DisableIfNoHandler = True
|
||||
OnExecute = actSetAsCurrentClick
|
||||
end
|
||||
object actCopyAll: TAction
|
||||
Caption = 'Copy All'
|
||||
DisableIfNoHandler = True
|
||||
OnExecute = actCopyAllClick
|
||||
end
|
||||
object actViewMore: TAction
|
||||
Category = 'View'
|
||||
Caption = 'More'
|
||||
DisableIfNoHandler = True
|
||||
OnExecute = actViewMoreExecute
|
||||
end
|
||||
object actViewGoto: TAction
|
||||
Category = 'View'
|
||||
Caption = 'Goto'
|
||||
DisableIfNoHandler = True
|
||||
OnExecute = actViewGotoExecute
|
||||
end
|
||||
object actViewLimit: TAction
|
||||
Category = 'View'
|
||||
Caption = '10'
|
||||
DisableIfNoHandler = True
|
||||
OnExecute = actViewLimitExecute
|
||||
end
|
||||
object actViewTop: TAction
|
||||
Category = 'View'
|
||||
Caption = 'Top'
|
||||
DisableIfNoHandler = True
|
||||
OnExecute = actViewTopExecute
|
||||
end
|
||||
object actViewBottom: TAction
|
||||
Category = 'View'
|
||||
Caption = 'Bottom'
|
||||
DisableIfNoHandler = True
|
||||
OnExecute = actViewBottomExecute
|
||||
end
|
||||
end
|
||||
object mnuLimit: TPopupMenu
|
||||
left = 192
|
||||
top = 112
|
||||
object popLimit10: TMenuItem
|
||||
Tag = 10
|
||||
Caption = 'Max 10'
|
||||
OnClick = popCountClick
|
||||
end
|
||||
object popLimit25: TMenuItem
|
||||
Tag = 25
|
||||
Caption = 'Max 25'
|
||||
OnClick = popCountClick
|
||||
end
|
||||
object popLimit50: TMenuItem
|
||||
Tag = 50
|
||||
Caption = 'Max 50'
|
||||
OnClick = popCountClick
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
@ -1,19 +1,59 @@
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TCallStackDlg','FORMDATA',[
|
||||
'TPF0'#241#13'TCallStackDlg'#12'CallStackDlg'#4'Left'#3')'#2#6'Height'#3#200#0
|
||||
+#3'Top'#3'>'#1#5'Width'#3'7'#2#18'HorzScrollBar.Page'#3'6'#2#18'VertScrollBa'
|
||||
+'r.Page'#3#199#0#13'ActiveControl'#7#11'lvCallStack'#7'Caption'#6#9'CallStac'
|
||||
+'k'#12'ClientHeight'#3#200#0#11'ClientWidth'#3'7'#2#7'Visible'#9#0#9'TListVi'
|
||||
+'ew'#11'lvCallStack'#6'Height'#3#200#0#5'Width'#3'7'#2#5'Align'#7#8'alClient'
|
||||
+#7'Columns'#14#1#5'Width'#2#20#0#1#7'Caption'#6#6'Source'#5'Width'#3#150#0#0
|
||||
+#1#7'Caption'#6#4'Line'#0#1#7'Caption'#6#8'Function'#5'Width'#3'"'#1#0#0#9'P'
|
||||
+'opupMenu'#7#8'mnuPopup'#9'RowSelect'#9#8'TabOrder'#2#0#9'ViewStyle'#7#8'vsR'
|
||||
+'eport'#10'OnDblClick'#7#19'lvCallStackDBLCLICK'#0#0#10'TPopupMenu'#8'mnuPop'
|
||||
+'up'#4'left'#2'B'#3'top'#2'X'#0#9'TMenuItem'#7'popShow'#7'Caption'#6#4'Show'
|
||||
+#7'Default'#9#7'OnClick'#7#12'popShowClick'#0#0#9'TMenuItem'#2'N1'#7'Caption'
|
||||
+#6#1'-'#0#0#9'TMenuItem'#15'popSetAsCurrent'#7'Caption'#6#14'Set as current'
|
||||
+#7'OnClick'#7#20'popSetAsCurrentClick'#0#0#9'TMenuItem'#10'popCopyAll'#7'Cap'
|
||||
+'tion'#6#8'Copy all'#8'ShortCut'#3'C@'#7'OnClick'#7#15'popCopyAllClick'#0#0#0
|
||||
+#0
|
||||
'TPF0'#241#13'TCallStackDlg'#12'CallStackDlg'#4'Left'#3#168#1#6'Height'#3#246
|
||||
+#0#3'Top'#3#241#0#5'Width'#3'2'#2#18'HorzScrollBar.Page'#3'1'#2#18'VertScrol'
|
||||
+'lBar.Page'#3#245#0#13'ActiveControl'#7#11'lvCallStack'#7'Caption'#6#9'CallS'
|
||||
+'tack'#12'ClientHeight'#3#246#0#11'ClientWidth'#3'2'#2#7'Visible'#9#0#9'TLis'
|
||||
+'tView'#11'lvCallStack'#6'Height'#3#204#0#3'Top'#2'*'#5'Width'#3'2'#2#5'Alig'
|
||||
+'n'#7#8'alClient'#7'Columns'#14#1#5'Width'#2#20#0#1#7'Caption'#6#5'Index'#5
|
||||
+'Width'#2'#'#0#1#7'Caption'#6#6'Source'#5'Width'#3#150#0#0#1#7'Caption'#6#4
|
||||
+'Line'#0#1#7'Caption'#6#8'Function'#5'Width'#3'"'#1#0#0#9'PopupMenu'#7#8'mnu'
|
||||
+'Popup'#9'RowSelect'#9#8'TabOrder'#2#0#9'ViewStyle'#7#8'vsReport'#10'OnDblCl'
|
||||
+'ick'#7#19'lvCallStackDBLCLICK'#0#0#8'TToolBar'#8'ToolBar1'#6'Height'#2'*'#5
|
||||
+'Width'#3'2'#2#12'ButtonHeight'#2'('#11'ButtonWidth'#2'2'#7'Caption'#6#9'tbB'
|
||||
+'uttons'#11'EdgeBorders'#11#0#4'Flat'#9#12'ShowCaptions'#9#8'TabOrder'#2#1#0
|
||||
+#11'TToolButton'#11'ToolButton1'#4'Left'#2#1#6'Action'#7#7'actShow'#0#0#11'T'
|
||||
+'ToolButton'#11'ToolButton2'#4'Left'#2'3'#6'Action'#7#13'actSetCurrent'#0#0
|
||||
+#11'TToolButton'#11'ToolButton4'#4'Left'#2'e'#5'Width'#2#3#7'Caption'#6#11'T'
|
||||
+'oolButton4'#5'Style'#7#12'tbsSeparator'#0#0#11'TToolButton'#11'ToolButton5'
|
||||
+#4'Left'#3#166#0#6'Action'#7#11'actViewMore'#0#0#11'TToolButton'#11'ToolButt'
|
||||
+'on6'#4'Left'#2'h'#6'Action'#7#12'actViewLimit'#7'Caption'#6#6'Max 10'#12'Dr'
|
||||
+'opdownMenu'#7#8'mnuLimit'#5'Style'#7#11'tbsDropDown'#0#0#6'TPanel'#6'Panel1'
|
||||
+#4'Left'#3'?'#1#6'Height'#2'('#5'Width'#2'2'#10'BevelOuter'#7#6'bvNone'#12'C'
|
||||
+'lientHeight'#2'('#11'ClientWidth'#2'2'#8'TabOrder'#2#5#0#5'TEdit'#7'txtGoto'
|
||||
+#4'Left'#2#2#6'Height'#2#22#3'Top'#2#8#5'Width'#2'.'#10'OnKeyPress'#7#15'txt'
|
||||
+'GotoKeyPress'#8'TabOrder'#2#0#4'Text'#6#1'0'#0#0#0#11'TToolButton'#11'ToolB'
|
||||
+'utton7'#4'Left'#3'q'#1#6'Action'#7#11'actViewGoto'#0#0#11'TToolButton'#11'T'
|
||||
+'oolButton3'#4'Left'#3#166#1#6'Action'#7#10'actCopyAll'#0#0#11'TToolButton'
|
||||
+#11'ToolButton8'#4'Left'#3#163#1#5'Width'#2#3#7'Caption'#6#11'ToolButton8'#5
|
||||
+'Style'#7#12'tbsSeparator'#0#0#11'TToolButton'#11'ToolButton9'#4'Left'#3#216
|
||||
+#0#5'Width'#2#3#7'Caption'#6#11'ToolButton9'#5'Style'#7#12'tbsSeparator'#0#0
|
||||
+#11'TToolButton'#12'ToolButton10'#4'Left'#3#219#0#6'Action'#7#10'actViewTop'
|
||||
+#0#0#11'TToolButton'#12'ToolButton11'#4'Left'#3#13#1#6'Action'#7#13'actViewB'
|
||||
+'ottom'#0#0#0#10'TPopupMenu'#8'mnuPopup'#4'left'#2'B'#3'top'#2'X'#0#9'TMenuI'
|
||||
+'tem'#7'popShow'#6'Action'#7#7'actShow'#7'Default'#9#7'OnClick'#7#12'actShow'
|
||||
+'Click'#0#0#9'TMenuItem'#2'N1'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#15'popSetA'
|
||||
+'sCurrent'#6'Action'#7#13'actSetCurrent'#7'OnClick'#7#20'actSetAsCurrentClic'
|
||||
+'k'#0#0#9'TMenuItem'#10'popCopyAll'#6'Action'#7#10'actCopyAll'#7'OnClick'#7
|
||||
+#15'actCopyAllClick'#0#0#0#11'TActionList'#10'aclActions'#4'left'#3#128#0#3
|
||||
+'top'#2'h'#0#7'TAction'#7'actShow'#7'Caption'#6#4'Show'#18'DisableIfNoHandle'
|
||||
+'r'#9#9'OnExecute'#7#12'actShowClick'#0#0#7'TAction'#13'actSetCurrent'#7'Cap'
|
||||
+'tion'#6#7'Current'#18'DisableIfNoHandler'#9#9'OnExecute'#7#20'actSetAsCurre'
|
||||
+'ntClick'#0#0#7'TAction'#10'actCopyAll'#7'Caption'#6#8'Copy All'#18'DisableI'
|
||||
+'fNoHandler'#9#9'OnExecute'#7#15'actCopyAllClick'#0#0#7'TAction'#11'actViewM'
|
||||
+'ore'#8'Category'#6#4'View'#7'Caption'#6#4'More'#18'DisableIfNoHandler'#9#9
|
||||
+'OnExecute'#7#18'actViewMoreExecute'#0#0#7'TAction'#11'actViewGoto'#8'Catego'
|
||||
+'ry'#6#4'View'#7'Caption'#6#4'Goto'#18'DisableIfNoHandler'#9#9'OnExecute'#7
|
||||
+#18'actViewGotoExecute'#0#0#7'TAction'#12'actViewLimit'#8'Category'#6#4'View'
|
||||
+#7'Caption'#6#2'10'#18'DisableIfNoHandler'#9#9'OnExecute'#7#19'actViewLimitE'
|
||||
+'xecute'#0#0#7'TAction'#10'actViewTop'#8'Category'#6#4'View'#7'Caption'#6#3
|
||||
+'Top'#18'DisableIfNoHandler'#9#9'OnExecute'#7#17'actViewTopExecute'#0#0#7'TA'
|
||||
+'ction'#13'actViewBottom'#8'Category'#6#4'View'#7'Caption'#6#6'Bottom'#18'Di'
|
||||
+'sableIfNoHandler'#9#9'OnExecute'#7#20'actViewBottomExecute'#0#0#0#10'TPopup'
|
||||
+'Menu'#8'mnuLimit'#4'left'#3#192#0#3'top'#2'p'#0#9'TMenuItem'#10'popLimit10'
|
||||
+#3'Tag'#2#10#7'Caption'#6#6'Max 10'#7'OnClick'#7#13'popCountClick'#0#0#9'TMe'
|
||||
+'nuItem'#10'popLimit25'#3'Tag'#2#25#7'Caption'#6#6'Max 25'#7'OnClick'#7#13'p'
|
||||
+'opCountClick'#0#0#9'TMenuItem'#10'popLimit50'#3'Tag'#2'2'#7'Caption'#6#6'Ma'
|
||||
+'x 50'#7'OnClick'#7#13'popCountClick'#0#0#0#0
|
||||
]);
|
||||
|
||||
@ -37,29 +37,74 @@ interface
|
||||
|
||||
uses
|
||||
LResources, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||
ComCtrls, Debugger, DebuggerDlg, Menus, ClipBrd;
|
||||
ComCtrls, Debugger, DebuggerDlg, Menus, ClipBrd, ExtCtrls, StdCtrls, Spin,
|
||||
ActnList;
|
||||
|
||||
type
|
||||
|
||||
{ TCallStackDlg }
|
||||
|
||||
TCallStackDlg = class(TDebuggerDlg)
|
||||
aclActions: TActionList;
|
||||
actCopyAll: TAction;
|
||||
actViewBottom: TAction;
|
||||
actViewTop: TAction;
|
||||
actViewLimit: TAction;
|
||||
actViewGoto: TAction;
|
||||
actViewMore: TAction;
|
||||
actSetCurrent: TAction;
|
||||
actShow: TAction;
|
||||
ToolButton10: TToolButton;
|
||||
ToolButton11: TToolButton;
|
||||
ToolButton3: TToolButton;
|
||||
ToolButton8: TToolButton;
|
||||
ToolButton9: TToolButton;
|
||||
txtGoto: TEdit;
|
||||
lvCallStack: TListView;
|
||||
Panel1: TPanel;
|
||||
popLimit50: TMenuItem;
|
||||
popLimit25: TMenuItem;
|
||||
popLimit10: TMenuItem;
|
||||
popCopyAll: TMenuItem;
|
||||
N1: TMenuItem;
|
||||
popSetAsCurrent: TMenuItem;
|
||||
popShow: TMenuItem;
|
||||
mnuPopup: TPopupMenu;
|
||||
mnuLimit: TPopupMenu;
|
||||
ToolBar1: TToolBar;
|
||||
ToolButton1: TToolButton;
|
||||
ToolButton2: TToolButton;
|
||||
ToolButton4: TToolButton;
|
||||
ToolButton5: TToolButton;
|
||||
ToolButton6: TToolButton;
|
||||
ToolButton7: TToolButton;
|
||||
procedure actViewBottomExecute(Sender: TObject);
|
||||
procedure actViewGotoExecute(Sender: TObject);
|
||||
procedure actViewMoreExecute(Sender: TObject);
|
||||
procedure actViewLimitExecute(Sender: TObject);
|
||||
procedure actViewTopExecute(Sender: TObject);
|
||||
procedure popCountClick(Sender: TObject);
|
||||
procedure txtGotoKeyPress(Sender: TObject; var Key: char);
|
||||
procedure lvCallStackDBLCLICK(Sender: TObject);
|
||||
procedure popCopyAllClick(Sender: TObject);
|
||||
procedure popSetAsCurrentClick(Sender : TObject);
|
||||
procedure popShowClick(Sender: TObject);
|
||||
procedure actCopyAllClick(Sender: TObject);
|
||||
procedure actSetAsCurrentClick(Sender : TObject);
|
||||
procedure actShowClick(Sender: TObject);
|
||||
private
|
||||
FCallStack: TIDECallStack;
|
||||
FCallStackNotification: TIDECallStackNotification;
|
||||
FViewCount: Integer;
|
||||
FViewLimit: Integer;
|
||||
FViewStart: Integer;
|
||||
procedure SetViewLimit(const AValue: Integer);
|
||||
procedure SetViewStart(AStart: Integer);
|
||||
procedure SetViewMax;
|
||||
procedure CallStackChanged(Sender: TObject);
|
||||
procedure CallStackCurrent(Sender: TObject);
|
||||
procedure GotoIndex(AIndex: Integer);
|
||||
function GetCurrentEntry: TCallStackEntry;
|
||||
function GetFunction(const Entry: TCallStackEntry): string;
|
||||
procedure SetCallStack(const AValue: TIDECallStack);
|
||||
function GetFunction(const Entry: TCallStackEntry): string;
|
||||
procedure UpdateView;
|
||||
procedure JumpToSource;
|
||||
procedure CopyToClipBoard;
|
||||
protected
|
||||
@ -70,11 +115,14 @@ type
|
||||
destructor Destroy; override;
|
||||
|
||||
property CallStack: TIDECallStack read FCallStack write SetCallStack;
|
||||
property ViewLimit: Integer read FViewLimit write SetViewLimit;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
uses BaseDebugManager;
|
||||
|
||||
uses
|
||||
BaseDebugManager;
|
||||
|
||||
{ TCallStackDlg }
|
||||
|
||||
@ -84,46 +132,72 @@ begin
|
||||
FCallStackNotification := TIDECallStackNotification.Create;
|
||||
FCallStackNotification.AddReference;
|
||||
FCallStackNotification.OnChange := @CallStackChanged;
|
||||
FCallStackNotification.OnCurrent := @CallStackCurrent;
|
||||
FViewLimit := 10;
|
||||
FViewCount := 10;
|
||||
FViewStart := 0;
|
||||
actViewLimit.Caption := popLimit10.Caption;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.CallStackChanged(Sender: TObject);
|
||||
begin
|
||||
if FViewStart = 0
|
||||
then UpdateView
|
||||
else SetViewStart(0);
|
||||
SetViewMax;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.CallStackCurrent(Sender: TObject);
|
||||
begin
|
||||
UpdateView;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.UpdateView;
|
||||
var
|
||||
n: Integer;
|
||||
Item: TListItem;
|
||||
Entry: TCallStackEntry;
|
||||
begin
|
||||
First, Last : Integer;
|
||||
begin
|
||||
BeginUpdate;
|
||||
try
|
||||
if CallStack = nil
|
||||
if (CallStack = nil) or (CallStack.Count=0)
|
||||
then begin
|
||||
txtGoto.Text:= '0';
|
||||
lvCallStack.Items.Clear;
|
||||
exit;
|
||||
end;
|
||||
|
||||
First:= FViewStart;
|
||||
Last := First + FViewLimit;
|
||||
if Last > CallStack.Count - 1 then Last := CallStack.Count-1;
|
||||
|
||||
// Reuse entries, so add and remove only
|
||||
// Remove unneded
|
||||
for n := lvCallStack.Items.Count - 1 downto CallStack.Count do
|
||||
for n := lvCallStack.Items.Count - 1 downto Last - First + 1 do
|
||||
lvCallStack.Items.Delete(n);
|
||||
|
||||
// Add needed
|
||||
for n := lvCallStack.Items.Count to CallStack.Count - 1 do
|
||||
for n := lvCallStack.Items.Count to Last - First do
|
||||
begin
|
||||
Item := lvCallStack.Items.Add;
|
||||
Item.SubItems.Add('');
|
||||
Item.SubItems.Add('');
|
||||
Item.SubItems.Add('');
|
||||
Item.SubItems.Add('');
|
||||
end;
|
||||
|
||||
for n := 0 to lvCallStack.Items.Count - 1 do
|
||||
for n := 0 to Last - First do
|
||||
begin
|
||||
Item := lvCallStack.Items[n];
|
||||
Entry := CallStack.Entries[n];
|
||||
Entry := CallStack.Entries[First + n];
|
||||
if Entry.Current
|
||||
then Item.Caption := '>'
|
||||
else Item.Caption := ' ';
|
||||
Item.SubItems[0] := Entry.Source;
|
||||
Item.SubItems[1] := IntToStr(Entry.Line);
|
||||
Item.SubItems[2] := GetFunction(Entry);
|
||||
Item.SubItems[0] := IntToStr(Entry.Index);
|
||||
Item.SubItems[1] := Entry.Source;
|
||||
Item.SubItems[2] := IntToStr(Entry.Line);
|
||||
Item.SubItems[3] := GetFunction(Entry);
|
||||
end;
|
||||
|
||||
finally
|
||||
@ -148,20 +222,33 @@ begin
|
||||
lvCallStack.EndUpdate;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.JumpToSource;
|
||||
function TCallStackDlg.GetCurrentEntry: TCallStackEntry;
|
||||
var
|
||||
CurItem: TListItem;
|
||||
idx: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
if Callstack = nil then Exit;
|
||||
|
||||
CurItem := lvCallStack.Selected;
|
||||
if CurItem = nil then Exit;
|
||||
|
||||
idx := FViewStart + CurItem.Index;
|
||||
if idx >= CallStack.Count then Exit;
|
||||
|
||||
Result := CallStack.Entries[idx];
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.JumpToSource;
|
||||
var
|
||||
Entry: TCallStackEntry;
|
||||
Filename: String;
|
||||
begin
|
||||
CurItem:=lvCallStack.Selected;
|
||||
if CurItem = nil then exit;
|
||||
if CurItem.Index >= CallStack.Count then Exit;
|
||||
|
||||
Entry := CallStack.Entries[CurItem.Index];
|
||||
Entry := GetCurrentEntry;
|
||||
if Entry = nil then Exit;
|
||||
|
||||
Filename := Entry.Source;
|
||||
if DoGetFullDebugFilename(Filename,true) <> mrOk then exit;
|
||||
if DoGetFullDebugFilename(Filename, true) <> mrOk then exit;
|
||||
|
||||
DoJumpToCodePos(Filename, Entry.Line, 0);
|
||||
end;
|
||||
@ -195,21 +282,92 @@ begin
|
||||
JumpToSource;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.popCopyAllClick(Sender: TObject);
|
||||
procedure TCallStackDlg.popCountClick(Sender: TObject);
|
||||
begin
|
||||
if FViewCount = TMenuItem(Sender).Tag then Exit;
|
||||
FViewCount := TMenuItem(Sender).Tag;
|
||||
ViewLimit := FViewCount;
|
||||
actViewLimit.Caption := TMenuItem(Sender).Caption;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.txtGotoKeyPress(Sender: TObject; var Key: char);
|
||||
begin
|
||||
case Key of
|
||||
'0'..'9', #8 : ;
|
||||
#13 : SetViewStart(StrToIntDef(txtGoto.Text, 0));
|
||||
else
|
||||
Key := #0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.actCopyAllClick(Sender: TObject);
|
||||
begin
|
||||
CopyToClipBoard;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.popSetAsCurrentClick(Sender : TObject);
|
||||
procedure TCallStackDlg.actSetAsCurrentClick(Sender : TObject);
|
||||
var
|
||||
Entry: TCallStackEntry;
|
||||
begin
|
||||
CallStack.Current := CallStack.Entries[lvCallStack.Selected.Index];
|
||||
Entry := GetCurrentEntry;
|
||||
if Entry = nil then Exit;
|
||||
|
||||
CallStack.Current := Entry;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.popShowClick(Sender: TObject);
|
||||
procedure TCallStackDlg.actShowClick(Sender: TObject);
|
||||
begin
|
||||
JumpToSource;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.actViewBottomExecute(Sender: TObject);
|
||||
begin
|
||||
if CallStack <> nil
|
||||
then SetViewStart(CallStack.Count - 1 - FViewLimit)
|
||||
else SetViewStart(0);
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.actViewGotoExecute(Sender: TObject);
|
||||
begin
|
||||
SetViewStart(StrToIntDef(txtGoto.Text, 0));
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.actViewMoreExecute(Sender: TObject);
|
||||
begin
|
||||
ViewLimit := ViewLimit + FViewCount;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.actViewTopExecute(Sender: TObject);
|
||||
begin
|
||||
SetViewStart(0);
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.actViewLimitExecute(Sender: TObject);
|
||||
begin
|
||||
ViewLimit := FViewCount;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.SetViewStart(AStart: Integer);
|
||||
begin
|
||||
if CallStack = nil then Exit;
|
||||
|
||||
if (AStart > CallStack.Count - 1 - FViewLimit)
|
||||
then AStart:= CallStack.Count - 1 - FViewLimit;
|
||||
if AStart < 0 then AStart:= 0;
|
||||
if FViewStart = AStart then Exit;
|
||||
|
||||
FViewStart:= AStart;
|
||||
txtGoto.Text:= IntToStr(AStart);
|
||||
UpdateView;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.SetViewMax;
|
||||
begin
|
||||
// If CallStack = nil
|
||||
// then lblViewCnt.Caption:= '0'
|
||||
// else lblViewCnt.Caption:= IntToStr(CallStack.Count);
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.SetCallStack(const AValue: TIDECallStack);
|
||||
begin
|
||||
if FCallStack = AValue then Exit;
|
||||
@ -234,6 +392,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.SetViewLimit(const AValue: Integer);
|
||||
begin
|
||||
if FViewLimit = AValue then Exit;
|
||||
FViewLimit := AValue;
|
||||
UpdateView;
|
||||
end;
|
||||
|
||||
function TCallStackDlg.GetFunction(const Entry: TCallStackEntry): string;
|
||||
var
|
||||
S: String;
|
||||
@ -251,6 +416,14 @@ begin
|
||||
Result := Entry.FunctionName + S;
|
||||
end;
|
||||
|
||||
procedure TCallStackDlg.GotoIndex(AIndex: Integer);
|
||||
begin
|
||||
if AIndex < 0 then Exit;
|
||||
if AIndex >= FCallstack.Count then Exit;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I callstackdlg.lrs}
|
||||
|
||||
|
||||
@ -37,7 +37,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Laz_XMLCfg,
|
||||
LCLProc, IDEProcs, DBGUtils;
|
||||
LCLProc, IDEProcs, DBGUtils, maps;
|
||||
|
||||
type
|
||||
// datatype pointing to data on the target
|
||||
@ -662,7 +662,6 @@ type
|
||||
function GetArgumentValue(const AnIndex: Integer): String;
|
||||
function GetCurrent: Boolean;
|
||||
procedure SetCurrent(const AValue: Boolean);
|
||||
protected
|
||||
public
|
||||
constructor Create(const AIndex:Integer; const AnAdress: TDbgPtr;
|
||||
const AnArguments: TStrings; const AFunctionName: String;
|
||||
@ -684,40 +683,46 @@ type
|
||||
|
||||
TBaseCallStack = class(TObject)
|
||||
private
|
||||
FEntries: TList; // list of created entries
|
||||
FEntryIndex: TList; // index to created entries
|
||||
FEntries: TMap; // list of created entries
|
||||
FCount: Integer;
|
||||
function GetEntry(const AIndex: Integer): TCallStackEntry;
|
||||
function IndexError(AIndex: Integer): TCallStackEntry;
|
||||
function GetEntry(AIndex: Integer): TCallStackEntry;
|
||||
protected
|
||||
function CheckCount: Boolean; virtual;
|
||||
procedure Clear;
|
||||
function CreateStackEntry(const AIndex: Integer): TCallStackEntry; virtual;
|
||||
function CreateStackEntry(AIndex: Integer): TCallStackEntry; virtual;
|
||||
function GetCurrent: TCallStackEntry; virtual;
|
||||
function GetStackEntry(const AIndex: Integer): TCallStackEntry; virtual;
|
||||
procedure SetCurrent(const AValue: TCallStackEntry); virtual;
|
||||
procedure SetCount(const ACount: Integer); virtual;
|
||||
function GetStackEntry(AIndex: Integer): TCallStackEntry; virtual;
|
||||
procedure SetCurrent(AValue: TCallStackEntry); virtual;
|
||||
procedure SetCount(ACount: Integer); virtual;
|
||||
public
|
||||
function Count: Integer;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
property Current: TCallStackEntry read GetCurrent write SetCurrent;
|
||||
property Entries[const AIndex: Integer]: TCallStackEntry read GetEntry;
|
||||
property Entries[AIndex: Integer]: TCallStackEntry read GetEntry;
|
||||
end;
|
||||
|
||||
{ TIDECallStack }
|
||||
|
||||
{ TIDECallStackNotification }
|
||||
|
||||
TIDECallStackNotification = class(TDebuggerNotification)
|
||||
private
|
||||
FOnChange: TNotifyEvent;
|
||||
FOnCurrent: TNotifyEvent;
|
||||
public
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
property OnCurrent: TNotifyEvent read FOnCurrent write FOnCurrent;
|
||||
end;
|
||||
|
||||
{ TIDECallStack }
|
||||
|
||||
TIDECallStack = class(TBaseCallStack)
|
||||
private
|
||||
FNotificationList: TList;
|
||||
protected
|
||||
procedure NotifyChange;
|
||||
procedure NotifyCurrent;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
@ -733,7 +738,9 @@ type
|
||||
FOldState: TDBGState;
|
||||
FOnChange: TNotifyEvent;
|
||||
FOnClear: TNotifyEvent;
|
||||
FOnCurrent: TNotifyEvent;
|
||||
protected
|
||||
procedure CurrentChanged;
|
||||
procedure Changed;
|
||||
function CheckCount: Boolean; override;
|
||||
procedure DoStateChange(const AOldState: TDBGState); virtual;
|
||||
@ -743,6 +750,7 @@ type
|
||||
public
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
property OnClear: TNotifyEvent read FOnClear write FOnClear;
|
||||
property OnCurrent: TNotifyEvent read FOnCurrent write FOnCurrent;
|
||||
end;
|
||||
|
||||
(******************************************************************************)
|
||||
@ -3093,42 +3101,42 @@ end;
|
||||
|
||||
procedure TBaseCallStack.Clear;
|
||||
var
|
||||
n:Integer;
|
||||
Iterator: TMapIterator;
|
||||
begin
|
||||
for n := 0 to FEntries.Count - 1 do
|
||||
TObject(FEntries[n]).Free;
|
||||
|
||||
Iterator:= TMapIterator.Create(FEntries);
|
||||
while not Iterator.EOM do
|
||||
begin
|
||||
TObject(Iterator.DataPtr^).Free;
|
||||
Iterator.Next;
|
||||
end;
|
||||
Iterator.Free;
|
||||
FEntries.Clear;
|
||||
FEntryIndex.Clear;
|
||||
FCount := -1;
|
||||
end;
|
||||
|
||||
function TBaseCallStack.CreateStackEntry(const AIndex: Integer): TCallStackEntry;
|
||||
function TBaseCallStack.CreateStackEntry(AIndex: Integer): TCallStackEntry;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TBaseCallStack.Count: Integer;
|
||||
begin
|
||||
if (FCount = -1)
|
||||
and not CheckCount
|
||||
if (FCount = -1) and not CheckCount
|
||||
then Result := 0
|
||||
else Result := FCount;
|
||||
end;
|
||||
|
||||
constructor TBaseCallStack.Create;
|
||||
begin
|
||||
FEntries := TList.Create;
|
||||
FEntryIndex := TList.Create;
|
||||
FEntries:= TMap.Create(its4, SizeOf(TCallStackEntry));
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
destructor TBaseCallStack.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
inherited Destroy;
|
||||
FreeAndNil(FEntries);
|
||||
FreeAndNil(FEntryIndex);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TBaseCallStack.GetCurrent: TCallStackEntry;
|
||||
@ -3136,53 +3144,48 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TBaseCallStack.GetEntry(const AIndex: Integer): TCallStackEntry;
|
||||
function TBaseCallStack.GetEntry(AIndex: Integer): TCallStackEntry;
|
||||
begin
|
||||
if (AIndex < 0)
|
||||
or (AIndex >= Count)
|
||||
then raise EInvalidOperation.CreateFmt('Index out of range (%d)', [AIndex]);
|
||||
or (AIndex >= Count) then IndexError(Aindex);
|
||||
|
||||
Result := GetStackEntry(AIndex);
|
||||
end;
|
||||
|
||||
function TBaseCallStack.GetStackEntry(const AIndex: Integer): TCallStackEntry;
|
||||
var
|
||||
idx: PtrInt;
|
||||
function TBaseCallStack.GetStackEntry(AIndex: Integer): TCallStackEntry;
|
||||
begin
|
||||
idx := PtrInt(PtrUInt(FEntryIndex[AIndex]));
|
||||
if idx = -1
|
||||
then begin
|
||||
// not created yet
|
||||
Result := CreateStackEntry(AIndex);
|
||||
if Result = nil then Exit;
|
||||
idx := FEntries.Add(Result);
|
||||
FEntryIndex[AIndex] := Pointer(idx);
|
||||
Result.FOwner := Self;
|
||||
end
|
||||
else begin
|
||||
Result := TCallStackEntry(FEntries[idx]);
|
||||
end;
|
||||
if (AIndex < 0)
|
||||
or (AIndex >= Count) then IndexError(AIndex);
|
||||
|
||||
if FEntries.GetData(AIndex, Result) then Exit;
|
||||
|
||||
Result := CreateStackEntry(AIndex);
|
||||
if Result = nil then Exit;
|
||||
FEntries.Add(AIndex, Result);
|
||||
Result.FOwner := Self;
|
||||
end;
|
||||
|
||||
procedure TBaseCallStack.SetCount(const ACount: Integer);
|
||||
var
|
||||
n: integer;
|
||||
function TBaseCallStack.IndexError(AIndex: Integer): TCallStackEntry;
|
||||
begin
|
||||
if FCount = ACount then Exit;
|
||||
Assert(ACount >= 0);
|
||||
raise EInvalidOperation.CreateFmt('Index out of range (%d)', [AIndex]);
|
||||
end;
|
||||
|
||||
FEntryIndex.Count := ACount;
|
||||
if FCount < 0 then FCount := 0;
|
||||
for n := FCount to ACount - 1 do
|
||||
FEntryIndex[n] := Pointer(-1);
|
||||
|
||||
procedure TBaseCallStack.SetCount(ACount: Integer);
|
||||
procedure Error;
|
||||
begin
|
||||
raise EInvalidOperation.CreateFmt('Illegal count (%d < 0)', [ACount]);
|
||||
end;
|
||||
|
||||
begin
|
||||
if ACount < 0 then Error;
|
||||
FCount := ACount;
|
||||
end;
|
||||
|
||||
procedure TBaseCallStack.SetCurrent(const AValue: TCallStackEntry);
|
||||
procedure TBaseCallStack.SetCurrent(AValue: TCallStackEntry);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
{ =========================================================================== }
|
||||
{ TIDECallStack }
|
||||
{ =========================================================================== }
|
||||
@ -3224,12 +3227,26 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TIDECallStack.NotifyCurrent;
|
||||
var
|
||||
n: Integer;
|
||||
Notification: TIDECallStackNotification;
|
||||
begin
|
||||
for n := 0 to FNotificationList.Count - 1 do
|
||||
begin
|
||||
Notification := TIDECallStackNotification(FNotificationList[n]);
|
||||
if Assigned(Notification.FOnCurrent)
|
||||
then Notification.FOnCurrent(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TIDECallStack.RemoveNotification(const ANotification: TIDECallStackNotification);
|
||||
begin
|
||||
FNotificationList.Remove(ANotification);
|
||||
ANotification.ReleaseReference;
|
||||
end;
|
||||
|
||||
|
||||
{ =========================================================================== }
|
||||
{ TDBGCallStack }
|
||||
{ =========================================================================== }
|
||||
@ -3253,6 +3270,11 @@ begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
procedure TDBGCallStack.CurrentChanged;
|
||||
begin
|
||||
if Assigned(FOnCurrent) then FOnCurrent(Self);
|
||||
end;
|
||||
|
||||
procedure TDBGCallStack.DoStateChange(const AOldState: TDBGState);
|
||||
begin
|
||||
if FDebugger.State = dsPause
|
||||
|
||||
@ -314,10 +314,10 @@ type
|
||||
private
|
||||
protected
|
||||
function CheckCount: Boolean; override;
|
||||
function CreateStackEntry(const AIndex: Integer): TCallStackEntry; override;
|
||||
function CreateStackEntry(AIndex: Integer): TCallStackEntry; override;
|
||||
|
||||
function GetCurrent: TCallStackEntry; override;
|
||||
procedure SetCurrent(const AValue: TCallStackEntry); override;
|
||||
procedure SetCurrent(AValue: TCallStackEntry); override;
|
||||
public
|
||||
end;
|
||||
|
||||
@ -650,7 +650,7 @@ begin
|
||||
FCurrentStackFrame := AIndex;
|
||||
SelectStackFrame(FCurrentStackFrame);
|
||||
|
||||
TGDBMICallstack(CallStack).Changed;
|
||||
TGDBMICallstack(CallStack).CurrentChanged;
|
||||
TGDBMILocals(Locals).Changed;
|
||||
TGDBMIWatches(Watches).Changed;
|
||||
end;
|
||||
@ -2922,7 +2922,7 @@ begin
|
||||
SetCount(cnt);
|
||||
end;
|
||||
|
||||
function TGDBMICallStack.CreateStackEntry(const AIndex: Integer): TCallStackEntry;
|
||||
function TGDBMICallStack.CreateStackEntry(AIndex: Integer): TCallStackEntry;
|
||||
var
|
||||
n, e: Integer;
|
||||
R: TGDBMIExecResult;
|
||||
@ -2989,7 +2989,7 @@ begin
|
||||
else Result := Entries[idx];
|
||||
end;
|
||||
|
||||
procedure TGDBMICallStack.SetCurrent(const AValue: TCallStackEntry);
|
||||
procedure TGDBMICallStack.SetCurrent(AValue: TCallStackEntry);
|
||||
begin
|
||||
TGDBMIDebugger(Debugger).CallStackSetCurrent(AValue.Index);
|
||||
end;
|
||||
|
||||
@ -279,12 +279,13 @@ type
|
||||
FMaster: TDBGCallStack;
|
||||
procedure CallStackChanged(Sender: TObject);
|
||||
procedure CallStackClear(Sender: TObject);
|
||||
procedure SetMaster(const AMaster: TDBGCallStack);
|
||||
procedure CallStackCurrent(Sender: TObject);
|
||||
procedure SetMaster(AMaster: TDBGCallStack);
|
||||
protected
|
||||
function CheckCount: Boolean; override;
|
||||
function GetCurrent: TCallStackEntry; override;
|
||||
function GetStackEntry(const AIndex: Integer): TCallStackEntry; override;
|
||||
procedure SetCurrent(const AValue: TCallStackEntry); override;
|
||||
function GetStackEntry(AIndex: Integer): TCallStackEntry; override;
|
||||
procedure SetCurrent(AValue: TCallStackEntry); override;
|
||||
public
|
||||
property Master: TDBGCallStack read FMaster write SetMaster;
|
||||
end;
|
||||
@ -345,6 +346,11 @@ begin
|
||||
NotifyChange;
|
||||
end;
|
||||
|
||||
procedure TManagedCallStack.CallStackCurrent(Sender: TObject);
|
||||
begin
|
||||
NotifyCurrent;
|
||||
end;
|
||||
|
||||
function TManagedCallStack.CheckCount: Boolean;
|
||||
begin
|
||||
Result := Master <> nil;
|
||||
@ -359,21 +365,21 @@ begin
|
||||
else Result := Master.Current;
|
||||
end;
|
||||
|
||||
function TManagedCallStack.GetStackEntry(const AIndex: Integer): TCallStackEntry;
|
||||
function TManagedCallStack.GetStackEntry(AIndex: Integer): TCallStackEntry;
|
||||
begin
|
||||
Assert(FMaster <> nil);
|
||||
|
||||
Result := FMaster.Entries[AIndex];
|
||||
end;
|
||||
|
||||
procedure TManagedCallStack.SetCurrent(const AValue: TCallStackEntry);
|
||||
procedure TManagedCallStack.SetCurrent(AValue: TCallStackEntry);
|
||||
begin
|
||||
if Master = nil then Exit;
|
||||
|
||||
Master.Current := AValue;
|
||||
end;
|
||||
|
||||
procedure TManagedCallStack.SetMaster(const AMaster: TDBGCallStack);
|
||||
procedure TManagedCallStack.SetMaster(AMaster: TDBGCallStack);
|
||||
var
|
||||
DoNotify: Boolean;
|
||||
begin
|
||||
@ -383,6 +389,7 @@ begin
|
||||
then begin
|
||||
FMaster.OnChange := nil;
|
||||
FMaster.OnClear := nil;
|
||||
FMaster.OnCurrent := nil;
|
||||
DoNotify := FMaster.Count <> 0;
|
||||
end
|
||||
else DoNotify := False;
|
||||
@ -396,6 +403,7 @@ begin
|
||||
else begin
|
||||
FMaster.OnChange := @CallStackChanged;
|
||||
FMaster.OnClear := @CallStackClear;
|
||||
FMaster.OnCurrent := @CallStackCurrent;
|
||||
DoNotify := DoNotify or (FMaster.Count <> 0);
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user