paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-29 00:42:46 +02:00
Code Issues Packages Projects Releases Wiki Activity

DBG: Setting groups to multiply selected breakpoints. Issue #0020478 / patch by Flávio Etrusco

Browse Source 
git-svn-id: trunk@33160 -
This commit is contained in:
martin 2011-10-30 01:49:55 +00:00
parent 9539b6f4eb
commit 91818313c5
4 changed files with 172 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
debugger/breakpointsdlg.lfm
View File

@ -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

128
debugger/breakpointsdlg.pp
View File

@ -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);

14
debugger/debugger.pp
View File

@ -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);

8
ide/lazarusidestrconsts.pas
View File

@ -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';