Debugger: Watches-Win, expand arrays to view entries

debugger/watchesdlg.pp

@@ -41,11 +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,
-  IDEImagesIntf, LazarusIDEStrConsts, DebuggerStrConst, Debugger,
+  LMessages, IDEImagesIntf, LazarusIDEStrConsts, DebuggerStrConst, Debugger,
   DebuggerTreeView, IdeDebuggerBase, DebuggerDlg, DbgIntfBaseTypes,
-  DbgIntfDebuggerBase, DbgIntfMiscClasses, SynEdit, laz.VirtualTrees,
+  DbgIntfDebuggerBase, DbgIntfMiscClasses, SynEdit, laz.VirtualTrees, SpinEx,
   LazDebuggerIntf, LazDebuggerIntfBaseTypes, BaseDebugManager, EnvironmentOpts,
-  StrUtils, IdeDebuggerWatchResult, IdeDebuggerWatchResPrinter;
+  StrUtils, IdeDebuggerWatchResult, IdeDebuggerWatchResPrinter,
+  ArrayNavigationFrame;
 
 type
 
@@ -151,6 +152,7 @@ type
     function GetWatches: TIdeWatches;
     procedure ContextChanged(Sender: TObject);
     procedure SnapshotChanged(Sender: TObject);
+    procedure WatchNavChanged(Sender: TArrayNavigationBar; AValue: Int64);
   private
     FWatchPrinter: TWatchResultPrinter;
     FWatchesInView: TIdeWatches;
@@ -168,6 +170,8 @@ 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;
@@ -175,6 +179,7 @@ type
     function  GetSelectedSnapshot: TSnapshot;
     property Watches: TIdeWatches read GetWatches;
   protected
+    function IsShortcut(var Message: TLMKey): Boolean; override;
     procedure DoBeginUpdate; override;
     procedure DoEndUpdate; override;
     procedure DoWatchesChanged; override;
@@ -495,6 +500,12 @@ var
   s: String;
   NewWatch: TCurrentWatch;
 begin
+  if (ActiveControl <> nil) and (
+       (ActiveControl is TCustomEdit) or (ActiveControl is TCustomSpinEditEx)
+     )
+  then
+    exit;
+
   if (Shift * [ssShift, ssAlt, ssAltGr, ssCtrl] = [ssCtrl]) and (Key = VK_V)
   then begin
     Key := 0;
@@ -699,6 +710,28 @@ 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;
@@ -1058,8 +1091,11 @@ begin
         if DoDelayedDelete then
           exit;
 
-        HasChildren := ((TypInfo <> nil) and (TypInfo.Fields <> nil) and (TypInfo.Fields.Count > 0)) or
+        HasChildren := ( (TypInfo <> nil) and (TypInfo.Fields <> nil) and (TypInfo.Fields.Count > 0) ) or
-                       ((WatchValue.ResultData <> nil) and (WatchValue.ResultData.FieldCount > 0));
+                       ( (WatchValue.ResultData <> nil) and
+                         ( (WatchValue.ResultData.FieldCount > 0) or
+                           ( (WatchValue.ResultData.ValueKind = rdkArray) and (WatchValue.ResultData.ArrayLength > 0) )
+                       ) );
         tvWatches.HasChildren[VNode] := HasChildren;
         if HasChildren and (WatchValue.Validity = ddsValid) and tvWatches.Expanded[VNode] then begin
           (* The current "AWatch" should be done. Allow UpdateItem for nested entries *)
@@ -1095,6 +1131,93 @@ 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;
+  Idx: String;
+  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;
+    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 do begin
+    Idx := IntToStr(Offs +  i);
+
+    NewWatch := AWatch.ChildrenByName[Idx];
+    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;
+
+  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
@@ -1112,6 +1235,8 @@ begin
     ChildCount := ResData.FieldCount;
     AWatch := AWatchValue.Watch;
     ExistingNode := tvWatches.GetFirstChildNoInit(VNode);
+    if ExistingNode <> nil then
+      tvWatches.NodeControl[ExistingNode].Free;
 
     for i := 0 to ResData.FieldCount-1 do begin
       ChildInfo := ResData.Fields[i];
@@ -1141,6 +1266,13 @@ begin
     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;
@@ -1258,6 +1390,17 @@ begin
   then Result := SnapshotManager.SelectedEntry;
 end;
 
+function TWatchesDlg.IsShortcut(var Message: TLMKey): Boolean;
+begin
+  Result := false;
+  if (ActiveControl <> nil) and (
+       (ActiveControl is TCustomEdit) or (ActiveControl is TCustomSpinEditEx)
+     )
+  then
+    exit;
+  Result := inherited IsShortcut(Message);
+end;
+
 procedure TWatchesDlg.WatchAdd(const ASender: TIdeWatches; const AWatch: TIdeWatch);
 var
   VNode: PVirtualNode;

ide/packages/idedebugger/arraynavigationframe.lfm

@@ -107,4 +107,13 @@ object ArrayNavigationBar: TArrayNavigationBar
     Flat = True
     OnClick = BtnChangeSizeClicked
   end
+  object lblBounds: TLabel
+    Left = 252
+    Height = 26
+    Top = 0
+    Width = 1
+    Align = alLeft
+    BorderSpacing.Left = 10
+    Visible = False
+  end
 end

ide/packages/idedebugger/arraynavigationframe.pas

@@ -26,6 +26,7 @@ type
     edArrayPageSize: TSpinEditEx;
     edArrayStart: TSpinEditEx;
     Label1: TLabel;
+    lblBounds: TLabel;
     procedure BtnChangePageClicked(Sender: TObject);
     procedure BtnChangeSizeClicked(Sender: TObject);
     procedure edArrayPageSizeEditingDone(Sender: TObject);
@@ -35,19 +36,31 @@ type
     FLowBound: int64;
     FOnIndexChanged: TArrayNavChangeEvent;
     FOnPageSize: TArrayNavChangeEvent;
+    FOwnerData: pointer;
+    FShowBoundInfo: Boolean;
     function GetIndex: int64;
+    function GetIndexOffs: int64;
+    function GetLimitedPageSize: int64;
     function GetPageSize: int64;
     procedure SetHighBound(AValue: int64);
     procedure SetIndex(AValue: int64);
     procedure SetLowBound(AValue: int64);
     procedure SetPageSize(AValue: int64);
+    procedure Loaded; override;
+    procedure SetShowBoundInfo(AValue: Boolean);
+    procedure UpdateBoundsInfo;
   public
     constructor Create(TheOwner: TComponent); override;
     property LowBound: int64 read FLowBound write SetLowBound;
     property HighBound: int64 read FHighBound write SetHighBound;
+    property ShowBoundInfo: Boolean read FShowBoundInfo write SetShowBoundInfo;
 
     property Index: int64 read GetIndex write SetIndex;
     property PageSize: int64 read GetPageSize write SetPageSize;
+    property IndexOffs: int64 read GetIndexOffs;
+    property LimitedPageSize: int64 read GetLimitedPageSize;
+
+    property OwnerData: pointer read FOwnerData write FOwnerData;
   published
     property OnIndexChanged: TArrayNavChangeEvent read FOnIndexChanged write FOnIndexChanged;
     property OnPageSize: TArrayNavChangeEvent read FOnPageSize write FOnPageSize;
@@ -63,6 +76,7 @@ procedure TArrayNavigationBar.SetHighBound(AValue: int64);
 begin
   if FHighBound = AValue then Exit;
   FHighBound := AValue;
+  UpdateBoundsInfo;
 end;
 
 procedure TArrayNavigationBar.BtnChangePageClicked(Sender: TObject);
@@ -123,6 +137,21 @@ begin
   Result := edArrayStart.Value;
 end;
 
+function TArrayNavigationBar.GetIndexOffs: int64;
+begin
+  Result := edArrayStart.Value - FLowBound;
+end;
+
+function TArrayNavigationBar.GetLimitedPageSize: int64;
+var
+  idx: Int64;
+begin
+  Result := edArrayPageSize.Value;
+  idx := edArrayStart.Value;
+  if (idx >= FLowBound) and (idx < FHighBound) then
+    Result := Max(1, Min(Result, FHighBound + 1 - idx));
+end;
+
 function TArrayNavigationBar.GetPageSize: int64;
 begin
   Result := edArrayPageSize.Value;
@@ -137,6 +166,7 @@ procedure TArrayNavigationBar.SetLowBound(AValue: int64);
 begin
   if FLowBound = AValue then Exit;
   FLowBound := AValue;
+  UpdateBoundsInfo;
 end;
 
 procedure TArrayNavigationBar.SetPageSize(AValue: int64);
@@ -144,9 +174,34 @@ begin
   edArrayPageSize.Value := AValue;
 end;
 
+procedure TArrayNavigationBar.Loaded;
+begin
+  inherited Loaded;
+  Constraints.MinWidth := btnArrayPageInc.Left + btnArrayPageInc.Width;
+end;
+
+procedure TArrayNavigationBar.SetShowBoundInfo(AValue: Boolean);
+begin
+  if FShowBoundInfo = AValue then Exit;
+  FShowBoundInfo := AValue;
+
+  UpdateBoundsInfo;
+  lblBounds.Visible := FShowBoundInfo;
+end;
+
+procedure TArrayNavigationBar.UpdateBoundsInfo;
+begin
+  if not FShowBoundInfo then
+    exit;
+
+  lblBounds.Caption := format(dlgInspectBoundsDD, [FLowBound, FHighBound]);
+end;
+
 constructor TArrayNavigationBar.Create(TheOwner: TComponent);
 begin
   inherited Create(TheOwner);
+  Name := '';
+  Constraints.MinWidth := btnArrayPageInc.Left + btnArrayPageInc.Width;
 
   edArrayStart.Hint := dlgInspectIndexOfFirstItemToShow;
   edArrayPageSize.Hint := dlgInspectAmountOfItemsToShow;

ide/packages/idedebugger/debugger.pp

@@ -609,6 +609,7 @@ type
 
     procedure BeginChildUpdate;
     procedure EndChildUpdate;
+    procedure LimitChildWatchCount(AMaxCnt: Integer; AKeepIndexEntriesBelow: Int64 = low(Int64));
     property ChildrenByName[AName: String]: TIdeWatch read GetChildrenByName;
     function HasAllValidParents(AThreadId: Integer; AStackFrame: Integer): boolean;
     property ParentWatch: TIdeWatch read FParentWatch;
@@ -6230,6 +6231,23 @@ begin
     FChildWatches.EndUpdate;
 end;
 
+procedure TIdeWatch.LimitChildWatchCount(AMaxCnt: Integer;
+  AKeepIndexEntriesBelow: Int64);
+var
+  w: TIdeWatch;
+  x: int64;
+  i: Integer;
+begin
+  i := 0;
+  while (FChildWatches.Count > AMaxCnt) and (i < FChildWatches.Count) do begin
+    w := FChildWatches[i];
+    if TryStrToInt64(w.Expression, x) and (x < AKeepIndexEntriesBelow) then
+      inc(i)
+    else
+      FChildWatches.Delete(0);
+  end;
+end;
+
 function TIdeWatch.HasAllValidParents(AThreadId: Integer; AStackFrame: Integer
   ): boolean;
 begin
@@ -6266,7 +6284,10 @@ var
 begin
   Result := Expression;
   if FParentWatch <> nil then begin
-    Result := '(' + FParentWatch.GetFullExpression(AThreadId, AStackFrame) + ').' + Result;
+    if (Result <> '') and (Result[1] in ['0'..'9']) then
+      Result := '(' + FParentWatch.GetFullExpression(AThreadId, AStackFrame) + ')[' + Result+']'
+    else
+      Result := '(' + FParentWatch.GetFullExpression(AThreadId, AStackFrame) + ').' + Result;
     if (defClassAutoCast in FParentWatch.FEvaluateFlags) then begin
       wv := GetAnyValidParentWatchValue(AThreadId, AStackFrame);
       if wv.ResultData <> nil then
@@ -6463,7 +6484,14 @@ end;
 destructor TCurrentWatch.Destroy;
 var
   w: TCurrentWatches;
+  s: TIdeWatch;
 begin
+  if FSnapShot <> nil then begin
+    s := FSnapShot;
+    SnapShot := Nil;
+    FreeAndNil(s);
+  end;
+
   if (TCurrentWatches(Collection) <> nil)
   then begin
     TCurrentWatches(Collection).NotifyRemove(Self);

ide/packages/idedebugger/debuggertreeview.pas

@@ -5,13 +5,14 @@ unit DebuggerTreeView;
 interface
 
 uses
-  Classes, SysUtils, laz.VirtualTrees, LMessages;
+  Classes, SysUtils, laz.VirtualTrees, SpinEx, LMessages, Controls;
 
 type
 
   TDbgTreeNodeData = record
-    Item: TObject;
+    Item: TObject;  // Must be the first field.  Node.AddChild will write the new "Item" at UserData^  (aka the memory at the start of UserData)
     CachedText: Array of String;
+    Control: TControl;
   end;
   PDbgTreeNodeData = ^TDbgTreeNodeData;
 
@@ -19,11 +20,14 @@ type
 
   TDbgTreeView = class(TLazVirtualStringTree)
   private
+    function GetNodeControl(Node: PVirtualNode): TControl;
     function GetNodeItem(Node: PVirtualNode): TObject;
     function GetNodeText(Node: PVirtualNode; AColumn: integer): String;
+    procedure SetNodeControl(Node: PVirtualNode; AValue: TControl);
     procedure SetNodeItem(Node: PVirtualNode; AValue: TObject);
     procedure SetNodeText(Node: PVirtualNode; AColumn: integer; AValue: String);
   protected
+    function DoCollapsing(Node: PVirtualNode): Boolean; override;
     procedure ValidateNodeDataSize(var Size: Integer); override;
     procedure DoFreeNode(Node: PVirtualNode); override;
     function DetermineLineImageAndSelectLevel(Node: PVirtualNode;
@@ -31,6 +35,7 @@ type
     procedure HandleMouseDblClick(var Message: TLMMouse; const HitInfo: THitInfo); override;
     procedure DoGetText(Node: PVirtualNode; Column: TColumnIndex;
       TextType: TVSTTextType; var AText: String); override;
+    procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override;
   public
     function GetNodeData(Node: PVirtualNode): PDbgTreeNodeData; reintroduce;
 
@@ -44,12 +49,23 @@ type
 
     property NodeItem[Node: PVirtualNode]: TObject read GetNodeItem write SetNodeItem;
     property NodeText[Node: PVirtualNode; AColumn: integer]: String read GetNodeText write SetNodeText;
+    property NodeControl[Node: PVirtualNode]: TControl read GetNodeControl write SetNodeControl;
   end;
 
 implementation
 
 { TDbgTreeView }
 
+function TDbgTreeView.GetNodeControl(Node: PVirtualNode): TControl;
+var
+  Data: PDbgTreeNodeData;
+begin
+  Result := nil;
+  Data := GetNodeData(Node);
+  if Data <> nil then
+    Result := Data^.Control;
+end;
+
 function TDbgTreeView.GetNodeItem(Node: PVirtualNode): TObject;
 var
   Data: PDbgTreeNodeData;
@@ -70,6 +86,25 @@ begin
     Result := Data^.CachedText[AColumn];
 end;
 
+procedure TDbgTreeView.SetNodeControl(Node: PVirtualNode; AValue: TControl);
+var
+  Data: PDbgTreeNodeData;
+begin
+  Data := GetNodeData(Node);
+  if Data = nil then
+    exit;
+  if Data^.Control = AValue then
+    exit;
+
+  Data^.Control.Free;
+  Data^.Control := AValue;
+  if AValue <> nil then begin
+    AValue.Visible := False;
+    AValue.Parent := Self;
+    AValue.AutoSize := False;
+  end;
+end;
+
 procedure TDbgTreeView.SetNodeItem(Node: PVirtualNode; AValue: TObject);
 var
   Data: PDbgTreeNodeData;
@@ -92,6 +127,33 @@ begin
   end;
 end;
 
+function TDbgTreeView.DoCollapsing(Node: PVirtualNode): Boolean;
+  procedure RecursivelyHideControls(N: PVirtualNode);
+  var
+    N2: PVirtualNode;
+    NData: PDbgTreeNodeData;
+  begin
+    NData := GetNodeData(N);
+    if NData^.Control <> nil then
+      NData^.Control.Visible := False;
+
+    while N <> nil do begin
+      N2 := GetFirstChildNoInit(N);
+      if N2 <> nil then
+        RecursivelyHideControls(N2);
+      N := GetNextSiblingNoInit(N);
+    end;
+  end;
+var
+  n: PVirtualNode;
+begin
+  n := GetFirstChildNoInit(Node);
+  if n <> nil then
+    RecursivelyHideControls(n);
+
+  Result := inherited DoCollapsing(Node);
+end;
+
 procedure TDbgTreeView.ValidateNodeDataSize(var Size: Integer);
 begin
   Size := SizeOf(TDbgTreeNodeData);
@@ -99,6 +161,7 @@ end;
 
 procedure TDbgTreeView.DoFreeNode(Node: PVirtualNode);
 begin
+  PDbgTreeNodeData(GetNodeData(Node))^.Control.Free;
   PDbgTreeNodeData(GetNodeData(Node))^ := Default(TDbgTreeNodeData);
   inherited DoFreeNode(Node);
 end;
@@ -134,6 +197,29 @@ begin
   end;
 end;
 
+procedure TDbgTreeView.DoPaintNode(var PaintInfo: TVTPaintInfo);
+var
+  NData: PDbgTreeNodeData;
+  r: TRect;
+begin
+  NData := GetNodeData(PaintInfo.Node);
+  if NData^.Control <> nil then begin
+    if PaintInfo.Column = 0 then begin
+      r := GetDisplayRect(PaintInfo.Node, 0, True, False);
+      r.Right := ClientWidth - r.Left - 1;
+      NData^.Control.BoundsRect := r;
+      NData^.Control.Visible := True;
+      if (r.Top < (r.Bottom - r.Height) * 2 + 5) or
+         (r.Bottom > ClientHeight - (r.Bottom - r.Height) * 2 - 5)
+      then
+        NData^.Control.Invalidate;
+    end;
+    exit;
+  end;
+
+  inherited DoPaintNode(PaintInfo);
+end;
+
 function TDbgTreeView.GetNodeData(Node: PVirtualNode): PDbgTreeNodeData;
 begin
   Result := PDbgTreeNodeData(inherited GetNodeData(Node));

ide/packages/idedebugger/idedebuggerstringconstants.pas

@@ -10,6 +10,7 @@ interface
 resourcestring
   dlgInspectIndexOfFirstItemToShow = 'Index of first item to show';
   dlgInspectAmountOfItemsToShow = 'Amount of items to show';
+  dlgInspectBoundsDD = 'Bounds: %d .. %d';
 
 implementation