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

DBG: Evaluate, keep previous results. Patch by Ludo Brands. Issue #0022196

Browse Source 
git-svn-id: trunk@37611 -
This commit is contained in:
martin 2012-06-10 22:40:45 +00:00
parent ea1462ce17
commit be4ab40c93
8 changed files with 169 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -4901,6 +4901,8 @@ images/debugger/debugger_power_grey.png -text svneol=unset#images/png
images/debugger/debugger_show_execution_point.png -text svneol=unset#image/png
images/debugger/debugger_source_line.png -text
images/debugger/debugger_watches.png -text svneol=unset#image/png
images/debugger/evaluate_no_hist.png -text
images/debugger/evaluate_up.png -text
images/designer/Order_back_one.png -text
images/designer/Order_forward_one.png -text
images/designer/Order_move_back.png -text

3
debugger/debuggerstrconst.pp
View File

@ -68,6 +68,9 @@ 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';
drsUseInstanceClassType = 'Use Instance class type';
drsLen = 'Len=%d: ';

74
debugger/evaluatedlg.lfm
View File

@ -19,9 +19,9 @@ inherited EvaluateDlg: TEvaluateDlg
AnchorSideTop.Control = ToolBar1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 16
Height = 14
Top = 47
Width = 59
Width = 57
BorderSpacing.Left = 6
BorderSpacing.Top = 3
Caption = '&Expression:'
@ -33,9 +33,9 @@ inherited EvaluateDlg: TEvaluateDlg
AnchorSideTop.Control = cmbExpression
AnchorSideTop.Side = asrBottom
Left = 6
Height = 16
Top = 95
Width = 36
Height = 14
Top = 91
Width = 35
BorderSpacing.Left = 6
BorderSpacing.Top = 6
Caption = '&Result:'
@ -46,9 +46,9 @@ inherited EvaluateDlg: TEvaluateDlg
AnchorSideLeft.Control = Owner
AnchorSideBottom.Control = cmbNewValue
Left = 6
Height = 16
Top = 242
Width = 59
Height = 14
Top = 246
Width = 55
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Bottom = 3
@ -71,7 +71,7 @@ inherited EvaluateDlg: TEvaluateDlg
TabOrder = 0
TabStop = True
object tbInspect: TToolButton
Left = 154
Left = 152
Top = 2
Caption = '&Inspect'
Enabled = False
@ -79,7 +79,7 @@ inherited EvaluateDlg: TEvaluateDlg
OnClick = tbInspectClick
end
object tbWatch: TToolButton
Left = 104
Left = 102
Top = 2
AllowAllUp = True
Caption = '&Watch'
@ -88,7 +88,7 @@ inherited EvaluateDlg: TEvaluateDlg
OnClick = tbWatchClick
end
object tbModify: TToolButton
Left = 54
Left = 52
Top = 2
Caption = '&Modify'
Enabled = False
@ -103,6 +103,20 @@ inherited EvaluateDlg: TEvaluateDlg
ImageIndex = 0
OnClick = tbEvaluateClick
end
object ToolButton1: TToolButton
Left = 202
Top = 2
Width = 10
Caption = 'ToolButton1'
Style = tbsSeparator
end
object tbHistory: TToolButton
Left = 212
Top = 2
Caption = 'History'
DropdownMenu = mnuHistory
Style = tbsDropDown
end
end
object cmbExpression: TComboBox[4]
AnchorSideLeft.Control = Owner
@ -111,14 +125,14 @@ inherited EvaluateDlg: TEvaluateDlg
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 6
Height = 23
Top = 66
Height = 21
Top = 64
Width = 388
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Top = 3
BorderSpacing.Right = 6
ItemHeight = 15
ItemHeight = 13
OnChange = cmbExpressionChange
OnKeyDown = cmbExpressionKeyDown
TabOrder = 2
@ -131,8 +145,8 @@ inherited EvaluateDlg: TEvaluateDlg
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = lblNewValue
Left = 6
Height = 122
Top = 114
Height = 132
Top = 108
Width = 388
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 6
@ -149,14 +163,14 @@ inherited EvaluateDlg: TEvaluateDlg
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 23
Top = 261
Height = 21
Top = 263
Width = 388
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
ItemHeight = 15
ItemHeight = 13
OnKeyDown = cmbNewValueKeyDown
TabOrder = 3
end
@ -165,10 +179,10 @@ inherited EvaluateDlg: TEvaluateDlg
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 306
Height = 19
Left = 312
Height = 17
Top = 46
Width = 88
Width = 82
Anchors = [akTop, akRight]
BorderSpacing.Right = 6
Caption = 'chkTypeCast'
@ -176,4 +190,20 @@ inherited EvaluateDlg: TEvaluateDlg
State = cbChecked
TabOrder = 4
end
object mnuHistory: TPopupMenu[8]
left = 72
top = 136
object MenuItem1: TMenuItem
Caption = 'None'
OnClick = MenuItem1Click
end
object MenuItem2: TMenuItem
Caption = 'Up'
OnClick = MenuItem2Click
end
object MenuItem3: TMenuItem
Caption = 'Down'
OnClick = MenuItem3Click
end
end
end

77
debugger/evaluatedlg.pp
View File

@ -39,11 +39,14 @@ interface
uses
Classes, SysUtils, LCLType, Forms,
IDEWindowIntf, IDEImagesIntf, LazarusIDEStrConsts,
ComCtrls, StdCtrls, DebuggerDlg, BaseDebugManager,
ComCtrls, StdCtrls, Menus, DebuggerDlg, BaseDebugManager,
InputHistory, IDEProcs, Debugger, DebuggerStrConst;
type
TEvalHistDirection=(EHDNone,EHDUp,EHDDown);
{ TEvaluateDlg }
TEvaluateDlg = class(TDebuggerDlg)
@ -53,6 +56,12 @@ type
Label1: TLabel;
Label2: TLabel;
lblNewValue: TLabel;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
mnuHistory: TPopupMenu;
ToolButton1: TToolButton;
tbHistory: TToolButton;
txtResult: TMemo;
ToolBar1: TToolBar;
tbInspect: TToolButton;
@ -68,12 +77,16 @@ type
procedure cmbExpressionChange(Sender: TObject);
procedure cmbExpressionKeyDown(Sender: TObject; var Key: Word;
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
fHistDirection:TEvalHistDirection;
function GetFindText: string;
procedure SetFindText(const NewFindText: string);
procedure Evaluate;
@ -90,6 +103,11 @@ implementation
var
EvaluateDlgWindowCreator: TIDEWindowCreator;
const
RESULTSEPARATOR='-----------';
RESULTEVAL='>>>> ';
RESULTMOD='<<>> ';
{ TEvaluateDlg }
constructor TEvaluateDlg.Create(TheOwner:TComponent);
@ -109,12 +127,18 @@ begin
Label2.Caption := lisDBGEMResult;
lblNewValue.Caption := lisDBGEMNewValue;
chkTypeCast.Caption := drsUseInstanceClassType;
fHistDirection:=EHDNone;
ToolBar1.Images := IDEImages.Images_16;
tbInspect.ImageIndex := IDEImages.LoadImage(16, 'debugger_inspect');
tbWatch.ImageIndex := IDEImages.LoadImage(16, 'debugger_watches');
tbModify.ImageIndex := IDEImages.LoadImage(16, 'debugger_modify');
tbEvaluate.ImageIndex := IDEImages.LoadImage(16, 'debugger_evaluate');
tbHistory.ImageIndex := IDEImages.LoadImage(16, 'evaluate_no_hist');
mnuHistory.Items[0].Caption:=drsEvalHistoryNone;
mnuHistory.Items[1].Caption:=dsrEvalHistoryUp;
mnuHistory.Items[2].Caption:=dsrEvalHistoryDown;
end;
procedure TEvaluateDlg.Evaluate;
@ -142,7 +166,20 @@ begin
else
tbModify.Enabled := False;
FreeAndNil(DBGType);
txtResult.Lines.Text := R;
if fHistDirection<>EHDNone then
begin
if txtResult.Lines.Text='' then
txtResult.Lines.Text := RESULTEVAL+ S+':'+LineEnding+ R + LineEnding
else
if fHistDirection=EHDUp then
txtResult.Lines.Text := RESULTEVAL+ S+':'+LineEnding+ R + LineEnding
+ RESULTSEPARATOR + LineEnding + txtResult.Lines.Text
else
txtResult.Lines.Text := txtResult.Lines.Text + RESULTSEPARATOR + LineEnding
+ RESULTEVAL+ S+':'+LineEnding+ R+LineEnding;
end
else
txtResult.Lines.Text := R;
end;
procedure TEvaluateDlg.cmbExpressionChange(Sender: TObject);
@ -166,6 +203,27 @@ begin
end;
end;
procedure TEvaluateDlg.MenuItem1Click(Sender: TObject);
begin
fHistDirection:=EHDNone;
tbHistory.ImageIndex := IDEImages.LoadImage(16, 'evaluate_no_hist');
txtResult.Lines.Clear;
end;
procedure TEvaluateDlg.MenuItem2Click(Sender: TObject);
begin
fHistDirection:=EHDUp;
tbHistory.ImageIndex := IDEImages.LoadImage(16, 'evaluate_up');
txtResult.Lines.Clear;
end;
procedure TEvaluateDlg.MenuItem3Click(Sender: TObject);
begin
fHistDirection:=EHDDown;
tbHistory.ImageIndex := IDEImages.LoadImage(16, 'callstack_goto');
txtResult.Lines.Clear;
end;
procedure TEvaluateDlg.SetFindText(const NewFindText: string);
begin
if NewFindText<>'' then
@ -199,7 +257,20 @@ begin
DBGType:=nil;
if not DebugBoss.Evaluate(S, R, DBGType) then Exit;
FreeAndNil(DBGType);
txtResult.Lines.Text := R;
if fHistDirection<>EHDNone then
begin
if txtResult.Lines.Text='' then
txtResult.Lines.Text := RESULTMOD+ S+':'+LineEnding+ R + LineEnding
else
if fHistDirection=EHDUp then
txtResult.Lines.Text := RESULTMOD+ S+':'+LineEnding+ R + LineEnding
+ RESULTSEPARATOR + LineEnding + txtResult.Lines.Text
else
txtResult.Lines.Text := txtResult.Lines.Text + RESULTSEPARATOR + LineEnding
+ RESULTMOD+ S+':'+LineEnding+ R+LineEnding;
end
else
txtResult.Lines.Text := R;
end;
procedure TEvaluateDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);

BIN
images/debugger/evaluate_no_hist.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 398 B

BIN
images/debugger/evaluate_up.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 416 B

36
images/laz_images.lrs
View File

@ -10520,6 +10520,42 @@ LazarusResources.Add('debugger_event_log','PNG',[
+#246#147#11't'#16#128#224''''#6#0#164#2'p'#240#27#255#227'#ns'#166#242'8'#0
+#27'@l'#170''''#152#194#31';'#5't|'#158'Bdv'#0#0#0#0'IEND'#174'B`'#130
]);
LazarusResources.Add('evaluate_no_hist','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#16#0#0#0#16#8#6#0#0#0#31#243#255'a'
+#0#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167
+#147#0#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#1'!IDAT8'#203#173
+#146#187'J'#3'A'#20#134#191#217#221#4'E'#2#18#188'&'#224#181#18#209#160'U'
+#192#194'B'#242#16#1'}'#1#193'&'#22#18#236#19'R['#8#10#218#138'h'#227#3#8#178
+#4'l'#4'!'#138#141#10'jT'#180'0}'#220#153#177'q'#133'YE3'#196#175#26#230'0'
+#135#255'2BkM;8'#180#137#247'u'#18#194#238#229#167'r/z'#241#175#22#134#23#183
+'H'#231'7'#127'] '#194#16'+'#229#178'1'#216#189#25'$'#213#219'M '#21#183#245
+'WV'#166#26#198'|'#173'X4'#23#132#204#173#30#240#30'H'#250#146#9'2'#227#253#0
+'Tk'#247'\?'#188#160#148#226'io'#249'g'#5#8#161'-C'#20'F'#136#149'R'#201#168
+#193'of'#200'N'#164'QZ'#179#127'\ci'#164'nZ'#248#166' Bn'#253#136#133#217'Q'
+#148#214#28#158'\r'#182#145#255#227#31'D'#232#234#140#227':'#2#23'AG<f'#223
+#194']"'#203#244'X'#15'Ri'#252#139'Gf'#244'yk-'#132#20#182'}&'#135#146'H'#165
+'9'#189'zf'#167#144#179#179#224#185#14#142#16#224'@<'#230#218'[h'#12#204#3
+#208#12'$RiRoU;'#11#173#242#1'5'#206't'#134#225#206'`'#26#0#0#0#0'IEND'#174
+'B`'#130
]);
LazarusResources.Add('evaluate_up','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#16#0#0#0#16#8#6#0#0#0#31#243#255'a'
+#0#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167
+#147#0#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#1'3IDAT8'#203#181
+#146#189'J'#3'A'#20#133#207#236#204'N'#20#13#200#226'OL$'#254#129' '#193'D'
+#173#2#22#22#146#135#8#232#11#8'6'#177#144#224#3#4'k'#11'AA['#17'm'#2#182#130
+#172#1'-'#132#224'*6QP'#163#162#133#233#215#157#185'V'#9'*'#178#236#18#252
+#170#11#247#22#231#227'\FDh'#7#3'm"Z'#19'c'#225#162#16'1'#0'`'#255#170'0'#188
+#184'}'#150#200'o]'#248#221#180#18'l'#148'J?'#162#236#221#13'V'#227'}='#211
+#158#210#184#175#191'_'#173'L5'#210#223#247'k'#197#226#223#10's'#171#135#242
+#211'SN'#191#21#157#200#140#15#0#0'*'#206'#jOo5'#173'u'#234'e'#127#217#245'U'
+#136'HQ'#142'H'#145#140'Y'#221#16#220#128#193#24'L'#193'a'#10'>$8?'#14#172'`'
+#187#25'd'''#19#208'D88q'#176'4RG '#133'&'#185#245'2-'#204#142'B'#19#225#232
+#244#6#151#155'y'#230#255#7#191#232#234#148#224#6#3#7'C'#135'4'#195#183#240
+#16#205'"='#214#11#165#9#246#245'3f'#168#26'N'#161#176'cS*iAi'#194#249#237'+'
+'v'#11#185'p'#10#205#6'`'#0#210#228#225#21#26#177'y'#0#128#235')(M'#136#127
+'T'#194')'#4#229#11';u'#131'('#138#183#140#235#0#0#0#0'IEND'#174'B`'#130
]);
LazarusResources.Add('pkg_add','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#16#0#0#0#16#8#6#0#0#0#31#243#255'a'
+#0#0#3#31'IDATx^u'#147'mh\E'#24#133#207'nr'#247#163'fi'#26'!5i)B'#27'iI5'#169

2
images/laz_images_list.txt
View File

@ -202,6 +202,8 @@ debugger/debugger_show_execution_point.png
debugger/debugger_source_line.png
debugger/debugger_watches.png
debugger/debugger_event_log.png
debugger/evaluate_no_hist.png
debugger/evaluate_up.png
packages/pkg_add.png
packages/pkg_graph.png
packages/pkg_inherited.png