From 40a5975659c060878126aebfffae70fc8c3972d3 Mon Sep 17 00:00:00 2001 From: Martin Date: Fri, 17 Mar 2023 20:22:50 +0100 Subject: [PATCH] Debugger: refactor Watch-Dialog, move code that controls watches in the tree to new unit --- .../idedebugger/dbgtreeviewwatchdata.pas | 440 +++++++++++++++ ide/packages/idedebugger/debugger.pp | 67 ++- ide/packages/idedebugger/idedebugger.lpk | 4 + ide/packages/idedebugger/idedebuggerbase.pas | 47 +- .../idedebugger/idedebuggerpackage.pas | 2 +- ide/packages/idedebugger/watchesdlg.lfm | 3 - ide/packages/idedebugger/watchesdlg.pp | 524 +++++------------- 7 files changed, 698 insertions(+), 389 deletions(-) create mode 100644 ide/packages/idedebugger/dbgtreeviewwatchdata.pas diff --git a/ide/packages/idedebugger/dbgtreeviewwatchdata.pas b/ide/packages/idedebugger/dbgtreeviewwatchdata.pas new file mode 100644 index 0000000000..61a1524c1d --- /dev/null +++ b/ide/packages/idedebugger/dbgtreeviewwatchdata.pas @@ -0,0 +1,440 @@ +unit DbgTreeViewWatchData; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Math, IdeDebuggerBase, DebuggerTreeView, + IdeDebuggerWatchResult, ArrayNavigationFrame, BaseDebugManager, + laz.VirtualTrees, DbgIntfDebuggerBase, Controls, LazDebuggerIntf, + LazDebuggerIntfBaseTypes; + +type + + { TDbgTreeViewWatchDataMgr } + + TDbgTreeViewWatchDataMgr = class + private + FCancelUpdate: Boolean; + FTreeView: TDbgTreeView; + FExpandingWatchAbleResult: TObject; + + procedure TreeViewExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure TreeViewInitChildren(Sender: TBaseVirtualTree; + Node: PVirtualNode; var ChildCount: Cardinal); + + procedure DoItemRemovedFromView(Sender: TDbgTreeView; AWatchAble: TObject; ANode: PVirtualNode); + procedure DoWatchAbleFreed(Sender: TObject); + procedure WatchNavChanged(Sender: TArrayNavigationBar; AValue: Int64); + protected + function WatchAbleResultFromNode(AVNode: PVirtualNode): TWatchAbleResultIntf; virtual; abstract; + function WatchAbleResultFromObject(AWatchAble: TObject): TWatchAbleResultIntf; virtual; abstract; + + procedure UpdateColumnsText(AWatchAble: TObject; AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode); virtual; abstract; + procedure ConfigureNewSubItem(AWatchAble: TObject); virtual; + + procedure UpdateSubItemsLocked(AWatchAble: TObject; AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out ChildCount: LongWord); virtual; + procedure UpdateSubItems(AWatchAble: TObject; AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out ChildCount: LongWord); virtual; + procedure DoUpdateArraySubItems(AWatchAble: TObject; AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out ChildCount: LongWord); + procedure DoUpdateStructSubItems(AWatchAble: TObject; AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out ChildCount: LongWord); + procedure DoUpdateOldSubItems(AWatchAble: TObject; AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out ChildCount: LongWord); + public + constructor Create(ATreeView: TDbgTreeView); + //destructor Destroy; override; + + procedure AddWatchData(AWatchAble: TObject; AWatchAbleResult: TWatchAbleResultIntf = nil); + procedure UpdateWatchData(AWatchAble: TObject; AVNode: PVirtualNode; AWatchAbleResult: TWatchAbleResultIntf = nil); + + property CancelUpdate: Boolean read FCancelUpdate write FCancelUpdate; + property TreeView: TDbgTreeView read FTreeView; + end; + +implementation + +{ TDbgTreeViewWatchDataMgr } + +procedure TDbgTreeViewWatchDataMgr.DoWatchAbleFreed(Sender: TObject); +var + VNode: PVirtualNode; + Nav: TControl; +begin + VNode := FTreeView.FindNodeForItem(Sender); + if VNode = nil then + exit; + + FTreeView.OnItemRemoved := nil; + FTreeView.NodeItem[VNode] := nil; + + if FTreeView.ChildCount[VNode] > 0 then begin + VNode := FTreeView.GetFirstVisible(VNode); + Nav := FTreeView.NodeControl[VNode]; + if (Nav <> nil) and (Nav is TArrayNavigationBar) then + TArrayNavigationBar(Nav).OwnerData := nil; + end; + + FTreeView.OnItemRemoved := @DoItemRemovedFromView; +end; + +procedure TDbgTreeViewWatchDataMgr.WatchNavChanged(Sender: TArrayNavigationBar; + AValue: Int64); +var + VNode: PVirtualNode; + AWatchAble: TObject; + AWatchAbleResult: TWatchAbleResultIntf; + c: LongWord; +begin + if Sender.OwnerData = nil then + exit; + + AWatchAble := TObject(Sender.OwnerData); + AWatchAbleResult := WatchAbleResultFromObject(AWatchAble); + if (AWatchAbleResult <> nil) and AWatchAbleResult.Enabled and + (AWatchAbleResult.Validity = ddsValid) + then begin + VNode := FTreeView.FindNodeForItem(AWatchAble); + if VNode = nil then + exit; + + UpdateSubItems(AWatchAble, AWatchAbleResult, VNode, c); + end; +end; + +procedure TDbgTreeViewWatchDataMgr.ConfigureNewSubItem(AWatchAble: TObject); +begin + // +end; + +procedure TDbgTreeViewWatchDataMgr.UpdateSubItemsLocked(AWatchAble: TObject; + AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out + ChildCount: LongWord); +begin + UpdateSubItems(AWatchAble, AWatchAbleResult, AVNode, ChildCount); +end; + +procedure TDbgTreeViewWatchDataMgr.UpdateSubItems(AWatchAble: TObject; + AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out + ChildCount: LongWord); +var + ResData: TWatchResultData; +begin + ChildCount := 0; + if (AWatchAble <> nil) or (AWatchAbleResult = nil) then + AWatchAbleResult := WatchAbleResultFromObject(AWatchAble); + if (AWatchAble = nil) or (AWatchAbleResult = nil) then begin + FTreeView.ChildCount[AVNode] := 0; + exit; + end; + + ResData := AWatchAbleResult.ResultData; + if (ResData <> nil) and + (ResData.FieldCount > 0) and + (ResData.ValueKind <> rdkConvertRes) + then + DoUpdateStructSubItems(AWatchAble, AWatchAbleResult, AVNode, ChildCount) + else + if (ResData <> nil) and + //(ResData.ValueKind = rdkArray) and + (ResData.ArrayLength > 0) + then + DoUpdateArraySubItems(AWatchAble, AWatchAbleResult, AVNode, ChildCount) + else + if (AWatchAbleResult.TypeInfo <> nil) and (AWatchAbleResult.TypeInfo.Fields <> nil) then + // Old Interface + DoUpdateOldSubItems(AWatchAble, AWatchAbleResult, AVNode, ChildCount); + + FTreeView.ChildCount[AVNode] := ChildCount; + FTreeView.Invalidate; +end; + +procedure TDbgTreeViewWatchDataMgr.DoUpdateArraySubItems(AWatchAble: TObject; + AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out + ChildCount: LongWord); +var + NewWatchAble: TObject; + i, TotalCount: Integer; + ResData: TWatchResultData; + ExistingNode, nd: PVirtualNode; + Nav: TArrayNavigationBar; + Offs, KeepCnt, KeepBelow: Int64; +begin + ChildCount := 0; + ResData := AWatchAbleResult.ResultData; + if (ResData = nil) then + exit; + + TotalCount := ResData.ArrayLength; + if (ResData.ValueKind <> rdkArray) or (TotalCount = 0) then + TotalCount := ResData.Count; + + ExistingNode := FTreeView.GetFirstChildNoInit(AVNode); + if ExistingNode = nil then + ExistingNode := FTreeView.AddChild(AVNode, nil) + else + FTreeView.NodeItem[ExistingNode] := nil; + + Nav := TArrayNavigationBar(FTreeView.NodeControl[ExistingNode]); + if Nav = nil then begin + Nav := TArrayNavigationBar.Create(nil); + Nav.ParentColor := False; + Nav.ParentBackground := False; + Nav.Color := FTreeView.Colors.BackGroundColor; + Nav.LowBound := ResData.LowBound; + Nav.HighBound := ResData.LowBound + TotalCount - 1; + Nav.ShowBoundInfo := True; + Nav.Index := ResData.LowBound; + Nav.PageSize := 10; + Nav.OnIndexChanged := @WatchNavChanged; + Nav.OnPageSize := @WatchNavChanged; + Nav.HardLimits := not(ResData.ValueKind = rdkArray); + FTreeView.NodeControl[ExistingNode] := Nav; + FTreeView.NodeText[ExistingNode, 0] := ' '; + FTreeView.NodeText[ExistingNode, 1] := ' '; + end; + Nav.OwnerData := AWatchAble; + ChildCount := Nav.LimitedPageSize; + + ExistingNode := FTreeView.GetNextSiblingNoInit(ExistingNode); + + Offs := Nav.Index; + for i := 0 to ChildCount - 1 do begin + NewWatchAble := AWatchAbleResult.ChildrenByNameAsArrayEntry[Offs + i]; + if NewWatchAble = nil then begin + dec(ChildCount); + continue; + end; + + ConfigureNewSubItem(NewWatchAble); + + if ExistingNode <> nil then begin + FTreeView.NodeItem[ExistingNode] := NewWatchAble; + nd := ExistingNode; + ExistingNode := FTreeView.GetNextSiblingNoInit(ExistingNode); + end + else begin + nd := FTreeView.AddChild(AVNode, NewWatchAble); + end; + (NewWatchAble as TFreeNotifyingIntf).AddFreeNotification(@DoWatchAbleFreed); + UpdateWatchData(NewWatchAble, nd); + end; + + inc(ChildCount); // for the nav row + + KeepCnt := Nav.PageSize; + KeepBelow := KeepCnt; + KeepCnt := max(max(50, KeepCnt+10), + Min(KeepCnt*10, 500) ); + KeepBelow := Min(KeepBelow, KeepCnt - Nav.PageSize); + (AWatchAble as TWatchAbleDataIntf).LimitChildWatchCount(KeepCnt, ResData.LowBound + KeepBelow); +end; + +procedure TDbgTreeViewWatchDataMgr.DoUpdateStructSubItems(AWatchAble: TObject; + AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out + ChildCount: LongWord); +var + ResData: TWatchResultData; + ExistingNode, nd: PVirtualNode; + AnchClass: String; + NewWatchAble: TObject; + ChildInfo: TWatchResultDataFieldInfo; +begin + ChildCount := 0; + ResData := AWatchAbleResult.ResultData; + ExistingNode := FTreeView.GetFirstChildNoInit(AVNode); + if ExistingNode <> nil then + FTreeView.NodeControl[ExistingNode].Free; + + AnchClass := ''; + if ResData.StructType <> dstRecord then + AnchClass := ResData.TypeName; + for ChildInfo in ResData do begin + NewWatchAble := AWatchAbleResult.ChildrenByNameAsField[ChildInfo.FieldName, AnchClass]; + if NewWatchAble = nil then begin + continue; + end; + inc(ChildCount); + + ConfigureNewSubItem(NewWatchAble); + + if ExistingNode <> nil then begin + FTreeView.NodeItem[ExistingNode] := NewWatchAble; + nd := ExistingNode; + ExistingNode := FTreeView.GetNextSiblingNoInit(ExistingNode); + end + else begin + nd := FTreeView.AddChild(AVNode, NewWatchAble); + end; + (NewWatchAble as TFreeNotifyingIntf).AddFreeNotification(@DoWatchAbleFreed); + UpdateWatchData(NewWatchAble, nd); + end; +end; + +procedure TDbgTreeViewWatchDataMgr.DoUpdateOldSubItems(AWatchAble: TObject; + AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out + ChildCount: LongWord); +var + TypInfo: TDBGType; + IsGdbmiArray: Boolean; + ExistingNode, nd: PVirtualNode; + AnchClass: String; + i: Integer; + NewWatchAble: TObject; +begin + TypInfo := AWatchAbleResult.TypeInfo; + + if (TypInfo <> nil) and (TypInfo.Fields <> nil) then begin + IsGdbmiArray := TypInfo.Attributes * [saDynArray, saArray] <> []; + ChildCount := TypInfo.Fields.Count; + ExistingNode := FTreeView.GetFirstChildNoInit(AVNode); + + AnchClass := TypInfo.TypeName; + for i := 0 to TypInfo.Fields.Count-1 do begin + if IsGdbmiArray then + NewWatchAble := AWatchAbleResult.ChildrenByNameAsArrayEntry[StrToInt64Def(TypInfo.Fields[i].Name, 0)] + else + NewWatchAble := AWatchAbleResult.ChildrenByNameAsField[TypInfo.Fields[i].Name, AnchClass]; + if NewWatchAble = nil then begin + dec(ChildCount); + continue; + end; + ConfigureNewSubItem(NewWatchAble); + + if ExistingNode <> nil then begin + FTreeView.NodeItem[ExistingNode] := NewWatchAble; + nd := ExistingNode; + ExistingNode := FTreeView.GetNextSiblingNoInit(ExistingNode); + end + else begin + nd := FTreeView.AddChild(AVNode, NewWatchAble); + end; + (NewWatchAble as TFreeNotifyingIntf).AddFreeNotification(@DoWatchAbleFreed); + UpdateWatchData(NewWatchAble, nd); + end; + end; +end; + +procedure TDbgTreeViewWatchDataMgr.TreeViewExpanded(Sender: TBaseVirtualTree; + Node: PVirtualNode); +var + AWatchAble: TObject; +begin + Node := FTreeView.GetFirstChildNoInit(Node); + while Node <> nil do begin + AWatchAble := FTreeView.NodeItem[Node]; + if AWatchAble <> nil then + UpdateWatchData(AWatchAble, Node); + Node := FTreeView.GetNextSiblingNoInit(Node); + end; +end; + +procedure TDbgTreeViewWatchDataMgr.TreeViewInitChildren( + Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); +var + AWatchAble: TObject; + AWatchAbleResult: TWatchAbleResultIntf; +begin + ChildCount := 0; + AWatchAble := FTreeView.NodeItem[Node]; + if (AWatchAble <> nil) then + AWatchAbleResult := WatchAbleResultFromObject(AWatchAble); + if (AWatchAble = nil) or (AWatchAbleResult = nil) then begin + FTreeView.ChildCount[Node] := 0; + exit; + end; + + FExpandingWatchAbleResult := AWatchAble; + UpdateSubItemsLocked(AWatchAble, AWatchAbleResult, Node, ChildCount); + FExpandingWatchAbleResult := nil; +end; + +procedure TDbgTreeViewWatchDataMgr.DoItemRemovedFromView(Sender: TDbgTreeView; + AWatchAble: TObject; ANode: PVirtualNode); +begin + if AWatchAble <> nil then + with (AWatchAble as TWatchAbleDataIntf) do begin + ClearDisplayData; + RemoveFreeNotification(@DoWatchAbleFreed); + end; +end; + +constructor TDbgTreeViewWatchDataMgr.Create(ATreeView: TDbgTreeView); +begin + FTreeView := ATreeView; + FTreeView.OnItemRemoved := @DoItemRemovedFromView; + FTreeView.OnExpanded := @TreeViewExpanded; + FTreeView.OnInitChildren := @TreeViewInitChildren; +end; + +procedure TDbgTreeViewWatchDataMgr.AddWatchData(AWatchAble: TObject; + AWatchAbleResult: TWatchAbleResultIntf); +var + AVNode: PVirtualNode; +begin + if AWatchAble = nil then + exit; + AVNode := FTreeView.FindNodeForItem(AWatchAble); + if AVNode = nil then begin + AVNode := FTreeView.AddChild(nil, AWatchAble); + FTreeView.SelectNode(AVNode); + (AWatchAble as TFreeNotifyingIntf).AddFreeNotification(@DoWatchAbleFreed); + end; + + UpdateWatchData(AWatchAble, AVNode, AWatchAbleResult); +end; + +procedure TDbgTreeViewWatchDataMgr.UpdateWatchData(AWatchAble: TObject; + AVNode: PVirtualNode; AWatchAbleResult: TWatchAbleResultIntf); +var + TypInfo: TDBGType; + HasChildren: Boolean; + c: LongWord; +begin + if not FTreeView.FullyVisible[AVNode] then + exit; + + if AWatchAbleResult = nil then + AWatchAbleResult := WatchAbleResultFromObject(AWatchAble); + + UpdateColumnsText(AWatchAble, AWatchAbleResult, AVNode); + FTreeView.Invalidate; + + if AWatchAbleResult = nil then + exit; + + // some debuggers may have run Application.ProcessMessages + if CancelUpdate then + exit; + + (* If the watch is ddsRequested or ddsEvaluating => keep any expanded tree-nodes. (Avoid flicker) + > ddsEvaluating includes "not HasAllValidParents" + If the debugger is running => keey any expanded tree-nodes + *) + + if (not(AWatchAbleResult.Validity in [ddsRequested, ddsEvaluating])) and + ((DebugBoss = nil) or (DebugBoss.State <> dsRun)) + then begin + TypInfo := AWatchAbleResult.TypeInfo; + HasChildren := ( (TypInfo <> nil) and (TypInfo.Fields <> nil) and (TypInfo.Fields.Count > 0) ) or + ( (AWatchAbleResult.ResultData <> nil) and + ( ( (AWatchAbleResult.ResultData.FieldCount > 0) and (AWatchAbleResult.ResultData.ValueKind <> rdkConvertRes) ) + or + //( (AWatchAbleResult.ResultData.ValueKind = rdkArray) and (AWatchAbleResult.ResultData.ArrayLength > 0) ) + (AWatchAbleResult.ResultData.ArrayLength > 0) + ) ); + FTreeView.HasChildren[AVNode] := HasChildren; + + if HasChildren and FTreeView.Expanded[AVNode] then begin + if (AWatchAbleResult.Validity = ddsValid) then begin + (* The current "AWatchAbleResult" should be done. Allow UpdateItem for nested entries *) + + UpdateSubItems(AWatchAble, AWatchAbleResult, AVNode, c); + end; + end + else + if AWatchAble <> FExpandingWatchAbleResult then + FTreeView.DeleteChildren(AVNode, False); + end +end; + +end. + diff --git a/ide/packages/idedebugger/debugger.pp b/ide/packages/idedebugger/debugger.pp index 07d815f5da..0c4cb79dca 100644 --- a/ide/packages/idedebugger/debugger.pp +++ b/ide/packages/idedebugger/debugger.pp @@ -532,14 +532,17 @@ type { TIdeWatchValue } - TIdeWatchValue = class(TWatchValue) + TIdeWatchValue = class(TWatchValue, TWatchAbleResultIntf) private - function GetChildrenByNameAsArrayEntry(AName: Int64): TIdeWatch; - function GetChildrenByNameAsField(AName, AClassName: String): TIdeWatch; + function GetChildrenByNameAsArrayEntry(AName: Int64): TObject; // TIdeWatch; + function GetChildrenByNameAsField(AName, AClassName: String): TObject; // TIdeWatch; function GetWatch: TIdeWatch; + function GetEnabled: Boolean; protected function GetTypeInfo: TDBGType; override; function GetValue: String; override; + function GetResultData: TWatchResultData; override; + function GetValidity: TDebuggerDataState; override; procedure RequestData; virtual; procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; @@ -561,8 +564,8 @@ type function MaybeCopyResult(ASourceWatch: TIdeWatch): boolean; - property ChildrenByNameAsField[AName, AClassName: String]: TIdeWatch read GetChildrenByNameAsField; - property ChildrenByNameAsArrayEntry[AName: Int64]: TIdeWatch read GetChildrenByNameAsArrayEntry; + property ChildrenByNameAsField[AName, AClassName: String]: TObject read GetChildrenByNameAsField; + property ChildrenByNameAsArrayEntry[AName: Int64]: TObject read GetChildrenByNameAsArrayEntry; end; { TIdeWatchValueList } @@ -587,7 +590,7 @@ type { TIdeWatch } - TIdeWatch = class(TWatch) + TIdeWatch = class(TWatch, TWatchAbleDataIntf) private FChildWatches: TIdeWatches; FDisplayName: String; @@ -601,6 +604,8 @@ type function GetAnyValidParentWatchValue(AThreadId: Integer; AStackFrame: Integer): TIdeWatchValue; function GetWatchDisplayName: String; procedure SetDisplayName(AValue: String); reintroduce; + function GetEnabled: Boolean; + function GetExpression: String; protected procedure InitChildWatches; function CreateChildWatches: TIdeWatches; virtual; @@ -4214,10 +4219,34 @@ begin ddsInvalid: Result := ''; ddsError: Result := ''; end; - end; -function TIdeWatchValue.GetChildrenByNameAsArrayEntry(AName: Int64): TIdeWatch; +function TIdeWatchValue.GetResultData: TWatchResultData; +var + i: Integer; +begin + Result := inherited GetResultData; + if (Watch = nil) or (not Watch.Enabled) then + exit; + i := DbgStateChangeCounter; // workaround for state changes during TWatchValue.GetResultData + if Validity = ddsUnknown then begin + Validity := ddsRequested; + RequestData; + if i <> DbgStateChangeCounter then exit; // in case the debugger did run. + // TODO: The watch can also be deleted by the user + Result := inherited GetResultData; + end; +end; + +function TIdeWatchValue.GetValidity: TDebuggerDataState; +begin + if (Watch = nil) or (Watch.HasAllValidParents(ThreadId, StackFrame)) then + Result := inherited GetValidity + else + Result := ddsEvaluating; // ddsWaitForParent; +end; + +function TIdeWatchValue.GetChildrenByNameAsArrayEntry(AName: Int64): TObject; begin Result := nil; if FWatch = nil then @@ -4232,7 +4261,7 @@ begin end; function TIdeWatchValue.GetChildrenByNameAsField(AName, AClassName: String - ): TIdeWatch; + ): TObject; begin Result := nil; if FWatch = nil then @@ -4251,6 +4280,13 @@ begin Result := TIdeWatch(inherited Watch); end; +function TIdeWatchValue.GetEnabled: Boolean; +begin + Result := Watch <> nil; + if Result then + Result := Watch.Enabled; +end; + function TIdeWatchValue.GetTypeInfo: TDBGType; var i: Integer; @@ -6491,6 +6527,16 @@ begin DoModified; end; +function TIdeWatch.GetEnabled: Boolean; +begin + Result := inherited Enabled; +end; + +function TIdeWatch.GetExpression: String; +begin + Result := inherited Expression; +end; + procedure TIdeWatch.SetParentWatch(AValue: TIdeWatch); begin if FParentWatch = AValue then Exit; @@ -6535,6 +6581,9 @@ begin Result.DisplayFormat := DisplayFormat; Result.DbgBackendConverter := DbgBackendConverter; Result.FDisplayName := ADispName; + if (defClassAutoCast in EvaluateFlags) then + Result.EvaluateFlags := Result.EvaluateFlags + [defClassAutoCast]; + EndChildUpdate; end; diff --git a/ide/packages/idedebugger/idedebugger.lpk b/ide/packages/idedebugger/idedebugger.lpk index 5d24b8582b..f5c3dc6883 100644 --- a/ide/packages/idedebugger/idedebugger.lpk +++ b/ide/packages/idedebugger/idedebugger.lpk @@ -178,6 +178,10 @@ + + + + diff --git a/ide/packages/idedebugger/idedebuggerbase.pas b/ide/packages/idedebugger/idedebuggerbase.pas index 3b1af8c43c..4285fd75c9 100644 --- a/ide/packages/idedebugger/idedebuggerbase.pas +++ b/ide/packages/idedebugger/idedebuggerbase.pas @@ -1,6 +1,7 @@ unit IdeDebuggerBase; {$mode objfpc}{$H+} +{$Interfaces CORBA} interface @@ -13,6 +14,47 @@ uses type + TFreeNotifyingIntf = interface ['fni'] + procedure AddFreeNotification(ANotification: TNotifyEvent); + procedure RemoveFreeNotification(ANotification: TNotifyEvent); + end; + + + TWatchAbleDataIntf = interface(TFreeNotifyingIntf) ['wdi'] + procedure LimitChildWatchCount(AMaxCnt: Integer; AKeepIndexEntriesBelow: Int64 = low(Int64)); virtual; + procedure ClearDisplayData; // Clear any cached display-data / keep only what's needed for the snapshot + + function GetEnabled: Boolean; + function GetExpression: String; + function GetDisplayName: String; + + property Enabled: Boolean read GetEnabled; + property Expression: String read GetExpression; // thread save / non-changing in begin/end-uptdate + property DisplayName: String read GetDisplayName; + end; + + TWatchAbleResultIntf = interface ['wdr'] + function GetChildrenByNameAsArrayEntry(AName: Int64): TObject; + function GetChildrenByNameAsField(AName, AClassName: String): TObject; + + function GetEnabled: Boolean; + function GetValidity: TDebuggerDataState; + function GetDisplayFormat: TWatchDisplayFormat; + function GetTypeInfo: TDBGType; deprecated; + function GetValue: string; + function GetResultData: TWatchResultData; + + property ChildrenByNameAsField[AName, AClassName: String]: TObject read GetChildrenByNameAsField; + property ChildrenByNameAsArrayEntry[AName: Int64]: TObject read GetChildrenByNameAsArrayEntry; + + property Enabled: Boolean read GetEnabled; + property Validity: TDebuggerDataState read GetValidity; + property DisplayFormat: TWatchDisplayFormat read GetDisplayFormat; + property TypeInfo: TDBGType read GetTypeInfo; + property Value: string read GetValue; // for etc + property ResultData: TWatchResultData read GetResultData; + end; + TWatch = class; { TWatchValue } @@ -270,7 +312,10 @@ end; function TWatchValue.GetValidity: TDebuggerDataState; begin - Result := FValidity; + if Watch <> nil then + Result := FValidity + else + Result := ddsUnknown; end; function TWatchValue.GetStackFrame: Integer; diff --git a/ide/packages/idedebugger/idedebuggerpackage.pas b/ide/packages/idedebugger/idedebuggerpackage.pas index 298f556e1b..fd9c13664a 100644 --- a/ide/packages/idedebugger/idedebuggerpackage.pas +++ b/ide/packages/idedebugger/idedebuggerpackage.pas @@ -17,7 +17,7 @@ uses WatchesDlg, CallStackDlg, LocalsDlg, ThreadDlg, BreakPropertyDlgGroups, HistoryDlg, PseudoTerminalDlg, RegistersDlg, DebugOutputForm, ExceptionDlg, FeedbackDlg, DebugAttachDialog, BreakPropertyDlg, EvaluateDlg, InspectDlg, - BreakPointsDlg, AssemblerDlg, LazarusPackageIntf; + BreakPointsDlg, AssemblerDlg, DbgTreeViewWatchData, LazarusPackageIntf; implementation diff --git a/ide/packages/idedebugger/watchesdlg.lfm b/ide/packages/idedebugger/watchesdlg.lfm index db31f7df3a..ccff207e10 100644 --- a/ide/packages/idedebugger/watchesdlg.lfm +++ b/ide/packages/idedebugger/watchesdlg.lfm @@ -47,9 +47,7 @@ object WatchesDlg: TWatchesDlg OnChange = tvWatchesChange OnDragOver = tvWatchesDragOver OnDragDrop = tvWatchesDragDrop - OnExpanded = tvWatchesExpanded OnFocusChanged = tvWatchesFocusChanged - OnInitChildren = tvWatchesInitChildren OnNodeDblClick = tvWatchesNodeDblClick end object ToolBar1: TToolBar @@ -187,7 +185,6 @@ object WatchesDlg: TWatchesDlg Width = 200 Align = alTop Caption = '...' - Color = clDefault ParentColor = False end end diff --git a/ide/packages/idedebugger/watchesdlg.pp b/ide/packages/idedebugger/watchesdlg.pp index 28311aa66c..5eb9834bc0 100644 --- a/ide/packages/idedebugger/watchesdlg.pp +++ b/ide/packages/idedebugger/watchesdlg.pp @@ -41,12 +41,12 @@ uses Classes, Forms, Controls, math, sysutils, LazLoggerBase, LazUTF8, Clipbrd, {$ifdef Windows} ActiveX, {$else} laz.FakeActiveX, {$endif} IDEWindowIntf, Menus, ComCtrls, ActnList, ExtCtrls, StdCtrls, LCLType, - LMessages, IDEImagesIntf, Debugger, - DebuggerTreeView, IdeDebuggerBase, DebuggerDlg, DbgIntfBaseTypes, - DbgIntfDebuggerBase, DbgIntfMiscClasses, SynEdit, laz.VirtualTrees, SpinEx, - LazDebuggerIntf, LazDebuggerIntfBaseTypes, BaseDebugManager, EnvironmentOpts, - IdeDebuggerWatchResult, IdeDebuggerWatchResPrinter, - ArrayNavigationFrame, IdeDebuggerUtils, IdeIntfStrConsts, IdeDebuggerStringConstants; + LMessages, IDEImagesIntf, Debugger, DebuggerTreeView, IdeDebuggerBase, + DebuggerDlg, DbgIntfBaseTypes, DbgIntfDebuggerBase, DbgIntfMiscClasses, + SynEdit, laz.VirtualTrees, SpinEx, LazDebuggerIntf, LazDebuggerIntfBaseTypes, + BaseDebugManager, EnvironmentOpts, IdeDebuggerWatchResult, + IdeDebuggerWatchResPrinter, ArrayNavigationFrame, IdeDebuggerUtils, + IdeIntfStrConsts, IdeDebuggerStringConstants, DbgTreeViewWatchData; type @@ -57,6 +57,8 @@ type wdsDeleting ); + TDbgTreeViewWatchValueMgr = class; + { TWatchesDlg } TWatchesDlg = class(TDebuggerDlg) @@ -136,11 +138,8 @@ type procedure tvWatchesDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; const Pt: TPoint; Mode: TDropMode; var Effect: LongWord; var Accept: Boolean); - procedure tvWatchesExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure tvWatchesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); - procedure tvWatchesInitChildren(Sender: TBaseVirtualTree; - Node: PVirtualNode; var ChildCount: Cardinal); procedure tvWatchesNodeDblClick(Sender: TBaseVirtualTree; const HitInfo: THitInfo); procedure popAddClick(Sender: TObject); @@ -152,21 +151,17 @@ type procedure popDeleteAllClick(Sender: TObject); private FQueuedUnLockCommandProcessing: Boolean; - procedure DoItemRemovedFromView(Sender: TDbgTreeView; AnItem: TObject; - ANode: PVirtualNode); procedure DoUnLockCommandProcessing(Data: PtrInt); - procedure DoWatchFreed(Sender: TObject); function GetWatches: TIdeWatches; procedure ContextChanged(Sender: TObject); procedure SnapshotChanged(Sender: TObject); - procedure WatchNavChanged(Sender: TArrayNavigationBar; AValue: Int64); private + FWatchTreeMgr: TDbgTreeViewWatchValueMgr; FWatchPrinter: TWatchResultPrinter; FWatchesInView: TIdeWatches; FPowerImgIdx, FPowerImgIdxGrey: Integer; FUpdateAllNeeded, FInEndUpdate: Boolean; FWatchInUpDateItem, FCurrentWatchInUpDateItem: TIdeWatch; - FExpandingWatch: TIdeWatch; FStateFlags: TWatchesDlgStateFlags; function GetSelected: TIdeWatch; // The focused Selected Node function GetThreadId: Integer; @@ -178,10 +173,6 @@ type procedure UpdateInspectPane; procedure UpdateItem(const VNode: PVirtualNode; const AWatch: TIdeWatch); - procedure UpdateArraySubItems(const VNode: PVirtualNode; - const AWatchValue: TIdeWatchValue; out ChildCount: LongWord); - procedure UpdateSubItems(const VNode: PVirtualNode; - const AWatchValue: TIdeWatchValue; out ChildCount: LongWord); procedure UpdateAll; procedure DisableAllActions; function GetSelectedSnapshot: TSnapshot; @@ -203,6 +194,26 @@ type property SnapshotManager; end; + { TDbgTreeViewWatchValueMgr } + + TDbgTreeViewWatchValueMgr = class(TDbgTreeViewWatchDataMgr) + private + FQueuedUnLockCommandProcessing: Boolean; + procedure DoUnLockCommandProcessing(Data: PtrInt); + protected + FWatchDlg: TWatchesDlg; + + function WatchAbleResultFromNode(AVNode: PVirtualNode): TWatchAbleResultIntf; override; + function WatchAbleResultFromObject(AWatchAble: TObject): TWatchAbleResultIntf; override; + + procedure UpdateColumnsText(AWatchAble: TObject; AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode); override; + procedure ConfigureNewSubItem(AWatchAble: TObject); override; + procedure UpdateSubItems(AWatchAble: TObject; AWatchAbleResult: TWatchAbleResultIntf; + AVNode: PVirtualNode; out ChildCount: LongWord); override; + procedure UpdateSubItemsLocked(AWatchAble: TObject; AWatchAbleResult: TWatchAbleResultIntf; + AVNode: PVirtualNode; out ChildCount: LongWord); override; + end; + implementation @@ -236,6 +247,9 @@ end; constructor TWatchesDlg.Create(AOwner: TComponent); begin inherited Create(AOwner); + FWatchTreeMgr := TDbgTreeViewWatchValueMgr.Create(tvWatches); + FWatchTreeMgr.FWatchDlg := Self; + FWatchPrinter := TWatchResultPrinter.Create; FWatchesInView := nil; FStateFlags := []; @@ -312,7 +326,7 @@ begin tvWatches.Header.Columns[1].Width := COL_WIDTHS[COL_WATCH_VALUE]; tvWatches.Header.Columns[2].Width := COL_WIDTHS[COL_WATCH_DATAADDR]; - tvWatches.OnItemRemoved := @DoItemRemovedFromView; + //tvWatches.OnItemRemoved := @DoItemRemovedFromView; end; destructor TWatchesDlg.Destroy; @@ -323,6 +337,7 @@ begin FQueuedUnLockCommandProcessing := False; FreeAndNil(FWatchPrinter); + FWatchTreeMgr.Free; tvWatches.Clear; // Must clear all nodes before any owned "Nav := TArrayNavigationBar" are freed; inherited Destroy; end; @@ -624,20 +639,6 @@ begin end; end; -procedure TWatchesDlg.tvWatchesExpanded(Sender: TBaseVirtualTree; - Node: PVirtualNode); -var - AWatch: TIdeWatch; -begin - Node := tvWatches.GetFirstChildNoInit(Node); - while Node <> nil do begin - AWatch := TIdeWatch(tvWatches.NodeItem[Node]); - if AWatch <> nil then - UpdateItem(Node, AWatch); - Node := tvWatches.GetNextSiblingNoInit(Node); - end; -end; - procedure TWatchesDlg.tvWatchesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); begin @@ -879,28 +880,6 @@ begin end; end; -procedure TWatchesDlg.WatchNavChanged(Sender: TArrayNavigationBar; AValue: Int64 - ); -var - VNode: PVirtualNode; - AWatch: TIdeWatch; - WatchValue: TIdeWatchValue; - c: LongWord; -begin - if Sender.OwnerData = nil then - exit; - - AWatch := TIdeWatch(Sender.OwnerData); - if AWatch.Enabled and AWatch.HasAllValidParents(GetThreadId, GetStackframe) then begin - VNode := tvWatches.FindNodeForItem(AWatch); - if VNode = nil then - exit; - - WatchValue := AWatch.Values[GetThreadId, GetStackframe]; - UpdateSubItems(VNode, WatchValue, c); - end; -end; - function TWatchesDlg.GetWatches: TIdeWatches; var Snap: TSnapshot; @@ -921,28 +900,6 @@ begin DebugBoss.UnLockCommandProcessing; end; -procedure TWatchesDlg.DoWatchFreed(Sender: TObject); -var - nd: PVirtualNode; -begin - nd := tvWatches.FindNodeForItem(Sender); - if nd = nil then - exit; - - tvWatches.OnItemRemoved := nil; - tvWatches.NodeItem[nd] := nil; - tvWatches.OnItemRemoved := @DoItemRemovedFromView; -end; - -procedure TWatchesDlg.DoItemRemovedFromView(Sender: TDbgTreeView; - AnItem: TObject; ANode: PVirtualNode); -begin - if AnItem <> nil then begin - TWatch(AnItem).ClearDisplayData; - TWatch(AnItem).RemoveFreeNotification(@DoWatchFreed); - end; -end; - procedure TWatchesDlg.DoBeginUpdate; begin inherited DoBeginUpdate; @@ -1231,81 +1188,7 @@ begin FWatchInUpDateItem := AWatch.TopParentWatch; FCurrentWatchInUpDateItem := AWatch; try - tvWatches.NodeText[VNode, COL_WATCH_EXPR-1]:= AWatch.DisplayName; - tvWatches.NodeText[VNode, 2] := ''; - if AWatch.Enabled and AWatch.HasAllValidParents(GetThreadId, GetStackframe) then begin - WatchValue := AWatch.Values[GetThreadId, GetStackframe]; - if (WatchValue <> nil) and - ( (GetSelectedSnapshot = nil) or not(WatchValue.Validity in [ddsUnknown, ddsEvaluating, ddsRequested]) ) - then begin - if (WatchValue.Validity = ddsValid) and (WatchValue.ResultData <> nil) then begin - WatchValueStr := FWatchPrinter.PrintWatchValue(WatchValue.ResultData, WatchValue.DisplayFormat); - WatchValueStr := ClearMultiline(DebugBoss.FormatValue(WatchValue.TypeInfo, WatchValueStr)); - if (WatchValue.ResultData.ValueKind = rdkArray) and (WatchValue.ResultData.ArrayLength > 0) - then tvWatches.NodeText[VNode, COL_WATCH_VALUE-1] := Format(drsLen, [WatchValue.ResultData.ArrayLength]) + WatchValueStr - else tvWatches.NodeText[VNode, COL_WATCH_VALUE-1] := WatchValueStr; - if WatchValue.ResultData.HasDataAddress then begin - da := WatchValue.ResultData.DataAddress; - if da = 0 - then tvWatches.NodeText[VNode, 2] := 'nil' - else tvWatches.NodeText[VNode, 2] := '$' + IntToHex(da, HexDigicCount(da, 4, True)); - end - end - else begin - if (WatchValue.TypeInfo <> nil) and - (WatchValue.TypeInfo.Attributes * [saArray, saDynArray] <> []) and - (WatchValue.TypeInfo.Len >= 0) - then tvWatches.NodeText[VNode, COL_WATCH_VALUE-1] := Format(drsLen, [WatchValue.TypeInfo.Len]) + WatchValue.Value - else tvWatches.NodeText[VNode, COL_WATCH_VALUE-1] := WatchValue.Value; - end; - end - else - tvWatches.NodeText[VNode, COL_WATCH_VALUE-1]:= ''; - - if ( ((DebugBoss <> nil) and (DebugBoss.State <> dsRun)) or - ((GetSelectedSnapshot <> nil) and not(AWatch is TCurrentWatch) ) - ) and - (WatchValue <> nil) and (WatchValue.Validity <> ddsRequested) - then begin - TypInfo := WatchValue.TypeInfo; - if DoDelayedDelete then - exit; - - HasChildren := ( (TypInfo <> nil) and (TypInfo.Fields <> nil) and (TypInfo.Fields.Count > 0) ) or - ( (WatchValue.ResultData <> nil) and - ( ( (WatchValue.ResultData.FieldCount > 0) and (WatchValue.ResultData.ValueKind <> rdkConvertRes) ) - or - //( (WatchValue.ResultData.ValueKind = rdkArray) and (WatchValue.ResultData.ArrayLength > 0) ) - (WatchValue.ResultData.ArrayLength > 0) - ) ); - tvWatches.HasChildren[VNode] := HasChildren; - if HasChildren and tvWatches.Expanded[VNode] then begin - if (WatchValue.Validity = ddsValid) then begin - (* The current "AWatch" should be done. Allow UpdateItem for nested entries *) - exclude(FStateFlags, wdsfUpdating); - FCurrentWatchInUpDateItem := nil; - - //AWatch.BeginChildUpdate; - UpdateSubItems(VNode, WatchValue, c); - //AWatch.EndChildUpdate; // This would currently trigger "UpdateAll" even when nothing changed, causing an endless loop - end; - end - else - if AWatch <> FExpandingWatch then - tvWatches.DeleteChildren(VNode, False); - end; - end - else - if not AWatch.Enabled then - tvWatches.NodeText[VNode, COL_WATCH_VALUE-1]:= '' - else - if (GetSelectedSnapshot = nil) and - (DebugBoss <> nil) and (DebugBoss.State in [dsPause, dsInternalPause]) - then - tvWatches.NodeText[VNode, COL_WATCH_VALUE-1]:= '' - else - tvWatches.NodeText[VNode, COL_WATCH_VALUE-1]:= ''; - + FWatchTreeMgr.UpdateWatchData(AWatch, VNode); finally if IsOuterUpdate then FWatchInUpDateItem := nil; @@ -1318,220 +1201,6 @@ begin end; end; -procedure TWatchesDlg.UpdateArraySubItems(const VNode: PVirtualNode; - const AWatchValue: TIdeWatchValue; out ChildCount: LongWord); -var - NewWatch, AWatch: TIdeWatch; - i, TotalCount: Integer; - ResData: TWatchResultData; - ExistingNode, nd: PVirtualNode; - Nav: TArrayNavigationBar; - Offs, KeepCnt, KeepBelow: Int64; -begin - ChildCount := 0; - ResData := AWatchValue.ResultData; - if (ResData = nil) then - exit; - - TotalCount := ResData.ArrayLength; - if (ResData.ValueKind <> rdkArray) or (TotalCount = 0) then - TotalCount := ResData.Count; - - AWatch := AWatchValue.Watch; - ExistingNode := tvWatches.GetFirstChildNoInit(VNode); - if ExistingNode = nil then - ExistingNode := tvWatches.AddChild(VNode, nil) - else - tvWatches.NodeItem[ExistingNode] := nil; - - Nav := TArrayNavigationBar(tvWatches.NodeControl[ExistingNode]); - if Nav = nil then begin - Nav := TArrayNavigationBar.Create(Self); - Nav.ParentColor := False; - Nav.ParentBackground := False; - Nav.Color := tvWatches.Colors.BackGroundColor; - Nav.LowBound := ResData.LowBound; - Nav.HighBound := ResData.LowBound + TotalCount - 1; - Nav.ShowBoundInfo := True; - Nav.Index := ResData.LowBound; - Nav.PageSize := 10; - Nav.OwnerData := AWatch; - Nav.OnIndexChanged := @WatchNavChanged; - Nav.OnPageSize := @WatchNavChanged; - Nav.HardLimits := not(ResData.ValueKind = rdkArray); - tvWatches.NodeControl[ExistingNode] := Nav; - tvWatches.NodeText[ExistingNode, 0] := ' '; - tvWatches.NodeText[ExistingNode, 1] := ' '; - end; - ChildCount := Nav.LimitedPageSize; - - ExistingNode := tvWatches.GetNextSiblingNoInit(ExistingNode); - - Offs := Nav.Index; - for i := 0 to ChildCount - 1 do begin - NewWatch := AWatchValue.ChildrenByNameAsArrayEntry[Offs + i]; - if NewWatch = nil then begin - dec(ChildCount); - continue; - end; - - if AWatch is TCurrentWatch then begin - NewWatch.DisplayFormat := wdfDefault; - NewWatch.Enabled := AWatch.Enabled; - if (defClassAutoCast in AWatch.EvaluateFlags) then - NewWatch.EvaluateFlags := NewWatch.EvaluateFlags + [defClassAutoCast]; - end; - - if ExistingNode <> nil then begin - tvWatches.NodeItem[ExistingNode] := NewWatch; - nd := ExistingNode; - ExistingNode := tvWatches.GetNextSiblingNoInit(ExistingNode); - end - else begin - nd := tvWatches.AddChild(VNode, NewWatch); - end; - UpdateItem(nd, NewWatch); - end; - - inc(ChildCount); // for the nav row - - if AWatch is TCurrentWatch then begin - KeepCnt := Nav.PageSize; - KeepBelow := KeepCnt; - KeepCnt := Max(Max(50, KeepCnt+10), - Min(KeepCnt*10, 500) ); - KeepBelow := Min(KeepBelow, KeepCnt - Nav.PageSize); - AWatch.LimitChildWatchCount(KeepCnt, ResData.LowBound + KeepBelow); - end; -end; - -procedure TWatchesDlg.UpdateSubItems(const VNode: PVirtualNode; - const AWatchValue: TIdeWatchValue; out ChildCount: LongWord); -var - NewWatch, AWatch: TIdeWatch; - TypInfo: TDBGType; - i: Integer; - ResData: TWatchResultData; - ExistingNode, nd: PVirtualNode; - ChildInfo: TWatchResultDataFieldInfo; - AnchClass: String; - IsGdbmiArray: Boolean; -begin - ChildCount := 0; - - if (AWatchValue.ResultData <> nil) and (AWatchValue.ResultData.FieldCount > 0) and - (AWatchValue.ResultData.ValueKind <> rdkConvertRes) - then begin - ResData := AWatchValue.ResultData; - AWatch := AWatchValue.Watch; - ExistingNode := tvWatches.GetFirstChildNoInit(VNode); - if ExistingNode <> nil then - tvWatches.NodeControl[ExistingNode].Free; - - AnchClass := ResData.TypeName; - for ChildInfo in ResData do begin - NewWatch := AWatchValue.ChildrenByNameAsField[ChildInfo.FieldName, AnchClass]; - if NewWatch = nil then begin - continue; - end; - inc(ChildCount); - - if AWatch is TCurrentWatch then begin - NewWatch.DisplayFormat := wdfDefault; - NewWatch.Enabled := AWatch.Enabled; - if EnvironmentOptions.DebuggerAutoSetInstanceFromClass then - NewWatch.EvaluateFlags := [defClassAutoCast]; - end; - - if ExistingNode <> nil then begin - tvWatches.NodeItem[ExistingNode] := NewWatch; - nd := ExistingNode; - ExistingNode := tvWatches.GetNextSiblingNoInit(ExistingNode); - end - else begin - nd := tvWatches.AddChild(VNode, NewWatch); - end; - UpdateItem(nd, NewWatch); - end; - - end - else - if (AWatchValue.ResultData <> nil) and - //(AWatchValue.ResultData.ValueKind = rdkArray) and - (AWatchValue.ResultData.ArrayLength > 0) - then begin - UpdateArraySubItems(VNode, AWatchValue, ChildCount); - end - else begin - // Old Interface - TypInfo := AWatchValue.TypeInfo; - AWatch := AWatchValue.Watch; - - if (TypInfo <> nil) and (TypInfo.Fields <> nil) then begin - IsGdbmiArray := TypInfo.Attributes * [saDynArray, saArray] <> []; - ChildCount := TypInfo.Fields.Count; - ExistingNode := tvWatches.GetFirstChildNoInit(VNode); - - AnchClass := TypInfo.TypeName; - for i := 0 to TypInfo.Fields.Count-1 do begin - if IsGdbmiArray then - NewWatch := AWatchValue.ChildrenByNameAsArrayEntry[StrToInt64Def(TypInfo.Fields[i].Name, 0)] - else - NewWatch := AWatchValue.ChildrenByNameAsField[TypInfo.Fields[i].Name, AnchClass]; - if NewWatch = nil then begin - dec(ChildCount); - continue; - end; - if AWatch is TCurrentWatch then begin - NewWatch.DisplayFormat := wdfDefault; - NewWatch.Enabled := AWatch.Enabled; - if EnvironmentOptions.DebuggerAutoSetInstanceFromClass then - NewWatch.EvaluateFlags := [defClassAutoCast]; - end; - - if ExistingNode <> nil then begin - tvWatches.NodeItem[ExistingNode] := NewWatch; - nd := ExistingNode; - ExistingNode := tvWatches.GetNextSiblingNoInit(ExistingNode); - end - else begin - nd := tvWatches.AddChild(VNode, NewWatch); - end; - UpdateItem(nd, NewWatch); - end; - end; - end; - - tvWatches.ChildCount[VNode] := ChildCount; -end; - -procedure TWatchesDlg.tvWatchesInitChildren(Sender: TBaseVirtualTree; - Node: PVirtualNode; var ChildCount: Cardinal); -// VTV.OnInitChildren -var - VNdWatch: TIdeWatch; - WatchValue: TIdeWatchValue; -begin - ChildCount := 0; - VNdWatch := TIdeWatch(tvWatches.NodeItem[Node]); - FExpandingWatch := VNdWatch; - - DebugBoss.LockCommandProcessing; - DebugBoss.Watches.CurrentWatches.BeginUpdate; - VNdWatch.BeginChildUpdate; - try - WatchValue := VNdWatch.Values[GetThreadId, GetStackframe]; - UpdateSubItems(Node, WatchValue, ChildCount); - finally - VNdWatch.EndChildUpdate; - DebugBoss.Watches.CurrentWatches.EndUpdate; - if not FQueuedUnLockCommandProcessing then - Application.QueueAsyncCall(@DoUnLockCommandProcessing, 0); - FQueuedUnLockCommandProcessing := True; - FExpandingWatch := nil; - end; -end; - procedure TWatchesDlg.UpdateAll; var i, l: Integer; @@ -1606,15 +1275,7 @@ begin BeginUpdate; try - VNode := tvWatches.FindNodeForItem(AWatch); - if VNode = nil - then begin - VNode := tvWatches.AddChild(nil, AWatch); - tvWatches.SelectNode(VNode); - AWatch.AddFreeNotification(@DoWatchFreed); - end; - - UpdateItem(VNode, AWatch); + FWatchTreeMgr.AddWatchData(AWatch); finally EndUpdate; end; @@ -1654,6 +1315,119 @@ begin tvWatchesChange(nil, nil); end; +{ TDbgTreeViewWatchValueMgr } + +procedure TDbgTreeViewWatchValueMgr.DoUnLockCommandProcessing(Data: PtrInt); +begin + FQueuedUnLockCommandProcessing := False; + DebugBoss.UnLockCommandProcessing; +end; + +function TDbgTreeViewWatchValueMgr.WatchAbleResultFromNode(AVNode: PVirtualNode): TWatchAbleResultIntf; +var + AWatchAble: TObject; +begin + AWatchAble := TreeView.NodeItem[AVNode]; + if AWatchAble = nil then exit(nil); + + Result := TIdeWatch(AWatchAble).Values[FWatchDlg.GetThreadId, FWatchDlg.GetStackframe]; +end; + +function TDbgTreeViewWatchValueMgr.WatchAbleResultFromObject(AWatchAble: TObject): TWatchAbleResultIntf; +var + nd: TObject; +begin + if AWatchAble = nil then exit(nil); + + Result := TIdeWatch(AWatchAble).Values[FWatchDlg.GetThreadId, FWatchDlg.GetStackframe]; +end; + +procedure TDbgTreeViewWatchValueMgr.UpdateColumnsText(AWatchAble: TObject; + AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode); +var + WatchValueStr: String; + da: TDBGPtr; +begin + TreeView.NodeText[AVNode, COL_WATCH_EXPR-1]:= TIdeWatch(AWatchAble).DisplayName; + TreeView.NodeText[AVNode, 2] := ''; + + if (AWatchAbleResult = nil) then begin + TreeView.NodeText[AVNode, COL_WATCH_VALUE-1]:= ''; + exit; + end; + + + if AWatchAbleResult.Enabled then begin + if (FWatchDlg.GetSelectedSnapshot = nil) or // live watch + (AWatchAbleResult.Validity in [ddsValid, ddsInvalid, ddsError]) // snapshot + then begin + if (AWatchAbleResult.Validity = ddsValid) and (AWatchAbleResult.ResultData <> nil) then begin + WatchValueStr := FWatchDlg.FWatchPrinter.PrintWatchValue(AWatchAbleResult.ResultData, AWatchAbleResult.DisplayFormat); + WatchValueStr := ClearMultiline(DebugBoss.FormatValue(AWatchAbleResult.TypeInfo, WatchValueStr)); + if (AWatchAbleResult.ResultData.ValueKind = rdkArray) and (AWatchAbleResult.ResultData.ArrayLength > 0) + then TreeView.NodeText[AVNode, COL_WATCH_VALUE-1] := Format(drsLen, [AWatchAbleResult.ResultData.ArrayLength]) + WatchValueStr + else TreeView.NodeText[AVNode, COL_WATCH_VALUE-1] := WatchValueStr; + if AWatchAbleResult.ResultData.HasDataAddress then begin + da := AWatchAbleResult.ResultData.DataAddress; + if da = 0 + then TreeView.NodeText[AVNode, 2] := 'nil' + else TreeView.NodeText[AVNode, 2] := '$' + IntToHex(da, HexDigicCount(da, 4, True)); + end + end + else begin + if (AWatchAbleResult.TypeInfo <> nil) and + (AWatchAbleResult.TypeInfo.Attributes * [saArray, saDynArray] <> []) and + (AWatchAbleResult.TypeInfo.Len >= 0) + then TreeView.NodeText[AVNode, COL_WATCH_VALUE-1] := Format(drsLen, [AWatchAbleResult.TypeInfo.Len]) + AWatchAbleResult.Value + else TreeView.NodeText[AVNode, COL_WATCH_VALUE-1] := AWatchAbleResult.Value; + end; + end + else + if (FWatchDlg.GetSelectedSnapshot = nil) and + (DebugBoss <> nil) and (DebugBoss.State in [dsPause, dsInternalPause]) + then + TreeView.NodeText[AVNode, COL_WATCH_VALUE-1]:= '' + else + TreeView.NodeText[AVNode, COL_WATCH_VALUE-1]:= ''; + end + else + TreeView.NodeText[AVNode, COL_WATCH_VALUE-1]:= ''; + +end; + +procedure TDbgTreeViewWatchValueMgr.ConfigureNewSubItem(AWatchAble: TObject); +begin + if (AWatchAble <> nil) and (AWatchAble is TCurrentWatch) then + TCurrentWatch(AWatchAble).DisplayFormat := wdfDefault; +end; + +procedure TDbgTreeViewWatchValueMgr.UpdateSubItems(AWatchAble: TObject; + AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out + ChildCount: LongWord); +begin + exclude(FWatchDlg.FStateFlags, wdsfUpdating); + FWatchDlg.FCurrentWatchInUpDateItem := nil; + inherited UpdateSubItems(AWatchAble, AWatchAbleResult, AVNode, ChildCount); +end; + +procedure TDbgTreeViewWatchValueMgr.UpdateSubItemsLocked(AWatchAble: TObject; + AWatchAbleResult: TWatchAbleResultIntf; AVNode: PVirtualNode; out + ChildCount: LongWord); +begin + DebugBoss.LockCommandProcessing; + DebugBoss.Watches.CurrentWatches.BeginUpdate; + TIdeWatch(AWatchAble).BeginChildUpdate; + try + UpdateSubItems(AWatchAble, AWatchAbleResult, AVNode, ChildCount); + finally + TIdeWatch(AWatchAble).EndChildUpdate; + DebugBoss.Watches.CurrentWatches.EndUpdate; + if not FQueuedUnLockCommandProcessing then + Application.QueueAsyncCall(@DoUnLockCommandProcessing, 0); + FQueuedUnLockCommandProcessing := True; + end; +end; + initialization WatchWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtWatches]);