mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-07 09:29:25 +01:00
Debugger: Configuration for value converter
This commit is contained in:
parent
2d0c2ea8ba
commit
6f99f0fe16
@ -0,0 +1,62 @@
|
|||||||
|
object JsonForDebugSettingsFrame: TJsonForDebugSettingsFrame
|
||||||
|
Left = 0
|
||||||
|
Height = 156
|
||||||
|
Top = 0
|
||||||
|
Width = 226
|
||||||
|
AutoSize = True
|
||||||
|
ChildSizing.TopBottomSpacing = 1
|
||||||
|
ChildSizing.VerticalSpacing = 1
|
||||||
|
ChildSizing.EnlargeHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 2
|
||||||
|
ClientHeight = 156
|
||||||
|
ClientWidth = 226
|
||||||
|
TabOrder = 0
|
||||||
|
DesignLeft = 394
|
||||||
|
DesignTop = 60
|
||||||
|
object lblFuncName: TLabel
|
||||||
|
Left = 0
|
||||||
|
Height = 23
|
||||||
|
Top = 1
|
||||||
|
Width = 45
|
||||||
|
Caption = '----'
|
||||||
|
end
|
||||||
|
object edFuncName: TEdit
|
||||||
|
Left = 45
|
||||||
|
Height = 23
|
||||||
|
Top = 1
|
||||||
|
Width = 181
|
||||||
|
AutoSize = False
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object lblJsonAddress: TLabel
|
||||||
|
Left = 0
|
||||||
|
Height = 23
|
||||||
|
Top = 25
|
||||||
|
Width = 45
|
||||||
|
Caption = '----'
|
||||||
|
end
|
||||||
|
object edJsonAddress: TEdit
|
||||||
|
Left = 45
|
||||||
|
Height = 23
|
||||||
|
Top = 25
|
||||||
|
Width = 181
|
||||||
|
AutoSize = False
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object lblJsonTypename: TLabel
|
||||||
|
Left = 0
|
||||||
|
Height = 23
|
||||||
|
Top = 49
|
||||||
|
Width = 45
|
||||||
|
Caption = '----'
|
||||||
|
end
|
||||||
|
object edJsonTypename: TEdit
|
||||||
|
Left = 45
|
||||||
|
Height = 23
|
||||||
|
Top = 49
|
||||||
|
Width = 181
|
||||||
|
AutoSize = False
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
@ -0,0 +1,328 @@
|
|||||||
|
unit FpDebugConvDebugForJson;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, Forms, Controls, ExtCtrls, StdCtrls,
|
||||||
|
FpDebugStringConstants, FpDebugValueConvertors, FpDebugDebuggerBase,
|
||||||
|
LazDebuggerValueConverter, LazDebuggerIntfBaseTypes, FpDbgInfo, FpDbgClasses,
|
||||||
|
FpdMemoryTools, FpDbgCallContextInfo, FpErrorMessages, DbgIntfBaseTypes;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TJsonForDebugSettingsFrame }
|
||||||
|
|
||||||
|
TJsonForDebugSettingsFrame = class(TFrame, TLazDbgValueConverterSettingsFrameIntf)
|
||||||
|
edFuncName: TEdit;
|
||||||
|
edJsonAddress: TEdit;
|
||||||
|
edJsonTypename: TEdit;
|
||||||
|
lblFuncName: TLabel;
|
||||||
|
lblJsonAddress: TLabel;
|
||||||
|
lblJsonTypename: TLabel;
|
||||||
|
private
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure ReadFrom(AConvertor: TLazDbgValueConverterIntf);
|
||||||
|
function WriteTo(AConvertor: TLazDbgValueConverterIntf): Boolean;
|
||||||
|
function GetFrame: TObject;
|
||||||
|
public
|
||||||
|
constructor Create(TheOwner: TComponent); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFpDbgValueConverterJsonForDebug }
|
||||||
|
|
||||||
|
TFpDbgValueConverterJsonForDebug = class(TFpDbgValueConverter)
|
||||||
|
private
|
||||||
|
FFunctionName: String;
|
||||||
|
FJsonAddressKey: String;
|
||||||
|
FJsonTypenameKey: String;
|
||||||
|
function FunctionNameIsStored: Boolean;
|
||||||
|
function GetProcAddr(AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope): TDBGPtr;
|
||||||
|
function JsonAddressKeyIsStored: Boolean;
|
||||||
|
protected
|
||||||
|
function GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf; override;
|
||||||
|
procedure Init; override;
|
||||||
|
public
|
||||||
|
class function GetName: String; override;
|
||||||
|
class function GetSupportedKinds: TDbgSymbolKinds; override;
|
||||||
|
procedure Assign(ASource: TFpDbgValueConverter); override;
|
||||||
|
function ConvertValue(ASourceValue: TFpValue;
|
||||||
|
AnFpDebugger: TFpDebugDebuggerBase;
|
||||||
|
AnExpressionScope: TFpDbgSymbolScope
|
||||||
|
): TFpValue; override;
|
||||||
|
|
||||||
|
published
|
||||||
|
property FunctionName: String read FFunctionName write FFunctionName stored FunctionNameIsStored;
|
||||||
|
property JsonAddressKey: String read FJsonAddressKey write FJsonAddressKey stored JsonAddressKeyIsStored;
|
||||||
|
property JsonTypenameKey: String read FJsonTypenameKey write FJsonTypenameKey;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
{ TJsonForDebugSettingsFrame }
|
||||||
|
|
||||||
|
procedure TJsonForDebugSettingsFrame.ReadFrom(
|
||||||
|
AConvertor: TLazDbgValueConverterIntf);
|
||||||
|
var
|
||||||
|
c: TFpDbgValueConverterJsonForDebug;
|
||||||
|
begin
|
||||||
|
if not (AConvertor.GetObject is TFpDbgValueConverterJsonForDebug) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
c := TFpDbgValueConverterJsonForDebug(AConvertor.GetObject);
|
||||||
|
|
||||||
|
edFuncName.Text := c.FFunctionName;
|
||||||
|
edJsonAddress.Text := c.FJsonAddressKey;
|
||||||
|
edJsonTypename.Text := c.FJsonTypenameKey;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJsonForDebugSettingsFrame.WriteTo(
|
||||||
|
AConvertor: TLazDbgValueConverterIntf): Boolean;
|
||||||
|
var
|
||||||
|
c: TFpDbgValueConverterJsonForDebug;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if not (AConvertor.GetObject is TFpDbgValueConverterJsonForDebug) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
c := TFpDbgValueConverterJsonForDebug(AConvertor.GetObject);
|
||||||
|
|
||||||
|
Result :=
|
||||||
|
(c.FFunctionName <> trim(edFuncName.Text)) or
|
||||||
|
(c.FJsonAddressKey <> trim(edJsonAddress.Text)) or
|
||||||
|
(c.FJsonTypenameKey <> trim(edJsonTypename.Text));
|
||||||
|
|
||||||
|
c.FFunctionName := trim(edFuncName.Text);
|
||||||
|
c.FJsonAddressKey := trim(edJsonAddress.Text);
|
||||||
|
c.FJsonTypenameKey := trim(edJsonTypename.Text);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJsonForDebugSettingsFrame.GetFrame: TObject;
|
||||||
|
begin
|
||||||
|
Result := Self;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJsonForDebugSettingsFrame.Create(TheOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(TheOwner);
|
||||||
|
lblFuncName.Caption := drsFunctionName;
|
||||||
|
lblJsonAddress.Caption := drsKeyForAddress;
|
||||||
|
lblJsonTypename.Caption := drsKeyForTypename;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFpDbgValueConverterJsonForDebug }
|
||||||
|
|
||||||
|
function TFpDbgValueConverterJsonForDebug.GetProcAddr(
|
||||||
|
AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope
|
||||||
|
): TDBGPtr;
|
||||||
|
var
|
||||||
|
CurProc: TDbgProcess;
|
||||||
|
ProcSymVal: TFpValue;
|
||||||
|
ProcSym: TFpSymbol;
|
||||||
|
begin
|
||||||
|
Result := AnFpDebugger.GetCachedData(pointer(Self));
|
||||||
|
if Result <> 0 then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
CurProc := AnFpDebugger.DbgController.CurrentProcess;
|
||||||
|
if CurProc = nil then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
ProcSymVal := AnExpressionScope.FindSymbol(FFunctionName);
|
||||||
|
if ProcSymVal <> nil then begin
|
||||||
|
if (ProcSymVal.Kind = skProcedure) and IsTargetAddr(ProcSymVal.DataAddress)
|
||||||
|
//and
|
||||||
|
// (ProcSymVal.NestedSymbolCount = 3)
|
||||||
|
then begin
|
||||||
|
Result := ProcSymVal.DataAddress.Address;
|
||||||
|
AnFpDebugger.SetCachedData(pointer(TFpDbgValueConverterJsonForDebug), Result);
|
||||||
|
ProcSymVal.ReleaseReference;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Result := 0;
|
||||||
|
Result := ProcSymVal.DataAddress.Address;
|
||||||
|
end;
|
||||||
|
|
||||||
|
ProcSym := CurProc.FindProcSymbol(FFunctionName);
|
||||||
|
if (ProcSym <> nil) and (ProcSym.Kind = skProcedure) and
|
||||||
|
(IsTargetAddr(ProcSym.Address))
|
||||||
|
then begin
|
||||||
|
Result := ProcSym.Address.Address;
|
||||||
|
AnFpDebugger.SetCachedData(pointer(TFpDbgValueConverterJsonForDebug), Result);
|
||||||
|
end;
|
||||||
|
ProcSym.ReleaseReference;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFpDbgValueConverterJsonForDebug.JsonAddressKeyIsStored: Boolean;
|
||||||
|
begin
|
||||||
|
Result := FJsonAddressKey <> 'Address';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFpDbgValueConverterJsonForDebug.FunctionNameIsStored: Boolean;
|
||||||
|
begin
|
||||||
|
Result := FFunctionName <> 'JsonForDebug';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFpDbgValueConverterJsonForDebug.GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf;
|
||||||
|
begin
|
||||||
|
Result := TJsonForDebugSettingsFrame.Create(nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFpDbgValueConverterJsonForDebug.Init;
|
||||||
|
begin
|
||||||
|
inherited Init;
|
||||||
|
FFunctionName := 'JsonForDebug';
|
||||||
|
FJsonAddressKey := 'Address'
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TFpDbgValueConverterJsonForDebug.GetName: String;
|
||||||
|
begin
|
||||||
|
Result := drsCallJsonForDebug;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TFpDbgValueConverterJsonForDebug.GetSupportedKinds: TDbgSymbolKinds;
|
||||||
|
begin
|
||||||
|
Result := [low(Result)..high(Result)];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFpDbgValueConverterJsonForDebug.Assign(ASource: TFpDbgValueConverter);
|
||||||
|
begin
|
||||||
|
inherited Assign(ASource);
|
||||||
|
if ASource is TFpDbgValueConverterJsonForDebug then begin
|
||||||
|
FFunctionName := TFpDbgValueConverterJsonForDebug(ASource).FFunctionName;
|
||||||
|
FJsonAddressKey := TFpDbgValueConverterJsonForDebug(ASource).FJsonAddressKey;
|
||||||
|
FJsonTypenameKey := TFpDbgValueConverterJsonForDebug(ASource).FJsonTypenameKey;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFpDbgValueConverterJsonForDebug.ConvertValue(ASourceValue: TFpValue;
|
||||||
|
AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope
|
||||||
|
): TFpValue;
|
||||||
|
var
|
||||||
|
CurProccess: TDbgProcess;
|
||||||
|
TpName, JsonText: String;
|
||||||
|
ProcAddr, SetLenProc, DecRefProc,
|
||||||
|
TpNameAddr, TpNewNameAddr, TpNameRefAddr, TextAddr, TextRefAddr: TDbgPtr;
|
||||||
|
CallContext: TFpDbgInfoCallContext;
|
||||||
|
r: Boolean;
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
|
||||||
|
if (not (svfAddress in ASourceValue.FieldFlags)) or
|
||||||
|
(not IsTargetAddr(ASourceValue.Address))
|
||||||
|
then begin
|
||||||
|
SetError(CreateError(fpErrAnyError, ['Value not in memory']));
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TpName := '';
|
||||||
|
if ASourceValue.TypeInfo <> nil then
|
||||||
|
TpName := ASourceValue.TypeInfo.Name;
|
||||||
|
|
||||||
|
if TpName = '' then begin
|
||||||
|
SetError(CreateError(fpErrAnyError, ['no typename']));
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
ProcAddr := GetProcAddr(AnFpDebugger, AnExpressionScope);
|
||||||
|
if ProcAddr = 0 then begin
|
||||||
|
SetError(CreateError(fpErrAnyError, ['JsonForDebug not found']));
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
CurProccess := AnFpDebugger.DbgController.CurrentProcess;
|
||||||
|
SetLenProc := AnFpDebugger.GetCached_FPC_ANSISTR_SETLENGTH;
|
||||||
|
DecRefProc := AnFpDebugger.GetCached_FPC_ANSISTR_DECR_REF;
|
||||||
|
if (SetLenProc = 0) or (DecRefProc = 0) or (CurProccess = nil)
|
||||||
|
then begin
|
||||||
|
SetError(CreateError(fpErrAnyError, ['internal error']));
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TpNameAddr := 0;
|
||||||
|
TpNewNameAddr := 0;
|
||||||
|
TpNameRefAddr := 0;
|
||||||
|
TextAddr := 0;
|
||||||
|
TextRefAddr := 0;
|
||||||
|
try
|
||||||
|
if (not AnFpDebugger.CreateAnsiStringInTarget(SetLenProc, TpNameAddr, TpName, AnExpressionScope.LocationContext)) or
|
||||||
|
(TpNameAddr = 0)
|
||||||
|
then begin
|
||||||
|
TpNameAddr := 0;
|
||||||
|
SetError(CreateError(fpErrAnyError, ['failed to set param']));
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
CallContext := AnFpDebugger.DbgController.Call(TargetLoc(ProcAddr), AnExpressionScope.LocationContext,
|
||||||
|
AnFpDebugger.MemReader, AnFpDebugger.MemConverter);
|
||||||
|
|
||||||
|
if (not CallContext.AddOrdinalParam(ASourceValue.Address.Address)) or
|
||||||
|
(not CallContext.AddOrdinalViaRefAsParam(TpNameAddr, TpNameRefAddr)) or
|
||||||
|
(not CallContext.AddOrdinalViaRefAsParam(0, TextRefAddr))
|
||||||
|
then begin
|
||||||
|
SetError(CreateError(fpErrAnyError, ['failed to set param']));
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
CallContext.FinalizeParams; // force the string as first param (32bit) // TODO
|
||||||
|
|
||||||
|
AnFpDebugger.DbgController.ProcessLoop;
|
||||||
|
|
||||||
|
if not CallContext.IsValid then begin
|
||||||
|
if (IsError(CallContext.LastError)) then
|
||||||
|
SetError(CallContext.LastError)
|
||||||
|
else
|
||||||
|
if (CallContext.Message <> '') then
|
||||||
|
SetError(CreateError(fpErrAnyError, [CallContext.Message]));
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
r := True;
|
||||||
|
if not CurProccess.ReadAddress(TpNameRefAddr, TpNewNameAddr) then begin
|
||||||
|
r := False;
|
||||||
|
TpNewNameAddr := 0;
|
||||||
|
end;
|
||||||
|
if not CurProccess.ReadAddress(TextRefAddr, TextAddr) then begin
|
||||||
|
r := False;
|
||||||
|
TextAddr:= 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not AnFpDebugger.ReadAnsiStringFromTarget(TpNewNameAddr, TpName) then
|
||||||
|
r := False;
|
||||||
|
if not AnFpDebugger.ReadAnsiStringFromTarget(TextAddr, JsonText) then
|
||||||
|
r := False;
|
||||||
|
|
||||||
|
if not r then begin
|
||||||
|
SetError(CreateError(fpErrAnyError, ['failed to get result']));
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
AnFpDebugger.DbgController.AbortCurrentCommand;
|
||||||
|
CallContext.ReleaseReference;
|
||||||
|
|
||||||
|
Result := TFpValueConstString.Create(JsonText);
|
||||||
|
TFpValueConstString(Result).SetTypeName(TpName);
|
||||||
|
|
||||||
|
finally
|
||||||
|
if TpNewNameAddr <> 0 then
|
||||||
|
TpNameAddr := TpNewNameAddr;
|
||||||
|
if TpNameAddr <> 0 then
|
||||||
|
AnFpDebugger.CallTargetFuncStringDecRef(DecRefProc, TpNameAddr, AnExpressionScope.LocationContext);
|
||||||
|
if TextAddr <> 0 then
|
||||||
|
AnFpDebugger.CallTargetFuncStringDecRef(DecRefProc, TextAddr, AnExpressionScope.LocationContext);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
ValueConverterClassList.Add(TFpDbgValueConverterJsonForDebug);
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
@ -41,7 +41,9 @@ uses
|
|||||||
{$IFDEF FPDEBUG_THREAD_CHECK} FpDbgCommon, {$ENDIF}
|
{$IFDEF FPDEBUG_THREAD_CHECK} FpDbgCommon, {$ENDIF}
|
||||||
FpDbgClasses, FpDbgInfo, FpErrorMessages, FpPascalBuilder, FpdMemoryTools,
|
FpDbgClasses, FpDbgInfo, FpErrorMessages, FpPascalBuilder, FpdMemoryTools,
|
||||||
FpPascalParser, FPDbgController, FpDbgDwarfDataClasses, FpDbgDwarfFreePascal,
|
FpPascalParser, FPDbgController, FpDbgDwarfDataClasses, FpDbgDwarfFreePascal,
|
||||||
FpDbgDwarf, FpDbgUtil;
|
FpDbgDwarf, FpDbgUtil,
|
||||||
|
// use converters
|
||||||
|
FpDebugValueConvertors, FpDebugConvDebugForJson;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
|
|||||||
@ -0,0 +1,21 @@
|
|||||||
|
unit FpDebugStringConstants;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils;
|
||||||
|
|
||||||
|
resourcestring
|
||||||
|
drsKeyForAddress = 'Key for Address';
|
||||||
|
drsKeyForTypename = 'Key for Typename';
|
||||||
|
|
||||||
|
drsFunctionName = 'Function name';
|
||||||
|
drsCallSysVarToLStr = 'Call SysVarToLStr';
|
||||||
|
drsCallJsonForDebug = 'Call JsonForDebug';
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
@ -6,9 +6,9 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, fgl, FpDbgInfo, FpdMemoryTools, FpDbgCallContextInfo,
|
Classes, SysUtils, fgl, FpDbgInfo, FpdMemoryTools, FpDbgCallContextInfo,
|
||||||
FpPascalBuilder, FpErrorMessages, FpDbgClasses, FpDbgUtil,
|
FpPascalBuilder, FpErrorMessages, FpDbgClasses, FpDbgUtil, DbgIntfBaseTypes,
|
||||||
DbgIntfBaseTypes, lazCollections, LazClasses, LCLProc, StrUtils,
|
lazCollections, LazClasses, LCLProc, StrUtils, FpDebugDebuggerBase, FpDebugStringConstants,
|
||||||
FpDebugDebuggerBase, LazDebuggerValueConverter, LazDebuggerIntfBaseTypes;
|
LazDebuggerValueConverter, LazDebuggerIntfBaseTypes;
|
||||||
|
|
||||||
type
|
type
|
||||||
TDbgSymbolKinds = set of TDbgSymbolKind;
|
TDbgSymbolKinds = set of TDbgSymbolKind;
|
||||||
@ -25,10 +25,13 @@ type
|
|||||||
FLastErrror: TFpError;
|
FLastErrror: TFpError;
|
||||||
protected
|
protected
|
||||||
function GetObject: TObject;
|
function GetObject: TObject;
|
||||||
|
function GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf; virtual;
|
||||||
|
procedure Init; virtual;
|
||||||
public
|
public
|
||||||
class function GetName: String; virtual; abstract;
|
class function GetName: String; virtual; abstract;
|
||||||
class function GetSupportedKinds: TDbgSymbolKinds; virtual;
|
class function GetSupportedKinds: TDbgSymbolKinds; virtual;
|
||||||
procedure Assign(ASource: TFpDbgValueConverter);
|
constructor Create; virtual;
|
||||||
|
procedure Assign(ASource: TFpDbgValueConverter); virtual;
|
||||||
function CreateCopy: TFpDbgValueConverter; virtual;
|
function CreateCopy: TFpDbgValueConverter; virtual;
|
||||||
function ConvertValue(ASourceValue: TFpValue;
|
function ConvertValue(ASourceValue: TFpValue;
|
||||||
AnFpDebugger: TFpDebugDebuggerBase;
|
AnFpDebugger: TFpDebugDebuggerBase;
|
||||||
@ -55,7 +58,8 @@ type
|
|||||||
FMatchTypeNames: TStrings;
|
FMatchTypeNames: TStrings;
|
||||||
procedure SetConverter(AValue: TFpDbgValueConverter);
|
procedure SetConverter(AValue: TFpDbgValueConverter);
|
||||||
protected
|
protected
|
||||||
function GetBackendSpecificObject: TObject;
|
function GetBackendSpecificObject: TObject; deprecated;
|
||||||
|
function GetConverter: TLazDbgValueConverterIntf;
|
||||||
public
|
public
|
||||||
constructor Create(AConverter: TFpDbgValueConverter);
|
constructor Create(AConverter: TFpDbgValueConverter);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
@ -98,21 +102,6 @@ type
|
|||||||
): TFpValue; override;
|
): TFpValue; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TFpDbgValueConverterJsonForDebug }
|
|
||||||
|
|
||||||
TFpDbgValueConverterJsonForDebug = class(TFpDbgValueConverter)
|
|
||||||
private
|
|
||||||
function GetProcAddr(AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope): TDBGPtr;
|
|
||||||
public
|
|
||||||
class function GetName: String; override;
|
|
||||||
class function GetSupportedKinds: TDbgSymbolKinds; override;
|
|
||||||
function ConvertValue(ASourceValue: TFpValue;
|
|
||||||
AnFpDebugger: TFpDebugDebuggerBase;
|
|
||||||
AnExpressionScope: TFpDbgSymbolScope
|
|
||||||
): TFpValue; override;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function ValueConverterClassList: TFpDbgValueConverterClassList;
|
function ValueConverterClassList: TFpDbgValueConverterClassList;
|
||||||
function ValueConverterConfigList: TFpDbgConverterConfigList;
|
function ValueConverterConfigList: TFpDbgConverterConfigList;
|
||||||
|
|
||||||
@ -167,11 +156,27 @@ begin
|
|||||||
Result := Self;
|
Result := Self;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TFpDbgValueConverter.GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf;
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFpDbgValueConverter.Init;
|
||||||
|
begin
|
||||||
|
//
|
||||||
|
end;
|
||||||
|
|
||||||
class function TFpDbgValueConverter.GetSupportedKinds: TDbgSymbolKinds;
|
class function TFpDbgValueConverter.GetSupportedKinds: TDbgSymbolKinds;
|
||||||
begin
|
begin
|
||||||
Result := [low(TDbgSymbolKinds)..high(TDbgSymbolKinds)];
|
Result := [low(TDbgSymbolKinds)..high(TDbgSymbolKinds)];
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
constructor TFpDbgValueConverter.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
Init;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TFpDbgValueConverter.Assign(ASource: TFpDbgValueConverter);
|
procedure TFpDbgValueConverter.Assign(ASource: TFpDbgValueConverter);
|
||||||
begin
|
begin
|
||||||
//
|
//
|
||||||
@ -193,6 +198,11 @@ begin
|
|||||||
Result := Self;
|
Result := Self;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TFpDbgConverterConfig.GetConverter: TLazDbgValueConverterIntf;
|
||||||
|
begin
|
||||||
|
Result := FConverter;
|
||||||
|
end;
|
||||||
|
|
||||||
function TFpDbgConverterConfig.CreateCopy: TFpDbgConverterConfig;
|
function TFpDbgConverterConfig.CreateCopy: TFpDbgConverterConfig;
|
||||||
begin
|
begin
|
||||||
Result := TFpDbgConverterConfigClass(ClassType).Create(nil);
|
Result := TFpDbgConverterConfigClass(ClassType).Create(nil);
|
||||||
@ -223,9 +233,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
function TFpDbgConverterConfig.CheckMatch(AValue: TFpValue): Boolean;
|
function TFpDbgConverterConfig.CheckMatch(AValue: TFpValue): Boolean;
|
||||||
var
|
|
||||||
t: TFpSymbol;
|
|
||||||
TpName: String;
|
|
||||||
begin
|
begin
|
||||||
Result := (AValue.Kind in (FMatchKinds * Converter.GetSupportedKinds)) and
|
Result := (AValue.Kind in (FMatchKinds * Converter.GetSupportedKinds)) and
|
||||||
CheckTypeMatch(AValue);
|
CheckTypeMatch(AValue);
|
||||||
@ -412,7 +419,7 @@ end;
|
|||||||
|
|
||||||
class function TFpDbgValueConverterVariantToLStr.GetName: String;
|
class function TFpDbgValueConverterVariantToLStr.GetName: String;
|
||||||
begin
|
begin
|
||||||
Result := 'Call SysVarToLStr';
|
Result := drsCallSysVarToLStr;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
class function TFpDbgValueConverterVariantToLStr.GetSupportedKinds: TDbgSymbolKinds;
|
class function TFpDbgValueConverterVariantToLStr.GetSupportedKinds: TDbgSymbolKinds;
|
||||||
@ -540,181 +547,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TFpDbgValueConverterJsonForDebug }
|
|
||||||
|
|
||||||
function TFpDbgValueConverterJsonForDebug.GetProcAddr(
|
|
||||||
AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope
|
|
||||||
): TDBGPtr;
|
|
||||||
var
|
|
||||||
CurProc: TDbgProcess;
|
|
||||||
ProcSymVal: TFpValue;
|
|
||||||
ProcSym: TFpSymbol;
|
|
||||||
begin
|
|
||||||
Result := AnFpDebugger.GetCachedData(pointer(TFpDbgValueConverterJsonForDebug));
|
|
||||||
if Result <> 0 then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
CurProc := AnFpDebugger.DbgController.CurrentProcess;
|
|
||||||
if CurProc = nil then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
ProcSymVal := AnExpressionScope.FindSymbol('JsonForDebug');
|
|
||||||
if ProcSymVal <> nil then begin
|
|
||||||
if (ProcSymVal.Kind = skProcedure) and IsTargetAddr(ProcSymVal.DataAddress) then begin
|
|
||||||
Result := ProcSymVal.DataAddress.Address;
|
|
||||||
AnFpDebugger.SetCachedData(pointer(TFpDbgValueConverterJsonForDebug), Result);
|
|
||||||
ProcSymVal.ReleaseReference;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
Result := 0;
|
|
||||||
Result := ProcSymVal.DataAddress.Address;
|
|
||||||
end;
|
|
||||||
|
|
||||||
ProcSym := CurProc.FindProcSymbol('JsonForDebug');
|
|
||||||
if (ProcSym <> nil) and (ProcSym.Kind = skProcedure) and
|
|
||||||
(IsTargetAddr(ProcSym.Address))
|
|
||||||
then begin
|
|
||||||
Result := ProcSym.Address.Address;
|
|
||||||
AnFpDebugger.SetCachedData(pointer(TFpDbgValueConverterJsonForDebug), Result);
|
|
||||||
end;
|
|
||||||
ProcSym.ReleaseReference;
|
|
||||||
end;
|
|
||||||
|
|
||||||
class function TFpDbgValueConverterJsonForDebug.GetName: String;
|
|
||||||
begin
|
|
||||||
Result := 'Call JsonForDebug';
|
|
||||||
end;
|
|
||||||
|
|
||||||
class function TFpDbgValueConverterJsonForDebug.GetSupportedKinds: TDbgSymbolKinds;
|
|
||||||
begin
|
|
||||||
Result := [low(Result)..high(Result)];
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TFpDbgValueConverterJsonForDebug.ConvertValue(ASourceValue: TFpValue;
|
|
||||||
AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope
|
|
||||||
): TFpValue;
|
|
||||||
var
|
|
||||||
CurProccess: TDbgProcess;
|
|
||||||
TpName, JsonText: String;
|
|
||||||
ProcAddr, SetLenProc, DecRefProc,
|
|
||||||
TpNameAddr, TpNewNameAddr, TpNameRefAddr, TextAddr, TextRefAddr: TDbgPtr;
|
|
||||||
CallContext: TFpDbgInfoCallContext;
|
|
||||||
r: Boolean;
|
|
||||||
AddrSize: Integer;
|
|
||||||
begin
|
|
||||||
Result := nil;
|
|
||||||
|
|
||||||
if (not (svfAddress in ASourceValue.FieldFlags)) or
|
|
||||||
(not IsTargetAddr(ASourceValue.Address))
|
|
||||||
then begin
|
|
||||||
SetError(CreateError(fpErrAnyError, ['Value not in memory']));
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
TpName := '';
|
|
||||||
if ASourceValue.TypeInfo <> nil then
|
|
||||||
TpName := ASourceValue.TypeInfo.Name;
|
|
||||||
|
|
||||||
if TpName = '' then begin
|
|
||||||
SetError(CreateError(fpErrAnyError, ['no typename']));
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
ProcAddr := GetProcAddr(AnFpDebugger, AnExpressionScope);
|
|
||||||
if ProcAddr = 0 then begin
|
|
||||||
SetError(CreateError(fpErrAnyError, ['JsonForDebug not found']));
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
CurProccess := AnFpDebugger.DbgController.CurrentProcess;
|
|
||||||
SetLenProc := AnFpDebugger.GetCached_FPC_ANSISTR_SETLENGTH;
|
|
||||||
DecRefProc := AnFpDebugger.GetCached_FPC_ANSISTR_DECR_REF;
|
|
||||||
if (SetLenProc = 0) or (DecRefProc = 0) or (CurProccess = nil)
|
|
||||||
then begin
|
|
||||||
SetError(CreateError(fpErrAnyError, ['internal error']));
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
TpNameAddr := 0;
|
|
||||||
TpNewNameAddr := 0;
|
|
||||||
TpNameRefAddr := 0;
|
|
||||||
TextAddr := 0;
|
|
||||||
TextRefAddr := 0;
|
|
||||||
try
|
|
||||||
if (not AnFpDebugger.CreateAnsiStringInTarget(SetLenProc, TpNameAddr, TpName, AnExpressionScope.LocationContext)) or
|
|
||||||
(TpNameAddr = 0)
|
|
||||||
then begin
|
|
||||||
TpNameAddr := 0;
|
|
||||||
SetError(CreateError(fpErrAnyError, ['failed to set param']));
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
CallContext := AnFpDebugger.DbgController.Call(TargetLoc(ProcAddr), AnExpressionScope.LocationContext,
|
|
||||||
AnFpDebugger.MemReader, AnFpDebugger.MemConverter);
|
|
||||||
|
|
||||||
if (not CallContext.AddOrdinalParam(ASourceValue.Address.Address)) or
|
|
||||||
(not CallContext.AddOrdinalViaRefAsParam(TpNameAddr, TpNameRefAddr)) or
|
|
||||||
(not CallContext.AddOrdinalViaRefAsParam(0, TextRefAddr))
|
|
||||||
then begin
|
|
||||||
SetError(CreateError(fpErrAnyError, ['failed to set param']));
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
CallContext.FinalizeParams; // force the string as first param (32bit) // TODO
|
|
||||||
|
|
||||||
AnFpDebugger.DbgController.ProcessLoop;
|
|
||||||
|
|
||||||
if not CallContext.IsValid then begin
|
|
||||||
if (IsError(CallContext.LastError)) then
|
|
||||||
SetError(CallContext.LastError)
|
|
||||||
else
|
|
||||||
if (CallContext.Message <> '') then
|
|
||||||
SetError(CreateError(fpErrAnyError, [CallContext.Message]));
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
r := True;
|
|
||||||
if not CurProccess.ReadAddress(TpNameRefAddr, TpNewNameAddr) then begin
|
|
||||||
r := False;
|
|
||||||
TpNewNameAddr := 0;
|
|
||||||
end;
|
|
||||||
if not CurProccess.ReadAddress(TextRefAddr, TextAddr) then begin
|
|
||||||
r := False;
|
|
||||||
TextAddr:= 0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
if not AnFpDebugger.ReadAnsiStringFromTarget(TpNewNameAddr, TpName) then
|
|
||||||
r := False;
|
|
||||||
if not AnFpDebugger.ReadAnsiStringFromTarget(TextAddr, JsonText) then
|
|
||||||
r := False;
|
|
||||||
|
|
||||||
if not r then begin
|
|
||||||
SetError(CreateError(fpErrAnyError, ['failed to get result']));
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
AnFpDebugger.DbgController.AbortCurrentCommand;
|
|
||||||
CallContext.ReleaseReference;
|
|
||||||
|
|
||||||
Result := TFpValueConstString.Create(JsonText);
|
|
||||||
TFpValueConstString(Result).SetTypeName(TpName);
|
|
||||||
|
|
||||||
finally
|
|
||||||
if TpNewNameAddr <> 0 then
|
|
||||||
TpNameAddr := TpNewNameAddr;
|
|
||||||
if TpNameAddr <> 0 then
|
|
||||||
AnFpDebugger.CallTargetFuncStringDecRef(DecRefProc, TpNameAddr, AnExpressionScope.LocationContext);
|
|
||||||
if TextAddr <> 0 then
|
|
||||||
AnFpDebugger.CallTargetFuncStringDecRef(DecRefProc, TextAddr, AnExpressionScope.LocationContext);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
ValueConverterClassList.Add(TFpDbgValueConverterVariantToLStr);
|
ValueConverterClassList.Add(TFpDbgValueConverterVariantToLStr);
|
||||||
ValueConverterClassList.Add(TFpDbgValueConverterJsonForDebug);
|
|
||||||
|
|
||||||
finalization;
|
finalization;
|
||||||
FreeAndNil(TheValueConverterClassList);
|
FreeAndNil(TheValueConverterClassList);
|
||||||
|
|||||||
@ -48,6 +48,14 @@
|
|||||||
<Filename Value="fpdebuggerresultdata.pas"/>
|
<Filename Value="fpdebuggerresultdata.pas"/>
|
||||||
<UnitName Value="FpDebuggerResultData"/>
|
<UnitName Value="FpDebuggerResultData"/>
|
||||||
</Item>
|
</Item>
|
||||||
|
<Item>
|
||||||
|
<Filename Value="fpdebugconvdebugforjson.pas"/>
|
||||||
|
<UnitName Value="FpDebugConvDebugForJson"/>
|
||||||
|
</Item>
|
||||||
|
<Item>
|
||||||
|
<Filename Value="fpdebugstringconstants.pas"/>
|
||||||
|
<UnitName Value="FpDebugStringConstants"/>
|
||||||
|
</Item>
|
||||||
</Files>
|
</Files>
|
||||||
<RequiredPkgs>
|
<RequiredPkgs>
|
||||||
<Item>
|
<Item>
|
||||||
|
|||||||
@ -10,7 +10,7 @@ interface
|
|||||||
uses
|
uses
|
||||||
FpDebugDebugger, FpDebugDebuggerUtils, FpDebugDebuggerWorkThreads,
|
FpDebugDebugger, FpDebugDebuggerUtils, FpDebugDebuggerWorkThreads,
|
||||||
FpDebugValueConvertors, FpDebugDebuggerBase, FpDebuggerResultData,
|
FpDebugValueConvertors, FpDebugDebuggerBase, FpDebuggerResultData,
|
||||||
LazarusPackageIntf;
|
FpDebugConvDebugForJson, FpDebugStringConstants, LazarusPackageIntf;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
|||||||
@ -9,17 +9,28 @@ uses
|
|||||||
Classes, SysUtils;
|
Classes, SysUtils;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
TLazDbgValueConverterIntf = interface;
|
||||||
|
|
||||||
|
TLazDbgValueConverterSettingsFrameIntf = interface
|
||||||
|
procedure ReadFrom(AConvertor: TLazDbgValueConverterIntf);
|
||||||
|
function WriteTo(AConvertor: TLazDbgValueConverterIntf): Boolean;
|
||||||
|
|
||||||
|
function GetFrame: TObject; // TFrame
|
||||||
|
procedure Free;
|
||||||
|
end;
|
||||||
|
|
||||||
TLazDbgValueConverterIntf = interface
|
TLazDbgValueConverterIntf = interface
|
||||||
procedure AddReference;
|
procedure AddReference;
|
||||||
procedure ReleaseReference;
|
procedure ReleaseReference;
|
||||||
function GetObject: TObject;
|
function GetObject: TObject;
|
||||||
|
function GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TLazDbgValueConvertSelectorIntf = interface
|
TLazDbgValueConvertSelectorIntf = interface
|
||||||
procedure AddFreeNotification(ANotification: TNotifyEvent);
|
procedure AddFreeNotification(ANotification: TNotifyEvent);
|
||||||
procedure RemoveFreeNotification(ANotification: TNotifyEvent);
|
procedure RemoveFreeNotification(ANotification: TNotifyEvent);
|
||||||
function GetBackendSpecificObject: TObject;
|
function GetConverter: TLazDbgValueConverterIntf;
|
||||||
|
function GetBackendSpecificObject: TObject; deprecated;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -6,7 +6,8 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, DbgIntfDebuggerBase, IdeDebuggerBase, Debugger,
|
Classes, SysUtils, DbgIntfDebuggerBase, IdeDebuggerBase, Debugger,
|
||||||
IdeDebuggerWatchResult, LazDebuggerIntf, LazDebuggerIntfBaseTypes;
|
IdeDebuggerWatchResult, LazDebuggerIntf, LazDebuggerIntfBaseTypes,
|
||||||
|
LazDebuggerValueConverter;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -90,7 +91,7 @@ type
|
|||||||
procedure RemoveNotification(AnEventType: TWatcheEvaluateEvent;
|
procedure RemoveNotification(AnEventType: TWatcheEvaluateEvent;
|
||||||
AnEvent: TNotifyEvent);
|
AnEvent: TNotifyEvent);
|
||||||
function ResData: TLzDbgWatchDataIntf;
|
function ResData: TLzDbgWatchDataIntf;
|
||||||
function GetFpDbgConverter: TObject;
|
function GetFpDbgConverter: TLazDbgValueConvertSelectorIntf;
|
||||||
protected
|
protected
|
||||||
procedure RequestData;
|
procedure RequestData;
|
||||||
function GetTypeInfo: TDBGType; override;
|
function GetTypeInfo: TDBGType; override;
|
||||||
@ -428,7 +429,7 @@ begin
|
|||||||
Result := FCurrentResData;
|
Result := FCurrentResData;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TTestWatchValue.GetFpDbgConverter: TObject;
|
function TTestWatchValue.GetFpDbgConverter: TLazDbgValueConvertSelectorIntf;
|
||||||
begin
|
begin
|
||||||
Result := nil;
|
Result := nil;
|
||||||
end;
|
end;
|
||||||
|
|||||||
@ -8,7 +8,8 @@ uses
|
|||||||
Classes, SysUtils, LazClasses, LazLoggerBase, IdeDebuggerWatchResult,
|
Classes, SysUtils, LazClasses, LazLoggerBase, IdeDebuggerWatchResult,
|
||||||
IdeDebuggerFpDbgValueConv, IdeDebuggerWatchResultJSon, DbgIntfDebuggerBase,
|
IdeDebuggerFpDbgValueConv, IdeDebuggerWatchResultJSon, DbgIntfDebuggerBase,
|
||||||
DbgIntfMiscClasses, LazDebuggerIntf, LazDebuggerTemplate,
|
DbgIntfMiscClasses, LazDebuggerIntf, LazDebuggerTemplate,
|
||||||
LazDebuggerIntfBaseTypes, FpDebugValueConvertors;
|
LazDebuggerIntfBaseTypes, LazDebuggerValueConverter, FpDebugValueConvertors,
|
||||||
|
FpDebugConvDebugForJson;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -245,36 +246,55 @@ function TWatchValue.GetResultData: TWatchResultData;
|
|||||||
Result := True;
|
Result := True;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
UsedConv: TLazDbgValueConverterIntf;
|
||||||
|
SrcData: TWatchResultData;
|
||||||
|
|
||||||
|
function CreateJson: TWatchResultDataJSon;
|
||||||
|
begin
|
||||||
|
Result := TWatchResultDataJSon.Create(SrcData.AsString);
|
||||||
|
Result.SetTypeName(SrcData.TypeName);
|
||||||
|
if SrcData.HasDataAddress then
|
||||||
|
Result.SetDataAddress(SrcData.DataAddress);
|
||||||
|
if (Result.Count > 0) or (Result.FieldCount > 0) then
|
||||||
|
FResultDataContent := rdcJSon;
|
||||||
|
if (UsedConv <> nil) and (UsedConv.GetObject is TFpDbgValueConverterJsonForDebug)
|
||||||
|
then begin
|
||||||
|
Result.JsonAddressKey := TFpDbgValueConverterJsonForDebug(UsedConv.GetObject).JsonAddressKey;
|
||||||
|
Result.JsonTypenameKey := TFpDbgValueConverterJsonForDebug(UsedConv.GetObject).JsonTypenameKey;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result := FResultData;
|
|
||||||
|
|
||||||
if (FResultDataContent = rdcNotSpecial) or (Result = nil) then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
if FResultDataSpecialised <> nil then begin
|
if FResultDataSpecialised <> nil then begin
|
||||||
Result := FResultDataSpecialised;
|
Result := FResultDataSpecialised;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if (Result.ValueKind = rdkConvertRes) and (Result.FieldCount > 0) and
|
Result := FResultData;
|
||||||
(Result.Fields[0].Field.ValueKind <> rdkError)
|
if (FResultDataContent = rdcNotSpecial) or (Result = nil) then
|
||||||
then
|
exit;
|
||||||
Result := Result.Fields[0].Field;
|
|
||||||
|
SrcData := FResultData;
|
||||||
|
UsedConv := nil;
|
||||||
|
if (SrcData.ValueKind = rdkConvertRes) and (SrcData.FieldCount > 0) and
|
||||||
|
(SrcData.Fields[0].Field <> nil) and
|
||||||
|
(SrcData.Fields[0].Field.ValueKind <> rdkError)
|
||||||
|
then begin
|
||||||
|
SrcData := SrcData.Fields[0].Field;
|
||||||
|
UsedConv := FResultData.BackendValueHandler;
|
||||||
|
end;
|
||||||
|
|
||||||
case FResultDataContent of
|
case FResultDataContent of
|
||||||
rdcJSon:
|
rdcJSon: begin
|
||||||
FResultDataSpecialised := TWatchResultDataJSon.Create(Result.AsString);
|
FResultDataSpecialised := CreateJson;
|
||||||
|
end;
|
||||||
|
|
||||||
else begin
|
else begin
|
||||||
FResultDataContent := rdcNotSpecial;
|
FResultDataContent := rdcNotSpecial;
|
||||||
|
|
||||||
if (Result.ValueKind in [rdkString, rdkPrePrinted]) and (IsMaybeJson(Result.AsString)) then begin
|
if (SrcData.ValueKind in [rdkString, rdkPrePrinted]) and (IsMaybeJson(SrcData.AsString)) then begin
|
||||||
FResultDataSpecialised := TWatchResultDataJSon.Create(Result.AsString);
|
FResultDataSpecialised := CreateJson;
|
||||||
TWatchResultDataJSon(FResultDataSpecialised).SetTypeName(FResultData.TypeName);
|
|
||||||
if FResultData.HasDataAddress then
|
|
||||||
TWatchResultDataJSon(FResultDataSpecialised).SetDataAddress(FResultData.DataAddress);
|
|
||||||
if (FResultDataSpecialised.Count > 0) or (FResultDataSpecialised.FieldCount > 0) then
|
|
||||||
FResultDataContent := rdcJSon;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if FResultDataContent = rdcNotSpecial then
|
if FResultDataContent = rdcNotSpecial then
|
||||||
|
|||||||
@ -698,7 +698,7 @@ type
|
|||||||
// FDataFlags: TWatchResultDataFlags;
|
// FDataFlags: TWatchResultDataFlags;
|
||||||
// Addr: TDbgPtr;
|
// Addr: TDbgPtr;
|
||||||
// MemDump
|
// MemDump
|
||||||
function GetBackendValueHandler: TLazDbgValueConverterIntf;
|
function GetBackendValueHandler: TLazDbgValueConverterIntf; virtual;
|
||||||
function GetClassID: TWatchResultDataClassID; virtual; //abstract;
|
function GetClassID: TWatchResultDataClassID; virtual; //abstract;
|
||||||
protected
|
protected
|
||||||
class function GetStorageClass: TWatchResultStorageClass; virtual; abstract;
|
class function GetStorageClass: TWatchResultStorageClass; virtual; abstract;
|
||||||
@ -721,6 +721,7 @@ type
|
|||||||
procedure ClearData; virtual; abstract;
|
procedure ClearData; virtual; abstract;
|
||||||
protected
|
protected
|
||||||
function GetValueKind: TWatchResultDataKind; virtual; //abstract;
|
function GetValueKind: TWatchResultDataKind; virtual; //abstract;
|
||||||
|
function GetTypeName: String; virtual;
|
||||||
function GetAsString: String; virtual; abstract;
|
function GetAsString: String; virtual; abstract;
|
||||||
function GetAsDesc: String; virtual; abstract;
|
function GetAsDesc: String; virtual; abstract;
|
||||||
function GetAsWideString: WideString; virtual; abstract;
|
function GetAsWideString: WideString; virtual; abstract;
|
||||||
@ -776,7 +777,7 @@ type
|
|||||||
function GetEnumerator: TWatchResultDataEnumerator; virtual;
|
function GetEnumerator: TWatchResultDataEnumerator; virtual;
|
||||||
public
|
public
|
||||||
property ValueKind: TWatchResultDataKind read GetValueKind;
|
property ValueKind: TWatchResultDataKind read GetValueKind;
|
||||||
property TypeName: String read FTypeName;
|
property TypeName: String read GetTypeName;
|
||||||
|
|
||||||
property AsString: String read GetAsString;
|
property AsString: String read GetAsString;
|
||||||
property AsDesc: String read GetAsDesc;
|
property AsDesc: String read GetAsDesc;
|
||||||
@ -1048,6 +1049,7 @@ type
|
|||||||
protected
|
protected
|
||||||
function GetHasDataAddress: Boolean; override;
|
function GetHasDataAddress: Boolean; override;
|
||||||
function GetDataAddress: TDBGPtr; override;
|
function GetDataAddress: TDBGPtr; override;
|
||||||
|
procedure SetDataAddress(AnAddr: TDbgPtr); override;
|
||||||
public
|
public
|
||||||
constructor Create(AStringVal: String);
|
constructor Create(AStringVal: String);
|
||||||
end;
|
end;
|
||||||
@ -1444,7 +1446,7 @@ type
|
|||||||
private
|
private
|
||||||
function GetClassID: TWatchResultDataClassID; override;
|
function GetClassID: TWatchResultDataClassID; override;
|
||||||
protected
|
protected
|
||||||
function GetBackendValueHandler: TLazDbgValueConverterIntf;
|
function GetBackendValueHandler: TLazDbgValueConverterIntf; override;
|
||||||
public
|
public
|
||||||
constructor Create(AHandler: TLazDbgValueConverterIntf);
|
constructor Create(AHandler: TLazDbgValueConverterIntf);
|
||||||
end;
|
end;
|
||||||
@ -2582,6 +2584,11 @@ begin
|
|||||||
Result := wdPrePrint;
|
Result := wdPrePrint;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TWatchResultData.GetTypeName: String;
|
||||||
|
begin
|
||||||
|
Result := FTypeName;
|
||||||
|
end;
|
||||||
|
|
||||||
function TWatchResultData.GetBackendValueHandler: TLazDbgValueConverterIntf;
|
function TWatchResultData.GetBackendValueHandler: TLazDbgValueConverterIntf;
|
||||||
begin
|
begin
|
||||||
Result := nil;
|
Result := nil;
|
||||||
@ -3462,6 +3469,11 @@ begin
|
|||||||
Result := FData.GetDataAddress;
|
Result := FData.GetDataAddress;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TWatchResultDataString.SetDataAddress(AnAddr: TDbgPtr);
|
||||||
|
begin
|
||||||
|
FData.FAddress := AnAddr;
|
||||||
|
end;
|
||||||
|
|
||||||
constructor TWatchResultDataString.Create(AStringVal: String);
|
constructor TWatchResultDataString.Create(AStringVal: String);
|
||||||
begin
|
begin
|
||||||
inherited Create;
|
inherited Create;
|
||||||
|
|||||||
@ -17,12 +17,15 @@ type
|
|||||||
FInternalJSon: TJSONData;
|
FInternalJSon: TJSONData;
|
||||||
FIndex: Integer;
|
FIndex: Integer;
|
||||||
FCurData: TWatchResultDataJSonBase;
|
FCurData: TWatchResultDataJSonBase;
|
||||||
|
FJsonAddressKey: String;
|
||||||
|
FJsonTypenameKey: String;
|
||||||
|
|
||||||
function JSon: TJSONData; inline;
|
function JSon: TJSONData; inline;
|
||||||
protected
|
protected
|
||||||
function GetAsString: String; override;
|
function GetAsString: String; override;
|
||||||
function GetDataAddress: TDBGPtr; override;
|
function GetDataAddress: TDBGPtr; override;
|
||||||
function GetHasDataAddress: Boolean; override;
|
function GetHasDataAddress: Boolean; override;
|
||||||
|
function GetTypeName: String; override;
|
||||||
|
|
||||||
// arary
|
// arary
|
||||||
function GetCount: Integer; override;
|
function GetCount: Integer; override;
|
||||||
@ -39,6 +42,9 @@ type
|
|||||||
procedure SetSelectedIndex(AnIndex: Integer); override;
|
procedure SetSelectedIndex(AnIndex: Integer); override;
|
||||||
|
|
||||||
function HandleExpressionSuffix(ASuffix: String): TWatchResultData; override;
|
function HandleExpressionSuffix(ASuffix: String): TWatchResultData; override;
|
||||||
|
|
||||||
|
property JsonAddressKey: String read FJsonAddressKey write FJsonAddressKey;
|
||||||
|
property JsonTypenameKey: String read FJsonTypenameKey write FJsonTypenameKey;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TWatchResultDataJSon }
|
{ TWatchResultDataJSon }
|
||||||
@ -92,18 +98,28 @@ function TWatchResultDataJSonBase.GetDataAddress: TDBGPtr;
|
|||||||
var
|
var
|
||||||
j: TJSONData;
|
j: TJSONData;
|
||||||
begin
|
begin
|
||||||
Result := 0;
|
|
||||||
j := JSon;
|
j := JSon;
|
||||||
if (j = nil) and not(j is TJSONObject) then
|
if (FJsonAddressKey = '') or (j = nil) or not(j is TJSONObject)
|
||||||
exit;
|
then
|
||||||
|
exit(inherited GetDataAddress);
|
||||||
|
|
||||||
if (TJSONObject(j).Elements['Address'] <> nil) then
|
try
|
||||||
j := TJSONObject(j).Elements['Address']
|
j := TJSONObject(j).Elements[FJsonAddressKey];
|
||||||
else
|
except
|
||||||
j := TJSONObject(j).Elements['DataAddress'];
|
j := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if j = nil then
|
||||||
|
exit(inherited GetDataAddress);
|
||||||
|
|
||||||
|
if j is TJSONString then begin
|
||||||
|
if not TryStrToQWord(j.AsString, Result) then
|
||||||
|
Result := inherited GetDataAddress;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
if ((j is TJSONFloatNumber)) or not(j is TJSONNumber) then
|
if ((j is TJSONFloatNumber)) or not(j is TJSONNumber) then
|
||||||
exit;
|
exit(inherited GetDataAddress);
|
||||||
|
|
||||||
if j is TJSONInt64Number then
|
if j is TJSONInt64Number then
|
||||||
Result := TDBGPtr(j.AsInt64)
|
Result := TDBGPtr(j.AsInt64)
|
||||||
@ -114,18 +130,48 @@ end;
|
|||||||
function TWatchResultDataJSonBase.GetHasDataAddress: Boolean;
|
function TWatchResultDataJSonBase.GetHasDataAddress: Boolean;
|
||||||
var
|
var
|
||||||
j: TJSONData;
|
j: TJSONData;
|
||||||
|
d: QWord;
|
||||||
begin
|
begin
|
||||||
|
Result := inherited GetHasDataAddress;
|
||||||
|
if Result then
|
||||||
|
exit;
|
||||||
|
|
||||||
j := JSon;
|
j := JSon;
|
||||||
Result := (j <> nil) and (j is TJSONObject);
|
Result := (FJsonAddressKey <> '') and (j <> nil) and (j is TJSONObject);
|
||||||
if not Result then
|
if not Result then
|
||||||
exit;
|
exit;
|
||||||
|
|
||||||
if (TJSONObject(j).Elements['Address'] <> nil) then
|
try
|
||||||
j := TJSONObject(j).Elements['Address']
|
j := TJSONObject(j).Elements[FJsonAddressKey];
|
||||||
else
|
except
|
||||||
j := TJSONObject(j).Elements['DataAddress'];
|
j := nil;
|
||||||
|
end;
|
||||||
|
if j = nil then
|
||||||
|
exit(False);
|
||||||
|
|
||||||
Result := (j is TJSONNumber) and not (j is TJSONFloatNumber);
|
Result := ((j is TJSONNumber) and not (j is TJSONFloatNumber)) or
|
||||||
|
((j is TJSONString) and (TryStrToQWord(j.AsString, d)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TWatchResultDataJSonBase.GetTypeName: String;
|
||||||
|
var
|
||||||
|
j: TJSONData;
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
j := JSon;
|
||||||
|
if (FJsonTypenameKey = '') or (j = nil) or not(j is TJSONObject) then
|
||||||
|
exit(inherited GetTypeName);
|
||||||
|
|
||||||
|
try
|
||||||
|
j := TJSONObject(j).Elements[FJsonTypenameKey];
|
||||||
|
except
|
||||||
|
j := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (j = nil) or not(j is TJSONString) then
|
||||||
|
exit(inherited GetTypeName);
|
||||||
|
|
||||||
|
Result := j.AsString;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TWatchResultDataJSonBase.GetCount: Integer;
|
function TWatchResultDataJSonBase.GetCount: Integer;
|
||||||
@ -159,6 +205,10 @@ begin
|
|||||||
FCurData := TWatchResultDataJSonBase.Create('');
|
FCurData := TWatchResultDataJSonBase.Create('');
|
||||||
if JSon <> nil then
|
if JSon <> nil then
|
||||||
FCurData.FInternalJSon := JSon.Items[FIndex];
|
FCurData.FInternalJSon := JSon.Items[FIndex];
|
||||||
|
|
||||||
|
TWatchResultDataJSon(FCurData).FJsonAddressKey := FJsonAddressKey;
|
||||||
|
TWatchResultDataJSon(FCurData).FJsonTypenameKey := FJsonTypenameKey;
|
||||||
|
|
||||||
Result := FCurData;
|
Result := FCurData;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -187,6 +237,10 @@ begin
|
|||||||
FCurData.FInternalJSon := JSon.Items[AnIndex];
|
FCurData.FInternalJSon := JSon.Items[AnIndex];
|
||||||
Result.FieldName := TJSONObject(JSon).Names[AnIndex];
|
Result.FieldName := TJSONObject(JSon).Names[AnIndex];
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
TWatchResultDataJSon(FCurData).FJsonAddressKey := FJsonAddressKey;
|
||||||
|
TWatchResultDataJSon(FCurData).FJsonTypenameKey := FJsonTypenameKey;
|
||||||
|
|
||||||
Result.Field := FCurData;
|
Result.Field := FCurData;
|
||||||
Result.Owner := Self;
|
Result.Owner := Self;
|
||||||
end;
|
end;
|
||||||
@ -316,6 +370,8 @@ begin
|
|||||||
|
|
||||||
if (Idx > SfxLen) and (js <> nil) and (js <> JSon) then begin
|
if (Idx > SfxLen) and (js <> nil) and (js <> JSon) then begin
|
||||||
Result := TWatchResultDataJSon.Create(js.AsJSON);
|
Result := TWatchResultDataJSon.Create(js.AsJSON);
|
||||||
|
TWatchResultDataJSon(Result).FJsonAddressKey := FJsonAddressKey;
|
||||||
|
TWatchResultDataJSon(Result).FJsonTypenameKey := FJsonTypenameKey;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|||||||
@ -17,6 +17,7 @@ object FpDbgValConvFrame: TFpDbgValConvFrame
|
|||||||
BevelOuter = bvNone
|
BevelOuter = bvNone
|
||||||
ClientHeight = 150
|
ClientHeight = 150
|
||||||
ClientWidth = 512
|
ClientWidth = 512
|
||||||
|
Constraints.MinHeight = 80
|
||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
object lstConverters: TCheckListBox
|
object lstConverters: TCheckListBox
|
||||||
Left = 5
|
Left = 5
|
||||||
@ -79,6 +80,7 @@ object FpDbgValConvFrame: TFpDbgValConvFrame
|
|||||||
BevelOuter = bvNone
|
BevelOuter = bvNone
|
||||||
ClientHeight = 362
|
ClientHeight = 362
|
||||||
ClientWidth = 512
|
ClientWidth = 512
|
||||||
|
Constraints.MinHeight = 120
|
||||||
TabOrder = 2
|
TabOrder = 2
|
||||||
object Panel4: TPanel
|
object Panel4: TPanel
|
||||||
Left = 342
|
Left = 342
|
||||||
@ -111,6 +113,7 @@ object FpDbgValConvFrame: TFpDbgValConvFrame
|
|||||||
Top = 25
|
Top = 25
|
||||||
Width = 160
|
Width = 160
|
||||||
ItemHeight = 15
|
ItemHeight = 15
|
||||||
|
OnChange = dropActionChange
|
||||||
Style = csDropDownList
|
Style = csDropDownList
|
||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
end
|
end
|
||||||
@ -181,6 +184,17 @@ object FpDbgValConvFrame: TFpDbgValConvFrame
|
|||||||
Top = 150
|
Top = 150
|
||||||
Width = 512
|
Width = 512
|
||||||
Align = alTop
|
Align = alTop
|
||||||
|
OnCanOffset = Splitter1CanOffset
|
||||||
ResizeAnchor = akTop
|
ResizeAnchor = akTop
|
||||||
end
|
end
|
||||||
|
object pnlCurConvSetting: TPanel
|
||||||
|
Left = 0
|
||||||
|
Height = 0
|
||||||
|
Top = 519
|
||||||
|
Width = 512
|
||||||
|
Align = alBottom
|
||||||
|
AutoSize = True
|
||||||
|
Caption = 'PnlConvSetting'
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
end
|
end
|
||||||
|
|||||||
@ -6,8 +6,8 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, Forms, Controls, ExtCtrls, StdCtrls, CheckLst, LCLIntf,
|
Classes, SysUtils, Forms, Controls, ExtCtrls, StdCtrls, CheckLst, LCLIntf,
|
||||||
Dialogs, StrUtils, FpDebugValueConvertors, IdeDebuggerStringConstants,
|
Dialogs, StrUtils, FpDebugValueConvertors, LazDebuggerValueConverter,
|
||||||
IdeDebuggerFpDbgValueConv;
|
IdeDebuggerStringConstants, IdeDebuggerFpDbgValueConv;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -26,23 +26,34 @@ type
|
|||||||
memoTypeNames: TMemo;
|
memoTypeNames: TMemo;
|
||||||
Panel1: TPanel;
|
Panel1: TPanel;
|
||||||
Panel2: TPanel;
|
Panel2: TPanel;
|
||||||
|
pnlCurConvSetting: TPanel;
|
||||||
pnlCurrentConv: TPanel;
|
pnlCurrentConv: TPanel;
|
||||||
Panel4: TPanel;
|
Panel4: TPanel;
|
||||||
Panel5: TPanel;
|
Panel5: TPanel;
|
||||||
Splitter1: TSplitter;
|
Splitter1: TSplitter;
|
||||||
procedure btnAddClick(Sender: TObject);
|
procedure btnAddClick(Sender: TObject);
|
||||||
procedure btnRemoveClick(Sender: TObject);
|
procedure btnRemoveClick(Sender: TObject);
|
||||||
|
procedure dropActionChange(Sender: TObject);
|
||||||
procedure lstConvertersClick(Sender: TObject);
|
procedure lstConvertersClick(Sender: TObject);
|
||||||
procedure lstConvertersItemClick(Sender: TObject; Index: integer);
|
procedure lstConvertersItemClick(Sender: TObject; Index: integer);
|
||||||
|
procedure Splitter1CanOffset(Sender: TObject; var NewOffset: Integer;
|
||||||
|
var Accept: Boolean);
|
||||||
private
|
private
|
||||||
FValConvList: TIdeFpDbgConverterConfigList;
|
FValConvList: TIdeFpDbgConverterConfigList;
|
||||||
FCurIdx: Integer;
|
FCurIdx: Integer;
|
||||||
FCurValConv: TIdeFpDbgConverterConfig;
|
FCurConvConf: TIdeFpDbgConverterConfig;
|
||||||
|
FCurConv: TLazDbgValueConverterIntf;
|
||||||
|
FCurConvSettings: TLazDbgValueConverterSettingsFrameIntf;
|
||||||
|
|
||||||
|
procedure SetCurConv(AValConv: TIdeFpDbgConverterConfig);
|
||||||
|
procedure UpdateConvForClass;
|
||||||
|
procedure UpdateConvPanel;
|
||||||
procedure FillList;
|
procedure FillList;
|
||||||
procedure UpdateButtons;
|
procedure UpdateButtons;
|
||||||
procedure SetValConvList(AValue: TIdeFpDbgConverterConfigList);
|
procedure SetValConvList(AValue: TIdeFpDbgConverterConfigList);
|
||||||
public
|
public
|
||||||
constructor Create(TheOwner: TComponent); override;
|
constructor Create(TheOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
procedure SaveCurrent;
|
procedure SaveCurrent;
|
||||||
procedure Setup;
|
procedure Setup;
|
||||||
|
|
||||||
@ -67,7 +78,7 @@ begin
|
|||||||
|
|
||||||
SaveCurrent;
|
SaveCurrent;
|
||||||
|
|
||||||
FCurValConv := nil;
|
FCurConvConf := nil;
|
||||||
AvailClass := ValueConverterClassList;
|
AvailClass := ValueConverterClassList;
|
||||||
obj := TIdeFpDbgConverterConfig.Create(AvailClass[0].Create);
|
obj := TIdeFpDbgConverterConfig.Create(AvailClass[0].Create);
|
||||||
obj.Enabled := True;
|
obj.Enabled := True;
|
||||||
@ -86,7 +97,7 @@ var
|
|||||||
i: Integer;
|
i: Integer;
|
||||||
begin
|
begin
|
||||||
SaveCurrent;
|
SaveCurrent;
|
||||||
FCurValConv := nil;
|
FCurConvConf := nil;
|
||||||
i := lstConverters.ItemIndex;
|
i := lstConverters.ItemIndex;
|
||||||
FValConvList.Delete(i);
|
FValConvList.Delete(i);
|
||||||
|
|
||||||
@ -97,6 +108,11 @@ begin
|
|||||||
lstConvertersClick(nil);
|
lstConvertersClick(nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TFpDbgValConvFrame.dropActionChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
UpdateConvForClass;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TFpDbgValConvFrame.lstConvertersClick(Sender: TObject);
|
procedure TFpDbgValConvFrame.lstConvertersClick(Sender: TObject);
|
||||||
var
|
var
|
||||||
AvailClass: TFpDbgValueConverterClassList;
|
AvailClass: TFpDbgValueConverterClassList;
|
||||||
@ -107,20 +123,20 @@ begin
|
|||||||
FCurIdx := lstConverters.ItemIndex;
|
FCurIdx := lstConverters.ItemIndex;
|
||||||
if FCurIdx >= FValConvList.Count then begin
|
if FCurIdx >= FValConvList.Count then begin
|
||||||
FCurIdx := -1;
|
FCurIdx := -1;
|
||||||
FCurValConv := nil;
|
FCurConvConf := nil;
|
||||||
lblDesc.Caption := '';
|
lblDesc.Caption := '';
|
||||||
EdName.Text := '';
|
EdName.Text := '';
|
||||||
memoTypeNames.Text := '';
|
memoTypeNames.Text := '';
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
FCurValConv := FValConvList[FCurIdx];
|
SetCurConv(FValConvList[FCurIdx]);
|
||||||
|
|
||||||
lblDesc.Caption := FCurValConv.Converter.GetName;
|
lblDesc.Caption := FCurConvConf.Converter.GetName;
|
||||||
EdName.Text := FCurValConv.Name;
|
EdName.Text := FCurConvConf.Name;
|
||||||
memoTypeNames.Text := FCurValConv.MatchTypeNames.Text;
|
memoTypeNames.Text := FCurConvConf.MatchTypeNames.Text;
|
||||||
|
|
||||||
AvailClass := ValueConverterClassList;
|
AvailClass := ValueConverterClassList;
|
||||||
dropAction.ItemIndex := AvailClass.IndexOf(TFpDbgValueConverterClass(FCurValConv.Converter.ClassType));
|
dropAction.ItemIndex := AvailClass.IndexOf(TFpDbgValueConverterClass(FCurConvConf.Converter.ClassType));
|
||||||
|
|
||||||
lstConvertersItemClick(nil, FCurIdx);
|
lstConvertersItemClick(nil, FCurIdx);
|
||||||
end;
|
end;
|
||||||
@ -141,12 +157,55 @@ begin
|
|||||||
UpdateButtons;
|
UpdateButtons;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TFpDbgValConvFrame.Splitter1CanOffset(Sender: TObject;
|
||||||
|
var NewOffset: Integer; var Accept: Boolean);
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFpDbgValConvFrame.SetCurConv(AValConv: TIdeFpDbgConverterConfig);
|
||||||
|
begin
|
||||||
|
FCurConvConf := AValConv;
|
||||||
|
FCurConv := TLazDbgValueConvertSelectorIntf(FCurConvConf).GetConverter;
|
||||||
|
UpdateConvPanel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFpDbgValConvFrame.UpdateConvForClass;
|
||||||
|
var
|
||||||
|
AvailClass: TFpDbgValueConverterClassList;
|
||||||
|
begin
|
||||||
|
if FCurConvConf = nil then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
AvailClass := ValueConverterClassList;
|
||||||
|
if (dropAction.ItemIndex <> AvailClass.IndexOf(TFpDbgValueConverterClass(FCurConv.GetObject.ClassType))) then begin
|
||||||
|
FCurConv := AvailClass[dropAction.ItemIndex].Create;
|
||||||
|
UpdateConvPanel;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFpDbgValConvFrame.UpdateConvPanel;
|
||||||
|
var
|
||||||
|
F: TFrame;
|
||||||
|
begin
|
||||||
|
if FCurConvSettings <> nil then
|
||||||
|
FCurConvSettings.Free;
|
||||||
|
|
||||||
|
FCurConvSettings := FCurConv.GetSettingsFrame;
|
||||||
|
if FCurConvSettings <> nil then begin
|
||||||
|
F := TFrame(FCurConvSettings.GetFrame);
|
||||||
|
F.Parent := pnlCurConvSetting;
|
||||||
|
F.Align := alClient;
|
||||||
|
FCurConvSettings.ReadFrom(FCurConv);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TFpDbgValConvFrame.FillList;
|
procedure TFpDbgValConvFrame.FillList;
|
||||||
var
|
var
|
||||||
i: Integer;
|
i: Integer;
|
||||||
obj: TIdeFpDbgConverterConfig;
|
obj: TIdeFpDbgConverterConfig;
|
||||||
begin
|
begin
|
||||||
FCurValConv := nil;
|
FCurConvConf := nil;
|
||||||
|
|
||||||
lstConverters.Clear;
|
lstConverters.Clear;
|
||||||
for i := 0 to FValConvList.Count - 1 do begin
|
for i := 0 to FValConvList.Count - 1 do begin
|
||||||
@ -160,14 +219,14 @@ procedure TFpDbgValConvFrame.UpdateButtons;
|
|||||||
begin
|
begin
|
||||||
btnAdd.Enabled := ValueConverterClassList.Count > 0;
|
btnAdd.Enabled := ValueConverterClassList.Count > 0;
|
||||||
btnRemove.Enabled := (lstConverters.Count > 0) and (lstConverters.ItemIndex >= 0);
|
btnRemove.Enabled := (lstConverters.Count > 0) and (lstConverters.ItemIndex >= 0);
|
||||||
pnlCurrentConv.Enabled := FCurValConv <> nil;
|
pnlCurrentConv.Enabled := FCurConvConf <> nil;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TFpDbgValConvFrame.SetValConvList(AValue: TIdeFpDbgConverterConfigList);
|
procedure TFpDbgValConvFrame.SetValConvList(AValue: TIdeFpDbgConverterConfigList);
|
||||||
begin
|
begin
|
||||||
if FValConvList = AValue then Exit;
|
if FValConvList = AValue then Exit;
|
||||||
FValConvList := AValue;
|
FValConvList := AValue;
|
||||||
FCurValConv := nil;
|
FCurConvConf := nil;
|
||||||
|
|
||||||
FillList;
|
FillList;
|
||||||
|
|
||||||
@ -182,21 +241,20 @@ procedure TFpDbgValConvFrame.SaveCurrent;
|
|||||||
var
|
var
|
||||||
AvailClass: TFpDbgValueConverterClassList;
|
AvailClass: TFpDbgValueConverterClassList;
|
||||||
begin
|
begin
|
||||||
if FCurValConv = nil then
|
if FCurConvConf = nil then
|
||||||
exit;
|
exit;
|
||||||
|
|
||||||
AvailClass := ValueConverterClassList;
|
AvailClass := ValueConverterClassList;
|
||||||
if (TrimSet(FCurValConv.MatchTypeNames.Text, [#1..#32]) <> TrimSet(memoTypeNames.Text, [#1..#32])) or
|
if ( (FCurConv = nil) or (FCurConvSettings = nil) or FCurConvSettings.WriteTo(FCurConv) ) or
|
||||||
(dropAction.ItemIndex <> AvailClass.IndexOf(TFpDbgValueConverterClass(FCurValConv.Converter.ClassType))) or
|
(TrimSet(FCurConvConf.MatchTypeNames.Text, [#1..#32]) <> TrimSet(memoTypeNames.Text, [#1..#32])) or
|
||||||
(EdName.Text <> FCurValConv.Name)
|
(FCurConvConf.Converter <> FCurConv) or
|
||||||
|
(EdName.Text <> FCurConvConf.Name)
|
||||||
then begin
|
then begin
|
||||||
FValConvList.Changed := True;
|
FValConvList.Changed := True;
|
||||||
if (dropAction.ItemIndex <> AvailClass.IndexOf(TFpDbgValueConverterClass(FCurValConv.Converter.ClassType))) then begin
|
FCurConvConf.Converter := TFpDbgValueConverter(FCurConv.GetObject);
|
||||||
FCurValConv.Converter := AvailClass[dropAction.ItemIndex].Create;
|
FCurConvConf.MatchKinds := FCurConvConf.Converter.GetSupportedKinds;
|
||||||
FCurValConv.MatchKinds := FCurValConv.Converter.GetSupportedKinds;
|
FCurConvConf.MatchTypeNames.Text := memoTypeNames.Text;
|
||||||
end;
|
FCurConvConf.Name := EdName.Text
|
||||||
FCurValConv.MatchTypeNames.Text := memoTypeNames.Text;
|
|
||||||
FCurValConv.Name := EdName.Text
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -211,7 +269,7 @@ begin
|
|||||||
lblTypeNames.Caption := dlgFpConvOptMatchTypesByName;
|
lblTypeNames.Caption := dlgFpConvOptMatchTypesByName;
|
||||||
lblAction.Caption := dlgFpConvOptAction;
|
lblAction.Caption := dlgFpConvOptAction;
|
||||||
|
|
||||||
FCurValConv := nil;
|
FCurConvConf := nil;
|
||||||
lblDesc.Caption := '-';
|
lblDesc.Caption := '-';
|
||||||
|
|
||||||
dropAction.Clear;
|
dropAction.Clear;
|
||||||
@ -228,5 +286,13 @@ begin
|
|||||||
Setup;
|
Setup;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
destructor TFpDbgValConvFrame.Destroy;
|
||||||
|
begin
|
||||||
|
if FCurConvSettings <> nil then
|
||||||
|
FCurConvSettings.Free;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user