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

DBG: Enable/Disable breakpoint groups

Browse Source 
git-svn-id: trunk@32784 -
This commit is contained in:
martin 2011-10-09 15:52:06 +00:00
parent 0e469c5afb
commit 8068974afb
7 changed files with 577 additions and 168 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -2761,6 +2761,8 @@ debugger/breakpointsdlg.lfm svneol=native#text/plain
debugger/breakpointsdlg.pp svneol=native#text/pascal
debugger/breakpropertydlg.lfm svneol=native#text/pascal
debugger/breakpropertydlg.pas svneol=native#text/pascal
debugger/breakpropertydlggroups.lfm svneol=native#text/plain
debugger/breakpropertydlggroups.pas svneol=native#text/pascal
debugger/callstackdlg.lfm svneol=native#text/plain
debugger/callstackdlg.pp svneol=native#text/pascal
debugger/cmdlinedebugger.pp svneol=native#text/pascal

19
debugger/breakpropertydlg.lfm
View File

@ -171,6 +171,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
BorderSpacing.Left = 24
BorderSpacing.Around = 6
ItemHeight = 15
OnKeyPress = cmbGroupKeyPress
TabOrder = 3
Text = 'cmbGroup'
end
@ -213,6 +214,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
BorderSpacing.Left = 6
BorderSpacing.Right = 6
Caption = 'Enable goups'
OnChange = chkEnableGroupsChange
TabOrder = 1
end
object chkDisableGroups: TCheckBox
@ -226,6 +228,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
BorderSpacing.Left = 6
BorderSpacing.Right = 6
Caption = 'Disable groups'
OnChange = chkDisableGroupsChange
TabOrder = 3
end
object edtEnableGroups: TEditButton
@ -247,6 +250,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
Enabled = False
MaxLength = 0
NumGlyphs = 1
OnButtonClick = edtEnableGroupsButtonClick
TabOrder = 2
end
object edtDisableGroups: TEditButton
@ -268,6 +272,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
Enabled = False
MaxLength = 0
NumGlyphs = 1
OnButtonClick = edtDisableGroupsButtonClick
TabOrder = 4
end
object chkEvalExpression: TCheckBox
@ -281,6 +286,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
BorderSpacing.Left = 6
BorderSpacing.Right = 6
Caption = 'Eval expression'
OnChange = chkEvalExpressionChange
TabOrder = 5
end
object chkLogMessage: TCheckBox
@ -313,6 +319,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
BorderSpacing.Top = 6
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
Enabled = False
TabOrder = 6
end
object edtLogMessage: TEdit
@ -399,12 +406,16 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
Width = 438
Anchors = [akTop, akLeft, akRight, akBottom]
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
OKButton.OnClick = btnOKClick
HelpButton.Name = 'HelpButton'
HelpButton.DefaultCaption = True
HelpButton.OnClick = btnHelpClick
CloseButton.Name = 'CloseButton'
CloseButton.DefaultCaption = True
CloseButton.Enabled = False
CancelButton.Name = 'CancelButton'
CancelButton.DefaultCaption = True
TabOrder = 5
ShowButtons = [pbOK, pbCancel, pbHelp]
ShowBevel = False
@ -478,7 +489,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
TabStop = True
end
object rbRead: TRadioButton
Left = 65
Left = 68
Height = 19
Top = 0
Width = 57
@ -487,7 +498,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
TabOrder = 0
end
object rbReadWrite: TRadioButton
Left = 122
Left = 128
Height = 19
Top = 0
Width = 85
@ -530,7 +541,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
TabOrder = 0
end
object rbLocal: TRadioButton
Left = 71
Left = 74
Height = 19
Top = 0
Width = 59
@ -539,7 +550,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
TabOrder = 1
end
object Label1: TLabel
Left = 130
Left = 133
Height = 19
Top = 0
Width = 4

267
debugger/breakpropertydlg.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, LCLProc,
ExtCtrls, StdCtrls, Buttons, ButtonPanel, EditBtn, Spin,
IDEHelpIntf,
IDEHelpIntf, BreakPropertyDlgGroups, EnvironmentOpts,
DebuggerDlg, Debugger, BaseDebugManager, LazarusIDEStrConsts, InputHistory;
type
@ -59,11 +59,18 @@ type
const ABreakpoint: TIDEBreakPoint);
procedure BreakPointUpdate(const ASender: TIDEBreakPoints;
const ABreakpoint: TIDEBreakPoint);
procedure chkDisableGroupsChange(Sender: TObject);
procedure chkEnableGroupsChange(Sender: TObject);
procedure chkEvalExpressionChange(Sender: TObject);
procedure chkLogCallStackChange(Sender: TObject);
procedure chkLogMessageChange(Sender: TObject);
procedure cmbGroupKeyPress(Sender: TObject; var Key: char);
procedure edtDisableGroupsButtonClick(Sender: TObject);
procedure edtEnableGroupsButtonClick(Sender: TObject);
private
FBreakpointsNotification : TIDEBreakPointsNotification;
FBreakpoint: TIDEBreakPoint;
FUpdatingInfo: Boolean;
protected
procedure DoEndUpdate; override;
procedure UpdateInfo;
@ -84,6 +91,51 @@ begin
UpdateInfo;
end;
procedure TBreakPropertyDlg.chkDisableGroupsChange(Sender: TObject);
begin
{$IFdef MSWindows}
if (not FUpdatingInfo) and (not EnvironmentOptions.DebuggerConfig.WarnedAboutBreakGroup)
then begin
if MessageDlg('Beta Feature', 'This feature requires special setup, See DEBUG-README.TXT. Continue?',
mtConfirmation, mbYesNo, 0)
<> mrYes
then begin
FUpdatingInfo := True;
chkDisableGroups.Checked := False;
FUpdatingInfo := False;
exit;
end;
EnvironmentOptions.DebuggerConfig.WarnedAboutBreakGroup := True;
end;
{$ENDIF}
edtDisableGroups.Enabled := chkDisableGroups.Checked;
end;
procedure TBreakPropertyDlg.chkEnableGroupsChange(Sender: TObject);
begin
{$IFdef MSWindows}
if (not FUpdatingInfo) and (not EnvironmentOptions.DebuggerConfig.WarnedAboutBreakGroup)
then begin
if MessageDlg('Beta Feature', 'This feature requires special setup, See DEBUG-README.TXT. Continue?',
mtConfirmation, mbYesNo, 0)
<> mrYes
then begin
FUpdatingInfo := True;
chkEnableGroups.Checked := False;
FUpdatingInfo := False;
exit;
end;
EnvironmentOptions.DebuggerConfig.WarnedAboutBreakGroup := True;
end;
{$ENDIF}
edtEnableGroups.Enabled := chkEnableGroups.Checked;
end;
procedure TBreakPropertyDlg.chkEvalExpressionChange(Sender: TObject);
begin
edtEvalExpression.Enabled := chkEvalExpression.Checked;
end;
procedure TBreakPropertyDlg.chkLogCallStackChange(Sender: TObject);
begin
edtLogCallStack.Enabled := chkLogCallStack.Checked;
@ -94,6 +146,31 @@ begin
edtLogMessage.Enabled := chkLogMessage.Checked;
end;
procedure TBreakPropertyDlg.cmbGroupKeyPress(Sender: TObject; var Key: char);
begin
if Key = ';' then Key := #0;
end;
procedure TBreakPropertyDlg.edtDisableGroupsButtonClick(Sender: TObject);
var
s: TCaption;
begin
if FBreakpoint = nil then Exit;
s := edtDisableGroups.Text;
if ExecuteBreakPointGroupDlg(FBreakpoint, s, DebugBoss.BreakPointGroups, bgaDisable) = mrok
then edtDisableGroups.Text := s;
end;
procedure TBreakPropertyDlg.edtEnableGroupsButtonClick(Sender: TObject);
var
s: TCaption;
begin
if FBreakpoint = nil then Exit;
s := edtEnableGroups.Text;
if ExecuteBreakPointGroupDlg(FBreakpoint, s, DebugBoss.BreakPointGroups, bgaEnable) = mrok
then edtEnableGroups.Text := s;
end;
procedure TBreakPropertyDlg.btnHelpClick(Sender: TObject);
begin
LazarusHelp.ShowHelpForIDEControl(Self);
@ -107,69 +184,134 @@ begin
end;
procedure TBreakPropertyDlg.btnOKClick(Sender: TObject);
function CheckGroupList(Alist: TStringList): Boolean;
var
i: Integer;
r: TModalResult;
s: String;
NewGroup: TIDEBreakPointGroup;
begin
Result := True;
s := '';
for i := 0 to Alist.Count-1 do begin
if Alist[i] = '' then continue;
if DebugBoss.BreakPointGroups.GetGroupByName(Alist[i]) = nil then
s := s + ', ' + Alist[i];
end;
if s = '' then exit;
delete(s, 1, 2);
r := MessageDlg(Format(dbgBreakPropertyGroupNotFound, [LineEnding, s]),
mtConfirmation, [mbYes, mbIgnore, mbCancel], 0);
if r = mrCancel then exit(False);
if r = mrYes then begin
for i := 0 to Alist.Count-1 do begin
if Alist[i] = '' then continue;
if DebugBoss.BreakPointGroups.GetGroupByName(Alist[i]) = nil then begin
NewGroup := TIDEBreakPointGroup(DebugBoss.BreakPointGroups.Add);
NewGroup.Name := Alist[i];
end;
end;
end;
end;
var
Actions: TIDEBreakPointActions;
GroupName: String;
NewGroup: TIDEBreakPointGroup;
ws: TDBGWatchPointScope;
wk: TDBGWatchPointKind;
i: SizeInt;
EnableGroupList, DisableGroupList: TStringList;
begin
if FBreakpoint = nil then Exit;
FBreakpointsNotification.OnUpdate := nil;
case FBreakpoint.Kind of
bpkSource:
begin
// filename + line
FBreakpoint.SetLocation(edtFilename.Text, edtLine.Value);
end;
bpkAddress:
begin
FBreakpoint.SetAddress(StrToQWordDef(edtFilename.Text, 0));
end;
bpkData:
begin
if rbGlobal.Checked
then ws := wpsGlobal
else ws := wpsLocal;
wk := wpkWrite;
if rbRead.Checked
then wk := wpkRead;
if rbReadWrite.Checked
then wk := wpkReadWrite;
FBreakpoint.SetWatch(edtFilename.Text, ws, wk);
end;
end;
// expression
FBreakpoint.Expression := edtCondition.Text;
// hitcount
FBreakpoint.BreakHitCount := StrToIntDef(edtCounter.Text, FBreakpoint.HitCount);
//auto continue
FBreakpoint.AutoContinueTime := StrToIntDef(edtAutocontinueMS.Text, FBreakpoint.AutoContinueTime);
// group
GroupName := cmbGroup.Text;
NewGroup := DebugBoss.BreakPointGroups.GetGroupByName(GroupName);
if not Assigned(NewGroup) and (GroupName <> '') then
begin
NewGroup := TIDEBreakPointGroup(DebugBoss.BreakPointGroups.Add);
NewGroup.Name := GroupName;
end;
FBreakpoint.Group := NewGroup;
// actions
Actions := [];
if chkActionBreak.Checked then Include(Actions, bpaStop);
if chkDisableGroups.Checked then Include(Actions, bpaDisableGroup);
if chkEnableGroups.Checked then Include(Actions, bpaEnableGroup);
if chkEvalExpression.Checked then Include(Actions, bpaEValExpression);
if chkLogMessage.Checked then Include(Actions, bpaLogMessage);
if chkLogCallStack.Checked then Include(Actions, bpaLogCallStack);
if chkTakeSnap.Checked then include(Actions, bpaTakeSnapshot);
FBreakpoint.Actions := Actions;
FBreakpoint.LogEvalExpression := edtEvalExpression.Text;
FBreakpoint.LogMessage := edtLogMessage.Text;
FBreakpoint.LogCallStackLimit := edtLogCallStack.Value;
EnableGroupList := TStringList.Create;
DisableGroupList := TStringList.Create;
InputHistories.HistoryLists.GetList('BreakPointExpression', True).Add(edtCondition.Text);
try
EnableGroupList.Delimiter := ';';
DisableGroupList.Delimiter := ';';
EnableGroupList.DelimitedText := edtEnableGroups.Text+';'+edtDisableGroups.Text;
if not CheckGroupList(EnableGroupList) then begin
ModalResult := mrNone;
exit;
end;
EnableGroupList.DelimitedText := edtEnableGroups.Text;
DisableGroupList.DelimitedText := edtDisableGroups.Text;
FBreakpointsNotification.OnUpdate := nil;
case FBreakpoint.Kind of
bpkSource:
begin
// filename + line
FBreakpoint.SetLocation(edtFilename.Text, edtLine.Value);
end;
bpkAddress:
begin
FBreakpoint.SetAddress(StrToQWordDef(edtFilename.Text, 0));
end;
bpkData:
begin
if rbGlobal.Checked
then ws := wpsGlobal
else ws := wpsLocal;
wk := wpkWrite;
if rbRead.Checked
then wk := wpkRead;
if rbReadWrite.Checked
then wk := wpkReadWrite;
FBreakpoint.SetWatch(edtFilename.Text, ws, wk);
end;
end;
// expression
FBreakpoint.Expression := edtCondition.Text;
// hitcount
FBreakpoint.BreakHitCount := StrToIntDef(edtCounter.Text, FBreakpoint.HitCount);
//auto continue
FBreakpoint.AutoContinueTime := StrToIntDef(edtAutocontinueMS.Text, FBreakpoint.AutoContinueTime);
// group
GroupName := cmbGroup.Text;
NewGroup := DebugBoss.BreakPointGroups.GetGroupByName(GroupName);
if not Assigned(NewGroup) and (GroupName <> '') then
begin
NewGroup := TIDEBreakPointGroup(DebugBoss.BreakPointGroups.Add);
NewGroup.Name := GroupName;
end;
FBreakpoint.Group := NewGroup;
// enable groups
for i := 0 to DebugBoss.BreakPointGroups.Count-1 do begin
NewGroup := DebugBoss.BreakPointGroups[i];
if EnableGroupList.IndexOf(NewGroup.Name) >= 0
then FBreakpoint.EnableGroupList.Add(NewGroup)
else FBreakpoint.EnableGroupList.Remove(NewGroup);
end;
// disable groups
for i := 0 to DebugBoss.BreakPointGroups.Count-1 do begin
NewGroup := DebugBoss.BreakPointGroups[i];
if DisableGroupList.IndexOf(NewGroup.Name) >= 0
then FBreakpoint.DisableGroupList.Add(NewGroup)
else FBreakpoint.DisableGroupList.Remove(NewGroup);
end;
// actions
Actions := [];
if chkActionBreak.Checked then Include(Actions, bpaStop);
if chkDisableGroups.Checked then Include(Actions, bpaDisableGroup);
if chkEnableGroups.Checked then Include(Actions, bpaEnableGroup);
if chkEvalExpression.Checked then Include(Actions, bpaEValExpression);
if chkLogMessage.Checked then Include(Actions, bpaLogMessage);
if chkLogCallStack.Checked then Include(Actions, bpaLogCallStack);
if chkTakeSnap.Checked then include(Actions, bpaTakeSnapshot);
FBreakpoint.Actions := Actions;
FBreakpoint.LogEvalExpression := edtEvalExpression.Text;
FBreakpoint.LogMessage := edtLogMessage.Text;
FBreakpoint.LogCallStackLimit := edtLogCallStack.Value;
InputHistories.HistoryLists.GetList('BreakPointExpression', True).Add(edtCondition.Text);
finally
EnableGroupList.Free;
DisableGroupList.Free;
end;
end;
procedure TBreakPropertyDlg.DoEndUpdate;
@ -182,7 +324,9 @@ procedure TBreakPropertyDlg.UpdateInfo;
var
Actions: TIDEBreakPointActions;
I: Integer;
s: String;
begin
FUpdatingInfo := True;
if FBreakpoint = nil then Exit;
case FBreakpoint.Kind of
bpkSource:
@ -220,6 +364,20 @@ begin
if FBreakpoint.Group = nil
then cmbGroup.Text := ''
else cmbGroup.Text := FBreakpoint.Group.Name;
// enable groups
s := '';
for i := 0 to FBreakpoint.EnableGroupList.Count - 1 do begin
if s <> '' then s := s + ';';
s := s + FBreakpoint.EnableGroupList[i].Name;
end;
edtEnableGroups.Text := s;
// disable groups
s := '';
for i := 0 to FBreakpoint.DisableGroupList.Count - 1 do begin
if s <> '' then s := s + ';';
s := s + FBreakpoint.DisableGroupList[i].Name;
end;
edtDisableGroups.Text := s;
// actions
Actions := FBreakpoint.Actions;
@ -233,6 +391,7 @@ begin
chkLogCallStack.Checked := bpaLogCallStack in Actions;
edtLogCallStack.Value := FBreakpoint.LogCallStackLimit;
chkTakeSnap.Checked := bpaTakeSnapshot in Actions;
FUpdatingInfo := False;
end;
constructor TBreakPropertyDlg.Create(AOwner: TComponent; ABreakPoint: TIDEBreakPoint);

45
debugger/breakpropertydlggroups.lfm Normal file
View File

@ -0,0 +1,45 @@
object BreakPointGroupDlg: TBreakPointGroupDlg
Left = 431
Height = 225
Top = 221
Width = 214
Caption = 'BreakPointGroupDlg'
ClientHeight = 225
ClientWidth = 214
LCLVersion = '0.9.31'
object ButtonPanel1: TButtonPanel
Left = 6
Height = 34
Top = 185
Width = 202
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton'
HelpButton.DefaultCaption = True
CloseButton.Name = 'CloseButton'
CloseButton.DefaultCaption = True
CancelButton.Name = 'CancelButton'
CancelButton.DefaultCaption = True
TabOrder = 1
ShowButtons = [pbOK, pbCancel]
end
object Label1: TLabel
Left = 0
Height = 16
Top = 0
Width = 214
Align = alTop
Caption = 'Label1'
ParentColor = False
WordWrap = True
end
object CheckListBox1: TCheckListBox
Left = 0
Height = 163
Top = 16
Width = 214
Align = alClient
ItemHeight = 0
TabOrder = 0
end
end

129
debugger/breakpropertydlggroups.pas Normal file
View File

@ -0,0 +1,129 @@
unit breakpropertydlggroups;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel, StdCtrls,
ExtCtrls, CheckLst, Debugger, LazarusIDEStrConsts;
type
TBreakPointGroupAction = (bgaEnable, bgaDisable);
{ TBreakPointGroupDlg }
TBreakPointGroupDlg = class(TForm)
ButtonPanel1: TButtonPanel;
CheckListBox1: TCheckListBox;
Label1: TLabel;
protected
FBrkPointPoint: TIDEBreakPoint;
FGroupList: TStringList;
FAvailableGroups: TIDEBreakPointGroups;
public
{ public declarations }
constructor Create(ABrkPointPoint: TIDEBreakPoint;
AGroupList: String;
AAvailableGroups: TIDEBreakPointGroups;
AAction: TBreakPointGroupAction
);
destructor Destroy; override;
function ShowModal: Integer; override;
end;
function ExecuteBreakPointGroupDlg(ABrkPointPoint: TIDEBreakPoint;
var AGroupList: String;
AAvailableGroups: TIDEBreakPointGroups;
AAction: TBreakPointGroupAction
): TModalResult;
implementation
function ExecuteBreakPointGroupDlg(ABrkPointPoint: TIDEBreakPoint;
var AGroupList: String; AAvailableGroups: TIDEBreakPointGroups;
AAction: TBreakPointGroupAction): TModalResult;
var
dlg: TBreakPointGroupDlg;
begin
Result := mrAbort;
dlg := TBreakPointGroupDlg.Create(ABrkPointPoint, AGroupList, AAvailableGroups, AAction);
try
Result := dlg.ShowModal;
if Result = mrOK then
AGroupList := dlg. FGroupList.DelimitedText;
finally
dlg.Free;
end;
end;
{ TBreakPointGroupDlg }
constructor TBreakPointGroupDlg.Create(ABrkPointPoint: TIDEBreakPoint;
AGroupList: String; AAvailableGroups: TIDEBreakPointGroups;
AAction: TBreakPointGroupAction);
var
g: TIDEBreakPointGroup;
i, j: Integer;
begin
inherited Create(nil);
FBrkPointPoint := ABrkPointPoint;
FAvailableGroups := AAvailableGroups;
FGroupList := TStringList.Create;
FGroupList.Delimiter := ';';
FGroupList.DelimitedText := AGroupList;
case AAction of
bgaEnable:
begin
Caption := dbgBreakGroupDlgCaptionEnable;
Label1.Caption := dbgBreakGroupDlgHeaderEnable;
end;
bgaDisable:
begin
Caption := dbgBreakGroupDlgCaptionDisable;
Label1.Caption := dbgBreakGroupDlgHeaderDisable;
end;
end;
for i := 0 to FAvailableGroups.Count - 1 do begin
g := FAvailableGroups[i];
j := CheckListBox1.Items.Add(g.Name);
CheckListBox1.Checked[j] := FGroupList.IndexOf(g.Name) >= 0;
end;
end;
destructor TBreakPointGroupDlg.Destroy;
begin
inherited Destroy;
FGroupList.Free;
end;
function TBreakPointGroupDlg.ShowModal: Integer;
var
i, j: Integer;
g: TIDEBreakPointGroup;
begin
Result := inherited ShowModal;
FGroupList.Clear;
if Result = mrOK then begin
for i := 0 to FAvailableGroups.Count - 1 do begin
g := FAvailableGroups[i];
j := CheckListBox1.Items.IndexOf(g.Name);
if j < 0 then continue;
if CheckListBox1.Checked[j] then begin
FGroupList.Add(g.Name);
end;
end;
end;
end;
{$R *.lfm}
end.

275
debugger/debugger.pp
View File

@ -174,6 +174,7 @@ type
FConfigStore: TConfigStorage;
public
property ConfigStore: TConfigStorage read FConfigStore write FConfigStore;
procedure Init; virtual;
procedure Load; virtual;
procedure Save; virtual;
end;
@ -186,9 +187,7 @@ type
FColumnValueWidth: Integer;
public
constructor Create;
procedure Init;
procedure Load; override;
procedure Save; override;
procedure Init; override;
published
property ColumnNameWidth: Integer read FColumnNameWidth write FColumnNameWidth;
property ColumnValueWidth: Integer read FColumnValueWidth write FColumnValueWidth;
@ -198,7 +197,9 @@ type
private
FDebuggerClass: String;
FTDebuggerWatchesDlgConfig: TDebuggerWatchesDlgConfig;
FWarnedAboutBreakGroup: Boolean;
public
procedure Init; override;
procedure Load; override;
procedure Save; override;
public
@ -206,6 +207,10 @@ type
destructor Destroy; override;
property DebuggerClass: String read FDebuggerClass write FDebuggerClass;
property DlgWatchesConfig: TDebuggerWatchesDlgConfig read FTDebuggerWatchesDlgConfig;
published
{$IFdef MSWindows}
property WarnedAboutBreakGroup: Boolean read FWarnedAboutBreakGroup write FWarnedAboutBreakGroup;
{$ENDIF}
end;
{ TFreeNotifyingObject }
@ -512,6 +517,28 @@ type
wpkReadWrite
);
TBaseBreakPoint = class;
TDBGBreakPoint = class;
{ TIDEBreakPointGroupList }
TIDEBreakPointGroupList = class
private
FList: TFPList;
FOwner: TBaseBreakPoint;
function GetItem(AIndex: Integer): TIDEBreakPointGroup;
public
constructor Create(AOwner: TBaseBreakPoint);
destructor Destroy; override;
procedure Assign(ASrc: TIDEBreakPointGroupList);
procedure Clear;
function Add(const AGroup: TIDEBreakPointGroup): Integer;
procedure Remove(const AGroup: TIDEBreakPointGroup);
function IndexOf(const AGroup: TIDEBreakPointGroup): Integer;
function Count: Integer;
property Items[AIndex: Integer]: TIDEBreakPointGroup read GetItem; default;
end;
{ TBaseBreakPoint }
TBaseBreakPoint = class(TDelayedUdateItem)
@ -588,16 +615,14 @@ type
end;
TBaseBreakPointClass = class of TBaseBreakPoint;
TDBGBreakPoint = class;
TIDEBreakPoint = class(TBaseBreakPoint)
private
FLogEvalExpression: String;
FMaster: TDBGBreakPoint;
FAutoContinueTime: Cardinal;
FActions: TIDEBreakPointActions;
FDisableGroupList: TList;
FEnableGroupList: TList;
FDisableGroupList: TIDEBreakPointGroupList;
FEnableGroupList: TIDEBreakPointGroupList;
FGroup: TIDEBreakPointGroup;
FLoading: Boolean;
FLogMessage: String;
@ -618,10 +643,10 @@ type
procedure DoActionChange; virtual;
procedure DoHit(const ACount: Integer; var AContinue: Boolean); override;
procedure EnableGroups;
procedure RemoveFromGroupList(const AGroup: TIDEBreakPointGroup;
const AGroupList: TList);
procedure ClearGroupList(const AGroupList: TList);
procedure ClearAllGroupLists;
{$IFDEF DBG_BREAKPOINT}
function DebugText: string;
{$ENDIF}
protected
// virtual properties
function GetActions: TIDEBreakPointActions; virtual;
@ -638,10 +663,6 @@ type
public
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
procedure AddDisableGroup(const AGroup: TIDEBreakPointGroup);
procedure AddEnableGroup(const AGroup: TIDEBreakPointGroup);
procedure RemoveDisableGroup(const AGroup: TIDEBreakPointGroup);
procedure RemoveEnableGroup(const AGroup: TIDEBreakPointGroup);
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
const OnLoadFilename: TOnLoadFilenameFromConfig;
const OnGetGroup: TOnGetGroupByName); virtual;
@ -656,6 +677,8 @@ type
property Actions: TIDEBreakPointActions read GetActions write SetActions;
property AutoContinueTime: Cardinal read GetAutoContinueTime write SetAutoContinueTime;
property Group: TIDEBreakPointGroup read GetGroup write SetGroup;
property DisableGroupList: TIDEBreakPointGroupList read FDisableGroupList;
property EnableGroupList: TIDEBreakPointGroupList read FEnableGroupList;
property LogEvalExpression: String read FLogEvalExpression write SetLogEvalExpression;
property Loading: Boolean read FLoading;
property LogMessage: String read GetLogMessage write SetLogMessage;
@ -810,8 +833,8 @@ type
procedure SetName(const AValue: String);
protected
procedure AssignTo(Dest: TPersistent); override;
procedure AddReference(const ABreakPoint: TIDEBreakPoint);
procedure RemoveReference(const ABreakPoint: TIDEBreakPoint);
procedure AddReference(const ABreakPointList: TIDEBreakPointGroupList);
procedure RemoveReference(const ABreakPointList: TIDEBreakPointGroupList);
public
function Add(const ABreakPoint: TIDEBreakPoint): Integer;
function Count: Integer;
@ -826,7 +849,7 @@ type
public
property Breakpoints[const AIndex: Integer]: TIDEBreakPoint read GetBreakpoint;
property Enabled: Boolean read FEnabled write SetEnabled;
property InitialEnabled: Boolean read FInitialEnabled write SetInitialEnabled;
//property InitialEnabled: Boolean read FInitialEnabled write SetInitialEnabled;
property Name: String read FName write SetName;
end;
@ -2958,6 +2981,70 @@ begin
Result:=bpaStop;
end;
{ TIDEBreakPointGroupList }
function TIDEBreakPointGroupList.GetItem(AIndex: Integer): TIDEBreakPointGroup;
begin
Result := TIDEBreakPointGroup(FList[AIndex]);
end;
constructor TIDEBreakPointGroupList.Create(AOwner: TBaseBreakPoint);
begin
FList := TFPList.Create;
FOwner := AOwner;
end;
destructor TIDEBreakPointGroupList.Destroy;
begin
inherited Destroy;
FList.Free;
end;
procedure TIDEBreakPointGroupList.Assign(ASrc: TIDEBreakPointGroupList);
var
i: Integer;
begin
Clear;
for i := 0 to ASrc.Count - 1 do
Add(ASrc[i]);
end;
procedure TIDEBreakPointGroupList.Clear;
var
i: Integer;
begin
for i:=0 to Count-1 do
Items[i].RemoveReference(Self);
FList.Clear;
end;
function TIDEBreakPointGroupList.Add(const AGroup: TIDEBreakPointGroup): Integer;
begin
if (AGroup = nil) or (IndexOf(AGroup) >= 0) then exit;
Result := FList.Add(AGroup);
AGroup.AddReference(Self);
FOwner.DoChanged;
end;
procedure TIDEBreakPointGroupList.Remove(const AGroup: TIDEBreakPointGroup);
begin
if (AGroup = nil) then exit;
AGroup.RemoveReference(Self);
if (IndexOf(AGroup) < 0) then exit;
FList.Remove(AGroup);
FOwner.DoChanged;
end;
function TIDEBreakPointGroupList.IndexOf(const AGroup: TIDEBreakPointGroup): Integer;
begin
Result := FList.IndexOf(AGroup);
end;
function TIDEBreakPointGroupList.Count: Integer;
begin
Result := FList.Count;
end;
{ TFreeNotifyingObject }
constructor TFreeNotifyingObject.Create;
@ -2996,31 +3083,32 @@ begin
FColumnValueWidth := -1;
end;
procedure TDebuggerWatchesDlgConfig.Load;
{ TDebuggerConfigStoreBase }
procedure TDebuggerConfigStoreBase.Init;
begin
//
end;
procedure TDebuggerConfigStoreBase.Load;
begin
Init;
ConfigStore.ReadObject('', self);
end;
procedure TDebuggerWatchesDlgConfig.Save;
procedure TDebuggerConfigStoreBase.Save;
begin
ConfigStore.WriteObject('', self);
end;
{ TDebuggerConfigStoreBase }
procedure TDebuggerConfigStoreBase.Load;
begin
//
end;
procedure TDebuggerConfigStoreBase.Save;
begin
//
end;
{ TDebuggerConfigStore }
procedure TDebuggerConfigStore.Init;
begin
inherited Init;
WarnedAboutBreakGroup := False;
end;
procedure TDebuggerConfigStore.Load;
const
OLD_GDB_DBG_NAME = 'GNU debugger (gdb)';
@ -3028,6 +3116,7 @@ const
var
s: String;
begin
inherited;
FDebuggerClass := ConfigStore.GetValue('Class', '');
if FDebuggerClass='' then begin
// try old format
@ -3046,6 +3135,7 @@ end;
procedure TDebuggerConfigStore.Save;
begin
inherited;
ConfigStore.SetDeleteValue('Class', FDebuggerClass, '');
ConfigStore.DeletePath('Type');
ConfigStore.AppendBasePath('WatchesDlg/');
@ -6389,22 +6479,6 @@ end;
{ TIDEBreakPoint }
{ =========================================================================== }
procedure TIDEBreakPoint.AddDisableGroup(const AGroup: TIDEBreakPointGroup);
begin
if AGroup = nil then Exit;
FDisableGroupList.Add(AGroup);
AGroup.AddReference(Self);
Changed;
end;
procedure TIDEBreakPoint.AddEnableGroup(const AGroup: TIDEBreakPointGroup);
begin
if AGroup = nil then Exit;
FEnableGroupList.Add(AGroup);
AGroup.AddReference(Self);
Changed;
end;
function TIDEBreakPoint.GetAutoContinueTime: Cardinal;
begin
Result := FAutoContinueTime;
@ -6475,6 +6549,8 @@ begin
TIDEBreakPoint(Dest).LogEvalExpression := FLogEvalExpression;
TIDEBreakPoint(Dest).LogMessage := FLogMessage;
TIDEBreakPoint(Dest).LogCallStackLimit := FLogCallStackLimit;
TIDEBreakPoint(Dest).EnableGroupList.Assign(FEnableGroupList);
TIDEBreakPoint(Dest).DisableGroupList.Assign(FDisableGroupList);
end;
if (Collection <> nil) and (TIDEBreakPoints(Collection).FMaster <> nil)
@ -6546,29 +6622,27 @@ end;
procedure TIDEBreakPoint.ClearAllGroupLists;
begin
ClearGroupList(FDisableGroupList);
ClearGroupList(FEnableGroupList);
FDisableGroupList.Clear;
FEnableGroupList.Clear;
end;
procedure TIDEBreakPoint.ClearGroupList(const AGroupList: TList);
{$IFDEF DBG_BREAKPOINT}
function TIDEBreakPoint.DebugText: string;
var
i: Integer;
AGroup: TIDEBreakPointGroup;
s: String;
begin
for i:=0 to AGroupList.Count-1 do begin
AGroup:=TIDEBreakPointGroup(AGroupList[i]);
AGroup.RemoveReference(Self);
end;
AGroupList.Clear;
WriteStr(s, FKind);
Result := dbgs(self) + ' ' + s + ' at ' + Source +':' + IntToStr(Line);
end;
{$ENDIF}
constructor TIDEBreakPoint.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
FGroup := nil;
FActions := [bpaStop];
FDisableGroupList := TList.Create;
FEnableGroupList := TList.Create;
FDisableGroupList := TIDEBreakPointGroupList.Create(Self);
FEnableGroupList := TIDEBreakPointGroupList.Create(Self);
end;
destructor TIDEBreakPoint.Destroy;
@ -6600,8 +6674,11 @@ procedure TIDEBreakPoint.DisableGroups;
var
n: Integer;
begin
{$IFDEF DBG_BREAKPOINT}
DebugLn(['DisableGroups: ', DebugText, ' Cnt=', FDisableGroupList.Count]);
{$ENDIF}
for n := 0 to FDisableGroupList.Count - 1 do
TIDEBreakPointGroup(FDisableGroupList[n]).Enabled := False;
FDisableGroupList[n].Enabled := False;
end;
procedure TIDEBreakPoint.DoActionChange;
@ -6620,6 +6697,8 @@ begin
if bpaLogCallStack in Actions
then FMaster.DoLogCallStack(FLogCallStackLimit);
// SnapShot is taken in TDebugManager.DebuggerChangeState
if Actions * [bpaDisableGroup, bpaEnableGroup] <> []
then sleep(2500);
if bpaEnableGroup in Actions
then EnableGroups;
if bpaDisableGroup in Actions
@ -6630,8 +6709,12 @@ procedure TIDEBreakPoint.EnableGroups;
var
n: Integer;
begin
for n := 0 to FDisableGroupList.Count - 1 do
TIDEBreakPointGroup(FDisableGroupList[n]).Enabled := True;
{$IFDEF DBG_BREAKPOINT}
DebugLn(['EnableGroups: ', DebugText, ' Cnt=', FEnableGroupList.Count]);
{$ENDIF}
for n := 0 to FEnableGroupList.Count - 1 do
FEnableGroupList[n].Enabled := True;
end;
function TIDEBreakPoint.GetActions: TIDEBreakPointActions;
@ -6648,24 +6731,21 @@ procedure TIDEBreakPoint.LoadFromXMLConfig(XMLConfig: TXMLConfig;
const Path: string; const OnLoadFilename: TOnLoadFilenameFromConfig;
const OnGetGroup: TOnGetGroupByName);
procedure LoadGroupList(GroupList: TList; const ListPath: string);
procedure LoadGroupList(GroupList: TIDEBreakPointGroupList; const ListPath: string);
var
i: Integer;
CurGroup: TIDEBreakPointGroup;
NewCount: Integer;
GroupName: String;
begin
ClearGroupList(GroupList);
GroupList.Clear;
NewCount:=XMLConfig.GetValue(ListPath+'Count',0);
for i:=0 to NewCount-1 do begin
GroupName:=XMLConfig.GetValue(ListPath+'Group'+IntToStr(i+1)+'/Name','');
if GroupName='' then continue;
CurGroup:=OnGetGroup(GroupName);
if CurGroup=nil then continue;
if GroupList=FDisableGroupList then
AddDisableGroup(CurGroup)
else if GroupList=FEnableGroupList then
AddEnableGroup(CurGroup);
GroupList.Add(CurGroup);
end;
end;
@ -6716,28 +6796,10 @@ begin
end;
end;
procedure TIDEBreakPoint.RemoveDisableGroup(const AGroup: TIDEBreakPointGroup);
begin
RemoveFromGroupList(AGroup,FDisableGroupList);
end;
procedure TIDEBreakPoint.RemoveEnableGroup(const AGroup: TIDEBreakPointGroup);
begin
RemoveFromGroupList(AGroup,FEnableGroupList);
end;
procedure TIDEBreakPoint.RemoveFromGroupList(const AGroup: TIDEBreakPointGroup;
const AGroupList: TList);
begin
if (AGroup = nil) then Exit;
AGroupList.Remove(AGroup);
AGroup.RemoveReference(Self);
end;
procedure TIDEBreakPoint.SaveToXMLConfig(const AConfig: TXMLConfig;
const APath: string; const OnSaveFilename: TOnSaveFilenameToConfig);
procedure SaveGroupList(const AList: TList; const AListPath: string);
procedure SaveGroupList(const AList: TIDEBreakPointGroupList; const AListPath: string);
var
i: Integer;
CurGroup: TIDEBreakPointGroup;
@ -6745,9 +6807,8 @@ procedure TIDEBreakPoint.SaveToXMLConfig(const AConfig: TXMLConfig;
AConfig.SetDeleteValue(AListPath + 'Count', AList.Count,0);
for i := 0 to AList.Count - 1 do
begin
CurGroup := TIDEBreakPointGroup(AList[i]);
AConfig.SetDeleteValue(Format('$%sGroup%d/Name', [AListPath, i+1]),
CurGroup.Name, '');
CurGroup := AList[i];
AConfig.SetDeleteValue(AListPath+'Group'+IntToStr(i+1)+'/Name', CurGroup.Name, '');
end;
end;
@ -6849,14 +6910,14 @@ begin
end;
(*
procedure TIDEBreakPoint.CopyGroupList(SrcGroupList, DestGroupList: TList;
procedure TIDEBreakPoint.CopyGroupList(SrcGroupList, DestGroupList: TIDEBreakPointGroupList;
DestGroups: TIDEBreakPointGroups);
var
i: Integer;
CurGroup: TIDEBreakPointGroup;
NewGroup: TIDEBreakPointGroup;
begin
ClearGroupList(DestGroupList);
DestGroupList.clear;
for i:=0 to SrcGroupList.Count-1 do begin
CurGroup:=TIDEBreakPointGroup(SrcGroupList[i]);
NewGroup:=DestGroups.GetGroupByName(CurGroup.Name);
@ -7412,9 +7473,9 @@ begin
end;
end;
procedure TIDEBreakPointGroup.AddReference(const ABreakPoint: TIDEBreakPoint);
procedure TIDEBreakPointGroup.AddReference(const ABreakPointList: TIDEBreakPointGroupList);
begin
FReferences.Add(ABreakPoint);
FReferences.Add(ABreakPointList);
end;
function TIDEBreakPointGroup.Count: Integer;
@ -7442,9 +7503,7 @@ begin
for n := FBreakpoints.Count - 1 downto 0 do
TIDEBreakPoint(FBreakpoints[n]).Group := nil;
for n := FReferences.Count - 1 downto 0 do
TIDEBreakPoint(FReferences[n]).RemoveDisableGroup(Self);
for n := FReferences.Count - 1 downto 0 do
TIDEBreakPoint(FReferences[n]).RemoveEnableGroup(Self);
TIDEBreakPointGroupList(FReferences[n]).Remove(Self);
inherited Destroy;
FreeAndNil(FBreakpoints);
@ -7469,8 +7528,8 @@ begin
Name:=XMLConfig.GetValue(Path+'Name/Value','');
// the breakpoints of this group are not loaded here.
// They are loaded by the TIDEBreakPoints object.
InitialEnabled:=XMLConfig.GetValue(Path+'InitialEnabled/Value',true);
FEnabled:=InitialEnabled;
FInitialEnabled:=XMLConfig.GetValue(Path+'InitialEnabled/Value',true);
FEnabled:=FInitialEnabled;
end;
procedure TIDEBreakPointGroup.SaveToXMLConfig(XMLConfig: TXMLConfig;
@ -7479,24 +7538,20 @@ begin
XMLConfig.SetDeleteValue(Path+'Name/Value',Name,'');
// the breakpoints of this group are not saved here.
// They are saved by the TIDEBreakPoints object.
XMLConfig.SetDeleteValue(Path+'InitialEnabled/Value',InitialEnabled,true);
XMLConfig.SetDeleteValue(Path+'InitialEnabled/Value',FInitialEnabled,true);
end;
procedure TIDEBreakPointGroup.RemoveReference(const ABreakPoint: TIDEBreakPoint);
procedure TIDEBreakPointGroup.RemoveReference(const ABreakPointList: TIDEBreakPointGroupList);
begin
FReferences.Remove(ABreakPoint);
FReferences.Remove(ABreakPointList);
end;
procedure TIDEBreakPointGroup.SetEnabled(const AValue: Boolean);
var
n: Integer;
begin
if FEnabled <> AValue
then begin
FEnabled := AValue;
for n := 0 to FBreakPoints.Count - 1 do
TIDEBreakPoint(FBreakPoints[n]).Enabled := FEnabled;
end;
for n := 0 to FBreakPoints.Count - 1 do
TIDEBreakPoint(FBreakPoints[n]).Enabled := AValue;
end;
procedure TIDEBreakPointGroup.SetInitialEnabled(const AValue: Boolean);
@ -7517,7 +7572,7 @@ begin
if Dest is TIDEBreakPointGroup then begin
DestGroup:=TIDEBreakPointGroup(Dest);
DestGroup.Name:=Name;
DestGroup.InitialEnabled:=InitialEnabled;
//DestGroup.InitialEnabled:=InitialEnabled;
DestGroup.Enabled:=Enabled;
end else
inherited AssignTo(Dest);
@ -7607,7 +7662,7 @@ var
i: Integer;
begin
for i:=0 to Count-1 do
Items[i].Enabled:=Items[i].InitialEnabled;
Items[i].Enabled:=Items[i].fInitialEnabled;
end;
function TIDEBreakPointGroups.GetItem(const AnIndex: Integer

8
ide/lazarusidestrconsts.pas
View File

@ -5319,6 +5319,12 @@ resourcestring
lisDebuggerFeedbackMore = 'More';
lisDebuggerFeedbackOk = 'OK';
// breakpointgroups
dbgBreakGroupDlgCaptionEnable = 'Select Groups';
dbgBreakGroupDlgHeaderEnable = 'Select groups to enable when breakpoint is hit';
dbgBreakGroupDlgCaptionDisable = 'Select Groups';
dbgBreakGroupDlgHeaderDisable = 'Select groups to disable when breakpoint is hit';
//Registers dialog
regdlgDisplayTypeForSelectedRegisters = 'Display type for selected Registers';
regdlgHex = 'Hex';
@ -5351,6 +5357,8 @@ resourcestring
lisDiscardChangesCreateNewProject = 'Discard changes, create new project';
lisDoYouStillWantToQuit = 'Do you still want to quit?';
lisDiscardChangesAndQuit = 'Discard changes and quit';
dbgBreakPropertyGroupNotFound = 'Some groups in the Enable/Disable list do not exist.%0:s'
+'Create them?%0:s%0:s%1:s';
implementation