paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 00:59:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

IdeDebugger: ValueFormatter "Custom Displayformat"

Browse Source
This commit is contained in:
Martin 2024-04-22 21:23:10 +02:00
parent 72fa9a1c96
commit fcaca1fe6a
35 changed files with 1196 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
components/ideintf/idedebuggervalueformatterintf.pas
View File

@ -15,15 +15,23 @@ unit IdeDebuggerValueFormatterIntf experimental;
interface
uses fgl, SysUtils, IdeDebuggerWatchValueIntf,
DbgIntfDebuggerBase;
DbgIntfDebuggerBase, Laz2_XMLCfg;
type
ILazDbgIdeValueFormatterConfigStorageIntf = interface ['{FCB5F11D-47EF-4701-AEE2-7E22A2B2601C}']
procedure LoadDataFromXMLConfig(const AConfig: TRttiXMLConfig; const APath: string);
procedure SaveDataToXMLConfig(const AConfig: TRttiXMLConfig; const APath: string);
end;
TLazDbgIdeValFormatterFeature = (
vffFormatValue, // FormatValue() for IWatchResultDataIntf
vffFormatOldValue, // FormatValue() for older backends TDBGType
vffValueData, // Normal data
vffValueMemDump // MemDump
vffValueMemDump, // MemDump
vffPreventOrigValue, // Does not support having the orig value shown with the translated result
vffSkipOnRecursion // The formatter may match during printing the value => skip it in this case
) experimental;
TLazDbgIdeValFormatterFeatures = set of TLazDbgIdeValFormatterFeature;
@ -52,6 +60,7 @@ type
function GetDefaultsObject: TObject; // for TXmlConfig.WriteObject / all published fields with DEFAULT values
function CreateCopy: ILazDbgIdeValueFormatterIntf;
procedure Free;
function GetInterface(const iidstr : shortstring;out obj) : boolean; // provided by TObject
end;
(* ILazDbgIdeValueFormatterSettingsFrameIntf

58
components/ideintf/idedebuggerwatchvalueintf.pas
View File

@ -168,6 +168,7 @@ type
class operator = (a,b: TWatchDisplayFormat): boolean;
function HasOverrides: boolean;
procedure MakeAllOverrides;
procedure CopyInheritedFrom(AnOther: TWatchDisplayFormat);
end;
PWatchDisplayFormat = ^TWatchDisplayFormat;
@ -283,8 +284,40 @@ type
IWatchResultDataIntf = interface;
IWatchResultPrinter = interface
function PrintWatchValue(AResValue: IWatchResultDataIntf; const ADispFormat: TWatchDisplayFormat): String;
(* IWatchResultPrinter & ValueFormmatters:
If a Valueformatter's FormatValue is called, it is given an IWatchResultPrinter.
Calling PrintWatchValue on this, will format the value WITHOUT ANY ValueFormmatters.
This can be changed by
- Setting a specific ValueFormatter with SetValueFormatter
- Specifing flags
~ "Default Valueformatter" is the formatter that was used before calling
(the outermost) value formatter.
This is either the global list, or list set by the IDE, or a specific
fomatter set by the IDE (e.g. due to watch properties specifing a
formatter)
~ "Current Valueformatter" is the formatter or list that was in use before
the current formatter was called.
This can be the "default", or it can be the formatter specified by the
next outer value formatter (if they are called nested)
In either case, the top "AResValue" passed from a value formatter to
IWatchResultPrinter is NOT going to any value formatter (to avoid circles).
The exception is, if wpfResValueIsNestedValue is used, as then the value
should be a nested value.
*)
TWatchResultPrinterFlag = (
wpfResValueIsNestedValue, // inc nest level / allow ValueFormatter directly on new top AResValue
wpfUseCurrentValueFormatterList,
wpfUseDefaultValueFormatterList
);
TWatchResultPrinterFlags = set of TWatchResultPrinterFlag;
IWatchResultPrinter = interface ['{DD3F17BB-0875-4882-8D8B-348A30166984}']
function PrintWatchValue(AResValue: IWatchResultDataIntf;
const ADispFormat: TWatchDisplayFormat;
AFlags: TWatchResultPrinterFlags = []
): String;
//procedure SetValueFormatter
end;
@ -297,7 +330,7 @@ type
end;
IWatchResultDataIntf = interface
IWatchResultDataIntf = interface ['{C69FF0ED-94F1-4F1A-BB67-CCED487A3DE5}']
// function GetClassID: TWatchResultDataClassID;
function GetInternalObject: TObject;
@ -638,5 +671,24 @@ begin
Pointer.Address.UseInherited := False;
end;
procedure TWatchDisplayFormat.CopyInheritedFrom(AnOther: TWatchDisplayFormat);
var
a: TWatchDisplayFormatAddr;
begin
if Num.UseInherited then Num := AnOther.Num;
if Num2.UseInherited then Num2 := AnOther.Num2;
if Enum.UseInherited then Enum := AnOther.Enum;
if EnumVal.UseInherited then EnumVal := AnOther.EnumVal;
if Bool.UseInherited then Bool := AnOther.Bool;
if Char.UseInherited then Char := AnOther.Char;
if Float.UseInherited then Float := AnOther.Float;
a := Struct.Address;
if Struct.UseInherited then Struct := AnOther.Struct;
if not a.UseInherited then Struct.Address := a;
a := Pointer.Address;
if Pointer.UseInherited then Pointer := AnOther.Pointer;
if not a.UseInherited then Pointer.Address := a;
end;
end.

17
ide/packages/idedebugger/frames/displayformatconfigframe.lfm
View File

@ -15,6 +15,7 @@ object DisplayFormatFrame: TDisplayFormatFrame
ClientWidth = 592
Constraints.MaxWidth = 850
Constraints.MinWidth = 480
LCLVersion = '3.99.0.0'
TabOrder = 0
DesignLeft = 427
DesignTop = 213
@ -43,7 +44,7 @@ object DisplayFormatFrame: TDisplayFormatFrame
end
object ToolButton2: TToolButton
Left = 45
Height = 22
Height = 8
Top = 2
Caption = 'ToolButton2'
Enabled = False
@ -65,7 +66,7 @@ object DisplayFormatFrame: TDisplayFormatFrame
end
object ToolButton4: TToolButton
Left = 71
Height = 22
Height = 8
Top = 2
Caption = 'ToolButton4'
Enabled = False
@ -171,7 +172,7 @@ object DisplayFormatFrame: TDisplayFormatFrame
end
object ToolButton12: TToolButton
Left = 132
Height = 22
Height = 8
Top = 2
Caption = 'ToolButton12'
Enabled = False
@ -180,7 +181,7 @@ object DisplayFormatFrame: TDisplayFormatFrame
end
object ToolButton13: TToolButton
Left = 175
Height = 22
Height = 8
Top = 2
Caption = 'ToolButton13'
Enabled = False
@ -189,7 +190,7 @@ object DisplayFormatFrame: TDisplayFormatFrame
end
object ToolButton14: TToolButton
Left = 211
Height = 22
Height = 8
Top = 2
Caption = 'ToolButton14'
Enabled = False
@ -198,7 +199,7 @@ object DisplayFormatFrame: TDisplayFormatFrame
end
object ToolButton15: TToolButton
Left = 248
Height = 22
Height = 8
Top = 2
Caption = 'ToolButton15'
Enabled = False
@ -207,7 +208,7 @@ object DisplayFormatFrame: TDisplayFormatFrame
end
object ToolButton16: TToolButton
Left = 286
Height = 22
Height = 8
Top = 2
Caption = 'ToolButton16'
Enabled = False
@ -216,7 +217,7 @@ object DisplayFormatFrame: TDisplayFormatFrame
end
object ToolButton17: TToolButton
Left = 351
Height = 22
Height = 8
Top = 2
Caption = 'ToolButton17'
Enabled = False

37
ide/packages/idedebugger/frames/displayformatconfigframe.pas
View File

@ -254,7 +254,9 @@ type
private type
TFmtButtons = (bsNum, bsEnum, bsBool, bsChar, bsFloat, bsStruct, bsPtr);
private
FAllowMultiTabs: boolean;
FHighlightModifiedTabs: boolean;
FShowAll: boolean;
FShowCurrent: boolean;
FDisplayFormatCount: integer;
@ -279,6 +281,7 @@ type
procedure SetDisplayFormatCount(AValue: integer);
procedure SetDisplayFormats(AIndex: integer; AValue: TWatchDisplayFormat);
procedure SetHighlightModifiedTabs(AValue: boolean);
procedure SetShowAll(AValue: boolean);
procedure SetShowCurrent(AValue: boolean);
procedure SetShowExtraSettings(AValue: boolean);
procedure SetShowMemDump(AValue: boolean);
@ -314,6 +317,8 @@ type
property CurrentResDataType: TWatchResultDataKind read FCurrentResDataType write SetCurrentResDataType;
published
property ShowCurrent: boolean read FShowCurrent write SetShowCurrent;
property ShowAll: boolean read FShowAll write SetShowAll;
property AllowMultiTabs: boolean read FAllowMultiTabs write FAllowMultiTabs;
property ShowMemDump: boolean read FShowMemDump write SetShowMemDump;
property ShowMultiRadio: boolean read FShowMultiRadio write SetShowMultiRadio;
property ShowOverrideChecks: boolean read FShowOverrideChecks write SetShowOverrideChecks;
@ -629,9 +634,16 @@ begin
if FCurrentResDataType = rdkUnknown then begin
FInButtonClick := True;
tbAll.Down := True;
FInButtonClick := False;
tbAllClick(nil);
if FShowAll then begin
tbAll.Down := True;
FInButtonClick := False;
tbAllClick(nil);
end
else begin
tbNumber.Down := True;
FInButtonClick := False;
tbFormatClick(tbNumber);
end;
exit;
end;
@ -686,6 +698,7 @@ begin
try
UpdateFormat;
if (not(ssShift in GetKeyShiftState)) or
(not FAllowMultiTabs) or
(not(tbNumber.Down or tbEnum.Down or tbBool.Down or tbChar.Down or tbFloat.Down or tbStruct.Down or tbPointer.Down))
then begin
tbNumber.Down := tbNumber = Sender;
@ -709,8 +722,9 @@ begin
rdkStruct: tbCurrent.Down := tbStruct.Down;
else tbCurrent.Down := False;
end;
tbAll.Down := tbNumber.Down and tbEnum.Down and tbBool.Down and tbChar.Down and
tbFloat.Down and tbStruct.Down and tbPointer.Down;
if FShowAll then
tbAll.Down := tbNumber.Down and tbEnum.Down and tbBool.Down and tbChar.Down and
tbFloat.Down and tbStruct.Down and tbPointer.Down;
finally
FInButtonClick := False;
end;
@ -801,11 +815,20 @@ begin
UpdateTabs;
end;
procedure TDisplayFormatFrame.SetShowAll(AValue: boolean);
begin
if FShowAll = AValue then Exit;
FShowAll := AValue;
tbAll.Visible := AValue;
ToolButton4.Visible := FShowCurrent;
end;
procedure TDisplayFormatFrame.SetShowCurrent(AValue: boolean);
begin
if FShowCurrent = AValue then Exit;
FShowCurrent := AValue;
tbCurrent.Visible := FShowCurrent;
ToolButton2.Visible := FShowCurrent;
end;
procedure TDisplayFormatFrame.SetShowExtraSettings(AValue: boolean);
@ -1791,6 +1814,8 @@ begin
DisplayFormatCount := 1;
FHighlightModifiedTabs := True;
FShowCurrent := True;
FShowAll := True;
FAllowMultiTabs := True;
FShowMemDump := True;
FShowMultiRadio := True;
FShowOverrideChecks := True;
@ -1944,7 +1969,7 @@ begin
rdkSet: tbEnum.Down := True;
rdkStruct: tbStruct.Down := True;
else begin
tbAll.Down := True;
if FShowAll then tbAll.Down := True;
tbNumber.Down := True;
tbEnum.Down := True;
tbBool.Down := True;

12
ide/packages/idedebugger/idedbgvalueformattersettingsframe.pas
View File

@ -189,6 +189,7 @@ begin
SpinMaxNest.Value := 0;
cbAppendOriginalValue.ItemIndex := -1;
cbAppendOriginalValue.Enabled := False;
end
else begin
pnlCurrentFormatter.Enabled := True;
@ -202,7 +203,16 @@ begin
SpinMinNest.Value := FCurFormatter.LimitByNestMin;
SpinMaxNest.Value := FCurFormatter.LimitByNestMax;
cbAppendOriginalValue.ItemIndex := ord(FCurFormatter.OriginalValue);
if (FCurFormatter.ValFormatter = nil) or
(vffPreventOrigValue in FCurFormatter.ValFormatter.SupportedFeatures)
then begin
cbAppendOriginalValue.ItemIndex := -1;
cbAppendOriginalValue.Enabled := False;
end
else begin
cbAppendOriginalValue.ItemIndex := ord(FCurFormatter.OriginalValue);
cbAppendOriginalValue.Enabled := True;
end;
end;

8
ide/packages/idedebugger/idedebugger.lpk
View File

@ -295,6 +295,14 @@
<Item>
<Filename Value="idedebuggervalueformatterarrayofchartostring.pas"/>
<UnitName Value="IdeDebuggerValueFormatterArrayOfCharToString"/>
<ResourceBaseClass Value="Frame"/>
<ResourceBaseClassname Value=""/>
</Item>
<Item>
<Filename Value="idedebuggervalueformatterdisplayformat.pas"/>
<UnitName Value="IdeDebuggerValueFormatterDisplayFormat"/>
<ResourceBaseClass Value="Frame"/>
<ResourceBaseClassname Value=""/>
</Item>
</Files>
<i18n>

3
ide/packages/idedebugger/idedebuggerpackage.pas
View File

@ -21,7 +21,8 @@ uses
IdeDebuggerValueFormatterDateTime, IdeDebuggerValueFormatterColor,
IdeDebuggerValueFormatterSetup, IdeDebuggerValueFormatterCurrency, DisplayFormatConfigFrame,
DisplayFormatDefaultsConfigFrame, IdeDebuggerDisplayFormats, IdeDebugger_DisplayFormat_Options,
ProjectDebugLink, IdeDebuggerValueFormatterArrayOfCharToString, LazarusPackageIntf;
ProjectDebugLink, IdeDebuggerValueFormatterArrayOfCharToString,
IdeDebuggerValueFormatterDisplayFormat, LazarusPackageIntf;
implementation

1
ide/packages/idedebugger/idedebuggerstringconstants.pas
View File

@ -503,6 +503,7 @@ resourcestring
DispFormatOptProjectText = 'General and specific project settings will be used first. Only if none of them sets a default, then the IDE-wide settings will be tried.';
dbgDoNotShowThisMessageAgain = 'Do not ask again';
optDispGutterCustomDisplayformat = 'Custom Displayformat';
implementation

106
ide/packages/idedebugger/idedebuggervalueformatter.pas
View File

@ -1,6 +1,7 @@
unit IdeDebuggerValueFormatter;
{$mode objfpc}{$H+}
{$INTERFACES CORBA}
interface
@ -19,9 +20,21 @@ type
TLazDbgIdeValFormatterOriginalValue = (vfovHide, vfovAtEnd, vfovAtFront);
IIdeDbgValueFormatterIntf = interface ['{2BEC59F6-7CD8-4CFE-B399-C25AFCADB700}']
function FormatValue(AWatchValue: IWatchResultDataIntf;
ADisplayFormat: TWatchDisplayFormat; ANestLevel: integer;
AWatchResultPrinter: IWatchResultPrinter; out APrintedValue: String
): Boolean;
function FormatValue(aDBGType: TDBGType;
aValue: string;
ADisplayFormat: TWatchDisplayFormat;
out APrintedValue: String
): boolean; deprecated 'For values from older backends only - to be removed as backends are upgraded';
end;
{ TIdeDbgValueFormatterSelector }
TIdeDbgValueFormatterSelector = class(TFreeNotifyingObject)
TIdeDbgValueFormatterSelector = class(TFreeNotifyingObject, IIdeDbgValueFormatterIntf)
private
FLimitByNestLevel: Boolean;
FLimitByNestMax: integer;
@ -32,6 +45,7 @@ type
FEnabled: Boolean;
FName: String;
FValFormatterRegEntry: TLazDbgIdeValueFormatterRegistryEntryClass;
FInFormatValue: boolean;
procedure FreeValFormater;
function GetMatchInherited: boolean;
@ -54,6 +68,11 @@ type
ADisplayFormat: TWatchDisplayFormat; ANestLevel: integer;
AWatchResultPrinter: IWatchResultPrinter; out APrintedValue: String
): Boolean; experimental;
function FormatValue(aDBGType: TDBGType;
aValue: string;
ADisplayFormat: TWatchDisplayFormat;
out APrintedValue: String
): boolean; deprecated 'For values from older backends only - to be removed as backends are upgraded';
function IsMatchingTypeName(ATypeName: String): boolean;
function IsMatchingInheritedTypeName(ATypeName: String): boolean;
@ -74,7 +93,8 @@ type
{ TIdeDbgValueFormatterSelectorList }
TIdeDbgValueFormatterSelectorList = class(
specialize TChangeNotificationGeneric< specialize TFPGObjectList<TIdeDbgValueFormatterSelector> >
specialize TChangeNotificationGeneric< specialize TFPGObjectList<TIdeDbgValueFormatterSelector> >,
IIdeDbgValueFormatterIntf
)
private
FChanged: Boolean;
@ -136,6 +156,7 @@ function TIdeDbgValueFormatterSelector.DoFormatValue(AWatchValue: IWatchResultDa
ADisplayFormat: TWatchDisplayFormat; AWatchResultPrinter: IWatchResultPrinter; out
APrintedValue: String): Boolean;
begin
FInFormatValue := True;
Result := ValFormatter.FormatValue(AWatchValue, ADisplayFormat, AWatchResultPrinter, APrintedValue);
if Result then begin
case OriginalValue of
@ -143,6 +164,7 @@ begin
vfovAtFront: APrintedValue := AWatchResultPrinter.PrintWatchValue(AWatchValue, ADisplayFormat) + ' = ' + APrintedValue;
end;
end;
FInFormatValue := False;
end;
constructor TIdeDbgValueFormatterSelector.Create;
@ -194,7 +216,8 @@ procedure TIdeDbgValueFormatterSelector.LoadDataFromXMLConfig(
const AConfig: TRttiXMLConfig; const APath: string);
var
s: String;
Def: TObject;
Def, o: TObject;
intf: ILazDbgIdeValueFormatterConfigStorageIntf;
begin
FreeValFormater;
AConfig.ReadObject(APath + 'Filter/', Self);
@ -207,24 +230,35 @@ begin
FValFormatter := FValFormatterRegEntry.CreateValueFormatter;
Def := FValFormatter.GetDefaultsObject;
AConfig.ReadObject(APath + 'Formatter/', FValFormatter.GetObject, Def);
Def.Free;
o := FValFormatter.GetObject;
if o <> nil then begin
Def := FValFormatter.GetDefaultsObject;
AConfig.ReadObject(APath + 'Formatter/', o, Def);
Def.Free;
end;
if FValFormatter.GetInterface(ILazDbgIdeValueFormatterConfigStorageIntf, intf) and (intf <> nil) then
intf.LoadDataFromXMLConfig(AConfig, APath);
end;
procedure TIdeDbgValueFormatterSelector.SaveDataToXMLConfig(
const AConfig: TRttiXMLConfig; const APath: string);
var
Def: TObject;
Def, o: TObject;
intf: ILazDbgIdeValueFormatterConfigStorageIntf;
begin
AConfig.WriteObject(APath + 'Filter/', Self);
AConfig.SetDeleteValue(APath + 'Filter/MatchTypeNames', MatchTypeNames.CommaText, '');
AConfig.SetValue(APath + 'FormatterClass', FValFormatterRegEntry.GetClassName);
Def := FValFormatter.GetDefaultsObject;
AConfig.WriteObject(APath + 'Formatter/', FValFormatter.GetObject, Def);
Def.Free;
o := FValFormatter.GetObject;
if o <> nil then begin
Def := FValFormatter.GetDefaultsObject;
AConfig.WriteObject(APath + 'Formatter/', o, Def);
Def.Free;
end;
if FValFormatter.GetInterface(ILazDbgIdeValueFormatterConfigStorageIntf, intf) and (intf <> nil) then
intf.SaveDataToXMLConfig(AConfig, APath);
end;
function TIdeDbgValueFormatterSelector.MatchesAll(AWatchValue: IWatchResultDataIntf;
@ -236,6 +270,7 @@ begin
Result := False;
if (ValFormatter = nil) or
(not (vffFormatValue in ValFormatter.SupportedFeatures)) or
((vffSkipOnRecursion in ValFormatter.SupportedFeatures) and FInFormatValue) or
(not (AWatchValue.ValueKind in ValFormatter.SupportedDataKinds)) or
( ADisplayFormat.MemDump and (not(vffValueMemDump in ValFormatter.SupportedFeatures)) ) or
( (not ADisplayFormat.MemDump) and (not(vffValueData in ValFormatter.SupportedFeatures)) ) or
@ -269,6 +304,33 @@ begin
Result := DoFormatValue(AWatchValue, ADisplayFormat, AWatchResultPrinter, APrintedValue);
end;
function TIdeDbgValueFormatterSelector.FormatValue(aDBGType: TDBGType; aValue: string;
ADisplayFormat: TWatchDisplayFormat; out APrintedValue: String): boolean;
begin
Result := False;
if (ValFormatter = nil) or
(not (vffFormatOldValue in ValFormatter.SupportedFeatures)) or
((vffSkipOnRecursion in ValFormatter.SupportedFeatures) and FInFormatValue) or
( ADisplayFormat.MemDump and (not(vffValueMemDump in ValFormatter.SupportedFeatures)) ) or
( (not ADisplayFormat.MemDump) and (not(vffValueData in ValFormatter.SupportedFeatures)) ) or
( LimitByNestLevel and (LimitByNestMin > 0) ) // only level 0 for old style watches
then
exit;
if not IsMatchingTypeName(aDBGType.TypeName) then
exit;
FInFormatValue := True;
Result := ValFormatter.FormatValue(aDBGType, aValue, ADisplayFormat, APrintedValue);
if Result then begin
case OriginalValue of
vfovAtEnd: APrintedValue := APrintedValue + ' = ' + aValue;
vfovAtFront: APrintedValue := aValue + ' = ' + APrintedValue;
end;
end;
FInFormatValue := False;
end;
function TIdeDbgValueFormatterSelector.IsMatchingTypeName(ATypeName: String): boolean;
begin
Result := FMatchTypeNames.CheckTypeName(ATypeName);
@ -405,34 +467,14 @@ function TIdeDbgValueFormatterSelectorList.FormatValue(aDBGType: TDBGType;
): boolean;
var
i: Integer;
f: TIdeDbgValueFormatterSelector;
v: ILazDbgIdeValueFormatterIntf;
begin
Result := aDBGType <> nil;
if not Result then
exit;
for i := 0 to Count - 1 do begin
f := Items[i];
v := f.ValFormatter;
if (v = nil) or
(not (vffFormatOldValue in v.SupportedFeatures)) or
( ADisplayFormat.MemDump and (not(vffValueMemDump in v.SupportedFeatures)) ) or
( (not ADisplayFormat.MemDump) and (not(vffValueData in v.SupportedFeatures)) ) or
( f.LimitByNestLevel and (f.LimitByNestMin > 0) ) // only level 0 for old style watches
then
continue;
if not f.IsMatchingTypeName(aDBGType.TypeName) then
continue;
Result := f.ValFormatter.FormatValue(aDBGType, aValue, ADisplayFormat, APrintedValue);
if Result then begin
case f.OriginalValue of
vfovAtEnd: APrintedValue := APrintedValue + ' = ' + aValue;
vfovAtFront: APrintedValue := aValue + ' = ' + APrintedValue;
end;
Result := Items[i].FormatValue(aDBGType, aValue, ADisplayFormat, APrintedValue);
if Result then
exit;
end;
end;
Result := False;
end;

643
ide/packages/idedebugger/idedebuggervalueformatterdisplayformat.lfm Normal file
View File

@ -0,0 +1,643 @@
object IdeDebuggerValueFormatterDisplayFormatFrame: TIdeDebuggerValueFormatterDisplayFormatFrame
Left = 0
Height = 399
Top = 0
Width = 642
ClientHeight = 399
ClientWidth = 642
Constraints.MinHeight = 90
TabOrder = 0
DesignLeft = 425
DesignTop = 16
object Panel1: TPanel
Left = 0
Height = 25
Top = 0
Width = 642
Align = alTop
AutoSize = True
BevelOuter = bvNone
ClientHeight = 25
ClientWidth = 642
TabOrder = 1
object cbOverrideWatch: TCheckBox
Left = 3
Height = 19
Top = 3
Width = 110
BorderSpacing.Around = 3
Caption = 'cbOverrideWatch'
TabOrder = 0
end
end
inline DisplayFormatFrame1: TDisplayFormatFrame
Height = 374
Top = 25
Width = 642
VertScrollBar.Increment = 37
VertScrollBar.Page = 374
Align = alClient
ClientHeight = 374
ClientWidth = 625
Constraints.MinHeight = 90
inherited ToolBar1: TToolBar
Width = 625
inherited ToolButton2: TToolButton
Height = 22
end
inherited ToolButton4: TToolButton
Height = 22
end
inherited ToolButton12: TToolButton
Height = 22
end
inherited ToolButton13: TToolButton
Height = 22
end
inherited ToolButton14: TToolButton
Height = 22
end
inherited ToolButton15: TToolButton
Height = 22
end
inherited ToolButton16: TToolButton
Height = 22
end
inherited ToolButton17: TToolButton
Height = 22
end
end
inherited PanelNum: TPanel
AnchorSideLeft.Control = DisplayFormatFrame1
AnchorSideRight.Control = DisplayFormatFrame1
Width = 625
ClientWidth = 625
inherited Spacer1: TLabel
Width = 113
end
inherited Spacer2: TLabel
Left = 117
Width = 508
end
inherited DividerBevelNum: TDividerBevel
Width = 625
end
inherited lbOverrideNumBase: TLabel
Width = 95
end
inherited PanelNumBase: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbNumDec: TRadioButton
Width = 85
end
inherited rbNumHex: TRadioButton
Left = 85
Width = 84
end
inherited rbNumOct: TRadioButton
Left = 169
Width = 85
end
inherited rbNumBin: TRadioButton
Left = 254
Width = 85
end
inherited rbNumChar: TRadioButton
Left = 339
Width = 84
end
inherited Label3: TLabel
Left = 423
Width = 85
end
end
inherited PanelNumSign: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbSignAuto: TRadioButton
Width = 169
end
inherited rbSignSigned: TRadioButton
Left = 169
Width = 170
end
inherited rbSignUnsigned: TRadioButton
Left = 339
Width = 169
end
end
inherited PanelNumDigits: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited DigitSpacer2: TLabel
Width = 339
end
inherited DigitSpacer1: TLabel
Left = 339
Width = 169
end
inherited lbNumDigits: TLabel
Left = 339
end
inherited SpinDigits: TSpinEdit
Left = 409
Width = 90
end
inherited cbNumSeparator: TCheckBox
Width = 335
end
inherited PanelNumSepGroup: TPanel
Width = 243
ClientWidth = 243
inherited rbNumSepNone: TRadioButton
Width = 58
end
inherited rbNumSepByte: TRadioButton
Left = 64
Width = 55
end
inherited rbNumSepWord: TRadioButton
Left = 121
Width = 59
end
inherited rbNumSepLong: TRadioButton
Left = 182
Width = 57
end
end
inherited Shape13: TShape
Left = 335
end
end
inherited Shape10: TShape
Left = 113
end
inherited Shape11: TShape
Left = 113
end
inherited Shape12: TShape
Left = 113
end
end
inherited PanelNum2: TPanel
AnchorSideLeft.Control = DisplayFormatFrame1
AnchorSideRight.Control = DisplayFormatFrame1
Width = 625
ClientWidth = 625
inherited Spacer13: TLabel
Width = 113
end
inherited Spacer14: TLabel
Left = 117
Width = 508
end
inherited DividerBevelNum2: TDividerBevel
Width = 625
end
inherited lbOverrideNum2Base: TLabel
Width = 95
end
inherited PanelNum2Visible: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited cbNum2Visibile: TCheckBox
Width = 508
end
end
inherited PanelNum2All: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited PanelNum2Base: TPanel
Width = 508
ClientWidth = 508
inherited rbNum2Dec: TRadioButton
Width = 85
end
inherited rbNum2Hex: TRadioButton
Left = 85
Width = 84
end
inherited rbNum2Oct: TRadioButton
Left = 169
Width = 85
end
inherited rbNum2Bin: TRadioButton
Left = 254
Width = 85
end
inherited rbNum2Char: TRadioButton
Left = 339
Width = 84
end
inherited Label1: TLabel
Left = 423
Height = 1
Width = 85
end
end
inherited PanelNum2Sign: TPanel
Width = 508
ClientWidth = 508
inherited rbSign2Auto: TRadioButton
Width = 169
end
inherited rbSign2Signed: TRadioButton
Left = 169
Width = 170
end
inherited rbSign2Unsigned: TRadioButton
Left = 339
Width = 169
end
end
inherited PanelNum2Digits: TPanel
Width = 508
ClientWidth = 508
inherited DigitSpacer4: TLabel
Width = 339
end
inherited DigitSpacer3: TLabel
Left = 339
Width = 169
end
inherited lbNum2Digits: TLabel
Left = 339
end
inherited Spin2Digits: TSpinEdit
Left = 415
Width = 88
end
inherited cbNum2Separator: TCheckBox
Width = 339
end
inherited PanelNum2SepGroup: TPanel
Width = 274
ClientWidth = 274
inherited rbNum2SepNone: TRadioButton
Width = 66
end
inherited rbNum2SepByte: TRadioButton
Left = 72
Width = 63
end
inherited rbNum2SepWord: TRadioButton
Left = 137
Width = 66
end
inherited rbNum2SepLong: TRadioButton
Left = 205
Width = 65
end
end
end
end
end
inherited PanelEnum: TPanel
AnchorSideLeft.Control = DisplayFormatFrame1
AnchorSideRight.Control = DisplayFormatFrame1
Width = 625
ClientWidth = 625
inherited Spacer3: TLabel
Width = 113
end
inherited Spacer4: TLabel
Left = 117
Width = 508
end
inherited DividerBevelEnum: TDividerBevel
Width = 625
end
inherited lbOverrideEnum: TLabel
Width = 95
end
inherited PanelEnumRb1: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbEnumName: TRadioButton
Width = 169
end
inherited rbEnumOrd: TRadioButton
Left = 169
Width = 170
end
inherited rbEnumNameAndOrd: TRadioButton
Left = 339
Width = 169
end
end
inherited PanelENumBase: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbENumDec: TRadioButton
Width = 85
end
inherited rbENumHex: TRadioButton
Left = 85
Width = 84
end
inherited rbENumOct: TRadioButton
Left = 169
Width = 85
end
inherited rbENumBin: TRadioButton
Left = 254
Width = 85
end
inherited rbENumChar: TRadioButton
Left = 339
Width = 81
end
inherited cbEnumSign: TCheckBox
Left = 423
Width = 85
end
inherited lbEnumBaseSpace: TLabel
Width = 85
end
inherited Shape18: TShape
Left = 419
end
end
inherited Shape16: TShape
Left = 113
end
inherited Shape17: TShape
Left = 113
end
end
inherited PanelEnumVal: TPanel
AnchorSideLeft.Control = DisplayFormatFrame1
AnchorSideRight.Control = DisplayFormatFrame1
Width = 625
ClientWidth = 625
inherited Spacer15: TLabel
Width = 113
end
inherited Spacer16: TLabel
Left = 117
Width = 508
end
inherited DividerBevelEnumVal: TDividerBevel
Width = 625
end
inherited lbOverrideEnumVal: TLabel
Width = 95
end
inherited PanelEnumValRb: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbEnumValName: TRadioButton
Width = 169
end
inherited rbEnumValOrd: TRadioButton
Left = 169
Width = 170
end
inherited rbEnumValNameAndOrd: TRadioButton
Left = 339
Width = 169
end
end
inherited PanelENumValBase: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbENumValDec: TRadioButton
Width = 85
end
inherited rbENumValHex: TRadioButton
Left = 85
Width = 84
end
inherited rbENumValOct: TRadioButton
Left = 169
Width = 85
end
inherited rbENumValBin: TRadioButton
Left = 254
Width = 85
end
inherited rbENumValChar: TRadioButton
Left = 339
Width = 81
end
inherited cbEnumValSign: TCheckBox
Left = 423
Width = 85
end
inherited lbEnumValBaseSpace: TLabel
Width = 85
end
end
end
inherited PanelFloat: TPanel
AnchorSideLeft.Control = DisplayFormatFrame1
AnchorSideRight.Control = DisplayFormatFrame1
Width = 625
ClientWidth = 625
inherited Spacer5: TLabel
Width = 113
end
inherited Spacer6: TLabel
Left = 117
Width = 508
end
inherited DividerBevelFloat: TDividerBevel
Width = 625
end
inherited lbOverrideFloat: TLabel
Width = 95
end
inherited PanelFloatRb: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbFloatPoint: TRadioButton
Width = 169
end
inherited rbFloatScience: TRadioButton
Left = 169
Width = 170
end
inherited lbFloatPrec: TLabel
Left = 339
end
inherited SpinFloatDigits: TSpinEdit
Left = 401
end
end
end
inherited PanelStruct: TPanel
AnchorSideLeft.Control = DisplayFormatFrame1
AnchorSideRight.Control = DisplayFormatFrame1
Width = 625
ClientWidth = 625
inherited Spacer7: TLabel
Width = 113
end
inherited Spacer8: TLabel
Left = 117
Width = 508
end
inherited DividerBevelStruct: TDividerBevel
Width = 625
end
inherited lbOverrideStruct: TLabel
Width = 95
end
inherited PanelStructFld: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbStructValOnly: TRadioButton
Width = 169
end
inherited rbStructFields: TRadioButton
Left = 169
Width = 170
end
inherited rbStructFull: TRadioButton
Left = 339
Width = 169
end
end
inherited PanelStructPointer: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbStructAddrOff: TRadioButton
Width = 169
end
inherited rbStructAddrOn: TRadioButton
Left = 169
Width = 170
end
inherited rbStructAddrOnly: TRadioButton
Left = 339
Width = 169
end
end
end
inherited PanelPointer: TPanel
AnchorSideLeft.Control = DisplayFormatFrame1
AnchorSideRight.Control = DisplayFormatFrame1
Width = 625
ClientWidth = 625
inherited Spacer9: TLabel
Width = 113
end
inherited Spacer10: TLabel
Left = 117
Width = 508
end
inherited DividerBevelPointerDeref: TDividerBevel
Width = 625
end
inherited lbOverridePointerDeref: TLabel
Width = 95
end
inherited PanelPointerDeref: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbPointerDerefOn: TRadioButton
Width = 169
end
inherited rbPointerDerefOff: TRadioButton
Left = 169
Width = 170
end
inherited rbPointerDerefOnly: TRadioButton
Left = 339
Width = 169
end
end
end
inherited PanelAddressFormat: TPanel
AnchorSideLeft.Control = DisplayFormatFrame1
AnchorSideRight.Control = DisplayFormatFrame1
Width = 625
ClientWidth = 625
inherited Spacer11: TLabel
Width = 113
end
inherited Spacer12: TLabel
Left = 117
Width = 508
end
inherited DividerBevelAddressFormat: TDividerBevel
Width = 625
end
inherited lbOverrideAddressFormat: TLabel
Width = 95
end
inherited PanelAddressType: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbAddressPlain: TRadioButton
Width = 169
end
inherited rbAddressTyped: TRadioButton
Left = 169
Width = 170
end
inherited Label5: TLabel
Left = 339
Height = 1
Width = 169
end
end
inherited PanelAddressBase: TPanel
Left = 117
Width = 508
ClientWidth = 508
inherited rbAddrNumHex: TRadioButton
Width = 85
end
inherited rbAddrNumDec: TRadioButton
Left = 85
Width = 84
end
inherited rbAddrNumOct: TRadioButton
Left = 169
Width = 85
end
inherited rbAddrNumBin: TRadioButton
Left = 254
Width = 85
end
inherited lpAddrSpace: TLabel
Left = 339
Height = 1
Width = 84
end
inherited cbAddrSign: TCheckBox
Left = 423
Width = 85
end
end
end
inherited PanelMemDump: TPanel
AnchorSideLeft.Control = DisplayFormatFrame1
AnchorSideRight.Control = DisplayFormatFrame1
Width = 625
ClientWidth = 625
inherited DividerBevelMemDump: TDividerBevel
Width = 625
end
inherited cbMemDump: TCheckBox
Width = 615
end
end
end
end

174
ide/packages/idedebugger/idedebuggervalueformatterdisplayformat.pas Normal file
View File

@ -0,0 +1,174 @@
unit IdeDebuggerValueFormatterDisplayFormat;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, ActnList, ExtCtrls, StdCtrls, DisplayFormatConfigFrame,
IdeDebuggerDisplayFormats,
// IdeIntf
IdeDebuggerValueFormatterIntf, IdeDebuggerWatchValueIntf,
// LazUtils
Laz2_XMLCfg,
// IdeDebugger
IdeDebuggerStringConstants;
type
{ TIdeDebuggerValueFormatterDisplayFormatFrame }
TIdeDebuggerValueFormatterDisplayFormatFrame = class(TFrame, ILazDbgIdeValueFormatterSettingsFrameIntf)
cbOverrideWatch: TCheckBox;
DisplayFormatFrame1: TDisplayFormatFrame;
Panel1: TPanel;
protected
procedure ReadFrom(AFormatter: ILazDbgIdeValueFormatterIntf);
function WriteTo(AFormatter: ILazDbgIdeValueFormatterIntf): Boolean;
public
constructor Create(TheOwner: TComponent); override;
end;
{ TIdeDbgValueFormatterDisplayFormat }
TIdeDbgValueFormatterDisplayFormat = class(
specialize TLazDbgIdeValueFormatterGeneric<TObject>,
ILazDbgIdeValueFormatterConfigStorageIntf
)
private
FDisplayFormat: TWatchDisplayFormat;
FOverrideWatch: boolean;
protected
procedure Init; override;
procedure Assign(AnOther: TObject); override;
public
class function GetRegisteredDisplayName: String;
function FormatValue(AWatchValue: IWatchResultDataIntf;
ADisplayFormat: TWatchDisplayFormat;
AWatchResultPrinter: IWatchResultPrinter; out APrintedValue: String
): Boolean; override; experimental;
function SupportedFeatures: TLazDbgIdeValFormatterFeatures; override;
// function SupportedDataKinds: TWatchResultDataKinds; override;
procedure LoadDataFromXMLConfig(const AConfig: TRttiXMLConfig; const APath: string);
procedure SaveDataToXMLConfig(const AConfig: TRttiXMLConfig; const APath: string);
published
property OverrideWatch: boolean read FOverrideWatch write FOverrideWatch;
end;
TIdeDbgValueFormatterRegistryDisplayFormat =
specialize TLazDbgIdeValueFormatterFrameRegistryEntryGeneric<TIdeDbgValueFormatterDisplayFormat, TIdeDebuggerValueFormatterDisplayFormatFrame>;
implementation
{$R *.lfm}
{ TIdeDebuggerValueFormatterDisplayFormatFrame }
procedure TIdeDebuggerValueFormatterDisplayFormatFrame.ReadFrom(
AFormatter: ILazDbgIdeValueFormatterIntf);
var
vf: TIdeDbgValueFormatterDisplayFormat;
begin
vf := TIdeDbgValueFormatterDisplayFormat(AFormatter.GetObject);
cbOverrideWatch.Checked := vf.OverrideWatch;
DisplayFormatFrame1.DisplayFormat := vf.FDisplayFormat;
DisplayFormatFrame1.SelectDefaultButton;
end;
function TIdeDebuggerValueFormatterDisplayFormatFrame.WriteTo(
AFormatter: ILazDbgIdeValueFormatterIntf): Boolean;
var
vf: TIdeDbgValueFormatterDisplayFormat;
df: TWatchDisplayFormat;
begin
vf := TIdeDbgValueFormatterDisplayFormat(AFormatter.GetObject);
df := DisplayFormatFrame1.DisplayFormat;
Result := (vf.FDisplayFormat <> df) or
(vf.OverrideWatch <> cbOverrideWatch.Checked);
vf.OverrideWatch := cbOverrideWatch.Checked;
vf.FDisplayFormat := df;
end;
constructor TIdeDebuggerValueFormatterDisplayFormatFrame.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
DisplayFormatFrame1.Setup;
DisplayFormatFrame1.ShowCurrent := False;
DisplayFormatFrame1.ShowAll := True;
DisplayFormatFrame1.AllowMultiTabs := True;
DisplayFormatFrame1.ShowExtraSettings := False;
DisplayFormatFrame1.ShowMemDump := False;
DisplayFormatFrame1.ShowOverrideChecks := True;
cbOverrideWatch.Caption := 'Override watch settings';
end;
{ TIdeDbgValueFormatterDisplayFormat }
procedure TIdeDbgValueFormatterDisplayFormat.Init;
begin
FDisplayFormat := DefaultWatchDisplayFormat;
FOverrideWatch := False;
end;
procedure TIdeDbgValueFormatterDisplayFormat.Assign(AnOther: TObject);
var
f: TIdeDbgValueFormatterDisplayFormat;
begin
inherited Assign(AnOther);
if AnOther is TIdeDbgValueFormatterDisplayFormat then begin
f := AnOther as TIdeDbgValueFormatterDisplayFormat;
FDisplayFormat := f.FDisplayFormat;
FOverrideWatch := f.FOverrideWatch;
end;
end;
class function TIdeDbgValueFormatterDisplayFormat.GetRegisteredDisplayName: String;
begin
Result := optDispGutterCustomDisplayformat;
end;
function TIdeDbgValueFormatterDisplayFormat.FormatValue(AWatchValue: IWatchResultDataIntf;
ADisplayFormat: TWatchDisplayFormat; AWatchResultPrinter: IWatchResultPrinter; out
APrintedValue: String): Boolean;
var
d: TWatchDisplayFormat;
begin
Result := True;
if FOverrideWatch then begin
d := FDisplayFormat;
d.CopyInheritedFrom(ADisplayFormat);
end
else begin
d := ADisplayFormat;
d.CopyInheritedFrom(FDisplayFormat);
end;
APrintedValue := AWatchResultPrinter.PrintWatchValue(AWatchValue, d, [wpfUseCurrentValueFormatterList]);
end;
function TIdeDbgValueFormatterDisplayFormat.SupportedFeatures: TLazDbgIdeValFormatterFeatures;
begin
Result := [vffFormatValue, vffValueData, vffSkipOnRecursion, vffPreventOrigValue];
end;
procedure TIdeDbgValueFormatterDisplayFormat.LoadDataFromXMLConfig(const AConfig: TRttiXMLConfig;
const APath: string);
begin
LoadDisplayFormatFromXMLConfig(AConfig, APath + 'DispFormat/', FDisplayFormat);
end;
procedure TIdeDbgValueFormatterDisplayFormat.SaveDataToXMLConfig(const AConfig: TRttiXMLConfig;
const APath: string);
begin
SaveDisplayFormatToXMLConfig(AConfig, APath + 'DispFormat/', FDisplayFormat);
end;
initialization
ValueFormatterRegistry.Add(TIdeDbgValueFormatterRegistryDisplayFormat);
end.

107
ide/packages/idedebugger/idedebuggerwatchresprinter.pas
View File

@ -70,14 +70,24 @@ type
private
FFormatFlags: TWatchResultPrinterFormatFlags;
FLineSeparator: String;
FOnlyValueFormatter: TIdeDbgValueFormatterSelector;
FOnlyValueFormatter: IIdeDbgValueFormatterIntf;
FDefaultValueFormatter, FCurrentValueFormatter, FNextValueFormatter: IIdeDbgValueFormatterIntf;
FTargetAddressSize: integer;
FDisplayFormatResolver: TDisplayFormatResolver;
FInValueFormatter: Boolean;
FNextCallIsValueFormatter: Boolean;
FInValFormNestLevel: integer;
FResValueInFormatter: TWatchResultData;
protected const
MAX_ALLOWED_NEST_LVL = 100;
protected type
TWatchResStoredSettings = record
FFormatFlags: TWatchResultPrinterFormatFlags;
FCurrentValueFormatter: IIdeDbgValueFormatterIntf;
FResValueInFormatter: TWatchResultData;
end;
protected
procedure StoreSetting(var AStorage: TWatchResStoredSettings); inline;
procedure RestoreSetting(const AStorage: TWatchResStoredSettings); inline;
function PrintNumber(AUnsignedValue: QWord; ASignedValue: Int64;
AByteSize: Integer;
const ANumFormat: TResolvedDisplayFormatNum;
@ -93,10 +103,11 @@ type
constructor Create;
destructor Destroy; override;
function PrintWatchValue(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat): String;
function PrintWatchValue(AResValue: IWatchResultDataIntf; const ADispFormat: TWatchDisplayFormat): String;
function PrintWatchValueIntf(AResValue: IWatchResultDataIntf; const ADispFormat: TWatchDisplayFormat; AFlags: TWatchResultPrinterFlags = []): String;
function IWatchResultPrinter.PrintWatchValue = PrintWatchValueIntf;
property FormatFlags: TWatchResultPrinterFormatFlags read FFormatFlags write FFormatFlags;
property OnlyValueFormatter: TIdeDbgValueFormatterSelector read FOnlyValueFormatter write FOnlyValueFormatter;
property OnlyValueFormatter: IIdeDbgValueFormatterIntf read FOnlyValueFormatter write FOnlyValueFormatter;
property TargetAddressSize: integer read FTargetAddressSize write FTargetAddressSize;
property DisplayFormatResolver: TDisplayFormatResolver read FDisplayFormatResolver;
@ -405,6 +416,20 @@ end;
{ TWatchResultPrinter }
procedure TWatchResultPrinter.StoreSetting(var AStorage: TWatchResStoredSettings);
begin
AStorage.FFormatFlags := FFormatFlags;
AStorage.FCurrentValueFormatter := FCurrentValueFormatter;
AStorage.FResValueInFormatter := FResValueInFormatter;
end;
procedure TWatchResultPrinter.RestoreSetting(const AStorage: TWatchResStoredSettings);
begin
FFormatFlags := AStorage.FFormatFlags;
FCurrentValueFormatter := AStorage.FCurrentValueFormatter;
FResValueInFormatter := AStorage.FResValueInFormatter;
end;
function TWatchResultPrinter.PrintNumber(AUnsignedValue: QWord; ASignedValue: Int64;
AByteSize: Integer; const ANumFormat: TResolvedDisplayFormatNum; PrintNil: Boolean): String;
@ -868,6 +893,7 @@ var
PtrDeref, PtrDeref2: TWatchResultData;
Resolved: TResolvedDisplayFormat;
n: Integer;
StoredSettings: TWatchResStoredSettings;
begin
inc(ANestLvl);
if ANestLvl > MAX_ALLOWED_NEST_LVL then
@ -875,21 +901,23 @@ begin
if AResValue = nil then
exit('???');
if not (FInValueFormatter or (rpfSkipValueFormatter in FFormatFlags)) then begin
FInValueFormatter := True;
FInValFormNestLevel := ANestLvl;
if FCurrentValueFormatter <> nil then begin
StoreSetting(StoredSettings);
// for the next IWatchResultPrinter.FormatValue call
FNextCallIsValueFormatter := True;
FInValFormNestLevel := ANestLvl;
FResValueInFormatter := AResValue;
//
try
if OnlyValueFormatter <> nil then begin
if OnlyValueFormatter.FormatValue(AResValue, ADispFormat, ANestLvl, Self, Result) then
exit;
end
else
if GlobalValueFormatterSelectorList.FormatValue(AResValue, ADispFormat, ANestLvl, Self, Result) then
if FCurrentValueFormatter.FormatValue(AResValue, ADispFormat, ANestLvl, Self, Result) then
exit;
finally
FInValueFormatter := False;
FNextCallIsValueFormatter := False;
RestoreSetting(StoredSettings);
end;
end;
end
else
FCurrentValueFormatter := FNextValueFormatter;
Result := '';
case AResValue.ValueKind of
@ -1004,21 +1032,56 @@ end;
function TWatchResultPrinter.PrintWatchValue(AResValue: TWatchResultData;
const ADispFormat: TWatchDisplayFormat): String;
begin
FNextValueFormatter := nil;
if FOnlyValueFormatter <> nil then
FDefaultValueFormatter := FOnlyValueFormatter
else
FDefaultValueFormatter := GlobalValueFormatterSelectorList;
if rpfSkipValueFormatter in FormatFlags then
FCurrentValueFormatter := nil
else
FCurrentValueFormatter := FDefaultValueFormatter;
if rpfMultiLine in FFormatFlags then
FLineSeparator := LineEnding
else
FLineSeparator := ' ';
if FInValueFormatter then
Result := PrintWatchValueEx(AResValue, ADispFormat, FInValFormNestLevel) // This will increase it by one, compared to the value given to the formatter
else
Result := PrintWatchValueEx(AResValue, ADispFormat, -1);
Result := PrintWatchValueEx(AResValue, ADispFormat, -1);
end;
function TWatchResultPrinter.PrintWatchValue(AResValue: IWatchResultDataIntf;
const ADispFormat: TWatchDisplayFormat): String;
function TWatchResultPrinter.PrintWatchValueIntf(AResValue: IWatchResultDataIntf;
const ADispFormat: TWatchDisplayFormat; AFlags: TWatchResultPrinterFlags): String;
var
AResValObj: TWatchResultData;
IncLvl: Integer;
begin
Result := PrintWatchValue(TWatchResultData(AResValue.GetInternalObject), ADispFormat);
AResValObj := TWatchResultData(AResValue.GetInternalObject);
FNextValueFormatter := nil;
if wpfUseDefaultValueFormatterList in AFlags then
FNextValueFormatter := FCurrentValueFormatter;
if wpfUseCurrentValueFormatterList in AFlags then
FNextValueFormatter := FDefaultValueFormatter;
FCurrentValueFormatter := nil;
IncLvl := 0;
if wpfResValueIsNestedValue in AFlags then begin
if AResValObj <> FResValueInFormatter then
FCurrentValueFormatter := FNextValueFormatter;
IncLvl := 1; // Incrementing the level protects against endless loop
end;
if FNextCallIsValueFormatter then begin
FNextCallIsValueFormatter := False;
Result := PrintWatchValueEx(AResValObj, ADispFormat, FInValFormNestLevel - 1 + IncLvl); // This will increase it by one, compared to the value given to the formatter
end
else begin
// TOOD: full init? Or Call PrintWatchValueEx ?
// TODO: inc level/count of iterations
Result := PrintWatchValueEx(AResValObj, ADispFormat, -1);
end;
end;
end.

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.af_ZA.po
View File

@ -1660,6 +1660,10 @@ msgctxt "idedebuggerstringconstants.liswlwatchlist"
msgid "Watches"
msgstr ""
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "idedebuggerstringconstants.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.ar.po
View File

@ -1655,6 +1655,10 @@ msgctxt "idedebuggerstringconstants.liswlwatchlist"
msgid "Watches"
msgstr ""
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "idedebuggerstringconstants.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.ca.po
View File

@ -1677,6 +1677,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Controls"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.cs.po
View File

@ -1707,6 +1707,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Sledování"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.de.po
View File

@ -1702,6 +1702,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Liste der überwachten Ausdrücke"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.es.po
View File

@ -1712,6 +1712,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Lista de puntos de observación"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.fi.po
View File

@ -1700,6 +1700,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Vahdit"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.fr.po
View File

@ -1707,6 +1707,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Suivis"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.he.po
View File

@ -1739,6 +1739,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "רשימת המשגיחים"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.hu.po
View File

@ -1707,6 +1707,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Figyelt elemek"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.id.po
View File

@ -1684,6 +1684,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Daftar Pengawasan"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.it.po
View File

@ -1712,6 +1712,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Elenco delle viste di Watch"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.ja.po
View File

@ -1710,6 +1710,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "監視リスト"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.lt.po
View File

@ -1710,6 +1710,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Stebimų sąrašas"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.nl.po
View File

@ -1680,6 +1680,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Watches"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.pl.po
View File

@ -1723,6 +1723,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Czujki"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.pot
View File

@ -1679,6 +1679,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr ""
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.pt_BR.po
View File

@ -1721,6 +1721,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Observadores"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.ru.po
View File

@ -1692,6 +1692,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Наблюдения"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.sk.po
View File

@ -1695,6 +1695,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Pozorovania"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.tr.po
View File

@ -1702,6 +1702,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "İzlemeler"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.uk.po
View File

@ -1700,6 +1700,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "Спостереження"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"

4
ide/packages/idedebugger/languages/idedebuggerstringconstants.zh_CN.po
View File

@ -1698,6 +1698,10 @@ msgctxt "lazarusidestrconsts.liswlwatchlist"
msgid "Watches"
msgstr "监视(&W)"
#: idedebuggerstringconstants.optdispguttercustomdisplayformat
msgid "Custom Displayformat"
msgstr ""
#: idedebuggerstringconstants.regdlgbinary
msgctxt "lazarusidestrconsts.regdlgbinary"
msgid "Binary"