diff --git a/.gitattributes b/.gitattributes index d15360145c..b6bd9713d4 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/debugger/breakpropertydlg.lfm b/debugger/breakpropertydlg.lfm index 172dfa3672..c3779fd883 100644 --- a/debugger/breakpropertydlg.lfm +++ b/debugger/breakpropertydlg.lfm @@ -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 diff --git a/debugger/breakpropertydlg.pas b/debugger/breakpropertydlg.pas index 5464416c6a..bb71be89d7 100644 --- a/debugger/breakpropertydlg.pas +++ b/debugger/breakpropertydlg.pas @@ -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); diff --git a/debugger/breakpropertydlggroups.lfm b/debugger/breakpropertydlggroups.lfm new file mode 100644 index 0000000000..f7be8c418e --- /dev/null +++ b/debugger/breakpropertydlggroups.lfm @@ -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 diff --git a/debugger/breakpropertydlggroups.pas b/debugger/breakpropertydlggroups.pas new file mode 100644 index 0000000000..f02b17863d --- /dev/null +++ b/debugger/breakpropertydlggroups.pas @@ -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. + diff --git a/debugger/debugger.pp b/debugger/debugger.pp index c7694e44dc..ad1198e264 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -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 diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 41b1124099..f5fdea2588 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -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