From 91818313c5db8b51e531014128aa38b81178b311 Mon Sep 17 00:00:00 2001 From: martin Date: Sun, 30 Oct 2011 01:49:55 +0000 Subject: [PATCH] =?UTF-8?q?DBG:=20Setting=20groups=20to=20multiply=20selec?= =?UTF-8?q?ted=20breakpoints.=20Issue=20#0020478=20/=20patch=20by=20Fl?= =?UTF-8?q?=C3=A1vio=20Etrusco?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit git-svn-id: trunk@33160 - --- debugger/breakpointsdlg.lfm | 22 +++++++ debugger/breakpointsdlg.pp | 128 ++++++++++++++++++++++++++++++++++++ debugger/debugger.pp | 14 ++++ ide/lazarusidestrconsts.pas | 8 +++ 4 files changed, 172 insertions(+) diff --git a/debugger/breakpointsdlg.lfm b/debugger/breakpointsdlg.lfm index 45ddeb24f8..bf93c87b89 100644 --- a/debugger/breakpointsdlg.lfm +++ b/debugger/breakpointsdlg.lfm @@ -121,6 +121,7 @@ inherited BreakpointsDlg: TBreakpointsDlg end end object mnuPopup: TPopupMenu[2] + OnPopup = mnuPopupPopup left = 24 top = 40 object popShow: TMenuItem @@ -155,6 +156,19 @@ inherited BreakpointsDlg: TBreakpointsDlg object popDelete: TMenuItem Action = actDeleteSelected end + object popGroup: TMenuItem + Caption = 'popGroup' + object popGroupSetNone: TMenuItem + Action = actGroupSetNone + end + object popGroupSetNew: TMenuItem + Action = actGroupSetNew + end + object popGroupSep: TMenuItem + Caption = '-' + Visible = False + end + end object N2: TMenuItem Caption = '-' end @@ -251,5 +265,13 @@ inherited BreakpointsDlg: TBreakpointsDlg OnExecute = actShowExecute ShortCut = 16470 end + object actGroupSetNew: TAction + Caption = 'actGroupSetNew' + OnExecute = actGroupSetNewExecute + end + object actGroupSetNone: TAction + Caption = 'actGroupSetNone' + OnExecute = actGroupSetNoneExecute + end end end diff --git a/debugger/breakpointsdlg.pp b/debugger/breakpointsdlg.pp index 63b4153bd9..117c4f58fe 100644 --- a/debugger/breakpointsdlg.pp +++ b/debugger/breakpointsdlg.pp @@ -54,6 +54,8 @@ type actAddSourceBP: TAction; actAddAddressBP: TAction; actAddWatchPoint: TAction; + actGroupSetNone: TAction; + actGroupSetNew: TAction; actShow: TAction; actProperties: TAction; actToggleCurrentEnable: TAction; @@ -68,6 +70,10 @@ type actDisableAllInSrc: TAction; ActionList1: TActionList; lvBreakPoints: TListView; + popGroupSep: TMenuItem; + popGroupSetNew: TMenuItem; + popGroupSetNone: TMenuItem; + popGroup: TMenuItem; popAddWatchPoint: TMenuItem; popAddAddressBP: TMenuItem; N0: TMenuItem; @@ -102,12 +108,15 @@ type procedure actAddWatchPointExecute(Sender: TObject); procedure actDisableSelectedExecute(Sender: TObject); procedure actEnableSelectedExecute(Sender: TObject); + procedure actGroupSetNoneExecute(Sender: TObject); + procedure actGroupSetNewExecute(Sender: TObject); procedure actShowExecute(Sender: TObject); procedure BreakpointsDlgCREATE(Sender: TObject); procedure lvBreakPointsClick(Sender: TObject); procedure lvBreakPointsColumnClick(Sender: TObject; Column: TListColumn); procedure lvBreakPointsDBLCLICK(Sender: TObject); procedure lvBreakPointsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); + procedure mnuPopupPopup(Sender: TObject); procedure popDeleteAllSameSourceCLICK(Sender: TObject); procedure popDisableAllSameSourceCLICK(Sender: TObject); procedure popEnableAllSameSourceCLICK(Sender: TObject); @@ -128,6 +137,8 @@ type procedure BreakPointRemove(const ASender: TIDEBreakPoints; const ABreakpoint: TIDEBreakPoint); procedure SetBaseDirectory(const AValue: string); + procedure popSetGroupItemClick(Sender: TObject); + procedure SetGroup(const NewGroup: TIDEBreakPointGroup); procedure UpdateItem(const AnItem: TListItem; const ABreakpoint: TIDEBreakPoint); @@ -240,6 +251,45 @@ begin UpdateAll; end; +procedure TBreakPointsDlg.SetGroup(const NewGroup: TIDEBreakPointGroup); +var + OldGroup: TIDEBreakPointGroup; + OldGroups: TList; + i: Integer; + PrevChoice: TModalResult; +begin + PrevChoice := mrNone; + OldGroups := TList.Create; + try + for i := 0 to lvBreakPoints.Items.Count - 1 do + if lvBreakPoints.Items[i].Selected then + begin + OldGroup := TIDEBreakPoint(lvBreakPoints.Items[i].Data).Group; + TIDEBreakPoint(lvBreakPoints.Items[i].Data).Group := NewGroup; + if (OldGroup <> nil) and (OldGroup.Count = 0) and (OldGroups.IndexOf(OldGroup) < 0) then + OldGroups.Add(OldGroup); + end; + finally + while OldGroups.Count > 0 do begin + OldGroup := TIDEBreakPointGroup(OldGroups[0]); + OldGroups.Delete(0); + if not (PrevChoice in [mrYesToAll, mrNoToAll]) then + begin + if OldGroups.Count > 0 then + PrevChoice := MessageDlg(Caption, Format(lisGroupEmptyDelete + lisGroupEmptyDeleteMore, + [OldGroup.Name, LineEnding, OldGroups.Count]), + mtConfirmation, mbYesNo + [mbYesToAll, mbNoToAll], 0) + else + PrevChoice := MessageDlg(Caption, Format(lisGroupEmptyDelete, + [OldGroup.Name]), mtConfirmation, mbYesNo, 0); + end; + if PrevChoice in [mrYes, mrYesToAll] then + OldGroup.Free; + end; + OldGroups.Free; + end; +end; + constructor TBreakPointsDlg.Create(AOwner: TComponent); begin inherited; @@ -312,6 +362,9 @@ begin actAddSourceBP.Caption := lisSourceBreakpoint; actAddAddressBP.Caption := lisAddressBreakpoint; actAddWatchPoint.Caption := lisWatchPoint; + popGroup.Caption := lisGroup; + actGroupSetNew.Caption := lisGroupSetNew; + actGroupSetNone.Caption := lisGroupSetNone; end; procedure TBreakPointsDlg.actEnableSelectedExecute(Sender: TObject); @@ -332,6 +385,60 @@ begin end; end; +procedure TBreakPointsDlg.actGroupSetNewExecute(Sender: TObject); +var + GroupName: String; + NewGroup: TIDEBreakPointGroup; +begin + GroupName := ''; + if not InputQuery(Caption, lisGroupNameInput, GroupName) then Exit; + if GroupName = '' then + begin + if MessageDlg(Caption, lisGroupNameEmptyClearInstead, + mtConfirmation, mbYesNo, 0) = mrYes then Exit; + NewGroup := nil; + end + else begin + NewGroup := DebugBoss.BreakPointGroups.GetGroupByName(GroupName); + if NewGroup = nil then + begin + if not TIDEBreakPointGroup.CheckName(GroupName) then + begin + MessageDlg(Caption, lisGroupNameInvalid, mtError, [mbOk], 0); + Exit; + end; + NewGroup := TIDEBreakPointGroup(DebugBoss.BreakPointGroups.Add); + try + NewGroup.Name := GroupName; + except + NewGroup.Free; + raise; + end; + end + else if MessageDlg(Caption, Format(lisGroupAssignExisting, + [GroupName]), mtConfirmation, mbYesNo, 0) <> mrYes + then + Exit; + end; + + SetGroup(NewGroup); +end; + +procedure TBreakPointsDlg.actGroupSetNoneExecute(Sender: TObject); +begin + SetGroup(nil); +end; + +procedure TBreakPointsDlg.popSetGroupItemClick(Sender: TObject); +var + Group: TIDEBreakPointGroup; +begin + Group := DebugBoss.BreakPointGroups.GetGroupByName((Sender as TMenuItem).Caption); + if Group = nil then + raise Exception.CreateFmt('Group %s not found', [(Sender as TMenuItem).Caption]); + SetGroup(Group); +end; + procedure TBreakPointsDlg.actShowExecute(Sender: TObject); begin JumpToCurrentBreakPoint; @@ -452,6 +559,27 @@ begin actProperties.Enabled := ItemSelected; actShow.Enabled := ItemSelected; + + popGroup.Enabled := ItemSelected; + actGroupSetNew.Enabled := ItemSelected; + actGroupSetNone.Enabled := ItemSelected; +end; + +procedure TBreakPointsDlg.mnuPopupPopup(Sender: TObject); +var + i: Integer; + MenuItem: TMenuItem; +begin + for i := popGroup.Count - 1 downto popGroup.IndexOf(popGroupSep) +1 do + popGroup.Items[i].Free; + for i := 0 to DebugBoss.BreakPointGroups.Count - 1 do + begin + MenuItem := TMenuItem.Create(popGroup); + MenuItem.Caption := DebugBoss.BreakPointGroups[i].Name; + MenuItem.OnClick := @popSetGroupItemClick; + popGroup.Add(MenuItem); + end; + popGroupSep.Visible := DebugBoss.BreakPointGroups.Count <> 0; end; procedure TBreakPointsDlg.popDeleteAllSameSourceCLICK(Sender: TObject); diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 57df60eb48..e289473002 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -852,6 +852,7 @@ type const Path: string); virtual; procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string); virtual; + class function CheckName(const AName: String): Boolean; public property Breakpoints[const AIndex: Integer]: TIDEBreakPoint read GetBreakpoint; property Enabled: Boolean read FEnabled write SetEnabled; @@ -7658,6 +7659,16 @@ begin XMLConfig.SetDeleteValue(Path+'InitialEnabled/Value',FInitialEnabled,true); end; +class function TIDEBreakPointGroup.CheckName(const AName: String): Boolean; +var + i: Integer; +begin + for i := 1 to Length(AName) do + if not (AName[i] in ['A'..'Z', 'a'..'z', '0'..'9', '_']) then + Exit(False); + Result := True; +end; + procedure TIDEBreakPointGroup.RemoveReference(const ABreakPointList: TIDEBreakPointGroupList); begin FReferences.Remove(ABreakPointList); @@ -7679,7 +7690,10 @@ end; procedure TIDEBreakPointGroup.SetName(const AValue: String); begin + if FName = AValue then Exit; + FName := AValue; + Changed(False); end; procedure TIDEBreakPointGroup.AssignTo(Dest: TPersistent); diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index b10e12a032..27315571e3 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -4616,6 +4616,14 @@ resourcestring lisDeleteBreakpointForWatch = 'Delete watchpoint for "%s"?'; lisDeleteAllBreakpoints = 'Delete all breakpoints?'; lisDeleteAllBreakpoints2 = 'Delete all breakpoints in file %s%s%s?'; + lisGroupNameInput = 'Group name:'; + lisGroupNameInvalid = 'BreakpointGroup name must be a valid Pascal identifier name.'; + lisGroupNameEmptyClearInstead = 'The group name cannot be empty. Clear breakpoints'' group(s)?'; + lisGroupAssignExisting = 'Assign to existing "%s" group?'; + lisGroupSetNew = 'Set new group...'; + lisGroupSetNone = 'Clear group(s)'; + lisGroupEmptyDelete = 'No more breakpoints are assigned to group "%s", delete it?'; + lisGroupEmptyDeleteMore = '%sThere are %d more empty groups, delete all?'; lisBreak = 'Break'; lisEnableGroups = 'Enable Groups'; lisDisableGroups = 'Disable Groups';