paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 06:38:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added option to callstack to select the current frame. Based on a patch by Martin Friebe

Browse Source 
git-svn-id: trunk@13700 -
This commit is contained in:
marc 2008-01-09 22:02:46 +00:00
parent 4f6a0dcd48
commit 1b0fb632fa
6 changed files with 273 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
debugger/callstackdlg.lfm
View File

@ -1,20 +1,23 @@
inherited CallStackDlg: TCallStackDlg
Left = 637
Left = 553
Height = 200
Top = 321
Width = 500
HorzScrollBar.Page = 499
Top = 318
Width = 567
HorzScrollBar.Page = 566
VertScrollBar.Page = 199
ActiveControl = lvCallStack
Caption = 'CallStack'
ClientHeight = 200
ClientWidth = 500
ClientWidth = 567
Visible = True
object lvCallStack: TListView
Height = 200
Width = 500
Width = 567
Align = alClient
Columns = <
item
Width = 10
end
item
Caption = 'Source'
Width = 150
@ -45,6 +48,7 @@ inherited CallStackDlg: TCallStackDlg
end
object popSetAsCurrent: TMenuItem
Caption = 'Set as current'
OnClick = popSetAsCurrentClick
end
object popCopyAll: TMenuItem
Caption = 'Copy all'

29
debugger/callstackdlg.lrs
View File

@ -1,18 +1,19 @@
{ 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'A'#1#5'Width'#3#244#1#18'HorzScrollBar.Page'#3#243#1#18'VertScroll'
+'Bar.Page'#3#199#0#13'ActiveControl'#7#11'lvCallStack'#7'Caption'#6#9'CallSt'
+'ack'#12'ClientHeight'#3#200#0#11'ClientWidth'#3#244#1#7'Visible'#9#0#9'TLis'
+'tView'#11'lvCallStack'#6'Height'#3#200#0#5'Width'#3#244#1#5'Align'#7#8'alCl'
+'ient'#7'Columns'#14#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
+'mnuPopup'#9'RowSelect'#9#8'TabOrder'#2#0#9'ViewStyle'#7#8'vsReport'#10'OnDb'
+'lClick'#7#19'lvCallStackDBLCLICK'#0#0#10'TPopupMenu'#8'mnuPopup'#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'#0#0#9'TMenuI'
+'tem'#10'popCopyAll'#7'Caption'#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')'#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#10#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
]);

33
debugger/callstackdlg.pp
View File

@ -52,6 +52,7 @@ type
mnuPopup: TPopupMenu;
procedure lvCallStackDBLCLICK(Sender: TObject);
procedure popCopyAllClick(Sender: TObject);
procedure popSetAsCurrentClick(Sender : TObject);
procedure popShowClick(Sender: TObject);
private
FCallStack: TIDECallStack;
@ -73,6 +74,7 @@ type
implementation
uses BaseDebugManager;
{ TCallStackDlg }
@ -109,15 +111,19 @@ begin
Item := lvCallStack.Items.Add;
Item.SubItems.Add('');
Item.SubItems.Add('');
Item.SubItems.Add('');
end;
for n := 0 to lvCallStack.Items.Count - 1 do
begin
Item := lvCallStack.Items[n];
Entry := CallStack.Entries[n];
Item.Caption := Entry.Source;
Item.SubItems[0] := IntToStr(Entry.Line);
Item.SubItems[1] := GetFunction(Entry);
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);
end;
finally
@ -145,15 +151,19 @@ end;
procedure TCallStackDlg.JumpToSource;
var
CurItem: TListItem;
Entry: TCallStackEntry;
Filename: String;
Line: Integer;
begin
CurItem:=lvCallStack.Selected;
if CurItem=nil then exit;
Filename:=CurItem.Caption;
if DoGetFullDebugFilename(Filename,true)<>mrOk then exit;
Line:=StrToIntDef(CurItem.SubItems[0],0);
DoJumpToCodePos(Filename,Line,0);
if CurItem = nil then exit;
if CurItem.Index >= CallStack.Count then Exit;
Entry := CallStack.Entries[CurItem.Index];
Filename := Entry.Source;
if DoGetFullDebugFilename(Filename,true) <> mrOk then exit;
DoJumpToCodePos(Filename, Entry.Line, 0);
end;
procedure TCallStackDlg.CopyToClipBoard;
@ -190,6 +200,11 @@ begin
CopyToClipBoard;
end;
procedure TCallStackDlg.popSetAsCurrentClick(Sender : TObject);
begin
CallStack.Current := CallStack.Entries[lvCallStack.Selected.Index];
end;
procedure TCallStackDlg.popShowClick(Sender: TObject);
begin
JumpToSource;

95
debugger/debugger.pp
View File

@ -63,7 +63,8 @@ type
dcLocal,
dcEvaluate,
dcModify,
dcEnvironment
dcEnvironment,
dcSetStackFrame
);
TDBGCommands = set of TDBGCommand;
@ -471,12 +472,15 @@ type
end;
TIDEWatchClass = class of TIDEWatch;
{ TDBGWatch }
TDBGWatch = class(TBaseWatch)
private
FSlave: TBaseWatch;
function GetDebugger: TDebugger;
protected
procedure DoChanged; override;
procedure DoChange; virtual;
procedure DoStateChange(const AOldState: TDBGState); virtual;
property Debugger: TDebugger read GetDebugger;
public
@ -538,13 +542,17 @@ type
write SetItem; default;
end;
{ TDBGWatches }
TDBGWatches = class(TBaseWatches)
private
FDebugger: TDebugger; // reference to our debugger
FOnChange: TNotifyEvent;
function GetItem(const AnIndex: Integer): TDBGWatch;
procedure SetItem(const AnIndex: Integer; const AValue: TDBGWatch);
protected
procedure DoStateChange(const AOldState: TDBGState); virtual;
procedure Update(Item: TCollectionItem); override;
property Debugger: TDebugger read FDebugger;
public
constructor Create(const ADebugger: TDebugger;
@ -555,6 +563,7 @@ type
public
property Items[const AnIndex: Integer]: TDBGWatch read GetItem
write SetItem; default;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
(******************************************************************************)
@ -608,6 +617,7 @@ type
FDebugger: TDebugger; // reference to our debugger
FOnChange: TNotifyEvent;
protected
procedure Changed; virtual;
procedure DoChange;
procedure DoStateChange(const AOldState: TDBGState); virtual;
function GetCount: Integer; virtual;
@ -632,10 +642,13 @@ type
(* TCallStackEntry needs to stay a readonly object so its data can be shared *)
(******************************************************************************)
TBaseCallStack = class;
{ TCallStackEntry }
TCallStackEntry = class(TObject)
private
FOwner: TBaseCallStack;
FIndex: Integer;
FAdress: TDbgPtr;
FFunctionName: String;
@ -645,6 +658,8 @@ type
function GetArgumentCount: Integer;
function GetArgumentName(const AnIndex: Integer): String;
function GetArgumentValue(const AnIndex: Integer): String;
function GetCurrent: Boolean;
procedure SetCurrent(const AValue: Boolean);
protected
public
constructor Create(const AIndex:Integer; const AnAdress: TDbgPtr;
@ -656,7 +671,9 @@ type
property ArgumentCount: Integer read GetArgumentCount;
property ArgumentNames[const AnIndex: Integer]: String read GetArgumentName;
property ArgumentValues[const AnIndex: Integer]: String read GetArgumentValue;
property Current: Boolean read GetCurrent write SetCurrent;
property FunctionName: String read FFunctionName;
property Index: Integer read FIndex;
property Line: Integer read FLine;
property Source: String read FSource;
end;
@ -673,12 +690,15 @@ type
function CheckCount: Boolean; virtual;
procedure Clear;
function CreateStackEntry(const 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;
public
function Count: Integer;
constructor Create;
destructor Destroy; override;
function GetStackEntry(const AIndex: Integer): TCallStackEntry; virtual;
property Current: TCallStackEntry read GetCurrent write SetCurrent;
property Entries[const AIndex: Integer]: TCallStackEntry read GetEntry;
end;
@ -712,6 +732,7 @@ type
FOnChange: TNotifyEvent;
FOnClear: TNotifyEvent;
protected
procedure Changed;
function CheckCount: Boolean; override;
procedure DoStateChange(const AOldState: TDBGState); virtual;
property Debugger: TDebugger read FDebugger;
@ -1020,7 +1041,7 @@ type
function Evaluate(const AExpression: String; var AResult: String): Boolean; // Evaluates the given expression, returns true if valid
function Modify(const AExpression, AValue: String): Boolean; // Modifies the given expression, returns true if valid
public
public
property Arguments: String read FArguments write FArguments; // Arguments feed to the program
property BreakPoints: TDBGBreakPoints read FBreakPoints; // list of all breakpoints
property CallStack: TDBGCallStack read FCallStack;
@ -1063,7 +1084,8 @@ const
'Local',
'Evaluate',
'Modify',
'Environment'
'Environment',
'SetStackFrame'
);
DBGStateNames: array[TDBGState] of string = (
@ -1102,7 +1124,7 @@ const
{dsStop } [dcRun, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch,
dcEvaluate, dcEnvironment],
{dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak,
dcWatch, dcLocal, dcEvaluate, dcModify, dcEnvironment],
dcWatch, dcLocal, dcEvaluate, dcModify, dcEnvironment, dcSetStackFrame],
{dsInit } [],
{dsRun } [dcPause, dcStop, dcBreak, dcWatch, dcEnvironment],
{dsError} [dcStop]
@ -2636,6 +2658,10 @@ begin
then FSlave.Changed;
end;
procedure TDBGWatch.DoChange;
begin
end;
procedure TDBGWatch.DoStateChange(const AOldState: TDBGState);
begin
end;
@ -2789,15 +2815,23 @@ end;
procedure TIDEWatches.Update(Item: TCollectionItem);
var
n: Integer;
n, m: Integer;
Notification: TIDEWatchesNotification;
begin
// Note: Item will be nil in case all items need to be updated
for n := 0 to FNotificationList.Count - 1 do
begin
Notification := TIDEWatchesNotification(FNotificationList[n]);
if Assigned(Notification.FOnUpdate)
then Notification.FOnUpdate(Self, TIDEWatch(Item));
if not Assigned(Notification.FOnUpdate) then Continue;
if Item = nil
then begin
for m := 0 to Count - 1 do
Notification.FOnUpdate(Self, Items[m]);
end
else begin
Notification.FOnUpdate(Self, TIDEWatch(Item));
end;
end;
end;
@ -2839,6 +2873,14 @@ begin
inherited SetItem(AnIndex, AValue);
end;
procedure TDBGWatches.Update(Item: TCollectionItem);
begin
inherited Update(Item);
// notyfy only if collection is changed
if (Item = nil) and Assigned(FOnChange)
then FOnChange(Self);
end;
(******************************************************************************)
(******************************************************************************)
@ -2946,6 +2988,11 @@ procedure TDBGLocals.DoStateChange(const AOldState: TDBGState);
begin
end;
procedure TDBGLocals.Changed;
begin
DoChange;
end;
function TDBGLocals.GetCount: Integer;
begin
Result := 0;
@ -3005,6 +3052,21 @@ begin
Result := GetPart('=', '', Result);
end;
function TCallStackEntry.GetCurrent: Boolean;
begin
Result := (FOwner <> nil) and (FOwner.GetCurrent = Self)
end;
procedure TCallStackEntry.SetCurrent(const AValue: Boolean);
begin
if FOwner = nil then Exit;
if GetCurrent = AValue then Exit;
if AValue
then FOwner.SetCurrent(self)
else FOwner.SetCurrent(nil);
end;
{ =========================================================================== }
{ TBaseCallStack }
{ =========================================================================== }
@ -3054,6 +3116,11 @@ begin
FreeAndNil(FEntryIndex);
end;
function TBaseCallStack.GetCurrent: TCallStackEntry;
begin
Result := nil;
end;
function TBaseCallStack.GetEntry(const AIndex: Integer): TCallStackEntry;
begin
if (AIndex < 0)
@ -3075,6 +3142,7 @@ begin
if Result = nil then Exit;
idx := FEntries.Add(Result);
FEntryIndex[AIndex] := Pointer(idx);
Result.FOwner := Self;
end
else begin
Result := TCallStackEntry(FEntries[idx]);
@ -3096,6 +3164,10 @@ begin
FCount := ACount;
end;
procedure TBaseCallStack.SetCurrent(const AValue: TCallStackEntry);
begin
end;
{ =========================================================================== }
{ TIDECallStack }
{ =========================================================================== }
@ -3147,6 +3219,11 @@ end;
{ TDBGCallStack }
{ =========================================================================== }
procedure TDBGCallStack.Changed;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
function TDBGCallStack.CheckCount: Boolean;
begin
Result := (FDebugger <> nil)
@ -3165,7 +3242,7 @@ procedure TDBGCallStack.DoStateChange(const AOldState: TDBGState);
begin
if FDebugger.State = dsPause
then begin
if Assigned(FOnChange) then FOnChange(Self);
Changed;
end
else begin
if (AOldState = dsPause) or (AOldState = dsNone) { Force clear on initialisation }

118
debugger/gdbmidebugger.pp
View File

@ -111,7 +111,8 @@ type
FPauseWaitState: TGDBMIPauseWaitState;
FInExecuteCount: Integer;
FDebuggerFlags: TGDBMIDebuggerFlags;
FCurrentStackFrame: Integer;
// GDB info (move to ?)
FGDBVersion: String;
FGDBCPU: String;
@ -136,6 +137,8 @@ type
function GDBStepInto: Boolean;
function GDBRunTo(const ASource: String; const ALine: Integer): Boolean;
function GDBJumpTo(const ASource: String; const ALine: Integer): Boolean;
procedure CallStackSetCurrent(AIndex: Integer);
// ---
procedure GDBStopCallback(const AResult: TGDBMIExecResult; const ATag: Integer);
function FindBreakpoint(const ABreakpoint: Integer): TDBGBreakPoint;
@ -156,6 +159,7 @@ type
function ProcessRunning(var AStoppedParams: String): Boolean;
function ProcessStopped(const AParams: String; const AIgnoreSigIntState: Boolean): Boolean;
procedure ProcessFrame(const AFrame: String = '');
procedure SelectStackFrame(AIndex: Integer);
// All ExecuteCommand functions are wrappers for the real (full) implementation
// ExecuteCommandFull is never called directly
@ -221,6 +225,8 @@ type
procedure Hit(var ACanContinue: Boolean);
end;
{ TGDBMILocals }
TGDBMILocals = class(TDBGLocals)
private
FLocals: TStringList;
@ -229,14 +235,18 @@ type
procedure AddLocals(const AParams:String);
protected
procedure DoStateChange(const AOldState: TDBGState); override;
procedure Invalidate;
function GetCount: Integer; override;
function GetName(const AnIndex: Integer): String; override;
function GetValue(const AnIndex: Integer): String; override;
public
procedure Changed; override;
constructor Create(const ADebugger: TDebugger);
destructor Destroy; override;
end;
{ TGDBMIWatch }
TGDBMIWatch = class(TDBGWatch)
private
FEvaluated: Boolean;
@ -245,18 +255,36 @@ type
protected
procedure DoEnableChange; override;
procedure DoExpressionChange; override;
procedure DoChange; override;
procedure DoStateChange(const AOldState: TDBGState); override;
function GetValue: String; override;
function GetValid: TValidState; override;
public
constructor Create(ACollection: TCollection); override;
procedure Invalidate;
end;
{ TDBGWatches }
{ TGDBMIWatches }
TGDBMIWatches = class(TDBGWatches)
private
protected
procedure Changed;
public
end;
{ TGDBMICallStack }
TGDBMICallStack = class(TDBGCallStack)
private
protected
function CheckCount: Boolean; override;
function CreateStackEntry(const AIndex: Integer): TCallStackEntry; override;
function GetCurrent: TCallStackEntry; override;
procedure SetCurrent(const AValue: TCallStackEntry); override;
public
end;
@ -458,6 +486,17 @@ end;
{ TGDBMIDebugger }
{ =========================================================================== }
procedure TGDBMIDebugger.CallStackSetCurrent(AIndex: Integer);
begin
if FCurrentStackFrame = AIndex then Exit;
FCurrentStackFrame := AIndex;
SelectStackFrame(FCurrentStackFrame);
TGDBMICallstack(CallStack).Changed;
TGDBMILocals(Locals).Changed;
TGDBMIWatches(Watches).Changed;
end;
class function TGDBMIDebugger.Caption: String;
begin
Result := 'GNU debugger (gdb)';
@ -931,7 +970,7 @@ begin
// Check for strings
ResultInfo := GetGDBTypeInfo(S);
if (ResultInfo = nil) then Exit;
try
case ResultInfo.Kind of
skPointer: begin
@ -1292,7 +1331,8 @@ end;
function TGDBMIDebugger.GetSupportedCommands: TDBGCommands;
begin
Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto,
dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify, dcEnvironment]
dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify, dcEnvironment,
dcSetStackFrame];
end;
function TGDBMIDebugger.GetTargetWidth: Byte;
@ -1510,7 +1550,7 @@ begin
Location.SrcLine := StrToIntDef(Frame.Values['line'], -1);
Frame.Free;
DoCurrent(Location);
end;
@ -1843,6 +1883,8 @@ var
CanContinue: Boolean;
begin
Result := True;
FCurrentStackFrame := 0;
List := CreateMIValueList(AParams);
try
Reason := List.Values['reason'];
@ -1960,7 +2002,7 @@ begin
dcRunTo: Result := GDBRunTo(String(APArams[0].VAnsiString), APArams[1].VInteger);
dcJumpto: Result := GDBJumpTo(String(APArams[0].VAnsiString), APArams[1].VInteger);
dcEvaluate: Result := GDBEvaluate(String(APArams[0].VAnsiString), String(APArams[1].VPointer^));
dcEnvironment: Result := GDBEnvironment(String(APArams[0].VAnsiString), AParams[1].VBoolean);
dcEnvironment: Result := GDBEnvironment(String(APArams[0].VAnsiString), AParams[1].VBoolean);
end;
end;
@ -1976,6 +2018,11 @@ begin
FCommandQueue.Clear;
end;
procedure TGDBMIDebugger.SelectStackFrame(AIndex: Integer);
begin
ExecuteCommand('-stack-select-frame %d', [AIndex], [cfIgnoreError]);
end;
function TGDBMIDebugger.StartDebugging(const AContinueCommand: String): Boolean;
function CheckFunction(const AFunction: String): Boolean;
var
@ -2479,6 +2526,12 @@ begin
FreeAndNil(LocList);
end;
procedure TGDBMILocals.Changed;
begin
Invalidate;
inherited Changed;
end;
constructor TGDBMILocals.Create(const ADebugger: TDebugger);
begin
FLocals := TStringList.Create;
@ -2501,11 +2554,16 @@ begin
DoChange;
end
else begin
FLocalsValid := False;
FLocals.Clear;
Invalidate;
end;
end;
procedure TGDBMILocals.Invalidate;
begin
FLocalsValid:=false;
FLocals.Clear;
end;
function TGDBMILocals.GetCount: Integer;
begin
if (Debugger <> nil)
@ -2587,6 +2645,11 @@ begin
inherited;
end;
procedure TGDBMIWatch.DoChange;
begin
Changed;
end;
procedure TGDBMIWatch.DoStateChange(const AOldState: TDBGState);
begin
if Debugger = nil then Exit;
@ -2596,6 +2659,11 @@ begin
if Debugger.State = dsPause then Changed;
end;
procedure TGDBMIWatch.Invalidate;
begin
FEvaluated := False;
end;
procedure TGDBMIWatch.EvaluationNeeded;
var
ExprIsValid: Boolean;
@ -2636,6 +2704,21 @@ begin
Result := inherited GetValid;
end;
{ =========================================================================== }
{ TGDBMIWatches }
{ =========================================================================== }
procedure TGDBMIWatches.Changed;
var
n: Integer;
begin
for n := 0 to Count - 1 do
TGDBMIWatch(Items[n]).Invalidate;
inherited Changed;
end;
{ =========================================================================== }
{ TGDBMICallStack }
{ =========================================================================== }
@ -2649,8 +2732,7 @@ begin
Result := inherited CheckCount;
if not Result then Exit;
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-info-depth',
[cfIgnoreError], R);
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-info-depth', [cfIgnoreError], R);
List := CreateMIValueList(R);
cnt := StrToIntDef(List.Values['depth'], -1);
FreeAndNil(List);
@ -2663,8 +2745,7 @@ begin
i:=0;
repeat
inc(i);
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-info-depth ' + IntToStr(i),
[cfIgnoreError], R);
TGDBMIDebugger(Debugger).ExecuteCommand('-stack-info-depth %d', [i], [cfIgnoreError], R);
List := CreateMIValueList(R);
cnt := StrToIntDef(List.Values['depth'], -1);
FreeAndNil(List);
@ -2736,6 +2817,21 @@ begin
Arguments.Free;
end;
function TGDBMICallStack.GetCurrent: TCallStackEntry;
var
idx: Integer;
begin
idx := TGDBMIDebugger(Debugger).FCurrentStackFrame;
if (idx < 0) or (idx >= Count)
then Result := nil
else Result := Entries[idx];
end;
procedure TGDBMICallStack.SetCurrent(const AValue: TCallStackEntry);
begin
TGDBMIDebugger(Debugger).CallStackSetCurrent(AValue.Index);
end;
{ =========================================================================== }
{ TGDBMIExpression }
{ =========================================================================== }

32
ide/debugmanager.pas
View File

@ -242,10 +242,13 @@ type
procedure ResetMaster;
end;
{ TManagedWatches }
TManagedWatches = class(TIDEWatches)
private
FMaster: TDBGWatches;
FManager: TDebugManager;
procedure WatchesChanged(Sender: TObject);
procedure SetMaster(const AMaster: TDBGWatches);
protected
procedure NotifyAdd(const AWatch: TIDEWatch); override;
@ -268,6 +271,8 @@ type
property Master: TDBGLocals read FMaster write SetMaster;
end;
{ TManagedCallStack }
TManagedCallStack = class(TIDECallStack)
private
FMaster: TDBGCallStack;
@ -276,7 +281,9 @@ type
procedure SetMaster(const AMaster: TDBGCallStack);
protected
function CheckCount: Boolean; override;
function GetCurrent: TCallStackEntry; override;
function GetStackEntry(const AIndex: Integer): TCallStackEntry; override;
procedure SetCurrent(const AValue: TCallStackEntry); override;
public
property Master: TDBGCallStack read FMaster write SetMaster;
end;
@ -346,11 +353,25 @@ begin
then SetCount(Master.Count);
end;
function TManagedCallStack.GetCurrent: TCallStackEntry;
begin
if Master = nil
then Result := nil
else Result := Master.Current;
end;
function TManagedCallStack.GetStackEntry(const AIndex: Integer): TCallStackEntry;
begin
Assert(FMaster <> nil);
Result := FMaster.GetStackEntry(AIndex);
Result := FMaster.Entries[AIndex];
end;
procedure TManagedCallStack.SetCurrent(const AValue: TCallStackEntry);
begin
if Master = nil then Exit;
Master.Current := AValue;
end;
procedure TManagedCallStack.SetMaster(const AMaster: TDBGCallStack);
@ -495,6 +516,9 @@ var
begin
if FMaster = AMaster then Exit;
if FMaster <> nil
then FMaster.OnChange := nil;
FMaster := AMaster;
if FMaster = nil
then begin
@ -503,9 +527,15 @@ begin
end
else begin
FMaster.Assign(Self);
FMaster.OnChange := @WatchesChanged;
end;
end;
procedure TManagedWatches.WatchesChanged(Sender: TObject);
begin
Changed;
end;
procedure TManagedWatches.NotifyAdd(const AWatch: TIDEWatch);
var
W: TDBGWatch;