Debugger: add binary display for watches. Issue #0032817 Patch by Silvio Clécio

git-svn-id: trunk@57196 -

components/debuggerintf/dbgintfdebuggerbase.pp

@@ -593,7 +593,7 @@ type
      wdfChar, wdfString,
      wdfDecimal, wdfUnsigned, wdfFloat, wdfHex,
      wdfPointer,
-     wdfMemDump
+     wdfMemDump, wdfBinary
     );
 
   TWatch = class;

components/lazdebuggergdbmi/gdbmidebugger.pp

@@ -12737,6 +12737,16 @@ var
           FTextValue := MemDump.AsText(0, MemDump.Count, TargetInfo^.TargetPtrSize*2);
           MemDump.Free;
         end;
+      wdfBinary:
+        begin
+          Result := PrepareExpr(AnExpression, True);
+          if not Result
+          then exit;
+          FValidity := ddsValid;
+          FTextValue := Concat('0b' + BinStr(GetPtrValue(AnExpression, [], True), TargetInfo^.TargetPtrSize*2));
+          if LastExecResult.State = dsError
+          then ParseLastError;
+        end;
       else // wdfDefault
         begin
           Result := False;

components/lazdebuggergdbmi/test/gdbmitestutils/testbase.pas

@@ -43,7 +43,7 @@ const
      'wdfChar', 'wdfString',
      'wdfDecimal', 'wdfUnsigned', 'wdfFloat', 'wdfHex',
      'wdfPointer',
-     'wdfMemDump'
+     'wdfMemDump', 'wdfBinary'
     );
 
 type

debugger/debugger.pp

@@ -556,7 +556,7 @@ const
      'wdfChar', 'wdfString',
      'wdfDecimal', 'wdfUnsigned', 'wdfFloat', 'wdfHex',
      'wdfPointer',
-     'wdfMemDump'
+     'wdfMemDump', 'wdfBinary'
     );
 
 type

debugger/watchpropertydlg.lfm

@@ -14,8 +14,8 @@ object WatchPropertyDlg: TWatchPropertyDlg
   LCLVersion = '1.9.0.0'
   object rgStyle: TRadioGroup
     Left = 6
-    Height = 102
-    Top = 139
+    Height = 104
+    Top = 138
     Width = 416
     Align = alClient
     AutoFill = True
@@ -31,7 +31,7 @@ object WatchPropertyDlg: TWatchPropertyDlg
     ChildSizing.ShrinkVertical = crsScaleChilds
     ChildSizing.Layout = cclLeftToRightThenTopToBottom
     ChildSizing.ControlsPerLine = 3
-    ClientHeight = 87
+    ClientHeight = 85
     ClientWidth = 412
     Columns = 3
     ItemIndex = 7
@@ -45,13 +45,14 @@ object WatchPropertyDlg: TWatchPropertyDlg
       'Record/Structure'
       'Default'
       'Memory Dump'
+      'Binary'
     )
     TabOrder = 1
   end
   object ButtonPanel: TButtonPanel
     Left = 6
-    Height = 28
-    Top = 247
+    Height = 27
+    Top = 248
     Width = 416
     OKButton.Name = 'OKButton'
     OKButton.DefaultCaption = True
@@ -70,13 +71,13 @@ object WatchPropertyDlg: TWatchPropertyDlg
   end
   object PanelTop: TPanel
     Left = 0
-    Height = 139
+    Height = 138
     Top = 0
     Width = 428
     Align = alTop
     AutoSize = True
     BevelOuter = bvNone
-    ClientHeight = 139
+    ClientHeight = 138
     ClientWidth = 428
     TabOrder = 0
     object lblExpression: TLabel
@@ -84,9 +85,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
       AnchorSideTop.Control = txtExpression
       AnchorSideTop.Side = asrCenter
       Left = 6
-      Height = 13
+      Height = 17
       Top = 11
-      Width = 62
+      Width = 64
       BorderSpacing.Left = 6
       Caption = 'Expression:'
       ParentColor = False
@@ -96,10 +97,10 @@ object WatchPropertyDlg: TWatchPropertyDlg
       AnchorSideLeft.Side = asrBottom
       AnchorSideRight.Control = PanelTop
       AnchorSideRight.Side = asrBottom
-      Left = 74
-      Height = 23
+      Left = 76
+      Height = 27
       Top = 6
-      Width = 348
+      Width = 346
       Anchors = [akTop, akLeft, akRight]
       BorderSpacing.Left = 6
       BorderSpacing.Top = 6
@@ -111,9 +112,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
       AnchorSideTop.Control = txtRepCount
       AnchorSideTop.Side = asrCenter
       Left = 6
-      Height = 13
-      Top = 40
-      Width = 79
+      Height = 17
+      Top = 44
+      Width = 78
       BorderSpacing.Left = 6
       Caption = 'Repeat Count:'
       ParentColor = False
@@ -123,9 +124,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
       AnchorSideLeft.Side = asrBottom
       AnchorSideTop.Control = txtExpression
       AnchorSideTop.Side = asrBottom
-      Left = 91
-      Height = 23
-      Top = 35
+      Left = 90
+      Height = 27
+      Top = 39
       Width = 60
       BorderSpacing.Left = 6
       BorderSpacing.Top = 6
@@ -137,9 +138,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
       AnchorSideLeft.Side = asrBottom
       AnchorSideTop.Control = txtRepCount
       AnchorSideTop.Side = asrCenter
-      Left = 204
-      Height = 23
-      Top = 35
+      Left = 203
+      Height = 27
+      Top = 39
       Width = 60
       BorderSpacing.Left = 6
       BorderSpacing.Top = 6
@@ -151,9 +152,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
       AnchorSideLeft.Side = asrBottom
       AnchorSideTop.Control = lblRepCount
       AnchorSideTop.Side = asrCenter
-      Left = 163
-      Height = 13
-      Top = 40
+      Left = 162
+      Height = 17
+      Top = 44
       Width = 35
       BorderSpacing.Left = 12
       Caption = 'Digits:'
@@ -163,9 +164,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
       AnchorSideTop.Control = txtRepCount
       AnchorSideTop.Side = asrBottom
       Left = 6
-      Height = 24
-      Top = 61
-      Width = 70
+      Height = 21
+      Top = 69
+      Width = 68
       BorderSpacing.Left = 6
       BorderSpacing.Top = 3
       Caption = 'Enabled'
@@ -176,9 +177,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
       AnchorSideTop.Control = chkEnabled
       AnchorSideTop.Side = asrBottom
       Left = 6
-      Height = 24
-      Top = 85
-      Width = 134
+      Height = 21
+      Top = 90
+      Width = 133
       AllowGrayed = True
       Caption = 'Allow Function Calls'
       TabOrder = 4
@@ -188,9 +189,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
       AnchorSideTop.Control = chkAllowFunc
       AnchorSideTop.Side = asrBottom
       Left = 6
-      Height = 24
-      Top = 109
-      Width = 137
+      Height = 21
+      Top = 111
+      Width = 142
       BorderSpacing.Bottom = 6
       Caption = 'chkUseInstanceClass'
       TabOrder = 5

debugger/watchpropertydlg.pp

@@ -76,10 +76,10 @@ implementation
 
 procedure TWatchPropertyDlg.btnOKClick(Sender: TObject);
 const
-  StyleToDispFormat: Array [0..8] of TWatchDisplayFormat =
+  StyleToDispFormat: Array [0..9] of TWatchDisplayFormat =
     (wdfChar, wdfString, wdfDecimal,
      wdfHex, wdfUnsigned, wdfPointer,
-     wdfStructure, wdfDefault, wdfMemDump
+     wdfStructure, wdfDefault, wdfMemDump, wdfBinary
     );
 begin
   if FWatch = nil
@@ -116,7 +116,8 @@ const
      0, 1, //wdfChar, wdfString,
      2, 4, //wdfDecimal, wdfUnsigned, (TODO unsigned)
      7, 3, //wdfFloat, wdfHex,
-     5, 8   //wdfPointer, wdfMemDump
+     5, 8, //wdfPointer, wdfMemDump
+     9     //wdfBinary
     );
 begin
   FWatch := AWatch;
@@ -158,7 +159,8 @@ begin
   rgStyle.Items[6]:= lisRecordStruct;
   rgStyle.Items[7]:= lisDefault;
   rgStyle.Items[8]:= lisMemoryDump;
-  //rgStyle.Items[9]:= lisFloatingPoin;
+  rgStyle.Items[9]:= lisBinary;
+  //rgStyle.Items[10]:= lisFloatingPoin;
 
   ButtonPanel.OKButton.Caption:=lisMenuOk;
   ButtonPanel.HelpButton.Caption:=lisMenuHelp;

ide/lazarusidestrconsts.pas

@@ -5484,6 +5484,7 @@ resourcestring
   lisPointer = 'Pointer';
   lisRecordStruct = 'Record/Structure';
   lisMemoryDump = 'Memory Dump';
+  lisBinary = 'Binary';
 
   // Callstack
   lisCallStackNotEvaluated = 'Stack not evaluated';