From 4bf617c018add43d26abe6996d6134e883040f75 Mon Sep 17 00:00:00 2001 From: Martin Date: Mon, 24 Jul 2023 22:43:06 +0200 Subject: [PATCH] IdeDebugger: Breakpoint dialog, drag/drop breakpoints-groups to reorder --- ide/packages/idedebugger/breakpointsdlg.pp | 63 +++++++++++++++---- .../idedebugger/breakprointgroupframe.lfm | 4 ++ .../idedebugger/breakprointgroupframe.pas | 55 ++++++++++++++-- ide/packages/idedebugger/debuggertreeview.pas | 1 - 4 files changed, 107 insertions(+), 16 deletions(-) diff --git a/ide/packages/idedebugger/breakpointsdlg.pp b/ide/packages/idedebugger/breakpointsdlg.pp index 5e4e7348db..2efeb0d730 100644 --- a/ide/packages/idedebugger/breakpointsdlg.pp +++ b/ide/packages/idedebugger/breakpointsdlg.pp @@ -54,7 +54,7 @@ type { TBreakPointsDlg } - TBreakPointsDlg = class(TDebuggerDlg, IFPObserver) + TBreakPointsDlg = class(TBreakPointsDlgBase, IFPObserver) actAddSourceBP: TAction; actAddAddressBP: TAction; actAddWatchPoint: TAction; @@ -155,7 +155,7 @@ type FUngroupedHeader, FAddGroupedHeader: TBreakpointGroupFrame; FLastTargetHeader: TBreakpointGroupFrame; - function GetDropTargetGroup(ANode: PVirtualNode): TBreakpointGroupFrame; + function GetDropTargetGroup(ANode: PVirtualNode): TBreakpointGroupFrame; procedure DoDetermineDropMode(const P: TPoint; var HitInfo: THitInfo; var NodeRect: TRect; var DropMode: TDropMode); procedure Notification(AComponent: TComponent; Operation: TOperation); override; @@ -188,6 +188,7 @@ type procedure JumpToCurrentBreakPoint; procedure ShowProperties; protected + procedure AcceptGroupHeaderDrop(ADroppedGroupFrame: TBreakpointGroupFrame; ATargetNode: PVirtualNode); override; procedure DoBreakPointsChanged; override; procedure DoBeginUpdate; override; procedure DoEndUpdate; override; @@ -1097,6 +1098,32 @@ begin Result := b1.Index - b2.Index; end; +procedure TBreakPointsDlg.AcceptGroupHeaderDrop( + ADroppedGroupFrame: TBreakpointGroupFrame; ATargetNode: PVirtualNode); +var + TargetGroupFrame: TBreakpointGroupFrame; + idx: Integer; +begin + TargetGroupFrame := GetDropTargetGroup(ATargetNode); + if (TargetGroupFrame = nil) or (TargetGroupFrame = ADroppedGroupFrame) then + exit; + + if TargetGroupFrame.GroupKind <> bgfGroup then begin + ADroppedGroupFrame.BrkGroup.Index := 0; + end + else begin + if TargetGroupFrame.BrkGroup = nil then + exit; + + idx := TargetGroupFrame.BrkGroup.Index; + if ADroppedGroupFrame.BrkGroup.Index > idx then + ADroppedGroupFrame.BrkGroup.Index := idx + 1 + else + ADroppedGroupFrame.BrkGroup.Index := idx; + end; +end; + + procedure TBreakPointsDlg.tvBreakPointsDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; const Pt: TPoint; var Effect: LongWord; Mode: TDropMode); @@ -1106,10 +1133,10 @@ var Brk: TIDEBreakPoint; idx: Integer; begin - TargetNd := tvBreakPoints.GetNodeAt(Pt); - if (TargetNd <> nil) and (Source = tvBreakPoints) and (tvBreakPoints.SelectedCount > 0) then begin - BeginUpdate; - try + BeginUpdate; + try + TargetNd := tvBreakPoints.GetNodeAt(Pt); + if (TargetNd <> nil) and (Source = tvBreakPoints) and (tvBreakPoints.SelectedCount > 0) then begin TargetHeader := GetDropTargetGroup(TargetNd); Brk := TIDEBreakPoint(tvBreakPoints.NodeItem[TargetNd]); if (tvBreakPoints.Header.SortColumn < 0) and (Brk <> nil) then begin @@ -1133,9 +1160,15 @@ begin if TargetHeader <> nil then TargetHeader.FrameDragDrop(Sender, Source, Pt.X, Pt.Y); - finally - EndUpdate; end; + + if (Source is TToolBar) and (TToolBar(Source).Owner is TBreakpointGroupFrame) then begin + AcceptGroupHeaderDrop(TBreakpointGroupFrame(TToolBar(Source).Owner), TargetNd); + end; + + FAddGroupedHeader.Visible := False; + finally + EndUpdate; end; end; @@ -1175,12 +1208,18 @@ begin FLastTargetHeader := nil; end; + if (Source is TToolBar) and (TToolBar(Source).Owner is TBreakpointGroupFrame) then begin + TargetHeader := GetDropTargetGroup(TargetNd); + Accept := (TToolBar(Source).Owner <> TargetHeader) and + (TargetHeader.GroupKind in [bgfGroup, bgfUngrouped]); + end; end; procedure TBreakPointsDlg.tvBreakPointsStartDrag(Sender: TObject; var DragObject: TDragObject); begin FAddGroupedHeader.Visible := True; + FDraggingGroupHeader := False; end; procedure TBreakPointsDlg.tvBreakPointsEndDrag(Sender, Target: TObject; X, @@ -1192,18 +1231,20 @@ end; function TBreakPointsDlg.GetDropTargetGroup(ANode: PVirtualNode ): TBreakpointGroupFrame; begin - Result := TBreakpointGroupFrame(tvBreakPoints.NodeControl[ANode]); + Result := GetGroupFrame(ANode); if Result = nil then begin ANode := tvBreakPoints.NodeParent[ANode]; if ANode <> nil then - Result := TBreakpointGroupFrame(tvBreakPoints.NodeControl[ANode]); + Result := GetGroupFrame(ANode); end; end; procedure TBreakPointsDlg.DoDetermineDropMode(const P: TPoint; var HitInfo: THitInfo; var NodeRect: TRect; var DropMode: TDropMode); begin - if tvBreakPoints.Header.SortColumn >= 0 then + if (tvBreakPoints.Header.SortColumn >= 0) or + (FDraggingGroupHeader) + then DropMode := dmNowhere; end; diff --git a/ide/packages/idedebugger/breakprointgroupframe.lfm b/ide/packages/idedebugger/breakprointgroupframe.lfm index 0515c3b754..6504083a57 100644 --- a/ide/packages/idedebugger/breakprointgroupframe.lfm +++ b/ide/packages/idedebugger/breakprointgroupframe.lfm @@ -23,6 +23,8 @@ object BreakpointGroupFrame: TBreakpointGroupFrame TabOrder = 0 OnDragDrop = FrameDragDrop OnDragOver = FrameDragOver + OnEndDrag = ToolBar1EndDrag + OnStartDrag = ToolBar1StartDrag object StaticText1: TStaticText Left = 1 Height = 16 @@ -34,6 +36,7 @@ object BreakpointGroupFrame: TBreakpointGroupFrame Caption = 'StaticText1' OnDragDrop = FrameDragDrop OnDragOver = FrameDragOver + OnMouseDown = StaticText1MouseDown TabOrder = 0 end object StaticText2: TStaticText @@ -47,6 +50,7 @@ object BreakpointGroupFrame: TBreakpointGroupFrame Caption = 'StaticText2' OnDragDrop = FrameDragDrop OnDragOver = FrameDragOver + OnMouseDown = StaticText1MouseDown TabOrder = 1 end end diff --git a/ide/packages/idedebugger/breakprointgroupframe.pas b/ide/packages/idedebugger/breakprointgroupframe.pas index 801607516f..88f454f7a7 100644 --- a/ide/packages/idedebugger/breakprointgroupframe.pas +++ b/ide/packages/idedebugger/breakprointgroupframe.pas @@ -7,12 +7,19 @@ interface uses Classes, SysUtils, Math, Forms, Controls, ComCtrls, StdCtrls, ExtCtrls, LCLType, Buttons, Graphics, Dialogs, laz.VirtualTrees, IDEImagesIntf, - DebuggerTreeView, Debugger, IdeDebuggerStringConstants, BaseDebugManager; + DebuggerTreeView, Debugger, IdeDebuggerStringConstants, BaseDebugManager, + DebuggerDlg; type TBreakpointGroupFrame = class; + TBreakPointsDlgBase = class(TDebuggerDlg) + protected + FDraggingGroupHeader: Boolean; + procedure AcceptGroupHeaderDrop(ADroppedGroupFrame: TBreakpointGroupFrame; ATargetNode: PVirtualNode); virtual; abstract; + end; + TOnDeleteGroup = procedure(Sender: TBreakpointGroupFrame; BrkGroup: TIDEBreakPointGroup) of object; TBreakpointGroupFrameKind = (bgfUngrouped, bgfGroup, bgfAddNewGroup, bgfAbandoned); @@ -29,9 +36,14 @@ type procedure FrameDragDrop(Sender, Source: TObject; X, Y: Integer); procedure FrameDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); + procedure StaticText1MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure ToolBar1EndDrag(Sender, Target: TObject; X, Y: Integer); + procedure ToolBar1StartDrag(Sender: TObject; var DragObject: TDragObject); private FGroupKind: TBreakpointGroupFrameKind; FOnDeleteGroup: TOnDeleteGroup; + FOwner: TBreakPointsDlgBase; FTree: TDbgTreeView; FNode: PVirtualNode; FBrkGroup: TIDEBreakPointGroup; @@ -43,7 +55,7 @@ type procedure SetVisible(Value: Boolean); reintroduce; procedure VisibleChanged; override; public - constructor Create(TheOwner: TComponent; ATree: TDbgTreeView; ANode: PVirtualNode; + constructor Create(TheOwner: TBreakPointsDlgBase; ATree: TDbgTreeView; ANode: PVirtualNode; ABrkGroup: TIDEBreakPointGroup; AGroupKind: TBreakpointGroupFrameKind = bgfGroup); reintroduce; destructor Destroy; override; @@ -66,6 +78,25 @@ implementation { TBreakpointGroupFrame } +procedure TBreakpointGroupFrame.StaticText1MouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + if ToolBar1.DragMode = dmAutomatic then + ToolBar1.BeginDrag(DragManager.DragImmediate, DragManager.DragThreshold); +end; + +procedure TBreakpointGroupFrame.ToolBar1EndDrag(Sender, Target: TObject; X, + Y: Integer); +begin + FOwner.FDraggingGroupHeader := False; +end; + +procedure TBreakpointGroupFrame.ToolBar1StartDrag(Sender: TObject; + var DragObject: TDragObject); +begin + FOwner.FDraggingGroupHeader := True; +end; + procedure TBreakpointGroupFrame.BtnDeleteClick(Sender: TObject); begin if assigned(FOnDeleteGroup) then @@ -123,6 +154,11 @@ begin Brk.Group := NewGroup; end; end; + + if (Source is TToolBar) and (TToolBar(Source).Owner is TBreakpointGroupFrame) then begin + FOwner.AcceptGroupHeaderDrop(TBreakpointGroupFrame(TToolBar(Source).Owner), FNode); + end; + finally if FGroupKind = bgfAddNewGroup then Visible := False; @@ -158,6 +194,11 @@ begin ToolBar1.Color := clBtnFace; ToolBar1.Font.Color := clDefault; end; + + if (Source is TToolBar) and (TToolBar(Source).Owner is TBreakpointGroupFrame) then begin + Accept := (TToolBar(Source).Owner <> Self) and + (GroupKind in [bgfGroup, bgfUngrouped]); + end; end; function TBreakpointGroupFrame.GetCount: Integer; @@ -201,11 +242,12 @@ begin FTree.NodeHeight[FNode] := min(40, Max(15, ToolBar1.Height)); end; -constructor TBreakpointGroupFrame.Create(TheOwner: TComponent; +constructor TBreakpointGroupFrame.Create(TheOwner: TBreakPointsDlgBase; ATree: TDbgTreeView; ANode: PVirtualNode; ABrkGroup: TIDEBreakPointGroup; AGroupKind: TBreakpointGroupFrameKind); begin inherited Create(nil); + FOwner := TheOwner; FTree := ATree; FNode := ANode; FBrkGroup := ABrkGroup; @@ -241,11 +283,16 @@ begin if FBrkGroup <> nil then StaticText1.Caption := FBrkGroup.Name; StaticText2.Caption := Format(' (%d)', [Count]); + + if (Count > 0) then + ToolBar1.DragMode := dmAutomatic + else + ToolBar1.DragMode := dmManual; end; bgfAddNewGroup: begin StaticText1.Caption := BreakViewHeaderAddGroup; StaticText2.Caption := ''; - StaticText1.Font.Style := [fsItalic]; + ToolBar1.Font.Style := [fsItalic]; end; bgfAbandoned: ; end; diff --git a/ide/packages/idedebugger/debuggertreeview.pas b/ide/packages/idedebugger/debuggertreeview.pas index 05ab511219..c9d9c782b8 100644 --- a/ide/packages/idedebugger/debuggertreeview.pas +++ b/ide/packages/idedebugger/debuggertreeview.pas @@ -94,7 +94,6 @@ type ): TCustomImageList; override; public function GetNodeData(Node: PVirtualNode): PDbgTreeNodeData; reintroduce; - function GetFocusedNode(OnlySelected: Boolean = True; AnIncludeControlNodes: Boolean = False): PVirtualNode; function FocusedData(OnlySelected: Boolean = True): PDbgTreeNodeData; function FocusedItem(OnlySelected: Boolean = True): TObject;