diff --git a/debugger/callstackdlg.lfm b/debugger/callstackdlg.lfm index 2a4d8a9273..b9b3aa9247 100644 --- a/debugger/callstackdlg.lfm +++ b/debugger/callstackdlg.lfm @@ -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 diff --git a/debugger/callstackdlg.lrs b/debugger/callstackdlg.lrs index 11a722176a..895d471e1f 100644 --- a/debugger/callstackdlg.lrs +++ b/debugger/callstackdlg.lrs @@ -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 ]); diff --git a/debugger/callstackdlg.pp b/debugger/callstackdlg.pp index 1eb7f61f85..f002d17488 100644 --- a/debugger/callstackdlg.pp +++ b/debugger/callstackdlg.pp @@ -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} diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 3b76c9a7aa..15dae2db33 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -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 diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index d8401885f8..260aed71e3 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -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; diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index 24b4870247..a4e70b06ab 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -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;