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

DBG: Added Thread dialog

Browse Source 
git-svn-id: trunk@30467 -
This commit is contained in:
martin 2011-04-25 11:17:47 +00:00
parent 4b1f5f2192
commit 580a85d184
15 changed files with 1088 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -2776,6 +2776,8 @@ debugger/test/debugtestform.lrs svneol=native#text/pascal
debugger/test/debugtestform.pp svneol=native#text/pascal
debugger/test/examples/testcntr.pp svneol=native#text/pascal
debugger/test/examples/testwait.pp svneol=native#text/pascal
debugger/threaddlg.lfm svneol=native#text/plain
debugger/threaddlg.pp svneol=native#text/pascal
debugger/watchesdlg.lfm svneol=native#text/plain
debugger/watchesdlg.pp svneol=native#text/pascal
debugger/watchpropertydlg.lfm svneol=native#text/plain

30
debugger/callstackdlg.lfm
View File

@ -1,7 +1,7 @@
inherited CallStackDlg: TCallStackDlg
Left = 466
Left = 306
Height = 246
Top = 191
Top = 130
Width = 562
BorderStyle = bsSizeToolWin
Caption = 'CallStack'
@ -60,31 +60,31 @@ inherited CallStackDlg: TCallStackDlg
ShowHint = True
TabOrder = 1
object ToolButtonShow: TToolButton
Left = 99
Left = 110
Top = 0
Action = actShow
ImageIndex = 0
end
object ToolButtonCurrent: TToolButton
Left = 149
Left = 160
Top = 0
Action = actSetCurrent
end
object ToolButton4: TToolButton
Left = 199
Left = 210
Top = 0
Width = 8
Caption = 'ToolButton4'
Style = tbsSeparator
end
object ToolButtonMore: TToolButton
Left = 269
Left = 280
Top = 0
Action = actViewMore
ImageIndex = 1
end
object ToolButtonMax: TToolButton
Left = 207
Left = 218
Top = 0
Action = actViewLimit
Caption = 'Max 10'
@ -92,7 +92,7 @@ inherited CallStackDlg: TCallStackDlg
Style = tbsDropDown
end
object ToolButtonGoto: TToolButton
Left = 477
Left = 488
Top = 0
Action = actViewGoto
ImageIndex = 4
@ -104,33 +104,33 @@ inherited CallStackDlg: TCallStackDlg
ImageIndex = 5
end
object ToolButton8: TToolButton
Left = 91
Left = 102
Top = 0
Width = 8
Caption = 'ToolButton8'
Style = tbsSeparator
end
object ToolButton9: TToolButton
Left = 319
Left = 330
Top = 0
Width = 8
Caption = 'ToolButton9'
Style = tbsSeparator
end
object ToolButtonTop: TToolButton
Left = 327
Left = 338
Top = 0
Action = actViewTop
ImageIndex = 2
end
object ToolButtonBottom: TToolButton
Left = 377
Left = 388
Top = 0
Action = actViewBottom
ImageIndex = 3
end
object Panel1: TPanel
Left = 427
Left = 438
Height = 40
Top = 0
Width = 50
@ -140,7 +140,7 @@ inherited CallStackDlg: TCallStackDlg
TabOrder = 0
object txtGoto: TEdit
Left = 2
Height = 21
Height = 23
Top = 8
Width = 46
OnKeyPress = txtGotoKeyPress
@ -159,7 +159,7 @@ inherited CallStackDlg: TCallStackDlg
Style = tbsCheck
end
object ToolButton2: TToolButton
Left = 527
Left = 538
Top = 0
Width = 8
Caption = 'ToolButton2'

14
debugger/callstackdlg.pp
View File

@ -719,20 +719,8 @@ begin
end;
function TCallStackDlg.GetFunction(const Entry: TCallStackEntry): string;
var
S: String;
m: Integer;
begin
S := '';
for m := 0 to Entry.ArgumentCount - 1 do
begin
if S <> '' then
S := S + ', ';
S := S + Entry.ArgumentValues[m];
end;
if S <> '' then
S := '(' + S + ')';
Result := Entry.FunctionName + S;
Result := Entry.GetFunctionWithArg;
end;
procedure TCallStackDlg.GotoIndex(AIndex: Integer);

505
debugger/debugger.pp
View File

@ -169,6 +169,41 @@ type
procedure ReleaseReference;
end;
TDebuggerChangeNotification = class(TDebuggerNotification)
private
FOnChange: TNotifyEvent;
public
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
{ TDebuggerNotificationList }
TDebuggerNotificationList = class(TObject)
private
FList: TList;
function GetItem(AIndex: Integer): TDebuggerNotification;
protected
function NextDownIndex(var Index: integer): boolean;
public
constructor Create;
destructor Destroy; override;
procedure Add(const ANotification: TDebuggerNotification);
procedure Remove(const ANotification: TDebuggerNotification);
function Count: Integer;
procedure Clear;
property Items[AIndex: Integer]: TDebuggerNotification read GetItem; default;
end;
{ TDebuggerChangeNotificationList }
TDebuggerChangeNotificationList = class(TDebuggerNotificationList)
private
function GetItem(AIndex: Integer): TDebuggerChangeNotification; reintroduce;
public
procedure NotifyChange(Sender: TObject);
property Items[AIndex: Integer]: TDebuggerChangeNotification read GetItem; default;
end;
TIDEBreakPoints = class;
TIDEBreakPointGroup = class;
@ -578,14 +613,13 @@ type
property Result: TDBGType read FResult;
end;
(******************************************************************************)
(******************************************************************************)
(** **)
(** W A T C H E S **)
(** **)
(******************************************************************************)
(******************************************************************************)
{%region Watches **************************************************************
******************************************************************************
** **
** W A T C H E S **
** **
******************************************************************************
******************************************************************************}
TWatchDisplayFormat =
(wdfDefault,
@ -741,7 +775,7 @@ type
private
FDebugger: TDebugger; // reference to our debugger
FOnChange: TNotifyEvent;
function GetItem(const AnIndex: Integer): TDBGWatch;
function GetItem(const AnIndex: Integer): TDBGWatch;
procedure SetItem(const AnIndex: Integer; const AValue: TDBGWatch);
protected
procedure DoStateChange(const AOldState: TDBGState); virtual;
@ -758,14 +792,15 @@ type
write SetItem; default;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
{%endregion ^^^^^ Watches ^^^^^ }
(******************************************************************************)
(******************************************************************************)
(** **)
(** L O C A L S **)
(** **)
(******************************************************************************)
(******************************************************************************)
{%region Locals ***************************************************************
******************************************************************************
** **
** L O C A L S **
** **
******************************************************************************
******************************************************************************}
{ TBaseLocals }
@ -820,15 +855,16 @@ type
constructor Create(const ADebugger: TDebugger);
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
{%endregion ^^^^^ Locals ^^^^^ }
(******************************************************************************)
(******************************************************************************)
(** **)
(** L I N E I N F O **)
(** **)
(******************************************************************************)
(******************************************************************************)
{%region Line Info ************************************************************
******************************************************************************
** **
** L I N E I N F O **
** **
******************************************************************************
******************************************************************************}
TIDELineInfoEvent = procedure(const ASender: TObject; const ASource: String) of object;
{ TBaseLineInfo }
@ -884,15 +920,15 @@ type
constructor Create(const ADebugger: TDebugger);
property OnChange: TIDELineInfoEvent read FOnChange write FOnChange;
end;
{%endregion ^^^^^ Line Info ^^^^^ }
{%region ^^^^^ Register ^^^^^ }
(******************************************************************************)
(******************************************************************************)
(** **)
(** R E G I S T E R S **)
(** **)
(******************************************************************************)
(******************************************************************************)
{%region Register *************************************************************
******************************************************************************
** **
** R E G I S T E R S **
** **
******************************************************************************
******************************************************************************}
{ TBaseRegisters }
@ -962,18 +998,18 @@ type
end;
{%endregion ^^^^^ Register ^^^^^ }
(******************************************************************************)
(******************************************************************************)
(** **)
(** C A L L S T A C K **)
(** **)
(******************************************************************************)
(******************************************************************************)
(* The entries for the callstack are created on demand. This way when the *)
(* first entry is needed, it isn't required to create the whole stack *)
(* *)
(* TCallStackEntry needs to stay a readonly object so its data can be shared *)
(******************************************************************************)
{%region Callstack ************************************************************
******************************************************************************
** **
** C A L L S T A C K **
** **
******************************************************************************
******************************************************************************
* The entries for the callstack are created on demand. This way when the *
* first entry is needed, it isn't required to create the whole stack *
* *
* TCallStackEntry needs to stay a readonly object so its data can be shared *
******************************************************************************}
TBaseCallStack = class;
@ -1007,6 +1043,7 @@ type
const ALine: Integer; AState: TCallStackEntryState = cseValid);
constructor CreateCopy(const ASource: TCallStackEntry);
destructor Destroy; override;
function GetFunctionWithArg: String;
property Address: TDbgPtr read FAdress;
property ArgumentCount: Integer read GetArgumentCount;
property ArgumentNames[const AnIndex: Integer]: String read GetArgumentName;
@ -1098,6 +1135,7 @@ type
property OnClear: TNotifyEvent read FOnClear write FOnClear;
property OnCurrent: TNotifyEvent read FOnCurrent write FOnCurrent;
end;
{%endregion ^^^^^ Callstack ^^^^^ }
{%region ***** Disassembler ***** }
(******************************************************************************)
@ -1282,6 +1320,105 @@ type
{%endregion ^^^^^ Disassembler ^^^^^ }
{%region Threads **************************************************************
******************************************************************************
** **
** T H R E A D S **
** **
******************************************************************************
******************************************************************************}
{ TIDEThreadsNotification }
TIDEThreadsNotification = class(TDebuggerChangeNotification)
end;
{ TDBGThreadEntry }
TDBGThreadEntry = class(TCallStackEntry)
private
FThreadId: Integer;
FThreadName: String;
FThreadState: String;
public
constructor Create(const AIndex:Integer; const AnAdress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String;
const ASource: String; const AFullFileName: String;
const ALine: Integer;
const AThreadId: Integer; const AThreadName: String;
const AThreadState: String;
AState: TCallStackEntryState = cseValid);
constructor CreateCopy(const ASource: TDBGThreadEntry);
property ThreadId: Integer read FThreadId;
property ThreadName: String read FThreadName;
property ThreadState: String read FThreadState;
end;
{ TBaseThreads }
TBaseThreads = class(TObject)
private
FCurrentThreadId: Integer;
FList: TList;
function GetEntry(const AnIndex: Integer): TDBGThreadEntry;
procedure SetCurrentThreadId(const AValue: Integer); virtual;
protected
procedure Assign(AOther: TBaseThreads);
public
constructor Create;
destructor Destroy; override;
function Count: Integer; virtual;
procedure Clear;
procedure Add(AThread: TDBGThreadEntry);
property Entries[const AnIndex: Integer]: TDBGThreadEntry read GetEntry; default;
property CurrentThreadId: Integer read FCurrentThreadId write SetCurrentThreadId;
end;
TDBGThreads = class;
TIDEThreads = class(TBaseThreads)
private
FNotificationList: TDebuggerChangeNotificationList;
FMaster: TDBGThreads;
FDataValid: Boolean;
procedure SetMaster(const AValue: TDBGThreads);
protected
procedure MasterDestroyed;
procedure Changed;
procedure InvalidateData;
procedure ValidateData;
public
constructor Create;
destructor Destroy; override;
function Count: Integer; override;
procedure AddNotification(const ANotification: TIDEThreadsNotification);
procedure RemoveNotification(const ANotification: TIDEThreadsNotification);
procedure ChangeCurrentThread(ANewId: Integer);
property Master: TDBGThreads read FMaster write SetMaster;
end;
{ TDBGThreads }
TDBGThreads = class(TObject)
private
FSlave: TIDEThreads;
FDebugger: TDebugger;
procedure SetSlave(const AValue: TIDEThreads);
protected
procedure ChangeCurrentThread(ANewId: Integer); virtual; abstract;
procedure RequestMasterData; virtual; abstract;
procedure Changed;
procedure Finished;
property Debugger: TDebugger read FDebugger write FDebugger;
public
constructor Create(const ADebugger: TDebugger);
destructor Destroy; override;
procedure DoStateChange(const AOldState: TDBGState); virtual;
property Slave: TIDEThreads read FSlave write SetSlave;
end;
{%endregion ^^^^^ Threads ^^^^^ }
(******************************************************************************)
(******************************************************************************)
(** **)
@ -1556,6 +1693,7 @@ type
FState: TDBGState;
FCallStack: TDBGCallStack;
FWatches: TDBGWatches;
FThreads: TDBGThreads;
FOnCurrent: TDBGCurrentLineEvent;
FOnException: TDBGExceptionEvent;
FOnOutput: TDBGOutputEvent;
@ -1581,6 +1719,7 @@ type
function CreateCallStack: TDBGCallStack; virtual;
function CreateDisassembler: TDBGDisassembler; virtual;
function CreateWatches: TDBGWatches; virtual;
function CreateThreads: TDBGThreads; virtual;
function CreateSignals: TDBGSignals; virtual;
function CreateExceptions: TDBGExceptions; virtual;
procedure DoCurrent(const ALocation: TDBGLocationRec);
@ -1662,6 +1801,7 @@ type
property TargetWidth: Byte read GetTargetWidth; // Currently only 32 or 64
property Waiting: Boolean read GetWaiting; // Set when the debugger is wating for a command to complete
property Watches: TDBGWatches read FWatches; // list of all watches etc
property Threads: TDBGThreads read FThreads;
property WorkingDir: String read FWorkingDir write FWorkingDir; // The working dir of the exe being debugged
// Events
property OnCurrent: TDBGCurrentLineEvent read FOnCurrent write FOnCurrent; // Passes info about the current line being debugged
@ -1803,6 +1943,259 @@ begin
Result:=bpaStop;
end;
{ TDBGThreads }
procedure TDBGThreads.SetSlave(const AValue: TIDEThreads);
begin
if FSlave = AValue then exit;
Assert((FSlave=nil) or (AValue=nil), 'TDBGThreads.Slave already set');
FSlave := AValue;
end;
procedure TDBGThreads.Changed;
begin
If Slave <> nil then Slave.InvalidateData;
end;
procedure TDBGThreads.Finished;
begin
If Slave <> nil then Slave.ValidateData;
end;
constructor TDBGThreads.Create(const ADebugger: TDebugger);
begin
FSlave := nil;
FDebugger := ADebugger;
end;
destructor TDBGThreads.Destroy;
begin
inherited Destroy;
if FSlave <> nil then FSlave.MasterDestroyed;
end;
procedure TDBGThreads.DoStateChange(const AOldState: TDBGState);
begin
//
end;
{ TIDEThreads }
procedure TIDEThreads.SetMaster(const AValue: TDBGThreads);
begin
if FMaster = AValue then exit;
Assert((FMaster=nil) or (AValue=nil), 'TIDEThreads.Master already set');
if FMaster <> nil then FMaster.Slave := nil;
FMaster := AValue;
if FMaster <> nil then FMaster.Slave := self;
InvalidateData;
end;
procedure TIDEThreads.MasterDestroyed;
begin
Master := nil;
end;
procedure TIDEThreads.InvalidateData;
begin
FDataValid := False;
Changed;
end;
procedure TIDEThreads.ValidateData;
begin
FDataValid := True;
Changed;
end;
procedure TIDEThreads.Changed;
begin
FNotificationList.NotifyChange(Self);
end;
constructor TIDEThreads.Create;
begin
inherited;
FNotificationList := TDebuggerChangeNotificationList.Create;
end;
destructor TIDEThreads.Destroy;
begin
inherited Destroy;
FNotificationList.Clear;
Master := nil;
FreeAndNil(FNotificationList);
end;
function TIDEThreads.Count: Integer;
begin
if (not FDataValid) and (FMaster <> nil) then
FMaster.RequestMasterData;
if FDataValid then
Result := inherited Count
else
Result := 0;
end;
procedure TIDEThreads.AddNotification(const ANotification: TIDEThreadsNotification);
begin
FNotificationList.Add(ANotification);
end;
procedure TIDEThreads.RemoveNotification(const ANotification: TIDEThreadsNotification);
begin
FNotificationList.Remove(ANotification);
end;
procedure TIDEThreads.ChangeCurrentThread(ANewId: Integer);
begin
if FMaster <> nil then FMaster.ChangeCurrentThread(ANewId);
end;
{ TDebuggerChangeNotificationList }
function TDebuggerChangeNotificationList.GetItem(AIndex: Integer): TDebuggerChangeNotification;
begin
Result := TDebuggerChangeNotification(FList[AIndex]);
end;
procedure TDebuggerChangeNotificationList.NotifyChange(Sender: TObject);
var
i: LongInt;
begin
i := Count;
while NextDownIndex(i) do
if Assigned(Items[i]) then
Items[i].OnChange(Sender);
end;
{ TDebuggerNotificationList }
function TDebuggerNotificationList.GetItem(AIndex: Integer): TDebuggerNotification;
begin
Result := TDebuggerNotification(FList[AIndex]);
end;
function TDebuggerNotificationList.NextDownIndex(var Index: integer): boolean;
begin
dec(Index);
if (Index >= FList.Count) then
Index := FList.Count-1;
Result := Index >= 0;
end;
function TDebuggerNotificationList.Count: Integer;
begin
Result := FList.Count;
end;
procedure TDebuggerNotificationList.Clear;
begin
while Count > 0 do
Remove(Items[0]);
end;
constructor TDebuggerNotificationList.Create;
begin
FList := TList.Create;
end;
destructor TDebuggerNotificationList.Destroy;
begin
inherited Destroy;
Clear;
FreeAndNil(FList);
end;
procedure TDebuggerNotificationList.Add(const ANotification: TDebuggerNotification);
begin
FList.Add(ANotification);
ANotification.AddReference;
end;
procedure TDebuggerNotificationList.Remove(const ANotification: TDebuggerNotification);
begin
ANotification.ReleaseReference;
FList.Remove(ANotification);
end;
{ TDBGThreadEntry }
constructor TDBGThreadEntry.Create(const AIndex: Integer; const AnAdress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String; const ASource: String;
const AFullFileName: String; const ALine: Integer; const AThreadId: Integer;
const AThreadName: String; const AThreadState: String;
AState: TCallStackEntryState);
begin
inherited Create(AIndex, AnAdress, AnArguments, AFunctionName, ASource,
AFullFileName, ALine, AState);
FThreadId := AThreadId;
FThreadName := AThreadName;
FThreadState := AThreadState;
end;
constructor TDBGThreadEntry.CreateCopy(const ASource: TDBGThreadEntry);
begin
inherited CreateCopy(ASource);
FThreadId := ASource.FThreadId;
FThreadName := ASource.FThreadName;
FThreadState := ASource.FThreadState;
end;
{ TBaseThreads }
function TBaseThreads.GetEntry(const AnIndex: Integer): TDBGThreadEntry;
begin
if (AnIndex < 0) or (AnIndex >= Count) then exit(nil);
Result := TDBGThreadEntry(FList[AnIndex]);
end;
procedure TBaseThreads.SetCurrentThreadId(const AValue: Integer);
begin
if FCurrentThreadId = AValue then exit;
FCurrentThreadId := AValue;
end;
procedure TBaseThreads.Assign(AOther: TBaseThreads);
var
i: Integer;
begin
Clear;
for i := 0 to AOther.FList.Count-1 do
FList.Add(TDBGThreadEntry.CreateCopy(TDBGThreadEntry(AOther.FList[i])));
end;
constructor TBaseThreads.Create;
begin
FList := TList.Create;
end;
destructor TBaseThreads.Destroy;
begin
Clear;
FreeAndNil(FList);
inherited Destroy;
end;
function TBaseThreads.Count: Integer;
begin
Result := FList.Count;
end;
procedure TBaseThreads.Clear;
begin
while FList.Count > 0 do begin
TDBGThreadEntry(Flist[0]).Free;
FList.Delete(0);
end;
end;
procedure TBaseThreads.Add(AThread: TDBGThreadEntry);
begin
FList.Add(TDBGThreadEntry.CreateCopy(AThread));
end;
{ TDebuggerProperties }
constructor TDebuggerProperties.Create;
@ -1902,6 +2295,7 @@ begin
FCallStack := CreateCallStack;
FDisassembler := CreateDisassembler;
FWatches := CreateWatches;
FThreads := CreateThreads;
FExceptions := CreateExceptions;
FSignals := CreateSignals;
FExitCode := 0;
@ -1957,6 +2351,11 @@ begin
Result := TDBGWatches.Create(Self, TDBGWatch);
end;
function TDebugger.CreateThreads: TDBGThreads;
begin
Result := nil;
end;
procedure TDebugger.DebuggerEnvironmentChanged (Sender: TObject );
begin
end;
@ -1984,6 +2383,7 @@ begin
FCallStack.FDebugger := nil;
FDisassembler.FDebugger := nil;
FWatches.FDebugger := nil;
FThreads.Debugger := nil;
FreeAndNil(FExceptions);
FreeAndNil(FBreakPoints);
@ -1993,6 +2393,7 @@ begin
FreeAndNil(FCallStack);
FreeAndNil(FDisassembler);
FreeAndNil(FWatches);
FreeAndNil(FThreads);
FreeAndNil(FDebuggerEnvironment);
FreeAndNil(FEnvironment);
FreeAndNil(FCurEnvironment);
@ -2306,6 +2707,7 @@ begin
then begin
OldState := FState;
FState := AValue;
FThreads.DoStateChange(OldState);
FBreakpoints.DoStateChange(OldState);
FLocals.DoStateChange(OldState);
FLineInfo.DoStateChange(OldState);
@ -4235,6 +4637,23 @@ begin
FreeAndNil(FArguments);
end;
function TCallStackEntry.GetFunctionWithArg: String;
var
S: String;
m: Integer;
begin
S := '';
for m := 0 to ArgumentCount - 1 do
begin
if S <> '' then
S := S + ', ';
S := S + ArgumentValues[m];
end;
if S <> '' then
S := '(' + S + ')';
Result := FunctionName + S;
end;
function TCallStackEntry.GetArgumentCount: Integer;
begin
Result := FArguments.Count;

330
debugger/gdbmidebugger.pp
View File

@ -369,6 +369,7 @@ type
function CreateCallStack: TDBGCallStack; override;
function CreateDisassembler: TDBGDisassembler; override;
function CreateWatches: TDBGWatches; override;
function CreateThreads: TDBGThreads; override;
function GetSupportedCommands: TDBGCommands; override;
function GetTargetWidth: Byte; override;
procedure InterruptTarget; virtual;
@ -376,6 +377,7 @@ type
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
procedure ClearCommandQueue;
procedure DoState(const OldState: TDBGState); override;
procedure DoThreadChanged;
property TargetPID: Integer read FTargetInfo.TargetPID;
property TargetPtrSize: Byte read FTargetInfo.TargetPtrSize;
property TargetFlags: TGDBMITargetFlags read FTargetInfo.TargetFlags write FTargetInfo.TargetFlags;
@ -464,6 +466,7 @@ const
GDCMD_PRIOR_LINE_INFO = 100; // Line info should run asap
GDCMD_PRIOR_DISASS = 30; // Run before watches
GDCMD_PRIOR_USER_ACT = 10; // set/change/remove brkpoint
GDCMD_PRIOR_THREAD = 5; // Run before watches, stack or locals
GDCMD_PRIOR_STACK = 2; // Run before watches
GDCMD_PRIOR_LOCALS = 1; // Run before watches (also registers etc)
@ -957,6 +960,7 @@ type
function GetCurrent: TCallStackEntry; override;
procedure SetCurrent(AValue: TCallStackEntry); override;
procedure DoThreadChanged;
public
end;
@ -1106,6 +1110,68 @@ type
{%endregion ^^^^^ Disassembler ^^^^^ }
{%region ***** Register ***** }
{ TGDBMIDebuggerCommandThreads }
TGDBMIDebuggerCommandThreads = class(TGDBMIDebuggerCommand)
private
FCurrentThreadId: Integer;
FThreads: Array of TDBGThreadEntry;
function GetThread(AnIndex: Integer): TDBGThreadEntry;
protected
function DoExecute: Boolean; override;
public
destructor Destroy; override;
//function DebugText: String; override;
function Count: Integer;
property Threads[AnIndex: Integer]: TDBGThreadEntry read GetThread;
property CurrentThreadId: Integer read FCurrentThreadId;
end;
{ TGDBMIDebuggerCommandChangeThread }
TGDBMIDebuggerCommandChangeThread = class(TGDBMIDebuggerCommand)
private
FNewId: Integer;
FSuccess: Boolean;
protected
function DoExecute: Boolean; override;
public
constructor Create(AOwner: TGDBMIDebugger; ANewId: Integer);
function DebugText: String; override;
property Success: Boolean read FSuccess;
property NewId: Integer read FNewId write FNewId;
end;
{ TGDBMIThreads }
TGDBMIThreads = class(TDBGThreads)
private
FGetThreadsCmdObj: TGDBMIDebuggerCommandThreads;
FThreadsReqState: TGDBMIEvaluationState;
FChangeThreadsCmdObj: TGDBMIDebuggerCommandChangeThread;
function GetDebugger: TGDBMIDebugger;
procedure ThreadsNeeded;
procedure CancelEvaluation;
procedure DoThreadsDestroyed(Sender: TObject);
procedure DoThreadsFinished(Sender: TObject);
procedure DoChangeThreadsDestroyed(Sender: TObject);
procedure DoChangeThreadsFinished(Sender: TObject);
protected
procedure RequestMasterData; override;
procedure ChangeCurrentThread(ANewId: Integer); override;
property Debugger: TGDBMIDebugger read GetDebugger;
public
constructor Create(const ADebugger: TDebugger);
destructor Destroy; override;
procedure DoStateChange(const AOldState: TDBGState); override;
end;
{%endregion ^^^^^ Register ^^^^^ }
{%region ***** TGDBMIExpression ***** }
@ -1303,6 +1369,251 @@ begin
Result := '"' + Result + '"';
end;
{ TGDBMIDebuggerCommandChangeThread }
function TGDBMIDebuggerCommandChangeThread.DoExecute: Boolean;
var
R: TGDBMIExecResult;
begin
Result := True;
FSuccess := ExecuteCommand('-thread-select %d', [FNewId], R);
if FSuccess then
FSuccess := R.State <> dsError;
end;
constructor TGDBMIDebuggerCommandChangeThread.Create(AOwner: TGDBMIDebugger; ANewId: Integer);
begin
inherited Create(AOwner);
FNewId := ANewId;
FSuccess := False;
end;
function TGDBMIDebuggerCommandChangeThread.DebugText: String;
begin
Result := Format('%s: NewId=%d', [ClassName, FNewId]);
end;
{ TGDBMIThreads }
procedure TGDBMIThreads.DoThreadsDestroyed(Sender: TObject);
begin
if FGetThreadsCmdObj = Sender
then FGetThreadsCmdObj:= nil;
end;
procedure TGDBMIThreads.DoThreadsFinished(Sender: TObject);
var
Cmd: TGDBMIDebuggerCommandThreads;
i: Integer;
begin
if Slave = nil then exit;
Cmd := TGDBMIDebuggerCommandThreads(Sender);
Slave.Clear;
for i := 0 to Cmd.Count - 1 do
Slave.Add(Cmd.Threads[i]);
Slave.CurrentThreadId := Cmd.CurrentThreadId;
Finished;
end;
procedure TGDBMIThreads.DoChangeThreadsDestroyed(Sender: TObject);
begin
if FChangeThreadsCmdObj = Sender
then FChangeThreadsCmdObj := nil;
end;
procedure TGDBMIThreads.DoChangeThreadsFinished(Sender: TObject);
var
Cmd: TGDBMIDebuggerCommandChangeThread;
begin
if Slave = nil then exit;
Cmd := TGDBMIDebuggerCommandChangeThread(Sender);
if not Cmd.Success then begin
Changed; // invalidate slave
exit;
end;
Slave.CurrentThreadId := Cmd.NewId;
Finished;
Debugger.DoThreadChanged;
end;
function TGDBMIThreads.GetDebugger: TGDBMIDebugger;
begin
Result := TGDBMIDebugger(inherited Debugger);
end;
procedure TGDBMIThreads.ThreadsNeeded;
var
ForceQueue: Boolean;
begin
if FThreadsReqState in [esValid, esRequested] then Exit;
if Debugger = nil then Exit;
if (Debugger.State = dsPause)
then begin
FThreadsReqState := esRequested;
FGetThreadsCmdObj := TGDBMIDebuggerCommandThreads.Create(Debugger);
FGetThreadsCmdObj.OnExecuted := @DoThreadsFinished;
FGetThreadsCmdObj.OnDestroy := @DoThreadsDestroyed;
FGetThreadsCmdObj.Properties := [dcpCancelOnRun];
FGetThreadsCmdObj.Priority := GDCMD_PRIOR_THREAD;
// If a ExecCmd is running, then defer exec until the exec cmd is done
ForceQueue := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil)
and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute)
and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued);
TGDBMIDebugger(Debugger).QueueCommand(FGetThreadsCmdObj, ForceQueue);
(* DoEvaluationFinished may be called immediately at this point *)
end;
end;
procedure TGDBMIThreads.CancelEvaluation;
begin
FThreadsReqState := esInvalid;
if FGetThreadsCmdObj <> nil
then begin
FGetThreadsCmdObj.OnExecuted := nil;
FGetThreadsCmdObj.OnDestroy := nil;
FGetThreadsCmdObj.Cancel;
end;
FGetThreadsCmdObj := nil;
end;
constructor TGDBMIThreads.Create(const ADebugger: TDebugger);
begin
inherited;
FThreadsReqState := esInvalid;
end;
destructor TGDBMIThreads.Destroy;
begin
CancelEvaluation;
inherited Destroy;
end;
procedure TGDBMIThreads.DoStateChange(const AOldState: TDBGState);
begin
if (Debugger = nil) or (Slave = nil) then Exit;
if Debugger.State in [dsPause, dsStop]
then begin
CancelEvaluation;
FThreadsReqState := esInvalid;
Changed;
end;
end;
procedure TGDBMIThreads.RequestMasterData;
begin
ThreadsNeeded;
end;
procedure TGDBMIThreads.ChangeCurrentThread(ANewId: Integer);
var
ForceQueue: Boolean;
begin
if Debugger = nil then Exit;
if (Debugger.State <> dsPause) then exit;
if FChangeThreadsCmdObj <> nil then begin
if FChangeThreadsCmdObj.State = dcsQueued then
FChangeThreadsCmdObj.NewId := ANewId;
exit;
end;
FChangeThreadsCmdObj := TGDBMIDebuggerCommandChangeThread.Create(Debugger, ANewId);
FChangeThreadsCmdObj.OnExecuted := @DoChangeThreadsFinished;
FChangeThreadsCmdObj.OnDestroy := @DoChangeThreadsDestroyed;
FChangeThreadsCmdObj.Properties := [dcpCancelOnRun];
FChangeThreadsCmdObj.Priority := GDCMD_PRIOR_USER_ACT;
// If a ExecCmd is running, then defer exec until the exec cmd is done
ForceQueue := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil)
and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute)
and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued);
TGDBMIDebugger(Debugger).QueueCommand(FChangeThreadsCmdObj, ForceQueue);
(* DoEvaluationFinished may be called immediately at this point *)
end;
{ TGDBMIDebuggerCommandThreads }
function TGDBMIDebuggerCommandThreads.GetThread(AnIndex: Integer): TDBGThreadEntry;
begin
Result := FThreads[AnIndex];
end;
function TGDBMIDebuggerCommandThreads.DoExecute: Boolean;
var
R: TGDBMIExecResult;
List, EList, ArgList: TGDBMINameValueList;
i, j: Integer;
line, ThrId: Integer;
func, filename, fullname: String;
ThrName, ThrState: string;
addr: TDBGPtr;
Arguments: TStringList;
begin
Result := True;
ExecuteCommand('-thread-info', R);
List := TGDBMINameValueList.Create(R);
EList := TGDBMINameValueList.Create;
ArgList := TGDBMINameValueList.Create;
FCurrentThreadId := StrToIntDef(List.Values['current-thread-id'], -1);
List.SetPath('threads');
SetLength(FThreads, List.Count);
for i := 0 to List.Count - 1 do begin
EList.Init(List.Items[i]^.Name);
ThrId := StrToIntDef(EList.Values['id'], -2);
ThrName := EList.Values['target-id'];
ThrState := EList.Values['state'];
EList.SetPath('frame');
addr := StrToQWordDef(EList.Values['addr'], 0);
func := EList.Values['func'];
filename := ConvertGdbPathAndFile(EList.Values['file']);
fullname := ConvertGdbPathAndFile(EList.Values['fullname']);
line := StrToIntDef(EList.Values['line'], 0);
EList.SetPath('args');
Arguments := TStringList.Create;
for j := 0 to EList.Count - 1 do begin
ArgList.Init(EList.Items[j]^.Name);
Arguments.Add(ArgList.Values['name'] + '=' + DeleteEscapeChars(ArgList.Values['value']));
end;
FThreads[i] := TDBGThreadEntry.Create(
0, addr,
Arguments,
func, filename, fullname, line,
ThrId,ThrName, ThrState
);
Arguments.Free;
end;
FreeAndNil(ArgList);
FreeAndNil(EList);
FreeAndNil(List);
end;
destructor TGDBMIDebuggerCommandThreads.Destroy;
var
i: Integer;
begin
for i := 0 to length(FThreads) - 1 do FreeAndNil(FThreads[i]);
FThreads := nil;
inherited Destroy;
end;
function TGDBMIDebuggerCommandThreads.Count: Integer;
begin
Result := length(FThreads);
end;
{ TGDBMIDebuggerCommandRegisterModified }
function TGDBMIDebuggerCommandRegisterModified.DoExecute: Boolean;
@ -4485,6 +4796,11 @@ begin
Result := TGDBMIWatches.Create(Self, TGDBMIWatch);
end;
function TGDBMIDebugger.CreateThreads: TDBGThreads;
begin
Result := TGDBMIThreads.Create(Self);
end;
destructor TGDBMIDebugger.Destroy;
begin
LockRelease;
@ -4569,6 +4885,14 @@ begin
inherited DoState(OldState);
end;
procedure TGDBMIDebugger.DoThreadChanged;
begin
TGDBMICallstack(CallStack).DoThreadChanged;
TGDBMILocals(Locals).Changed;
TGDBMIRegisters(Registers).Changed;
TGDBMIWatches(Watches).Changed;
end;
procedure TGDBMIDebugger.DoRelease;
begin
SetState(dsDestroying);
@ -7106,6 +7430,12 @@ begin
TGDBMIDebugger(Debugger).CallStackSetCurrent(AValue.Index);
end;
procedure TGDBMICallStack.DoThreadChanged;
begin
Clear;
Changed;
end;
{ =========================================================================== }
{ TGDBMIExpression }
{ =========================================================================== }

65
debugger/threaddlg.lfm Normal file
View File

@ -0,0 +1,65 @@
inherited ThreadsDlg: TThreadsDlg
Left = 345
Top = 428
Width = 774
BorderStyle = bsSizeToolWin
Caption = 'Threads'
ClientWidth = 774
object lvThreads: TListView[0]
Left = 0
Height = 214
Top = 26
Width = 774
Align = alClient
Columns = <
item
Width = 20
end
item
Caption = 'Id'
end
item
Caption = 'TargetId'
Width = 100
end
item
Caption = 'State'
end
item
Caption = 'Source'
Width = 150
end
item
Caption = 'Line'
end
item
Caption = 'Function'
Width = 300
end>
RowSelect = True
TabOrder = 0
ViewStyle = vsReport
OnDblClick = lvThreadsDblClick
end
object ToolBar1: TToolBar[1]
Left = 0
Height = 26
Top = 0
Width = 774
Caption = 'ToolBar1'
ShowCaptions = True
TabOrder = 1
object tbCurrent: TToolButton
Left = 1
Top = 2
Caption = 'tbCurrent'
OnClick = tbCurrentClick
end
object tbGoto: TToolButton
Left = 60
Top = 2
Caption = 'tbGoto'
OnClick = lvThreadsDblClick
end
end
end

164
debugger/threaddlg.pp Normal file
View File

@ -0,0 +1,164 @@
unit ThreadDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
Debugger, DebuggerDlg, LazarusIDEStrConsts, BaseDebugManager, MainBase;
type
{ TThreadsDlg }
TThreadsDlg = class(TDebuggerDlg)
lvThreads: TListView;
ToolBar1: TToolBar;
tbCurrent: TToolButton;
tbGoto: TToolButton;
procedure lvThreadsDblClick(Sender: TObject);
procedure tbCurrentClick(Sender: TObject);
procedure ThreadsChanged(Sender: TObject);
private
{ private declarations }
FThreadNotification: TIDEThreadsNotification;
FThreads: TIDEThreads;
procedure SetThreads(const AValue: TIDEThreads);
procedure JumpToSource;
public
{ public declarations }
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
property Threads: TIDEThreads read FThreads write SetThreads;
end;
implementation
{$R *.lfm}
{ TThreadsDlg }
procedure TThreadsDlg.ThreadsChanged(Sender: TObject);
var
i: Integer;
s: String;
Item: TListItem;
begin
if FThreads = nil then begin
lvThreads.Clear;
exit;
end;
lvThreads.Items.Count := FThreads.Count;
i := FThreads.Count;
while lvThreads.Items.Count > i do lvThreads.Items.Delete(i);
while lvThreads.Items.Count < i do begin
Item := lvThreads.Items.Add;
Item.SubItems.add('');
Item.SubItems.add('');
Item.SubItems.add('');
Item.SubItems.add('');
Item.SubItems.add('');
Item.SubItems.add('');
end;
for i := 0 to FThreads.Count - 1 do begin
if Threads[i].ThreadId = Threads.CurrentThreadId
then lvThreads.Items[i].Caption := '*'
else lvThreads.Items[i].Caption := '';
lvThreads.Items[i].SubItems[0] := IntToStr(Threads[i].ThreadId);
lvThreads.Items[i].SubItems[1] := Threads[i].ThreadName;
lvThreads.Items[i].SubItems[2] := Threads[i].ThreadState;
s := Threads[i].Source;
if s = '' then s := ';' + IntToHex(Threads[i].Address, 8);
lvThreads.Items[i].SubItems[3] := s;
lvThreads.Items[i].SubItems[4] := IntToStr(Threads[i].Line);
lvThreads.Items[i].SubItems[5] := Threads[i].GetFunctionWithArg;
lvThreads.Items[i].Data := Threads[i];
end;
end;
procedure TThreadsDlg.tbCurrentClick(Sender: TObject);
var
Item: TListItem;
id: LongInt;
begin
Item := lvThreads.Selected;
if Item = nil then exit;
id := StrToIntDef(Item.SubItems[0], -1);
if id < 0 then exit;
FThreads.ChangeCurrentThread(id);
end;
procedure TThreadsDlg.lvThreadsDblClick(Sender: TObject);
begin
JumpToSource;
end;
procedure TThreadsDlg.SetThreads(const AValue: TIDEThreads);
begin
if FThreads = AValue then exit;
if FThreads <> nil then FThreads.RemoveNotification(FThreadNotification);
FThreads := AValue;
if FThreads <> nil then FThreads.AddNotification(FThreadNotification);
ThreadsChanged(FThreads);
end;
procedure TThreadsDlg.JumpToSource;
var
Entry: TDBGThreadEntry;
Filename: String;
Item: TListItem;
begin
Item := lvThreads.Selected;
if Item = nil then exit;
Entry := TDBGThreadEntry(Item.Data);
if Entry = nil then Exit;
// avoid any process-messages, so this proc can not be re-entered (avoid opening one files many times)
DebugBoss.LockCommandProcessing;
try
// check the full name first
Filename := Entry.FullFileName;
if (Filename = '') or not DebugBoss.GetFullFilename(Filename, False) then
begin
// if fails the check the short file name
Filename := Entry.Source;
if (FileName = '') or not DebugBoss.GetFullFilename(Filename, True) then
Exit;
end;
MainIDE.DoJumpToSourcePosition(Filename, 0, Entry.Line, 0, True, True);
finally
DebugBoss.UnLockCommandProcessing;
end;end;
constructor TThreadsDlg.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
Caption:= lisThreads;
lvThreads.Column[1].Caption := lisThreadsID;
lvThreads.Column[2].Caption := lisThreadsName;
lvThreads.Column[2].Caption := lisThreadsState;
lvThreads.Column[3].Caption := lisThreadsSrc;
lvThreads.Column[4].Caption := lisThreadsLine;
lvThreads.Column[5].Caption := lisThreadsFunc;
tbCurrent.Caption := lisThreadsCurrent;
tbGoto.Caption := lisThreadsGoto;
FThreadNotification := TIDEThreadsNotification.Create;
FThreadNotification.AddReference;
FThreadNotification.OnChange := @ThreadsChanged;
end;
destructor TThreadsDlg.Destroy;
begin
SetThreads(nil);
FThreadNotification.OnChange := nil;
FThreadNotification.ReleaseReference;
inherited Destroy;
end;
end.

5
ide/basedebugmanager.pas
View File

@ -55,7 +55,8 @@ type
ddtRegisters,
ddtAssembler,
ddtInspect,
ddtPseudoTerminal
ddtPseudoTerminal,
ddtThreads
);
{ TBaseDebugManager }
@ -91,6 +92,7 @@ type
FLocals: TIDELocals;
FLineInfo: TIDELineInfo;
FWatches: TIDEWatches;
FThreads: TIDEThreads;
FRegisters: TIDERegisters;
FManagerStates: TDebugManagerStates;
function FindDebuggerClass(const Astring: String): TDebuggerClass;
@ -176,6 +178,7 @@ type
property Registers: TIDERegisters read FRegisters;
property Signals: TIDESignals read FSignals; // A list of actions for signals we know of
property Watches: TIDEWatches read FWatches;
property Threads: TIDEThreads read FThreads;
{$IFDEF DBG_WITH_DEBUGGER_DEBUG}
property Debugger: TDebugger read GetDebugger;
{$ENDIF}

25
ide/debugmanager.pas
View File

@ -56,7 +56,7 @@ uses
SourceMarks,
DebuggerDlg, Watchesdlg, BreakPointsdlg, BreakPropertyDlg, LocalsDlg, WatchPropertyDlg,
CallStackDlg, EvaluateDlg, RegistersDlg, AssemblerDlg, DebugOutputForm, ExceptionDlg,
InspectDlg, DebugEventsForm, PseudoTerminalDlg, FeedbackDlg,
InspectDlg, DebugEventsForm, PseudoTerminalDlg, FeedbackDlg, ThreadDlg,
GDBMIDebugger, SSHGDBMIDebugger, ProcessDebugger,
BaseDebugManager;
@ -127,6 +127,7 @@ type
procedure InitDebugEventsDlg;
procedure InitBreakPointDlg;
procedure InitWatchesDlg;
procedure InitThreadsDlg;
procedure InitPseudoTerminal;
procedure InitLocalsDlg;
procedure InitCallStackDlg;
@ -218,7 +219,7 @@ const
DebugDlgIDEWindow: array[TDebugDialogType] of TNonModalIDEWindow = (
nmiwDbgOutput, nmiwDbgEvents, nmiwBreakPoints, nmiwWatches, nmiwLocals,
nmiwCallStack, nmiwEvaluate, nmiwRegisters, nmiwAssembler, nmiwInspect,
nmiwPseudoTerminal
nmiwPseudoTerminal, nmiwThreads
);
type
@ -1556,6 +1557,7 @@ begin
ecEvaluate : ViewDebugDialog(ddtEvaluate);
ecInspect : ViewDebugDialog(ddtInspect);
ecViewPseudoTerminal: ViewDebugDialog(ddtPseudoTerminal);
ecViewThreads : ViewDebugDialog(ddtThreads);
end;
end;
end;
@ -1957,7 +1959,7 @@ const
DEBUGDIALOGCLASS: array[TDebugDialogType] of TDebuggerDlgClass = (
TDbgOutputForm, TDbgEventsForm, TBreakPointsDlg, TWatchesDlg, TLocalsDlg,
TCallStackDlg, TEvaluateDlg, TRegistersDlg, TAssemblerDlg, TIDEInspectDlg,
TPseudoConsoleDlg
TPseudoConsoleDlg, TThreadsDlg
);
var
CurDialog: TDebuggerDlg;
@ -1986,6 +1988,7 @@ begin
ddtAssembler: InitAssemblerDlg;
ddtInspect: InitInspectDlg;
ddtPseudoTerminal: InitPseudoTerminal;
ddtThreads: InitThreadsDlg;
end;
end
else begin
@ -2059,6 +2062,14 @@ begin
TheDialog.Watches := FWatches;
end;
procedure TDebugManager.InitThreadsDlg;
var
TheDialog: TThreadsDlg;
begin
TheDialog := TThreadsDlg(FDialogs[ddtThreads]);
TheDialog.Threads := FThreads;
end;
procedure TDebugManager.InitPseudoTerminal;
//var
// TheDialog: TPseudoConsoleDlg;
@ -2139,6 +2150,7 @@ begin
FBreakPoints := TManagedBreakPoints.Create(Self);
FBreakPointGroups := TIDEBreakPointGroups.Create;
FWatches := TManagedWatches.Create(Self);
FThreads := TIDEThreads.Create;
FExceptions := TManagedExceptions.Create(Self);
FSignals := TManagedSignals.Create(Self);
FLocals := TManagedLocals.Create;
@ -2176,6 +2188,7 @@ begin
SetDebugger(nil);
FreeAndNil(FWatches);
FreeAndNil(FThreads);
FreeAndNil(FBreakPoints);
FreeAndNil(FBreakPointGroups);
FreeAndNil(FCallStack);
@ -2199,6 +2212,7 @@ begin
FBreakPoints.Clear;
FBreakPointGroups.Clear;
FWatches.Clear;
FThreads.Clear;
FExceptions.Reset;
FSignals.Reset;
FUserSourceFiles.Clear;
@ -2220,6 +2234,8 @@ begin
itmViewRegisters.Tag := Ord(ddtRegisters);
itmViewCallStack.OnClick := @mnuViewDebugDialogClick;
itmViewCallStack.Tag := Ord(ddtCallStack);
itmViewThreads.OnClick := @mnuViewDebugDialogClick;
itmViewThreads.Tag := Ord(ddtThreads);
itmViewAssembler.OnClick := @mnuViewDebugDialogClick;
itmViewAssembler.Tag := Ord(ddtAssembler);
itmViewDebugOutput.OnClick := @mnuViewDebugDialogClick;
@ -2874,6 +2890,7 @@ begin
ecToggleDebugEvents: ViewDebugDialog(ddtEvents);
ecToggleLocals: ViewDebugDialog(ddtLocals);
ecViewPseudoTerminal: ViewDebugDialog(ddtPseudoTerminal);
ecViewThreads: ViewDebugDialog(ddtThreads);
else
Handled := False;
end;
@ -3140,6 +3157,7 @@ begin
then begin
TManagedBreakpoints(FBreakpoints).Master := nil;
TManagedWatches(FWatches).Master := nil;
FThreads.Master := nil;
TManagedLocals(FLocals).Master := nil;
TManagedLineInfo(FLineInfo).Master := nil;
TManagedCallStack(FCallStack).Master := nil;
@ -3151,6 +3169,7 @@ begin
else begin
TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints;
TManagedWatches(FWatches).Master := FDebugger.Watches;
FThreads.Master := FDebugger.Threads;
TManagedLocals(FLocals).Master := FDebugger.Locals;
TManagedLineInfo(FLineInfo).Master := FDebugger.LineInfo;
TManagedCallStack(FCallStack).Master := FDebugger.CallStack;

2
ide/ideoptiondefs.pas
View File

@ -94,6 +94,7 @@ type
nmiwAssembler,
nmiwInspect,
nmiwPseudoTerminal,
nmiwThreads,
// extra
nmiwSearchResultsViewName,
nmiwAnchorEditor,
@ -140,6 +141,7 @@ const
'Assembler',
'Inspect',
'PseudoTerminal',
'Threads',
// extra
'SearchResults',
'AnchorEditor',

4
ide/keymapping.pp
View File

@ -513,6 +513,7 @@ begin
ecToggleBreakPoints: SetResult(VK_B,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleLocals: SetResult(VK_L,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecViewPseudoTerminal: if HasConsoleSupport then SetResult(VK_T,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecViewThreads: SetResult(VK_T,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleCallStack: SetResult(VK_S,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleRegisters: SetResult(VK_R,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleAssembler: SetResult(VK_D,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
@ -1573,6 +1574,7 @@ begin
ecToggleBreakPoints: SetResult(VK_B,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleLocals: SetResult(VK_L,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecViewPseudoTerminal: if HasConsoleSupport then SetResult(VK_T,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecViewThreads: SetResult(VK_T,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleCallStack: SetResult(VK_S,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleRegisters: SetResult(VK_R,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleAssembler: SetResult(VK_D,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
@ -2079,6 +2081,7 @@ begin
ecToggleBreakPoints : Result:= srkmecToggleBreakPoints;
ecToggleDebuggerOut : Result:= srkmecToggleDebuggerOut;
ecToggleLocals : Result:= srkmecToggleLocals;
ecViewThreads : Result:= srkmecViewThreads;
ecViewPseudoTerminal : Result:= srkmecViewPseudoTerminal;
ecToggleCallStack : Result:= srkmecToggleCallStack;
ecToggleRegisters : Result:= srkmecToggleRegisters;
@ -2747,6 +2750,7 @@ begin
AddDefault(C, 'Toggle view Watches', lisKMToggleViewWatches, ecToggleWatches);
AddDefault(C, 'Toggle view Breakpoints', lisKMToggleViewBreakpoints, ecToggleBreakPoints);
AddDefault(C, 'Toggle view Local Variables', lisKMToggleViewLocalVariables, ecToggleLocals);
AddDefault(C, 'Toggle view Threads', lisKMToggleViewThreads, ecViewThreads);
if HasConsoleSupport then
AddDefault(C, 'Toggle view Terminal Output', lisKMToggleViewPseudoTerminal, ecViewPseudoTerminal);
AddDefault(C, 'Toggle view Call Stack', lisKMToggleViewCallStack, ecToggleCallStack);

14
ide/lazarusidestrconsts.pas
View File

@ -304,6 +304,7 @@ resourcestring
lisMenuViewPseudoTerminal = 'Terminal Output';
lisMenuViewRegisters = 'Registers';
lisMenuViewCallStack = 'Call Stack';
lisMenuViewThreads = 'Threads';
lisMenuViewAssembler = 'Assembler';
lisDbgAsmCopyToClipboard = 'Copy to clipboard';
lisMenuViewDebugOutput = 'Debug output';
@ -2602,6 +2603,7 @@ resourcestring
srkmecToggleBreakPoints = 'View breakpoints';
srkmecToggleDebuggerOut = 'View debugger output';
srkmecToggleLocals = 'View local variables';
srkmecViewThreads = 'View Threads';
srkmecViewPseudoTerminal = 'View Terminal Output';
srkmecTogglecallStack = 'View call stack';
srkmecToggleRegisters = 'View registers';
@ -2750,6 +2752,7 @@ resourcestring
lisKMToggleViewWatches = 'Toggle view Watches';
lisKMToggleViewBreakpoints = 'Toggle view Breakpoints';
lisKMToggleViewLocalVariables = 'Toggle view Local Variables';
lisKMToggleViewThreads = 'Toggle view Threads';
lisKMToggleViewPseudoTerminal = 'Toggle view Terminal Output';
lisKMToggleViewCallStack = 'Toggle view Call Stack';
lisKMToggleViewRegisters = 'Toggle view Registers';
@ -4665,6 +4668,17 @@ resourcestring
lisRegistersDlgName = 'Name';
lisRegistersDlgValue = 'Value';
// ThreadDlg
lisThreads = 'Threads';
lisThreadsId = 'Id';
lisThreadsName = 'Name';
lisThreadsState = 'State';
lisThreadsSrc = 'Source';
lisThreadsLine = 'Line';
lisThreadsFunc = 'Function';
lisThreadsCurrent = 'Current';
lisThreadsGoto = 'Goto';
// Exception Dialog
lisExceptionDialog = 'Debugger Exception Notification';
lisBtnBreak = 'Break';

1
ide/mainbar.pas
View File

@ -188,6 +188,7 @@ type
itmViewLocals: TIDEMenuCommand;
itmViewRegisters: TIDEMenuCommand;
itmViewCallStack: TIDEMenuCommand;
itmViewThreads: TIDEMenuCommand;
itmViewAssembler: TIDEMenuCommand;
itmViewDebugOutput: TIDEMenuCommand;
itmViewDebugEvents: TIDEMenuCommand;

1
ide/mainbase.pas
View File

@ -535,6 +535,7 @@ begin
itmViewPseudoTerminal := nil;
CreateMenuItem(itmViewDebugWindows,itmViewRegisters,'itmViewRegisters',lisMenuViewRegisters);
CreateMenuItem(itmViewDebugWindows,itmViewCallStack,'itmViewCallStack',lisMenuViewCallStack,'debugger_call_stack');
CreateMenuItem(itmViewDebugWindows,itmViewThreads,'itmViewThreads',lisMenuViewThreads);
CreateMenuItem(itmViewDebugWindows,itmViewAssembler,'itmViewAssembler',lisMenuViewAssembler);
CreateMenuItem(itmViewDebugWindows,itmViewDebugEvents,'itmViewDebugEvents',lisMenuViewDebugEvents,''{'debugger_events'});
CreateMenuItem(itmViewDebugWindows,itmViewDebugOutput,'itmViewDebugOutput',lisMenuViewDebugOutput,'debugger_output');

1
ideintf/idecommands.pas
View File

@ -186,6 +186,7 @@ const
ecToggleAssembler = ecFirstLazarus + 326;
ecToggleDebugEvents = ecFirstLazarus + 327;
ecViewPseudoTerminal = ecFirstLazarus + 328;
ecViewThreads = ecFirstLazarus + 329;
// sourcenotebook commands
ecNextEditor = ecFirstLazarus + 330;