mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-14 14:59:22 +02:00
Debugger: refactor Watch-Dialog, move code that controls watches in the tree to new unit
This commit is contained in:
Martin
parent
4b3bb40c9b
commit
40a5975659
440
ide/packages/idedebugger/dbgtreeviewwatchdata.pas
Normal file
440
ide/packages/idedebugger/dbgtreeviewwatchdata.pas
Normal file
@ -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.
|
||||
|
||||
@ -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 := '<invalid>';
|
||||
ddsError: Result := '<Error: '+ (inherited GetValue) +'>';
|
||||
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;
|
||||
|
||||
|
||||
@ -178,6 +178,10 @@
|
||||
<Filename Value="assemblerdlg.pp"/>
|
||||
<UnitName Value="AssemblerDlg"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="dbgtreeviewwatchdata.pas"/>
|
||||
<UnitName Value="DbgTreeViewWatchData"/>
|
||||
</Item>
|
||||
</Files>
|
||||
<i18n>
|
||||
<EnableI18N Value="True"/>
|
||||
|
||||
@ -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 <Error> 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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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]:= '<not evaluated>';
|
||||
|
||||
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]:= '<disabled>'
|
||||
else
|
||||
if (GetSelectedSnapshot = nil) and
|
||||
(DebugBoss <> nil) and (DebugBoss.State in [dsPause, dsInternalPause])
|
||||
then
|
||||
tvWatches.NodeText[VNode, COL_WATCH_VALUE-1]:= '<evaluating>'
|
||||
else
|
||||
tvWatches.NodeText[VNode, COL_WATCH_VALUE-1]:= '<not evaluated>';
|
||||
|
||||
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]:= '<not evaluated>';
|
||||
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]:= '<evaluating>'
|
||||
else
|
||||
TreeView.NodeText[AVNode, COL_WATCH_VALUE-1]:= '<not evaluated>';
|
||||
end
|
||||
else
|
||||
TreeView.NodeText[AVNode, COL_WATCH_VALUE-1]:= '<disabled>';
|
||||
|
||||
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]);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user