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

Debugger: redesign Inspect and Evaluate-Modify windows

Browse Source
This commit is contained in:
Martin 2022-07-29 19:36:17 +02:00
parent c7e3898de2
commit bca093c6ec
18 changed files with 2101 additions and 1202 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
debugger/debuggerstrconst.pp
View File

@ -70,9 +70,6 @@ resourcestring
drsInspectColWidthMethType = 'Method type column';
drsInspectColWidthMethReturns = 'Method returns column';
drsInspectColWidthMethAddress = 'Method address column';
drsEvalHistoryNone = 'No history kept';
dsrEvalHistoryUp = 'Insert result at top of history';
dsrEvalHistoryDown = 'Append result at bottom of history';
dsrEvalUseFpDebugConverter = 'Use FpDebug Converter';
drsUseInstanceClassType = 'Use Instance class type';
@ -83,6 +80,7 @@ resourcestring
dlgFpConvOptDefault = '- Default -';
dlgFpConvOptDisabled = '- Disabled -';
dlgFpConvOptFpConverter = 'Converter';
dlgFpConvOptFpNoConverter = 'No Converter';
implementation

348
debugger/evaluatedlg.lfm
View File

@ -1,232 +1,158 @@
object EvaluateDlg: TEvaluateDlg
Left = 470
Left = 454
Height = 290
Top = 393
Width = 400
ActiveControl = cmbExpression
Top = 318
Width = 420
BorderStyle = bsSizeToolWin
Caption = 'Evaluate/Modify'
ClientHeight = 290
ClientWidth = 400
ClientWidth = 420
Constraints.MinHeight = 200
Constraints.MinWidth = 300
KeyPreview = True
OnClose = FormClose
OnCreate = FormCreate
OnKeyDown = FormKeyDown
OnMouseDown = FormMouseDown
LCLVersion = '2.3.0.0'
object Label1: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = ToolBar1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 15
Top = 47
Width = 59
BorderSpacing.Left = 6
BorderSpacing.Top = 3
Caption = '&Expression:'
Color = clDefault
FocusControl = cmbExpression
ParentColor = False
end
object Label2: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = chkTypeCast
AnchorSideTop.Side = asrBottom
Left = 6
Height = 15
Top = 116
Width = 35
BorderSpacing.Left = 6
BorderSpacing.Top = 6
Caption = '&Result:'
Color = clDefault
FocusControl = txtResult
ParentColor = False
end
object lblNewValue: TLabel
AnchorSideLeft.Control = Owner
AnchorSideBottom.Control = cmbNewValue
Left = 6
Height = 15
Top = 243
Width = 58
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Bottom = 3
Caption = '&New value:'
Color = clDefault
FocusControl = cmbNewValue
ParentColor = False
end
object ToolBar1: TToolBar
Left = 0
Height = 44
Top = 0
Width = 400
AutoSize = True
ButtonHeight = 40
ButtonWidth = 50
Caption = 'ToolBar1'
EdgeBorders = [ebTop, ebBottom]
Indent = 2
ShowCaptions = True
TabOrder = 0
TabStop = True
object tbInspect: TToolButton
Left = 154
Top = 2
Caption = '&Inspect'
Enabled = False
ImageIndex = 3
OnClick = tbInspectClick
end
object tbWatch: TToolButton
Left = 104
Top = 2
AllowAllUp = True
Caption = '&Watch'
Enabled = False
ImageIndex = 2
OnClick = tbWatchClick
end
object tbModify: TToolButton
Left = 54
Top = 2
Caption = '&Modify'
Enabled = False
ImageIndex = 1
OnClick = tbModifyClick
end
object tbEvaluate: TToolButton
Left = 2
Top = 2
Caption = 'E&valuate'
Enabled = False
ImageIndex = 0
OnClick = tbEvaluateClick
end
object ToolButton1: TToolButton
Left = 204
Height = 40
Top = 2
Caption = 'ToolButton1'
Style = tbsSeparator
end
object tbHistory: TToolButton
Left = 210
Top = 2
Caption = 'History'
DropdownMenu = mnuHistory
Style = tbsDropDown
end
end
object cmbExpression: TComboBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 6
Height = 23
Top = 65
Width = 388
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Top = 3
BorderSpacing.Right = 6
ItemHeight = 15
OnChange = cmbExpressionChange
OnKeyDown = cmbExpressionKeyDown
OnKeyUp = cmbExpressionKeyUp
OnSelect = cmbExpressionSelect
TabOrder = 2
end
object txtResult: TMemo
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = lblNewValue
Left = 6
Height = 103
Top = 134
Width = 388
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Top = 3
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
Left = 0
Height = 150
Top = 112
Width = 420
Align = alClient
OnMouseDown = FormMouseDown
ScrollBars = ssAutoVertical
TabOrder = 3
end
object cmbNewValue: TComboBox
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 23
Top = 261
Width = 388
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
ItemHeight = 15
OnKeyDown = cmbNewValueKeyDown
TabOrder = 4
end
object chkTypeCast: TCheckBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = cmbExpression
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 91
Width = 85
BorderSpacing.Left = 6
BorderSpacing.Top = 3
Caption = 'chkTypeCast'
Checked = True
OnChange = chkFpDbgConvChange
State = cbChecked
TabOrder = 1
end
object chkFpDbgConv: TCheckBox
AnchorSideLeft.Control = chkTypeCast
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = chkTypeCast
AnchorSideTop.Side = asrCenter
AnchorSideRight.Side = asrBottom
Left = 97
Height = 19
Top = 91
Width = 100
BorderSpacing.Left = 6
Caption = 'chkFpDbgConv'
Checked = True
OnChange = chkFpDbgConvChange
State = cbChecked
TabOrder = 5
inline WatchInspectNav1: TWatchInspectNav
Width = 420
Align = alTop
ClientWidth = 420
inherited ToolBar1: TToolBar
Height = 68
Width = 420
inherited tbDivPower: TToolButton
Height = 22
end
inherited tbDivForwBackw: TToolButton
Height = 22
end
inherited tbDivFlags: TToolButton
Height = 22
end
inherited tbDivCol: TToolButton
Height = 22
end
inherited ArrayNavigationBar1: TArrayNavigationBar
Left = 1
Height = 23
Top = 24
Width = 253
ClientHeight = 23
ClientWidth = 253
inherited btnArrayFastDown: TSpeedButton
Height = 23
end
inherited btnArrayFastUp: TSpeedButton
Height = 23
end
inherited edArrayStart: TSpinEditEx
Height = 23
end
inherited btnArrayStart: TSpeedButton
Height = 23
end
inherited btnArrayEnd: TSpeedButton
Height = 23
end
inherited Label1: TLabel
Height = 23
end
inherited btnArrayPageDec: TSpeedButton
Height = 23
end
inherited edArrayPageSize: TSpinEditEx
Height = 23
end
inherited btnArrayPageInc: TSpeedButton
Height = 23
end
inherited lblBounds: TLabel
Height = 23
end
end
inherited tbDivArray: TToolButton
Left = 254
Height = 22
Top = 24
end
inherited BtnAddWatch: TToolButton
Left = 259
Top = 24
end
inherited BtnInspect: TToolButton
Left = 1
Top = 46
end
inherited BtnEvaluate: TToolButton
Left = 326
Top = 24
end
inherited tbDivAdd: TToolButton
Left = 47
Height = 22
Top = 46
end
inherited btnEvalHistory: TToolButton
Left = 52
Top = 46
end
end
inherited Panel1: TPanel
Width = 420
ClientWidth = 420
inherited EdInspect: TComboBox
Width = 398
end
inherited BtnExecute: TSpeedButton
Left = 399
end
end
end
object mnuHistory: TPopupMenu
Left = 72
Top = 136
object MenuItem1: TMenuItem
Caption = 'None'
OnClick = MenuItem1Click
object Panel1: TPanel
Left = 0
Height = 25
Top = 265
Width = 420
Align = alBottom
AutoSize = True
BorderSpacing.Top = 3
Caption = 'Panel1'
ClientHeight = 25
ClientWidth = 420
TabOrder = 2
object EdModify: TComboBox
Left = 1
Height = 23
Top = 1
Width = 398
Align = alClient
ItemHeight = 15
OnKeyDown = EdModifyKeyDown
ParentShowHint = False
ShowHint = True
TabOrder = 0
TextHint = 'New Value'
end
object MenuItem2: TMenuItem
Caption = 'Up'
OnClick = MenuItem2Click
end
object MenuItem3: TMenuItem
Caption = 'Down'
OnClick = MenuItem3Click
object BtnExecModify: TSpeedButton
Left = 399
Height = 23
Top = 1
Width = 20
Align = alRight
Caption = ':='
OnClick = BtnExecModifyClick
end
end
end

487
debugger/evaluatedlg.pp
View File

@ -39,83 +39,56 @@ interface
uses
Classes, SysUtils,
// LCL
LCLType, Forms, Controls, ComCtrls, StdCtrls, Menus, Dialogs,
LCLType, Forms, Controls, ComCtrls, StdCtrls, Menus, Dialogs, ExtCtrls,
Buttons,
// IdeIntf
IDEWindowIntf, IDEImagesIntf,
// DebuggerIntf
DbgIntfDebuggerBase, LazClasses, LazDebuggerIntf, LazDebuggerIntfBaseTypes,
// IDE
LazarusIDEStrConsts, BaseDebugManager, InputHistory, IDEProcs, Debugger,
IdeDebuggerWatchResPrinter, IdeDebuggerWatchResult, DebuggerDlg,
DebuggerStrConst, EnvironmentOpts;
IdeDebuggerWatchResPrinter, IdeDebuggerWatchResult, IdeDebuggerOpts,
IdeDebuggerFpDbgValueConv, WatchInspectToolbar, DebuggerDlg, DebuggerStrConst,
IdeDebuggerStringConstants, EnvironmentOpts;
type
TEvalHistDirection=(EHDNone,EHDUp,EHDDown);
{ TEvaluateDlg }
TEvaluateDlg = class(TDebuggerDlg)
chkTypeCast: TCheckBox;
chkFpDbgConv: TCheckBox;
cmbExpression: TComboBox;
cmbNewValue: TComboBox;
Label1: TLabel;
Label2: TLabel;
lblNewValue: TLabel;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
mnuHistory: TPopupMenu;
ToolButton1: TToolButton;
tbHistory: TToolButton;
Panel1: TPanel;
EdModify: TComboBox;
BtnExecModify: TSpeedButton;
txtResult: TMemo;
ToolBar1: TToolBar;
tbInspect: TToolButton;
tbWatch: TToolButton;
tbModify: TToolButton;
tbEvaluate: TToolButton;
procedure chkFpDbgConvChange(Sender: TObject);
procedure cmbExpressionKeyUp(Sender: TObject; var {%H-}Key: Word;
{%H-}Shift: TShiftState);
procedure cmbExpressionSelect(Sender: TObject);
procedure cmbNewValueKeyDown(Sender: TObject; var Key: Word;
{%H-}Shift: TShiftState);
procedure FormActivate(Sender: TObject);
WatchInspectNav1: TWatchInspectNav;
procedure BtnExecModifyClick(Sender: TObject);
procedure EdModifyKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormShow(Sender: TObject);
procedure cmbExpressionChange(Sender: TObject);
procedure cmbExpressionKeyDown(Sender: TObject; var Key: Word;
{%H-}Shift: TShiftState);
procedure MenuItem1Click(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
procedure MenuItem3Click(Sender: TObject);
procedure tbEvaluateClick(Sender: TObject);
procedure tbInspectClick(Sender: TObject);
procedure tbModifyClick(Sender: TObject);
procedure tbWatchClick(Sender: TObject);
private
fSkipKeySelect: Boolean;
fHistDirection:TEvalHistDirection;
FWatchPrinter: TWatchResultPrinter;
FInspectWatches: TCurrentWatches;
FCurrentWatchValue: TCurrentWatchValue;
procedure DoWatchValidityChanged(Sender: TObject);
function GetFindText: string;
procedure SetFindText(const NewFindText: string);
procedure Evaluate;
procedure DoAddInspect(Sender: TObject);
procedure DoAddWatch(Sender: TObject);
function DoBeforeUpdate(ASender: TObject): boolean;
procedure DoDebuggerState(ADebugger: TDebuggerIntf; AnOldState: TDBGState);
procedure DoDispFormatChanged(Sender: TObject);
procedure DoEnvOptChanged(Sender: TObject; Restore: boolean);
procedure DoHistDirChanged(Sender: TObject; NewDir: TEvalHistDirection);
procedure DoWatchesInvalidated(Sender: TObject);
procedure DoWatchUpdated(const ASender: TIdeWatches; const AWatch: TIdeWatch);
function GetEvalExpression: string;
procedure SetEvalExpression(const NewExpression: string);
procedure Modify;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure Execute(const AExpression: String);
property FindText: string read GetFindText write SetFindText;
procedure UpdateData;
property EvalExpression: string read GetEvalExpression write SetEvalExpression;
end;
implementation
@ -138,112 +111,169 @@ begin
ThreadsMonitor := DebugBoss.Threads;
CallStackMonitor := DebugBoss.CallStack;
WatchesMonitor := DebugBoss.Watches;
WatchesNotification.OnUpdate := @DoWatchUpdated;
DebugBoss.RegisterStateChangeHandler(@DoDebuggerState);
DebugBoss.RegisterWatchesInvalidatedHandler(@DoWatchesInvalidated);
FWatchPrinter := TWatchResultPrinter.Create;
FInspectWatches := TCurrentWatches.Create(WatchesMonitor);
fSkipKeySelect := False;
WatchInspectNav1.Init(WatchesMonitor, ThreadsMonitor, CallStackMonitor, []);
WatchInspectNav1.HistoryList := InputHistories.HistoryLists.
GetList(ClassName,True,rltCaseSensitive);
Caption := lisKMEvaluateModify;
cmbExpression.Items.Assign(InputHistories.HistoryLists.
GetList(ClassName,True,rltCaseSensitive));
EdModify.TextHint := drsNewValue;
EdModify.Hint := drsNewValueToAssignToTheVari;
Panel1.Enabled := False;
tbEvaluate.Caption := lisEvaluate;
tbModify.Caption := lisModify;
tbWatch.Caption := lisWatch;
tbInspect.Caption := lisInspect;
tbHistory.Caption := lisMenuViewHistory;
WatchInspectNav1.btnUseInstance.Down := EnvironmentOptions.DebuggerAutoSetInstanceFromClass;
Label1.Caption := lisDBGEMExpression;
Label2.Caption := lisDBGEMResult;
lblNewValue.Caption := lisDBGEMNewValue;
chkTypeCast.Caption := drsUseInstanceClassType;
chkFpDbgConv.Caption := dsrEvalUseFpDebugConverter;
fHistDirection:=EHDNone;
WatchInspectNav1.ShowInspectColumns := False;
WatchInspectNav1.ShowArrayNav := False;
WatchInspectNav1.ShowEvalHist := True;
WatchInspectNav1.ShowAddEval:= False;
WatchInspectNav1.ShowDisplayFormat := True;
ToolBar1.Images := IDEImages.Images_16;
tbInspect.ImageIndex := IDEImages.LoadImage('debugger_inspect');
tbWatch.ImageIndex := IDEImages.LoadImage('debugger_watches');
tbModify.ImageIndex := IDEImages.LoadImage('debugger_modify');
tbEvaluate.ImageIndex := IDEImages.LoadImage('debugger_evaluate');
tbHistory.ImageIndex := IDEImages.LoadImage('evaluate_no_hist');
WatchInspectNav1.OnAddWatchClicked := @DoAddWatch;
WatchInspectNav1.OnAddInspectClicked := @DoAddInspect;
WatchInspectNav1.OnEvalHistDirectionChanged := @DoHistDirChanged;
WatchInspectNav1.OnDisplayFormatChanged := @DoDispFormatChanged;
//Clear;
//WatchInspectNav1.OnClear := @DoClear;
WatchInspectNav1.OnBeforeEvaluate := @DoBeforeUpdate;
WatchInspectNav1.OnWatchUpdated := @DoWatchUpdated;
EnvironmentOptions.AddHandlerAfterWrite(@DoEnvOptChanged);
DoEnvOptChanged(nil, False);
mnuHistory.Items[0].Caption:=drsEvalHistoryNone;
mnuHistory.Items[1].Caption:=dsrEvalHistoryUp;
mnuHistory.Items[2].Caption:=dsrEvalHistoryDown;
end;
destructor TEvaluateDlg.Destroy;
begin
ReleaseRefAndNil(FCurrentWatchValue);
FreeAndNil(FWatchPrinter);
DebugBoss.UnregisterStateChangeHandler(@DoDebuggerState);
DebugBoss.UnregisterWatchesInvalidatedHandler(@DoWatchesInvalidated);
EnvironmentOptions.RemoveHandlerAfterWrite(@DoEnvOptChanged);
FreeAndNil(FWatchPrinter);
inherited Destroy;
FreeAndNil(FInspectWatches);
end;
procedure TEvaluateDlg.Execute(const AExpression: String);
begin
SetFindText(AExpression);
SetEvalExpression(AExpression);
end;
procedure TEvaluateDlg.FormActivate(Sender: TObject);
begin
cmbExpression.DropDownCount := EnvironmentOptions.DropDownCount;
cmbNewValue.DropDownCount := EnvironmentOptions.DropDownCount;
end;
procedure TEvaluateDlg.UpdateData;
begin
ReleaseRefAndNil(FCurrentWatchValue);
FInspectWatches.Clear;
Evaluate;
end;
procedure TEvaluateDlg.DoWatchValidityChanged(Sender: TObject);
procedure TEvaluateDlg.DoAddWatch(Sender: TObject);
var
expr: TCaption;
ResultText: String;
w: TCurrentWatch;
begin
if (FCurrentWatchValue = nil ) then begin
txtResult.Clear;
if DebugBoss = nil then
exit;
DebugBoss.Watches.CurrentWatches.BeginUpdate;
try
w := DebugBoss.Watches.CurrentWatches.Find(WatchInspectNav1.Expression);
if w = nil then
w := DebugBoss.Watches.CurrentWatches.Add(WatchInspectNav1.Expression);
if (w <> nil) then begin
WatchInspectNav1.InitWatch(w);
w.Enabled := True;
DebugBoss.ViewDebugDialog(ddtWatches, False);
end;
finally
DebugBoss.Watches.CurrentWatches.EndUpdate;
end;
end;
function TEvaluateDlg.DoBeforeUpdate(ASender: TObject): boolean;
begin
Result := DebugBoss.State = dsPause;
end;
procedure TEvaluateDlg.DoDebuggerState(ADebugger: TDebuggerIntf;
AnOldState: TDBGState);
begin
if (not WatchInspectNav1.PowerIsDown) or (not Visible) then exit;
if (ADebugger.State = dsPause) and (AnOldState <> dsPause) then begin
WatchInspectNav1.UpdateData(True);
end;
end;
procedure TEvaluateDlg.DoDispFormatChanged(Sender: TObject);
begin
if (WatchInspectNav1.CurrentWatchValue = nil) or (WatchInspectNav1.CurrentWatchValue.Watch = nil)
then begin
if (not WatchInspectNav1.PowerIsDown) or (not Visible) then exit;
WatchInspectNav1.UpdateData;
exit;
end;
if DebugBoss.State <> dsPause then
DoWatchUpdated(WatchInspectNav1.Watches, WatchInspectNav1.CurrentWatchValue.Watch);
end;
procedure TEvaluateDlg.DoEnvOptChanged(Sender: TObject; Restore: boolean);
begin
WatchInspectNav1.ShowCallFunction := EnvironmentOptions.DebuggerAllowFunctionCalls;
WatchInspectNav1.EdInspect.DropDownCount := EnvironmentOptions.DropDownCount;
EdModify.DropDownCount := EnvironmentOptions.DropDownCount;
end;
procedure TEvaluateDlg.DoHistDirChanged(Sender: TObject;
NewDir: TEvalHistDirection);
begin
txtResult.Lines.Clear;
end;
procedure TEvaluateDlg.DoWatchesInvalidated(Sender: TObject);
begin
if (not WatchInspectNav1.PowerIsDown) or (not Visible) then exit;
WatchInspectNav1.UpdateData(True);
end;
procedure TEvaluateDlg.DoWatchUpdated(const ASender: TIdeWatches;
const AWatch: TIdeWatch);
var
expr, ResultText: String;
begin
if (WatchInspectNav1.CurrentWatchValue = nil) or
not (WatchInspectNav1.CurrentWatchValue.Validity in [ddsError, ddsInvalid, ddsValid])
then
exit;
if not (FCurrentWatchValue.Validity in [ddsValid, ddsError, ddsInvalid]) then
if (AWatch <> WatchInspectNav1.CurrentWatchValue.Watch) or
(ASender <> WatchInspectNav1.Watches)
then
exit;
expr := cmbExpression.Text;
expr := WatchInspectNav1.Expression;
ResultText := '';
if cmbExpression.Items.IndexOf(expr) = -1 then
cmbExpression.Items.Insert(0, expr);
if FCurrentWatchValue.Validity = ddsValid then begin
ResultText := FWatchPrinter.PrintWatchValue(FCurrentWatchValue.ResultData, wdfStructure);
if (FCurrentWatchValue.ResultData <> nil) and
(FCurrentWatchValue.ResultData.ValueKind = rdkArray) and (FCurrentWatchValue.ResultData.ArrayLength > 0)
if WatchInspectNav1.CurrentWatchValue.Validity = ddsValid then begin
ResultText := FWatchPrinter.PrintWatchValue(WatchInspectNav1.CurrentWatchValue.ResultData, WatchInspectNav1.DisplayFormat);
if (WatchInspectNav1.CurrentWatchValue.ResultData <> nil) and
(WatchInspectNav1.CurrentWatchValue.ResultData.ValueKind = rdkArray) and (WatchInspectNav1.CurrentWatchValue.ResultData.ArrayLength > 0)
then
ResultText := Format(drsLen, [FCurrentWatchValue.ResultData.ArrayLength]) + ResultText
ResultText := Format(drsLen, [WatchInspectNav1.CurrentWatchValue.ResultData.ArrayLength]) + ResultText
else
if (FCurrentWatchValue.TypeInfo <> nil) and
(FCurrentWatchValue.TypeInfo.Attributes * [saArray, saDynArray] <> []) and
(FCurrentWatchValue.TypeInfo.Len >= 0)
if (WatchInspectNav1.CurrentWatchValue.TypeInfo <> nil) and
(WatchInspectNav1.CurrentWatchValue.TypeInfo.Attributes * [saArray, saDynArray] <> []) and
(WatchInspectNav1.CurrentWatchValue.TypeInfo.Len >= 0)
then
ResultText := Format(drsLen, [FCurrentWatchValue.TypeInfo.Len]) + ResultText;
ResultText := Format(drsLen, [WatchInspectNav1.CurrentWatchValue.TypeInfo.Len]) + ResultText;
end
else
ResultText := FCurrentWatchValue.Value;
ResultText := WatchInspectNav1.CurrentWatchValue.Value;
tbModify.Enabled := FCurrentWatchValue.Validity = ddsValid;
Panel1.Enabled := WatchInspectNav1.CurrentWatchValue.Validity = ddsValid;
if fHistDirection<>EHDNone then
if WatchInspectNav1.EvalHistDirection <> EHDNone then
begin
if txtResult.Lines.Text='' then
txtResult.Lines.Text := RESULTEVAL+ expr+':'+LineEnding+ ResultText + LineEnding
else
if fHistDirection=EHDUp then
if WatchInspectNav1.EvalHistDirection = EHDUp then
txtResult.Lines.Text := RESULTEVAL+ expr+':'+LineEnding+ ResultText + LineEnding
+ RESULTSEPARATOR + LineEnding + txtResult.Lines.Text
else
@ -257,143 +287,40 @@ begin
txtResult.Lines.Text := ResultText;
end;
procedure TEvaluateDlg.Evaluate;
var
expr: String;
Opts: TWatcheEvaluateFlags;
tid, idx: Integer;
stack: TIdeCallStack;
AWatch: TCurrentWatch;
procedure TEvaluateDlg.DoAddInspect(Sender: TObject);
begin
if DebugBoss.State <> dsPause then
exit;
expr := trim(cmbExpression.Text);
if expr = '' then Exit;
InputHistories.HistoryLists.Add(ClassName, expr,rltCaseSensitive);
Opts := [];
if chkTypeCast.Checked then
Opts := Opts + [defClassAutoCast];
if not chkFpDbgConv.Checked then
Opts := Opts + [defSkipValConv];
tid := ThreadsMonitor.CurrentThreads.CurrentThreadId;
stack := CallStackMonitor.CurrentCallStackList.EntriesForThreads[tid];
idx := 0;
if stack <> nil then
idx := stack.CurrentIndex;
if (FCurrentWatchValue <> nil) and
(FCurrentWatchValue.Validity in [ddsEvaluating, ddsRequested]) and
(FCurrentWatchValue.Expression = expr) and
(FCurrentWatchValue.EvaluateFlags = Opts) and
(FCurrentWatchValue.ThreadId = tid) and
(FCurrentWatchValue.StackFrame = idx)
then begin
FCurrentWatchValue.Value;
DoWatchValidityChanged(FCurrentWatchValue);
exit;
end;
ReleaseRefAndNil(FCurrentWatchValue);
FInspectWatches.Clear;
FInspectWatches.BeginUpdate;
AWatch := FInspectWatches.Find(expr);
if AWatch = nil then begin
FInspectWatches.Clear;
AWatch := FInspectWatches.Add(expr);
end;
AWatch.EvaluateFlags := Opts;
AWatch.Enabled := True;
FInspectWatches.EndUpdate;
FCurrentWatchValue := AWatch.Values[tid, idx] as TCurrentWatchValue;
if FCurrentWatchValue <> nil then begin
FCurrentWatchValue.OnValidityChanged := @DoWatchValidityChanged;
FCurrentWatchValue.AddReference;
FCurrentWatchValue.Value;
DoWatchValidityChanged(FCurrentWatchValue);
end;
DebugBoss.Inspect(WatchInspectNav1.Expression);
end;
procedure TEvaluateDlg.cmbExpressionChange(Sender: TObject);
var
HasExpression: Boolean;
procedure TEvaluateDlg.SetEvalExpression(const NewExpression: string);
begin
HasExpression := Trim(cmbExpression.Text) <> '';
tbEvaluate.Enabled := HasExpression;
tbModify.Enabled := HasExpression;
tbWatch.Enabled := HasExpression;
tbInspect.Enabled := HasExpression;
if NewExpression<>'' then
WatchInspectNav1.Execute(NewExpression);
WatchInspectNav1.FocusEnterExpression;
end;
procedure TEvaluateDlg.cmbExpressionKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
function TEvaluateDlg.GetEvalExpression: string;
begin
fSkipKeySelect := True;
if (Key = VK_RETURN) and tbEvaluate.Enabled
then begin
Evaluate;
Key := 0;
end;
end;
procedure TEvaluateDlg.MenuItem1Click(Sender: TObject);
begin
fHistDirection:=EHDNone;
tbHistory.ImageIndex := IDEImages.LoadImage('evaluate_no_hist');
txtResult.Lines.Clear;
end;
procedure TEvaluateDlg.MenuItem2Click(Sender: TObject);
begin
fHistDirection:=EHDUp;
tbHistory.ImageIndex := IDEImages.LoadImage('evaluate_up');
txtResult.Lines.Clear;
end;
procedure TEvaluateDlg.MenuItem3Click(Sender: TObject);
begin
fHistDirection:=EHDDown;
tbHistory.ImageIndex := IDEImages.LoadImage('callstack_goto');
txtResult.Lines.Clear;
end;
procedure TEvaluateDlg.SetFindText(const NewFindText: string);
begin
if NewFindText<>'' then
begin
cmbExpression.Text := NewFindText;
cmbExpressionChange(nil);
cmbExpression.SelectAll;
tbEvaluateClick(tbEvaluate);
end;
ActiveControl := cmbExpression;
end;
function TEvaluateDlg.GetFindText: string;
begin
Result := cmbExpression.Text;
Result := WatchInspectNav1.Expression;
end;
procedure TEvaluateDlg.Modify;
var
S, V: String;
begin
S := Trim(cmbExpression.Text);
S := Trim(WatchInspectNav1.Expression);
if S = '' then Exit;
V := cmbNewValue.Text;
V := EdModify.Text;
if not DebugBoss.Modify(S, V) then begin
MessageDlg(lisCCOErrorCaption, synfTheDebuggerWasNotAbleToModifyTheValue, mtError, [mbOK],
0);
Exit;
end;
if cmbNewValue.Items.IndexOf(V) = -1
then cmbNewValue.Items.Insert(0, V);
if EdModify.Items.IndexOf(V) = -1
then EdModify.Items.Insert(0, V);
Evaluate;
WatchInspectNav1.UpdateData(True);
end;
procedure TEvaluateDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
@ -406,87 +333,51 @@ begin
IDEDialogLayoutList.ApplyLayout(Self,400,300);
end;
procedure TEvaluateDlg.cmbNewValueKeyDown(Sender: TObject; var Key: Word;
procedure TEvaluateDlg.EdModifyKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_RETURN) and (tbModify.Enabled)
if (Key = VK_RETURN) and (Shift * [ssShift, ssCtrl, ssAlt] = [ssShift]) and
(EdModify.Text <> '')
then begin
Modify;
Key := 0;
end;
end;
procedure TEvaluateDlg.cmbExpressionKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure TEvaluateDlg.BtnExecModifyClick(Sender: TObject);
begin
fSkipKeySelect := False;
end;
procedure TEvaluateDlg.chkFpDbgConvChange(Sender: TObject);
begin
UpdateData;
end;
procedure TEvaluateDlg.cmbExpressionSelect(Sender: TObject);
begin
if not fSkipKeySelect then
Evaluate;
end;
procedure TEvaluateDlg.FormShow(Sender: TObject);
begin
cmbExpression.SetFocus;
end;
procedure TEvaluateDlg.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_ESCAPE) and not Docked then
Close
else
inherited;
end;
procedure TEvaluateDlg.tbEvaluateClick(Sender: TObject);
begin
Evaluate;
end;
procedure TEvaluateDlg.tbInspectClick(Sender: TObject);
begin
DebugBoss.Inspect(cmbExpression.Text);
end;
procedure TEvaluateDlg.tbModifyClick(Sender: TObject);
begin
if cmbNewValue.Text = '' then begin
if EdModify.Text = '' then begin
MessageDlg(lisCCOErrorCaption, synfNewValueIsEmpty, mtError, [mbOK], 0);
exit;
end;
Modify;
end;
procedure TEvaluateDlg.tbWatchClick(Sender: TObject);
var
S: String;
Watch: TCurrentWatch;
procedure TEvaluateDlg.FormShow(Sender: TObject);
begin
S := cmbExpression.Text;
if s = '' then
exit;
if DebugBoss.Watches.CurrentWatches.Find(S) = nil
then begin
DebugBoss.Watches.CurrentWatches.BeginUpdate;
try
Watch := DebugBoss.Watches.CurrentWatches.Add(S);
Watch.Enabled := True;
if EnvironmentOptions.DebuggerAutoSetInstanceFromClass then
Watch.EvaluateFlags := Watch.EvaluateFlags + [defClassAutoCast];
finally
DebugBoss.Watches.CurrentWatches.EndUpdate;
end;
end;
DebugBoss.ViewDebugDialog(ddtWatches);
WatchInspectNav1.FocusEnterExpression;
end;
procedure TEvaluateDlg.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_ESCAPE) and (not Docked) and
( (not WatchInspectNav1.DropDownOpen) or
(EdModify.DroppedDown and EdModify.Focused) )
then
Close
else
inherited;
end;
procedure TEvaluateDlg.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbExtra1 then
WatchInspectNav1.GoPrevBrowseEntry
else
if Button = mbExtra2 then
WatchInspectNav1.GoNextBrowseEntry;
end;
initialization

270
debugger/inspectdlg.lfm
View File

@ -1,16 +1,15 @@
object IDEInspectDlg: TIDEInspectDlg
Left = 423
Left = 430
Height = 596
Top = 139
Width = 561
Top = 155
Width = 498
BorderStyle = bsSizeToolWin
Caption = 'IDEInspectDlg'
ClientHeight = 596
ClientWidth = 561
ClientWidth = 498
Constraints.MinHeight = 200
Constraints.MinWidth = 200
KeyPreview = True
OnActivate = FormActivate
OnClose = FormClose
OnCreate = FormCreate
OnKeyDown = FormKeyDown
@ -21,14 +20,14 @@ object IDEInspectDlg: TIDEInspectDlg
Left = 0
Height = 23
Top = 573
Width = 561
Width = 498
Panels = <>
end
object PageControl: TPageControl
Left = 0
Height = 503
Top = 70
Width = 561
Height = 523
Top = 50
Width = 498
ActivePage = ErrorPage
Align = alClient
TabIndex = 3
@ -48,8 +47,8 @@ object IDEInspectDlg: TIDEInspectDlg
end
object ErrorPage: TTabSheet
Caption = 'ErrorPage'
ClientHeight = 475
ClientWidth = 553
ClientHeight = 495
ClientWidth = 490
OnMouseDown = DataGridMouseDown
PopupMenu = PopupMenu1
TabVisible = False
@ -57,7 +56,7 @@ object IDEInspectDlg: TIDEInspectDlg
Left = 0
Height = 1
Top = 0
Width = 553
Width = 490
Align = alTop
Color = clDefault
ParentColor = False
@ -66,184 +65,101 @@ object IDEInspectDlg: TIDEInspectDlg
end
end
end
object EdInspect: TComboBox
Left = 0
Height = 23
Top = 0
Width = 561
inline WatchInspectNav1: TWatchInspectNav
Height = 50
Width = 498
Align = alTop
ItemHeight = 15
OnEditingDone = EdInspectEditingDone
OnKeyDown = EdInspectKeyDown
TabOrder = 2
Text = '(...)'
end
object ToolBar1: TToolBar
AnchorSideTop.Control = EdInspect
Left = 0
Height = 47
Top = 23
Width = 561
AutoSize = True
Caption = 'ToolBar1'
ShowCaptions = True
TabOrder = 3
object btnPower: TToolButton
Left = 1
Top = 2
Caption = 'O'
Down = True
OnClick = btnPowerClick
ShowCaption = False
Style = tbsCheck
end
object tbDiv1: TToolButton
Left = 24
Height = 22
Top = 2
Caption = 'tbDiv1'
Style = tbsDivider
end
object tbDiv3: TToolButton
Left = 194
Height = 22
Top = 2
Caption = 'tbDiv3'
Style = tbsDivider
end
object btnUseInstance: TToolButton
Left = 82
Hint = 'Use Instance class'
Top = 2
AllowAllUp = True
Caption = 'Instance'
OnClick = btnUseInstanceClick
ParentShowHint = False
ShowHint = True
Style = tbsCheck
end
object btnColClass: TToolButton
Left = 199
Hint = 'Show Class Column'
Top = 2
AllowAllUp = True
Caption = 'C'
Down = True
OnClick = btnColClassClick
ParentShowHint = False
ShowHint = True
Style = tbsCheck
end
object btnColType: TToolButton
Left = 222
Top = 2
AllowAllUp = True
Caption = 'T'
Down = True
OnClick = btnColClassClick
ParentShowHint = False
ShowHint = True
Style = tbsCheck
end
object btnColVisibility: TToolButton
Left = 245
Top = 2
AllowAllUp = True
Caption = 'V'
Down = True
OnClick = btnColClassClick
ParentShowHint = False
ShowHint = True
Style = tbsCheck
end
object btnBackward: TToolButton
Left = 29
Top = 2
Caption = '<<'
OnClick = btnBackwardClick
end
object btnForward: TToolButton
Left = 53
Top = 2
Caption = '>>'
OnClick = btnForwardClick
end
object tbDiv2: TToolButton
Left = 77
Height = 22
Top = 2
Caption = 'tbDiv2'
Style = tbsDivider
end
object BtnAddWatch: TToolButton
Left = 273
Top = 2
Caption = 'Add Watch'
OnClick = BtnAddWatchClick
end
object tbDiv4: TToolButton
Left = 268
Height = 22
Top = 2
Caption = 'tbDiv4'
Style = tbsDivider
end
object tbDiv5: TToolButton
Left = 340
Height = 22
Top = 2
Caption = 'tbDiv5'
Style = tbsDivider
end
inline ArrayNavigationBar1: TArrayNavigationBar
Left = 1
Height = 23
Top = 24
Width = 253
ClientHeight = 23
ClientWidth = 253
inherited btnArrayFastDown: TSpeedButton
Height = 23
ClientHeight = 50
ClientWidth = 498
inherited ToolBar1: TToolBar
Height = 47
Width = 498
inherited tbDivPower: TToolButton
Height = 22
end
inherited btnArrayFastUp: TSpeedButton
Height = 23
inherited tbDivForwBackw: TToolButton
Height = 22
end
inherited edArrayStart: TSpinEditEx
Height = 23
inherited tbDivFlags: TToolButton
Height = 22
end
inherited btnArrayStart: TSpeedButton
Height = 23
inherited tbDivCol: TToolButton
Height = 22
end
inherited btnArrayEnd: TSpeedButton
inherited ArrayNavigationBar1: TArrayNavigationBar
Left = 1
Height = 23
Top = 24
Width = 253
ClientHeight = 23
ClientWidth = 253
inherited btnArrayFastDown: TSpeedButton
Height = 23
end
inherited btnArrayFastUp: TSpeedButton
Height = 23
end
inherited edArrayStart: TSpinEditEx
Height = 23
end
inherited btnArrayStart: TSpeedButton
Height = 23
end
inherited btnArrayEnd: TSpeedButton
Height = 23
end
inherited Label1: TLabel
Height = 23
end
inherited btnArrayPageDec: TSpeedButton
Height = 23
end
inherited edArrayPageSize: TSpinEditEx
Height = 23
end
inherited btnArrayPageInc: TSpeedButton
Height = 23
end
inherited lblBounds: TLabel
Height = 23
end
end
inherited Label1: TLabel
Height = 23
inherited tbDivArray: TToolButton
Left = 254
Height = 22
Top = 24
end
inherited btnArrayPageDec: TSpeedButton
Height = 23
inherited BtnAddWatch: TToolButton
Left = 259
Top = 24
end
inherited edArrayPageSize: TSpinEditEx
Height = 23
inherited BtnInspect: TToolButton
Left = 378
Top = 24
end
inherited btnArrayPageInc: TSpeedButton
Height = 23
inherited BtnEvaluate: TToolButton
Left = 326
Top = 24
end
inherited lblBounds: TLabel
Height = 23
inherited tbDivAdd: TToolButton
Left = 424
Height = 22
Top = 24
end
inherited btnEvalHistory: TToolButton
Left = 429
Top = 24
end
end
object btnUseConverter: TToolButton
Left = 134
Hint = 'Use Converter'
Top = 2
AllowAllUp = True
Caption = 'Converter'
Down = True
OnClick = btnUseConverterClick
ParentShowHint = False
ShowHint = True
Style = tbsCheck
inherited Panel1: TPanel
Width = 498
ClientWidth = 498
inherited EdInspect: TComboBox
Width = 476
end
inherited BtnExecute: TSpeedButton
Left = 477
end
end
end
object TimerClearData: TTimer

742
debugger/inspectdlg.pas
View File

File diff suppressed because it is too large Load Diff

19
ide/debugmanager.pas
View File

@ -1434,15 +1434,6 @@ begin
FBreakPoints[i].SetLocation(FBreakPoints[i].Source, FBreakPoints[i].Line);
end;
// update inspect
// TODO: Move here from DebuggerCurrentLine / Only currently State change locks execution of gdb
//if ( ((FDebugger.State in [dsPause]) and (OldState = dsRun)) or
// (OldState in [dsPause]) ) and
if (OldState in [dsPause]) and (FDialogs[ddtInspect] <> nil)
then TIDEInspectDlg(FDialogs[ddtInspect]).UpdateData;
if (OldState in [dsPause]) and (FDialogs[ddtEvaluate] <> nil)
then TEvaluateDlg(FDialogs[ddtEvaluate]).UpdateData;
case FDebugger.State of
dsError: begin
{$ifdef VerboseDebugger}
@ -1570,10 +1561,6 @@ begin
// Must be after stack frame selection (for inspect)
if FDialogs[ddtAssembler] <> nil
then TAssemblerDlg(FDialogs[ddtAssembler]).SetLocation(FDebugger, Alocation.Address);
if (FDialogs[ddtInspect] <> nil)
then TIDEInspectDlg(FDialogs[ddtInspect]).UpdateData;
if (FDialogs[ddtEvaluate] <> nil)
then TEvaluateDlg(FDialogs[ddtEvaluate]).UpdateData;
if (SrcLine > 0) and (CurrentSourceUnitInfo <> nil) and
GetFullFilename(CurrentSourceUnitInfo, SrcFullName, True)
@ -1921,9 +1908,9 @@ begin
exit;
if SourceEditorManager.GetActiveSE.SelectionAvailable
then
TheDialog.FindText := SourceEditorManager.GetActiveSE.Selection
TheDialog.EvalExpression := SourceEditorManager.GetActiveSE.Selection
else
TheDialog.FindText := SourceEditorManager.GetActiveSE.GetOperandAtCurrentCaret;
TheDialog.EvalExpression := SourceEditorManager.GetActiveSE.GetOperandAtCurrentCaret;
end;
constructor TDebugManager.Create(TheOwner: TComponent);
@ -3029,7 +3016,7 @@ begin
if Destroying then Exit;
ViewDebugDialog(ddtEvaluate);
if FDialogs[ddtEvaluate] <> nil then
TEvaluateDlg(FDialogs[ddtEvaluate]).FindText := AExpression;
TEvaluateDlg(FDialogs[ddtEvaluate]).EvalExpression := AExpression;
end;
procedure TDebugManager.Inspect(const AExpression: String);

10
ide/lazarusidestrconsts.pas
View File

@ -556,9 +556,6 @@ resourcestring
lisInspectMethods = 'Methods';
lisInspectUseInstance = 'Instance';
lisInspectUseInstanceHint = 'Use instance class';
lisInspectShowColClass = 'Show class column';
lisInspectShowColType = 'Show type column';
lisInspectShowColVisibility = 'Show visibility column';
lisInspectClassInherit = '%s: class %s inherits from %s';
lisInspectUnavailableError = '%s: unavailable (error: %s)';
lisInspectPointerTo = 'Pointer to %s';
@ -5608,15 +5605,8 @@ resourcestring
lisOn = '? (On)';
lisTakeSnapshot = 'Take a Snapshot';
// Evaluate/Modify Dialog
lisEvaluate = 'E&valuate';
lisModify = '&Modify';
lisWatch = '&Watch';
lisInspect = '&Inspect';
lisDBGEMExpression = '&Expression:';
lisDBGEMResult = '&Result:';
lisDBGEMNewValue = '&New value:';
// Breakpoint Properties Dialog
lisBreakPointProperties = 'Breakpoint Properties';
lisLine = 'Line:';

2
ide/main.pp
View File

@ -1387,7 +1387,6 @@ begin
CodeExplorerOptions.OnAfterWrite := @CodeExplorerOptionsAfterWrite;
CodeExplorerOptions.Load;
DebuggerOptions := TDebuggerOptions.Create;
DebuggerOptions.PrimaryConfigPath := GetPrimaryConfigPath;
DebuggerOptions.CreateConfig;
DebuggerOptions.Load;
@ -1773,7 +1772,6 @@ begin
FreeThenNil(MiscellaneousOptions);
FreeThenNil(EditorOpts);
IDECommandList := nil;
FreeThenNil(DebuggerOptions);
FreeThenNil(EnvironmentOptions);
FreeThenNil(IDECommandScopes);
// free control selection

1
ide/packages/idedebugger/arraynavigationframe.lfm
View File

@ -6,6 +6,7 @@ object ArrayNavigationBar: TArrayNavigationBar
AutoSize = True
ClientHeight = 26
ClientWidth = 320
LCLVersion = '2.3.0.0'
TabOrder = 0
DesignLeft = 518
DesignTop = 777

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

@ -37,6 +37,7 @@ type
FLowBound: int64;
FOnIndexChanged: TArrayNavChangeEvent;
FOnPageSize: TArrayNavChangeEvent;
FOnSizeChanged: TNotifyEvent;
FOwnerData: pointer;
FShowBoundInfo: Boolean;
function GetIndex: int64;
@ -50,6 +51,7 @@ type
procedure SetPageSize(AValue: int64);
procedure SetShowBoundInfo(AValue: Boolean);
procedure UpdateBoundsInfo;
procedure DoOnSizeChanged;
public
constructor Create(TheOwner: TComponent); override;
procedure Loaded; override;
@ -66,6 +68,7 @@ type
published
property OnIndexChanged: TArrayNavChangeEvent read FOnIndexChanged write FOnIndexChanged;
property OnPageSize: TArrayNavChangeEvent read FOnPageSize write FOnPageSize;
property OnSizeChanged: TNotifyEvent read FOnSizeChanged write FOnSizeChanged;
property HardLimits: Boolean read FHardLimits write SetHardLimits;
end;
@ -202,8 +205,8 @@ begin
if FShowBoundInfo = AValue then Exit;
FShowBoundInfo := AValue;
UpdateBoundsInfo;
lblBounds.Visible := FShowBoundInfo;
UpdateBoundsInfo;
end;
procedure TArrayNavigationBar.UpdateBoundsInfo;
@ -225,6 +228,13 @@ begin
if FShowBoundInfo then
lblBounds.Caption := format(dlgInspectBoundsDD, [FLowBound, FHighBound]);
DoOnSizeChanged;
end;
procedure TArrayNavigationBar.DoOnSizeChanged;
begin
if FOnSizeChanged <> nil then
FOnSizeChanged(Self);
end;
constructor TArrayNavigationBar.Create(TheOwner: TComponent);

289
ide/packages/idedebugger/frames/watchinspecttoolbar.lfm Normal file
View File

@ -0,0 +1,289 @@
object WatchInspectNav: TWatchInspectNav
Left = 0
Height = 112
Top = 0
Width = 1040
ClientHeight = 112
ClientWidth = 1040
OnResize = FrameResize
TabOrder = 0
DesignLeft = 66
DesignTop = 35
object ToolBar1: TToolBar
Left = 0
Height = 25
Top = 25
Width = 1040
AutoSize = True
Caption = 'ToolBar1'
List = True
ParentShowHint = False
ShowCaptions = True
ShowHint = True
TabOrder = 1
object btnPower: TToolButton
Left = 1
Top = 2
Caption = 'O'
Down = True
OnClick = btnPowerClick
ShowCaption = False
Style = tbsCheck
end
object tbDivPower: TToolButton
Left = 24
Height = 22
Top = 2
Caption = 'tbDivPower'
Style = tbsDivider
end
object btnBackward: TToolButton
Left = 29
Top = 2
Caption = '<<'
OnClick = btnBackwardClick
end
object btnForward: TToolButton
Left = 53
Top = 2
Caption = '>>'
OnClick = btnForwardClick
end
object tbDivForwBackw: TToolButton
Left = 77
Height = 22
Top = 2
Caption = 'tbDivForwBackw'
Style = tbsDivider
end
object btnUseInstance: TToolButton
Left = 82
Hint = 'Use Instance class'
Top = 2
AllowAllUp = True
Caption = 'Instance'
Down = True
OnClick = btnFunctionEvalClick
ParentShowHint = False
ShowHint = True
Style = tbsCheck
end
object btnFunctionEval: TToolButton
Left = 134
Hint = 'Evaluate Functions'
Top = 2
AllowAllUp = True
Caption = 'Function'
Down = True
OnClick = btnFunctionEvalClick
ParentShowHint = False
ShowHint = True
Style = tbsCheck
end
object btnUseConverter: TToolButton
Left = 189
Hint = 'Use Converter'
Top = 2
AllowAllUp = True
Caption = 'Converter'
DropdownMenu = popConverter
ParentShowHint = False
ShowHint = True
Style = tbsButtonDrop
end
object tbDivFlags: TToolButton
Left = 259
Height = 22
Top = 2
Caption = 'tbDivFlags'
Style = tbsDivider
end
object btnColClass: TToolButton
Left = 264
Hint = 'Show Class Column'
Top = 2
AllowAllUp = True
Caption = 'C'
Down = True
OnClick = btnColTypeClick
ParentShowHint = False
ShowHint = True
Style = tbsCheck
end
object btnColType: TToolButton
Left = 287
Top = 2
AllowAllUp = True
Caption = 'T'
Down = True
OnClick = btnColTypeClick
ParentShowHint = False
ShowHint = True
Style = tbsCheck
end
object btnColVisibility: TToolButton
Left = 310
Top = 2
AllowAllUp = True
Caption = 'V'
Down = True
OnClick = btnColTypeClick
ParentShowHint = False
ShowHint = True
Style = tbsCheck
end
object tbDivCol: TToolButton
Left = 366
Height = 22
Top = 2
Caption = 'tbDivCol'
Style = tbsDivider
end
inline ArrayNavigationBar1: TArrayNavigationBar
Left = 371
Height = 23
Top = 2
Width = 253
ClientHeight = 23
ClientWidth = 253
inherited btnArrayFastDown: TSpeedButton
Height = 23
end
inherited btnArrayFastUp: TSpeedButton
Height = 23
end
inherited edArrayStart: TSpinEditEx
Height = 23
end
inherited btnArrayStart: TSpeedButton
Height = 23
end
inherited btnArrayEnd: TSpeedButton
Height = 23
end
inherited Label1: TLabel
Height = 23
end
inherited btnArrayPageDec: TSpeedButton
Height = 23
end
inherited edArrayPageSize: TSpinEditEx
Height = 23
end
inherited btnArrayPageInc: TSpeedButton
Height = 23
end
inherited lblBounds: TLabel
Height = 23
end
end
object tbDivArray: TToolButton
Left = 624
Height = 22
Top = 2
Caption = 'tbDivArray'
Style = tbsDivider
end
object BtnAddWatch: TToolButton
Left = 629
Top = 2
Caption = 'Add Watch'
OnClick = BtnAddWatchClick
end
object BtnInspect: TToolButton
Left = 748
Top = 2
Caption = 'Inspect'
OnClick = BtnInspectClick
end
object BtnEvaluate: TToolButton
Left = 696
Top = 2
Caption = 'Evaluate'
OnClick = BtnEvaluateClick
end
object tbDivAdd: TToolButton
Left = 794
Height = 22
Top = 2
Caption = 'tbDivAdd'
Style = tbsDivider
end
object btnEvalHistory: TToolButton
Left = 799
Top = 2
Caption = 'History'
DropdownMenu = mnuHistory
Style = tbsButtonDrop
end
object btnDisplayFormat: TToolButton
Left = 333
Top = 2
AllowAllUp = True
Caption = 'df'
DropdownMenu = popDispForm
ParentShowHint = False
ShowHint = True
Style = tbsButtonDrop
Visible = False
end
end
object Panel1: TPanel
Left = 0
Height = 25
Top = 0
Width = 1040
Align = alTop
AutoSize = True
Caption = 'Panel1'
ClientHeight = 25
ClientWidth = 1040
TabOrder = 0
object EdInspect: TComboBox
Left = 1
Height = 23
Top = 1
Width = 1018
Align = alClient
ItemHeight = 15
OnChange = EdInspectChange
OnEditingDone = EdInspectEditingDone
OnKeyDown = EdInspectKeyDown
TabOrder = 0
TextHint = 'Enter Expression'
end
object BtnExecute: TSpeedButton
Left = 1019
Height = 23
Top = 1
Width = 20
Align = alRight
Caption = '='
OnClick = BtnExecuteClick
end
end
object mnuHistory: TPopupMenu
Left = 784
Top = 56
object MenuItem1: TMenuItem
Caption = 'None'
OnClick = MenuItem1Click
end
object MenuItem2: TMenuItem
Caption = 'Up'
OnClick = MenuItem1Click
end
object MenuItem3: TMenuItem
Caption = 'Down'
OnClick = MenuItem1Click
end
end
object popConverter: TPopupMenu
Left = 204
Top = 56
end
object popDispForm: TPopupMenu
Left = 334
Top = 62
end
end

811
ide/packages/idedebugger/frames/watchinspecttoolbar.pas Normal file
View File

@ -0,0 +1,811 @@
unit WatchInspectToolbar;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, ComCtrls, Buttons, StdCtrls, ExtCtrls,
Menus, LCLType, SpinEx, IDEImagesIntf, LazUTF8, LazClasses, LazDebuggerIntf,
IdeDebuggerStringConstants, ArrayNavigationFrame, IdeDebuggerOpts, Debugger,
IdeDebuggerFpDbgValueConv;
type
TEvalHistDirection=(EHDNone,EHDUp,EHDDown);
TEvalHistDirectionChangedEvent = procedure(Sender: TObject; NewDir: TEvalHistDirection) of object;
TInspectWatchBeforeUdateEvent = function(ASender: TObject): boolean of object;
TInspectWatchUpdatedEvent = procedure (const ASender: TIdeWatches; const AWatch: TIdeWatch) of object;
{ TWatchInspectNav }
TWatchInspectNav = class(TFrame)
btnDisplayFormat: TToolButton;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
mnuHistory: TPopupMenu;
Panel1: TPanel;
EdInspect: TComboBox;
popConverter: TPopupMenu;
popDispForm: TPopupMenu;
BtnExecute: TSpeedButton;
ToolBar1: TToolBar;
btnPower: TToolButton;
tbDivPower: TToolButton;
btnBackward: TToolButton;
btnForward: TToolButton;
tbDivForwBackw: TToolButton;
btnUseInstance: TToolButton;
btnFunctionEval: TToolButton;
btnUseConverter: TToolButton;
tbDivFlags: TToolButton;
btnColClass: TToolButton;
btnColType: TToolButton;
btnColVisibility: TToolButton;
tbDivCol: TToolButton;
ArrayNavigationBar1: TArrayNavigationBar;
tbDivArray: TToolButton;
BtnAddWatch: TToolButton;
BtnInspect: TToolButton;
BtnEvaluate: TToolButton;
tbDivAdd: TToolButton;
btnEvalHistory: TToolButton;
procedure BtnAddWatchClick(Sender: TObject);
procedure btnBackwardClick(Sender: TObject);
procedure btnColTypeClick(Sender: TObject);
procedure BtnEvaluateClick(Sender: TObject);
procedure btnForwardClick(Sender: TObject);
procedure btnFunctionEvalClick(Sender: TObject);
procedure BtnInspectClick(Sender: TObject);
procedure btnPowerClick(Sender: TObject);
procedure EdInspectChange(Sender: TObject);
procedure EdInspectEditingDone(Sender: TObject);
procedure EdInspectKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FrameResize(Sender: TObject);
procedure MenuItem1Click(Sender: TObject);
procedure BtnExecuteClick(Sender: TObject);
private const
MAX_HISTORY = 1000;
private
FDefaultEvalOpts: TWatcheEvaluateFlags;
FOnAddEvaluateClicked: TNotifyEvent;
FOnAddInspectClicked: TNotifyEvent;
FOnAddWatchClicked: TNotifyEvent;
FOnBeforeEvaluate: TInspectWatchBeforeUdateEvent;
FOnClear: TNotifyEvent;
FOnColumnsChanged: TNotifyEvent;
FOnDisplayFormatChanged: TNotifyEvent;
FOnEvalHistDirectionChanged: TEvalHistDirectionChangedEvent;
FOnWatchUpdated: TInspectWatchUpdatedEvent;
FCurrentWatchValue: TIdeWatchValue;
FEvalHistDirection: TEvalHistDirection;
FExpression: String;
FHistoryListMaxCount: integer;
FHistoryList: TStrings;
FBrowseHistoryIndex: Integer;
FBrowseHistory: TStringList;
FPowerImgIdx, FPowerImgIdxGrey: Integer;
FThreadsMonitor: TIdeThreadsMonitor;
FCallStackMonitor: TIdeCallStackMonitor;
FInspectWatches: TCurrentWatches;
procedure ArrayNavSizeChanged(Sender: TObject);
procedure DoDbpConvMenuClicked(Sender: TObject);
procedure DoDispFormatClicked(Sender: TObject);
function GetButtonDown(AIndex: Integer): Boolean;
function GetButtonEnabled(AIndex: Integer): Boolean;
function GetDisplayFormat: TWatchDisplayFormat;
function GetDropDownOpen: boolean;
function GetExpression: String;
function GetOnArrayNavChanged(AIndex: Integer): TArrayNavChangeEvent;
procedure SetButtonEnabled(AIndex: Integer; AValue: Boolean);
procedure SetHistoryList(AValue: TStrings);
procedure SetOnArrayNavChanged(AIndex: Integer; AValue: TArrayNavChangeEvent);
function GetShowButtons(AIndex: Integer): Boolean;
procedure SetShowButtons(AIndex: Integer; AValue: Boolean);
function DisplayFormatName(ADispFormat: TWatchDisplayFormat): string;
procedure DoDbgOptChanged(Sender: TObject; Restore: boolean);
procedure AddToHistory(AnExpression: String);
procedure DoClear;
procedure DoWatchUpdated(AWatch: TIdeWatch);
protected
procedure VisibleChanged; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure Init(AWatchesMonitor: TIdeWatchesMonitor;
AThreadsMonitor: TIdeThreadsMonitor;
ACallStackMonitor: TIdeCallStackMonitor;
ADefaultEvalOpts: TWatcheEvaluateFlags
);
procedure InitWatch(AWatch: TIdeWatch);
procedure Execute(const AnExpression: ansistring; ASkipHistory: Boolean = False);
procedure UpdateData(AForceClear: Boolean = False);// context changed instead
procedure DoContextChanged;
procedure FocusEnterExpression;
procedure GoPrevBrowseEntry;
procedure GoNextBrowseEntry;
procedure DeleteLastHistoryIf(AnExpression: String);
property Expression: String read GetExpression;
property Watches: TCurrentWatches read FInspectWatches;
property CurrentWatchValue: TIdeWatchValue read FCurrentWatchValue;
property DefaultEvalOpts: TWatcheEvaluateFlags read FDefaultEvalOpts write FDefaultEvalOpts;
property HistoryList: TStrings read FHistoryList write SetHistoryList;
property HistoryListMaxCount: integer read FHistoryListMaxCount write FHistoryListMaxCount;
property DisplayFormat: TWatchDisplayFormat read GetDisplayFormat;
property EvalHistDirection: TEvalHistDirection read FEvalHistDirection;
property DropDownOpen: boolean read GetDropDownOpen;
published
property ShowInspectColumns: Boolean index 0 read GetShowButtons write SetShowButtons;
property ShowArrayNav: Boolean index 1 read GetShowButtons write SetShowButtons;
property ShowAddWatch: Boolean index 2 read GetShowButtons write SetShowButtons;
property ShowAddInspect: Boolean index 3 read GetShowButtons write SetShowButtons;
property ShowAddEval: Boolean index 4 read GetShowButtons write SetShowButtons;
property ShowEvalHist: Boolean index 5 read GetShowButtons write SetShowButtons;
property ShowCallFunction: Boolean index 6 read GetShowButtons write SetShowButtons;
property ShowDisplayFormat: Boolean index 7 read GetShowButtons write SetShowButtons;
property ColClassIsDown: Boolean index 0 read GetButtonDown;
property ColTypeIsDown: Boolean index 1 read GetButtonDown;
property ColVisibilityIsDown: Boolean index 2 read GetButtonDown;
property PowerIsDown: Boolean index 3 read GetButtonDown;
property UseInstanceIsDown: Boolean index 4 read GetButtonDown;
property ColClassEnabled: Boolean index 0 read GetButtonEnabled write SetButtonEnabled;
property ColTypeEnabled: Boolean index 1 read GetButtonEnabled write SetButtonEnabled;
property ColVisibilityEnabled: Boolean index 2 read GetButtonEnabled write SetButtonEnabled;
property OnBeforeEvaluate: TInspectWatchBeforeUdateEvent read FOnBeforeEvaluate write FOnBeforeEvaluate;
property OnWatchUpdated: TInspectWatchUpdatedEvent read FOnWatchUpdated write FOnWatchUpdated;
property OnClear: TNotifyEvent read FOnClear write FOnClear;
property OnColumnsChanged: TNotifyEvent read FOnColumnsChanged write FOnColumnsChanged;
property OnAddWatchClicked: TNotifyEvent read FOnAddWatchClicked write FOnAddWatchClicked;
property OnAddEvaluateClicked: TNotifyEvent read FOnAddEvaluateClicked write FOnAddEvaluateClicked;
property OnAddInspectClicked: TNotifyEvent read FOnAddInspectClicked write FOnAddInspectClicked;
property OnArrayIndexChanged: TArrayNavChangeEvent index 0 read GetOnArrayNavChanged write SetOnArrayNavChanged;
property OnArrayPageSize: TArrayNavChangeEvent index 1 read GetOnArrayNavChanged write SetOnArrayNavChanged;
property OnDisplayFormatChanged: TNotifyEvent read FOnDisplayFormatChanged write FOnDisplayFormatChanged;
property OnEvalHistDirectionChanged: TEvalHistDirectionChangedEvent read FOnEvalHistDirectionChanged write FOnEvalHistDirectionChanged;
end;
implementation
{$R *.lfm}
{ TWatchInspectNav }
function TWatchInspectNav.GetShowButtons(AIndex: Integer): Boolean;
begin
case AIndex of
0: Result := btnColClass.Visible;
1: Result := ArrayNavigationBar1.Visible;
2: Result := BtnAddWatch.Visible;
3: Result := BtnInspect.Visible;
4: Result := BtnEvaluate.Visible;
5: Result := btnEvalHistory.Visible;
6: Result := btnFunctionEval .Visible;
7: Result := btnDisplayFormat.Visible;
end;
end;
procedure TWatchInspectNav.SetOnArrayNavChanged(AIndex: Integer;
AValue: TArrayNavChangeEvent);
begin
case AIndex of
0: ArrayNavigationBar1.OnIndexChanged := AValue;
1: ArrayNavigationBar1.OnPageSize := AValue;
end;
end;
procedure TWatchInspectNav.MenuItem1Click(Sender: TObject);
begin
if Sender = MenuItem3 then begin
FEvalHistDirection := EHDDown;
btnEvalHistory.ImageIndex := IDEImages.LoadImage('callstack_goto');
end
else
if Sender = MenuItem2 then begin
FEvalHistDirection := EHDUp;
btnEvalHistory.ImageIndex := IDEImages.LoadImage('evaluate_up');
end
else begin
FEvalHistDirection := EHDNone;
btnEvalHistory.ImageIndex := IDEImages.LoadImage('evaluate_no_hist');
end;
if FOnEvalHistDirectionChanged <> nil then
FOnEvalHistDirectionChanged(Self, FEvalHistDirection);
FrameResize(nil);
end;
procedure TWatchInspectNav.BtnExecuteClick(Sender: TObject);
begin
DoClear;
ReleaseRefAndNil(FCurrentWatchValue);
FInspectWatches.Clear;
Execute(EdInspect.Text);
end;
procedure TWatchInspectNav.EdInspectKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_RETURN) then
EdInspectEditingDone(nil)
else
if (Key = VK_UP) or (Key = VK_DOWN) then
EdInspect.DroppedDown := True;
end;
procedure TWatchInspectNav.FrameResize(Sender: TObject);
var
w, h: Integer;
begin
ToolBar1.InvalidatePreferredSize;
Height := ToolBar1.Top + ToolBar1.Height;
end;
procedure TWatchInspectNav.EdInspectEditingDone(Sender: TObject);
begin
if FExpression = EdInspect.Text then
exit;
Execute(EdInspect.Text);
end;
procedure TWatchInspectNav.btnColTypeClick(Sender: TObject);
begin
if FOnColumnsChanged <> nil then
FOnColumnsChanged(Self);
end;
procedure TWatchInspectNav.BtnEvaluateClick(Sender: TObject);
begin
if FOnAddEvaluateClicked <> nil then
FOnAddEvaluateClicked(Self);
end;
procedure TWatchInspectNav.btnForwardClick(Sender: TObject);
begin
GoNextBrowseEntry;
end;
procedure TWatchInspectNav.btnFunctionEvalClick(Sender: TObject);
begin
UpdateData;
end;
procedure TWatchInspectNav.BtnInspectClick(Sender: TObject);
begin
if FOnAddInspectClicked <> nil then
FOnAddInspectClicked(Self);
end;
procedure TWatchInspectNav.btnBackwardClick(Sender: TObject);
begin
GoPrevBrowseEntry;
end;
procedure TWatchInspectNav.BtnAddWatchClick(Sender: TObject);
begin
if FOnAddWatchClicked <> nil then
FOnAddWatchClicked(Self);
end;
procedure TWatchInspectNav.btnPowerClick(Sender: TObject);
begin
if btnPower.Down
then begin
btnPower.ImageIndex := FPowerImgIdx;
DoClear; // todo: only get result data released
ReleaseRefAndNil(FCurrentWatchValue);
FInspectWatches.Clear;
UpdateData;
end
else begin
btnPower.ImageIndex := FPowerImgIdxGrey;
end;
end;
procedure TWatchInspectNav.EdInspectChange(Sender: TObject);
begin
BtnExecute.Enabled := EdInspect.Text <> '';
BtnAddWatch.Enabled := EdInspect.Text <> '';
BtnEvaluate.Enabled := EdInspect.Text <> '';
BtnInspect.Enabled := EdInspect.Text <> '';
end;
function TWatchInspectNav.GetOnArrayNavChanged(AIndex: Integer
): TArrayNavChangeEvent;
begin
case AIndex of
0: Result := ArrayNavigationBar1.OnIndexChanged;
1: Result := ArrayNavigationBar1.OnPageSize;
end;
end;
procedure TWatchInspectNav.SetButtonEnabled(AIndex: Integer; AValue: Boolean);
begin
case AIndex of
0: btnColClass.Enabled := AValue;
1: btnColType.Enabled := AValue;
2: btnColVisibility.Enabled := AValue;
end;
end;
function TWatchInspectNav.GetButtonDown(AIndex: Integer): Boolean;
begin
case AIndex of
0: Result := btnColClass.Down;
1: Result := btnColType.Down;
2: Result := btnColVisibility.Down;
3: Result := btnPower.Down;
4: Result := btnUseInstance.Down;
end;
end;
function TWatchInspectNav.GetButtonEnabled(AIndex: Integer): Boolean;
begin
case AIndex of
0: Result := btnColClass.Enabled;
1: Result := btnColType.Enabled;
2: Result := btnColVisibility.Enabled;
end;
end;
function TWatchInspectNav.GetDisplayFormat: TWatchDisplayFormat;
begin
Result := TWatchDisplayFormat(btnDisplayFormat.Tag);
end;
function TWatchInspectNav.GetDropDownOpen: boolean;
begin
Result := EdInspect.Focused and EdInspect.DroppedDown;
end;
function TWatchInspectNav.GetExpression: String;
begin
Result := EdInspect.Text;
end;
procedure TWatchInspectNav.DoDbpConvMenuClicked(Sender: TObject);
begin
btnUseConverter.Tag := TMenuItem(Sender).Tag;
btnUseConverter.Caption := TMenuItem(Sender).Caption;
FrameResize(nil);
UpdateData;
end;
procedure TWatchInspectNav.DoDispFormatClicked(Sender: TObject);
begin
btnDisplayFormat.Caption := TMenuItem(Sender).Caption;
btnDisplayFormat.Tag := TMenuItem(Sender).Tag;
if FOnDisplayFormatChanged <> nil then
FOnDisplayFormatChanged(Self);
FrameResize(nil);
end;
procedure TWatchInspectNav.ArrayNavSizeChanged(Sender: TObject);
begin
FrameResize(nil);
end;
procedure TWatchInspectNav.SetHistoryList(AValue: TStrings);
begin
if FHistoryList = AValue then Exit;
FHistoryList := AValue;
if FHistoryList <> nil then
EdInspect.Items.Assign(FHistoryList);
end;
procedure TWatchInspectNav.SetShowButtons(AIndex: Integer; AValue: Boolean);
begin
case AIndex of
0: begin
btnColClass.Visible := AValue;
btnColType.Visible := AValue;
btnColVisibility.Visible := AValue;
end;
1: ArrayNavigationBar1.Visible := AValue;
2: BtnAddWatch.Visible := AValue;
3: BtnInspect.Visible := AValue;
4: BtnEvaluate.Visible := AValue;
5: btnEvalHistory.Visible := AValue;
6: begin
btnFunctionEval.Visible := AValue;
if not AValue then
btnFunctionEval.Down := False;
end;
7: btnDisplayFormat.Visible := AValue;
end;
tbDivCol.Visible := (ShowInspectColumns or ShowDisplayFormat);
tbDivArray.Visible := (ShowArrayNav);
tbDivAdd.Visible := (ShowAddWatch or ShowAddEval or ShowAddInspect) and
ShowEvalHist;
FrameResize(nil);
end;
function TWatchInspectNav.DisplayFormatName(ADispFormat: TWatchDisplayFormat
): string;
begin
Result := '?';
case ADispFormat of
wdfDefault: Result := dbgDispFormatDefault ;
wdfChar: Result := dbgDispFormatCharacter ;
wdfString: Result := dbgDispFormatString ;
wdfDecimal: Result := dbgDispFormatDecimal ;
wdfUnsigned: Result := dbgDispFormatUnsigned ;
wdfHex: Result := dbgDispFormatHexadecimal ;
wdfBinary: Result := dbgDispFormatBinary ;
wdfFloat: Result := dbgDispFormatFloatingPoin;
wdfPointer: Result := dbgDispFormatPointer ;
wdfStructure: Result := dbgDispFormatRecordStruct;
wdfMemDump: Result := dbgDispFormatMemoryDump ;
end;
end;
procedure TWatchInspectNav.DoDbgOptChanged(Sender: TObject; Restore: boolean);
var
m: TMenuItem;
i: Integer;
begin
popConverter.Items.Clear;
m := TMenuItem.Create(Self);
m.Caption := drsDebugConverter;
m.OnClick := @DoDbpConvMenuClicked;
m.Tag := -2;
popConverter.Items.Add(m);
m := TMenuItem.Create(Self);
m.Caption := drsNoDebugConverter;
m.OnClick := @DoDbpConvMenuClicked;
m.Tag := -1;
popConverter.Items.Add(m);
for i := 0 to DebuggerOptions.FpDbgConverterConfig.Count - 1 do begin
m := TMenuItem.Create(Self);
m.Caption := DebuggerOptions.FpDbgConverterConfig.IdeItems[i].Name;
m.OnClick := @DoDbpConvMenuClicked;
m.Tag := i;
popConverter.Items.Add(m)
end;
btnUseConverter.Visible := DebuggerOptions.FpDbgConverterConfig.Count > 0;
btnUseConverter.Tag := -2;
btnUseConverter.Caption := drsDebugConverter;
FrameResize(nil);
UpdateData;
end;
procedure TWatchInspectNav.AddToHistory(AnExpression: String);
var
i: Integer;
begin
inc(FBrowseHistoryIndex);
while FBrowseHistory.Count > FBrowseHistoryIndex do
FBrowseHistory.Delete(FBrowseHistoryIndex);
while FBrowseHistory.Count > MAX_HISTORY - 1 do
FBrowseHistory.Delete(0);
if (FBrowseHistory.Count = 0) or (FBrowseHistory[FBrowseHistory.Count-1] <> AnExpression)
then
FBrowseHistoryIndex := FBrowseHistory.Add(AnExpression);
if FHistoryList <> nil then begin
if (FHistoryList.Count = 0) or
(UTF8CompareLatinTextFast(FHistoryList[0], AnExpression) <> 0)
then begin
for i:=FHistoryList.Count-1 downto 0 do
if UTF8CompareLatinTextFast(FHistoryList[i], AnExpression) = 0 then
FHistoryList.Delete(i);
FHistoryList.Insert(0, AnExpression);
if FHistoryListMaxCount > 0 then
while FHistoryList.Count > FHistoryListMaxCount do
FHistoryList.Delete(FHistoryList.Count-1);
end;
EdInspect.Items.Assign(FHistoryList);
end
else
EdInspect.Items.Insert(0, AnExpression);
end;
constructor TWatchInspectNav.Create(TheOwner: TComponent);
var
df: TWatchDisplayFormat;
m: TMenuItem;
begin
inherited Create(TheOwner);
FBrowseHistory := TStringList.Create;
EdInspect.TextHint := drsEnterExpression;
ToolBar1.Images := IDEImages.Images_16;
FPowerImgIdx := IDEImages.LoadImage('debugger_power');
FPowerImgIdxGrey := IDEImages.LoadImage('debugger_power_grey');
btnPower.ImageIndex := FPowerImgIdx;
btnPower.Caption := '';
btnPower.Hint := drsDisableEnableUpdatesForTh;
btnBackward.ImageIndex := IDEImages.LoadImage('arrow_left');
btnBackward.Caption := '';
btnForward.ImageIndex := IDEImages.LoadImage('arrow_right');
btnForward.Caption := '';
btnUseInstance.Caption := drsUseInstanceClass;
btnUseInstance.Hint := drsUseInstanceClassHint;
BtnEvaluate.Caption := drsUseFunctionCalls;
BtnEvaluate.Hint := drsUseFunctionCallsHint;
btnColClass.Hint := lisInspectShowColClass;
btnColType.Hint := lisInspectShowColType;
btnColVisibility.Hint := lisInspectShowColVisibility;
BtnAddWatch.ImageIndex := IDEImages.LoadImage('debugger_watches');
BtnAddWatch.Caption := drsAddWatch;
BtnEvaluate.ImageIndex := IDEImages.LoadImage('debugger_evaluate');
BtnEvaluate.Caption := drsEvaluate;
BtnInspect.ImageIndex := IDEImages.LoadImage('debugger_inspect');
BtnInspect.Caption := drsInspect;
btnEvalHistory.Caption := drsHistory;
btnEvalHistory.ImageIndex := IDEImages.LoadImage('evaluate_no_hist');
mnuHistory.Items[0].Caption := drsNoHistoryKept;
mnuHistory.Items[1].Caption := drsInsertResultAtTopOfHistor;
mnuHistory.Items[2].Caption := drsAppendResultAtBottomOfHis;
for df := low(TWatchDisplayFormat) to high(TWatchDisplayFormat) do begin
if df = wdfMemDump then
continue;
m := TMenuItem.Create(Self);
m.Caption := DisplayFormatName(df);
m.Tag := ord(df);
m.OnClick := @DoDispFormatClicked;
popDispForm.Items.Add(m);
end;
btnDisplayFormat.Caption := DisplayFormatName(wdfStructure);
btnDisplayFormat.Tag := Ord(wdfStructure);
btnBackward.Enabled := False;
btnForward.Enabled := False;
btnColClass.Enabled := False;
btnColType.Enabled := False;
btnColVisibility.Enabled := False;
FEvalHistDirection:=EHDNone;
btnBackward.Enabled := False;
btnForward.Enabled := False;
ArrayNavigationBar1.OnSizeChanged := @ArrayNavSizeChanged;
DebuggerOptions.AddHandlerAfterWrite(@DoDbgOptChanged);
DoDbgOptChanged(nil, False);
EdInspectChange(nil);
end;
destructor TWatchInspectNav.Destroy;
begin
DebuggerOptions.RemoveHandlerAfterWrite(@DoDbgOptChanged);
inherited Destroy;
FBrowseHistory.Free;
ReleaseRefAndNil(FCurrentWatchValue);
FreeAndNil(FInspectWatches);
end;
procedure TWatchInspectNav.Init(AWatchesMonitor: TIdeWatchesMonitor;
AThreadsMonitor: TIdeThreadsMonitor; ACallStackMonitor: TIdeCallStackMonitor;
ADefaultEvalOpts: TWatcheEvaluateFlags);
begin
FInspectWatches := TCurrentWatches.Create(AWatchesMonitor);
FCallStackMonitor := ACallStackMonitor;
FThreadsMonitor := AThreadsMonitor;
FDefaultEvalOpts := ADefaultEvalOpts;
end;
procedure TWatchInspectNav.InitWatch(AWatch: TIdeWatch);
var
Opts: TWatcheEvaluateFlags;
Conv: TIdeFpDbgConverterConfig;
begin
Opts := AWatch.EvaluateFlags;
if btnUseInstance.Down then
include(Opts, defClassAutoCast);
if btnFunctionEval.Down then
include(Opts, defAllowFunctionCall);
Conv := nil;
case btnUseConverter.Tag of
-2: ;
-1: include(Opts, defSkipValConv);
otherwise begin
Conv := DebuggerOptions.FpDbgConverterConfig.IdeItems[btnUseConverter.Tag];
end
end;
AWatch.EvaluateFlags := Opts;
AWatch.FpDbgConverter := Conv;
end;
procedure TWatchInspectNav.Execute(const AnExpression: ansistring;
ASkipHistory: Boolean);
begin
if not ASkipHistory then
AddToHistory(AnExpression);
FExpression := AnExpression;
EdInspect.Text := FExpression;
EdInspectChange(nil);
ArrayNavigationBar1.Index := 0;
UpdateData;
end;
procedure TWatchInspectNav.DoContextChanged;
begin
if (not btnPower.Down) or (not Visible) then exit;
UpdateData;
end;
procedure TWatchInspectNav.FocusEnterExpression;
begin
if IsVisible then
EdInspect.SetFocus;
end;
procedure TWatchInspectNav.GoPrevBrowseEntry;
begin
if FBrowseHistoryIndex <= 0 then
exit;
if FBrowseHistoryIndex >= FBrowseHistory.Count then
FBrowseHistoryIndex := FBrowseHistory.Count - 1;
dec(FBrowseHistoryIndex);
Execute(FBrowseHistory[FBrowseHistoryIndex], True);
end;
procedure TWatchInspectNav.GoNextBrowseEntry;
begin
if FBrowseHistoryIndex >= FBrowseHistory.Count -1 then
exit;
if FBrowseHistoryIndex < 0 then
FBrowseHistoryIndex := 0;
inc(FBrowseHistoryIndex);
Execute(FBrowseHistory[FBrowseHistoryIndex], True);
end;
procedure TWatchInspectNav.DeleteLastHistoryIf(AnExpression: String);
begin
if (FBrowseHistory.Count > 0) and (FBrowseHistory[FBrowseHistory.Count-1] = AnExpression)
then
FBrowseHistory.Delete(FBrowseHistory.Count-1);
if (FHistoryList <> nil) and (FHistoryList.Count > 0) and (FHistoryList[0] = AnExpression)
then
FHistoryList.Delete(0);
end;
procedure TWatchInspectNav.UpdateData(AForceClear: Boolean);
var
Opts: TWatcheEvaluateFlags;
AWatch: TCurrentWatch;
tid, idx: Integer;
stack: TIdeCallStack;
expr: String;
Conv: TIdeFpDbgConverterConfig;
begin
if AForceClear then
FInspectWatches.Clear;
btnBackward.Enabled := FBrowseHistoryIndex > 0;
btnForward.Enabled := FBrowseHistoryIndex < FBrowseHistory.Count - 1;
expr := trim(FExpression);
if expr = '' then begin
ReleaseRefAndNil(FCurrentWatchValue);
DoClear;
exit;
end;
if FOnBeforeEvaluate = nil then
exit;
if not FOnBeforeEvaluate(Self) then
exit;
if (FCallStackMonitor = nil) or (FThreadsMonitor = nil)
// or (DebugBoss.State <> dsPause)
then
exit;
tid := FThreadsMonitor.CurrentThreads.CurrentThreadId;
stack := FCallStackMonitor.CurrentCallStackList.EntriesForThreads[tid];
idx := 0;
if stack <> nil then
idx := stack.CurrentIndex;
Opts := FDefaultEvalOpts;
if btnUseInstance.Down then
include(Opts, defClassAutoCast);
if btnFunctionEval.Down then
include(Opts, defAllowFunctionCall);
Conv := nil;
case btnUseConverter.Tag of
-2: ;
-1: include(Opts, defSkipValConv);
otherwise begin
Conv := DebuggerOptions.FpDbgConverterConfig.IdeItems[btnUseConverter.Tag];
end
end;
if (FCurrentWatchValue <> nil) and
(FCurrentWatchValue.Expression = expr) and
(FCurrentWatchValue.EvaluateFlags = Opts) and
(FCurrentWatchValue.ThreadId = tid) and
(FCurrentWatchValue.StackFrame = idx) and
(FCurrentWatchValue.Watch <> nil) and
(FCurrentWatchValue.Watch.FpDbgConverter = Conv)
then begin
FCurrentWatchValue.Value;
DoWatchUpdated(FCurrentWatchValue.Watch);
exit;
end;
ReleaseRefAndNil(FCurrentWatchValue);
FInspectWatches.BeginUpdate;
AWatch := FInspectWatches.Find(expr);
if AWatch = nil then begin
FInspectWatches.Clear;
AWatch := FInspectWatches.Add(expr);
ArrayNavigationBar1.Index := 0;
end;
AWatch.EvaluateFlags := Opts;
AWatch.FpDbgConverter := Conv;
AWatch.Enabled := True;
AWatch.RepeatCount := ArrayNavigationBar1.PageSize;
FInspectWatches.EndUpdate;
FCurrentWatchValue := AWatch.Values[tid, idx];
if FCurrentWatchValue <> nil then begin
FCurrentWatchValue.AddReference;
FCurrentWatchValue.Value;
end;
DoWatchUpdated(AWatch);
end;
procedure TWatchInspectNav.DoClear;
begin
if FOnClear <> nil then
FOnClear(Self);
end;
procedure TWatchInspectNav.DoWatchUpdated(AWatch: TIdeWatch);
begin
if FOnWatchUpdated <> nil then
FOnWatchUpdated(FInspectWatches, AWatch);
end;
procedure TWatchInspectNav.VisibleChanged;
begin
inherited VisibleChanged;
if IsControlVisible then
FrameResize(nil);
end;
end.

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

@ -91,7 +91,12 @@
</Item>
<Item>
<Filename Value="idedebuggerwatchresultjson.pas"/>
<UnitName Value="idedebuggerwatchresultjson"/>
<UnitName Value="IdeDebuggerWatchResultJSon"/>
</Item>
<Item>
<Filename Value="frames\watchinspecttoolbar.pas"/>
<UnitName Value="WatchInspectToolbar"/>
<ResourceBaseClass Value="Frame"/>
</Item>
</Files>
<i18n>

17
ide/packages/idedebugger/idedebuggeropts.pas
View File

@ -37,14 +37,23 @@ type
property FpDbgConverterConfig: TIdeFpDbgConverterConfigList read FFpDbgConverterConfig write FFpDbgConverterConfig;
end;
var
DebuggerOptions: TDebuggerOptions = nil;
function GetDebuggerOptions: TDebuggerOptions;
property DebuggerOptions: TDebuggerOptions read GetDebuggerOptions;
implementation
const
DebuggerOptsConfFileName = 'debuggeroptions.xml';
var
TheDebuggerOptions: TDebuggerOptions = nil;
function GetDebuggerOptions: TDebuggerOptions;
begin
if TheDebuggerOptions = nil then
TheDebuggerOptions := TDebuggerOptions.Create;
Result := TheDebuggerOptions;
end;
{ TDebuggerOptions }
@ -69,6 +78,7 @@ end;
constructor TDebuggerOptions.Create;
begin
inherited Create;
FpDbgConverterConfig := TIdeFpDbgConverterConfigList.Create;
end;
@ -115,7 +125,8 @@ begin
FFilename:=GetDefaultConfigFilename;
end;
finalization
TheDebuggerOptions.Free;
end.

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

@ -13,7 +13,7 @@ uses
IdeDebuggerWatchResUtils, ArrayNavigationFrame, IdeDebuggerStringConstants,
IdeDebuggerFpDbgValueConv, IdeFpDbgValueConverterSettingsFrame,
IdeDebugger_FpValConv_Options, IdeDebuggerOpts, IdeDebuggerWatchResultJSon,
LazarusPackageIntf;
WatchInspectToolbar, LazarusPackageIntf;
implementation

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

@ -21,6 +21,40 @@ resourcestring
dlgIdeDbgEnterName = 'Enter name';
dlgFpConvOptName = 'Name';
drsUseInstanceClass = 'Instance';
drsUseInstanceClassHint = 'Use Instance class type';
drsUseFunctionCalls = 'Function';
drsUseFunctionCallsHint = 'Allow function calls';
drsEnterExpression = 'Enter Expression';
drsAddWatch = 'Add watch';
drsEvaluate = 'Evaluate';
drsInspect = 'Inspect';
drsHistory = 'History';
drsDebugConverter = 'Converter';
drsNoDebugConverter= 'No Converter';
drsDisableEnableUpdatesForTh = 'Disable/Enable updates for the entire window';
drsNoHistoryKept = 'No history kept';
drsInsertResultAtTopOfHistor = 'Insert result at top of history';
drsAppendResultAtBottomOfHis = 'Append result at bottom of history';
lisInspectShowColClass = 'Show class column';
lisInspectShowColType = 'Show type column';
lisInspectShowColVisibility = 'Show visibility column';
drsNewValue = 'New Value';
drsNewValueToAssignToTheVari = 'New value to assign to the variable in the '
+'debugged process. Use shift-enter to confirm';
dbgDispFormatDefault = 'Default';
dbgDispFormatCharacter = 'Character';
dbgDispFormatString = 'String';
dbgDispFormatDecimal = 'Decimal';
dbgDispFormatUnsigned = 'Unsigned';
dbgDispFormatHexadecimal = 'Hexadecimal';
dbgDispFormatFloatingPoin = 'Floating Point';
dbgDispFormatPointer = 'Pointer';
dbgDispFormatRecordStruct = 'Record/Structure';
dbgDispFormatMemoryDump = 'Memory Dump';
dbgDispFormatBinary = 'Binary';
implementation
end.

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

@ -1,6 +1,50 @@
msgid ""
msgstr "Content-Type: text/plain; charset=UTF-8"
#: idedebuggerstringconstants.dbgdispformatbinary
msgid "Binary"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatcharacter
msgid "Character"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatdecimal
msgid "Decimal"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatdefault
msgid "Default"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatfloatingpoin
msgid "Floating Point"
msgstr ""
#: idedebuggerstringconstants.dbgdispformathexadecimal
msgid "Hexadecimal"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatmemorydump
msgid "Memory Dump"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatpointer
msgid "Pointer"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatrecordstruct
msgid "Record/Structure"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatstring
msgid "String"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatunsigned
msgid "Unsigned"
msgstr ""
#: idedebuggerstringconstants.dlgfpconvoptaction
msgid "Action"
msgstr ""
@ -50,3 +94,83 @@ msgstr ""
msgid "Index of first item to show"
msgstr ""
#: idedebuggerstringconstants.drsaddwatch
msgid "Add watch"
msgstr ""
#: idedebuggerstringconstants.drsappendresultatbottomofhis
msgid "Append result at bottom of history"
msgstr ""
#: idedebuggerstringconstants.drsdebugconverter
msgid "Converter"
msgstr ""
#: idedebuggerstringconstants.drsdisableenableupdatesforth
msgid "Disable/Enable updates for the entire window"
msgstr ""
#: idedebuggerstringconstants.drsenterexpression
msgid "Enter Expression"
msgstr ""
#: idedebuggerstringconstants.drsevaluate
msgid "Evaluate"
msgstr ""
#: idedebuggerstringconstants.drshistory
msgid "History"
msgstr ""
#: idedebuggerstringconstants.drsinsertresultattopofhistor
msgid "Insert result at top of history"
msgstr ""
#: idedebuggerstringconstants.drsinspect
msgid "Inspect"
msgstr ""
#: idedebuggerstringconstants.drsnewvalue
msgid "New Value"
msgstr ""
#: idedebuggerstringconstants.drsnewvaluetoassigntothevari
msgid "New value to assign to the variable in the debugged process. Use shift-enter to confirm"
msgstr ""
#: idedebuggerstringconstants.drsnodebugconverter
msgid "No Converter"
msgstr ""
#: idedebuggerstringconstants.drsnohistorykept
msgid "No history kept"
msgstr ""
#: idedebuggerstringconstants.drsusefunctioncalls
msgid "Function"
msgstr ""
#: idedebuggerstringconstants.drsusefunctioncallshint
msgid "Allow function calls"
msgstr ""
#: idedebuggerstringconstants.drsuseinstanceclass
msgid "Instance"
msgstr ""
#: idedebuggerstringconstants.drsuseinstanceclasshint
msgid "Use Instance class type"
msgstr ""
#: idedebuggerstringconstants.lisinspectshowcolclass
msgid "Show class column"
msgstr ""
#: idedebuggerstringconstants.lisinspectshowcoltype
msgid "Show type column"
msgstr ""
#: idedebuggerstringconstants.lisinspectshowcolvisibility
msgid "Show visibility column"
msgstr ""

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

@ -11,6 +11,50 @@ msgstr ""
"Language: ru\n"
"X-Generator: Poedit 2.4.3\n"
#: idedebuggerstringconstants.dbgdispformatbinary
msgid "Binary"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatcharacter
msgid "Character"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatdecimal
msgid "Decimal"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatdefault
msgid "Default"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatfloatingpoin
msgid "Floating Point"
msgstr ""
#: idedebuggerstringconstants.dbgdispformathexadecimal
msgid "Hexadecimal"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatmemorydump
msgid "Memory Dump"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatpointer
msgid "Pointer"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatrecordstruct
msgid "Record/Structure"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatstring
msgid "String"
msgstr ""
#: idedebuggerstringconstants.dbgdispformatunsigned
msgid "Unsigned"
msgstr ""
#: idedebuggerstringconstants.dlgfpconvoptaction
msgid "Action"
msgstr "Действие"
@ -60,3 +104,83 @@ msgstr "Границы: %d .. %d"
msgid "Index of first item to show"
msgstr "Индекс первого показываемого элемента"
#: idedebuggerstringconstants.drsaddwatch
msgid "Add watch"
msgstr ""
#: idedebuggerstringconstants.drsappendresultatbottomofhis
msgid "Append result at bottom of history"
msgstr ""
#: idedebuggerstringconstants.drsdebugconverter
msgid "Converter"
msgstr ""
#: idedebuggerstringconstants.drsdisableenableupdatesforth
msgid "Disable/Enable updates for the entire window"
msgstr ""
#: idedebuggerstringconstants.drsenterexpression
msgid "Enter Expression"
msgstr ""
#: idedebuggerstringconstants.drsevaluate
msgid "Evaluate"
msgstr ""
#: idedebuggerstringconstants.drshistory
msgid "History"
msgstr ""
#: idedebuggerstringconstants.drsinsertresultattopofhistor
msgid "Insert result at top of history"
msgstr ""
#: idedebuggerstringconstants.drsinspect
msgid "Inspect"
msgstr ""
#: idedebuggerstringconstants.drsnewvalue
msgid "New Value"
msgstr ""
#: idedebuggerstringconstants.drsnewvaluetoassigntothevari
msgid "New value to assign to the variable in the debugged process. Use shift-enter to confirm"
msgstr ""
#: idedebuggerstringconstants.drsnodebugconverter
msgid "No Converter"
msgstr ""
#: idedebuggerstringconstants.drsnohistorykept
msgid "No history kept"
msgstr ""
#: idedebuggerstringconstants.drsusefunctioncalls
msgid "Function"
msgstr ""
#: idedebuggerstringconstants.drsusefunctioncallshint
msgid "Allow function calls"
msgstr ""
#: idedebuggerstringconstants.drsuseinstanceclass
msgid "Instance"
msgstr ""
#: idedebuggerstringconstants.drsuseinstanceclasshint
msgid "Use Instance class type"
msgstr ""
#: idedebuggerstringconstants.lisinspectshowcolclass
msgid "Show class column"
msgstr ""
#: idedebuggerstringconstants.lisinspectshowcoltype
msgid "Show type column"
msgstr ""
#: idedebuggerstringconstants.lisinspectshowcolvisibility
msgid "Show visibility column"
msgstr ""