← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to debugger/registersdlg.pp

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
debugger/registersdlg.pp
1
 
{ $Id: registersdlg.pp 23459 2010-01-15 02:41:46Z paul $ }
 
1
{ $Id: registersdlg.pp 37200 2012-05-06 12:33:51Z martin $ }
2
2
{               ----------------------------------------------  
3
3
                 registersdlg.pp  -  Overview of registers 
4
4
                ---------------------------------------------- 
5
5
 
6
6
 @created(Sun Nov 16th WET 2008)
7
 
 @lastmod($Date: 2010-01-15 02:41:46 +0000 (Fri, 15 Jan 2010) $)
 
7
 @lastmod($Date: 2012-05-06 14:33:51 +0200 (Sun, 06 May 2012) $)
8
8
 @author(Marc Weustink <marc@@dommelstein.net>)                       
9
9
 
10
10
 This unit contains the registers debugger dialog.
36
36
interface
37
37
 
38
38
uses
39
 
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
40
 
  ComCtrls, Debugger, DebuggerDlg;
 
39
  SysUtils, Classes, Controls, Forms, Clipbrd,
 
40
  BaseDebugManager, IDEWindowIntf, DebuggerStrConst,
 
41
  ComCtrls, ActnList, Menus, Debugger, DebuggerDlg,
 
42
  LazarusIDEStrConsts, IDEImagesIntf;
41
43
 
42
44
type
43
45
 
44
46
  { TRegistersDlg }
45
47
 
46
48
  TRegistersDlg = class(TDebuggerDlg)
 
49
    actCopyName: TAction;
 
50
    actCopyValue: TAction;
 
51
    actPower: TAction;
 
52
    ActionList1: TActionList;
47
53
    ImageList1: TImageList;
48
54
    lvRegisters: TListView;
 
55
    DispDefault: TMenuItem;
 
56
    DispHex: TMenuItem;
 
57
    DispBin: TMenuItem;
 
58
    DispOct: TMenuItem;
 
59
    DispDec: TMenuItem;
 
60
    DispRaw: TMenuItem;
 
61
    PopDispDefault: TMenuItem;
 
62
    PopDispHex: TMenuItem;
 
63
    PopDispBin: TMenuItem;
 
64
    PopDispOct: TMenuItem;
 
65
    PopDispDec: TMenuItem;
 
66
    PopDispRaw: TMenuItem;
 
67
    popCopyValue: TMenuItem;
 
68
    popCopyName: TMenuItem;
 
69
    popFormat: TMenuItem;
 
70
    popL1: TMenuItem;
 
71
    PopupDispType: TPopupMenu;
 
72
    PopupMenu1: TPopupMenu;
 
73
    ToolBar1: TToolBar;
 
74
    ToolButton1: TToolButton;
 
75
    ToolButtonDispType: TToolButton;
 
76
    ToolButtonPower: TToolButton;
 
77
    procedure actCopyNameExecute(Sender: TObject);
 
78
    procedure actCopyValueExecute(Sender: TObject);
 
79
    procedure actPowerExecute(Sender: TObject);
 
80
    procedure DispDefaultClick(Sender: TObject);
 
81
    procedure lvRegistersSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
 
82
    procedure ToolButtonDispTypeClick(Sender: TObject);
49
83
  private
50
84
    FRegisters: TIDERegisters;
51
85
    FRegistersNotification: TIDERegistersNotification;
 
86
    FPowerImgIdx, FPowerImgIdxGrey: Integer;
52
87
    procedure RegistersChanged(Sender: TObject);
53
88
    procedure SetRegisters(const AValue: TIDERegisters);
 
89
    function IndexOfName(AName: String): Integer;
54
90
  protected
55
91
    procedure DoBeginUpdate; override;
56
92
    procedure DoEndUpdate; override;
 
93
    function  ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
 
94
    procedure ColSizeSetter(AColId: Integer; ASize: Integer);
57
95
  public
58
96
    constructor Create(AOwner: TComponent); override;
59
97
    destructor Destroy; override;
66
104
 
67
105
{$R *.lfm}
68
106
 
69
 
uses
70
 
  LazarusIDEStrConsts;
71
 
  
 
107
var
 
108
  RegisterDlgWindowCreator: TIDEWindowCreator;
 
109
 
 
110
const
 
111
  COL_REGISTER_NAME   = 1;
 
112
  COL_REGISTER_VALUE  = 2;
 
113
  COL_WIDTHS: Array[0..1] of integer = ( 150, 50);
 
114
 
 
115
function RegisterDlgColSizeGetter(AForm: TCustomForm; AColId: Integer; var ASize: Integer): Boolean;
 
116
begin
 
117
  Result := AForm is TRegistersDlg;
 
118
  if Result then
 
119
    Result := TRegistersDlg(AForm).ColSizeGetter(AColId, ASize);
 
120
end;
 
121
 
 
122
procedure RegisterDlgColSizeSetter(AForm: TCustomForm; AColId: Integer; ASize: Integer);
 
123
begin
 
124
  if AForm is TRegistersDlg then
 
125
    TRegistersDlg(AForm).ColSizeSetter(AColId, ASize);
 
126
end;
 
127
 
72
128
{ TRegistersDlg }
73
129
 
74
130
constructor TRegistersDlg.Create(AOwner: TComponent);
 
131
var
 
132
  i: Integer;
75
133
begin
76
134
  inherited Create(AOwner);
77
135
  FRegistersNotification := TIDERegistersNotification.Create;
78
136
  FRegistersNotification.AddReference;
79
137
  FRegistersNotification.OnChange := @RegistersChanged;
80
138
  Caption:= lisRegisters;
81
 
  lvRegisters.Columns[0].Caption:= lisRegistersDlgName;
82
 
  lvRegisters.Columns[1].Caption:= lisRegistersDlgValue;
 
139
  lvRegisters.Columns[0].Caption:= lisName;
 
140
  lvRegisters.Columns[1].Caption:= lisValue;
 
141
 
 
142
  ActionList1.Images := IDEImages.Images_16;
 
143
  ToolBar1.Images := IDEImages.Images_16;
 
144
 
 
145
  FPowerImgIdx := IDEImages.LoadImage(16, 'debugger_power');
 
146
  FPowerImgIdxGrey := IDEImages.LoadImage(16, 'debugger_power_grey');
 
147
  actPower.ImageIndex := FPowerImgIdx;
 
148
  //actPower.Caption := lisDbgWinPower;
 
149
  actPower.Hint := lisDbgWinPowerHint;
 
150
 
 
151
  actCopyName.Caption := lisLocalsDlgCopyName;
 
152
  actCopyValue.Caption := lisLocalsDlgCopyValue;
 
153
 
 
154
  ToolButtonDispType.Hint := regdlgDisplayTypeForSelectedRegisters;
 
155
 
 
156
  DispDefault.Caption := dlgPasStringKeywordsOptDefault;
 
157
  DispHex.Caption := regdlgHex;
 
158
  DispBin.Caption := regdlgBinary;
 
159
  DispOct.Caption := regdlgOctal;
 
160
  DispDec.Caption := regdlgDecimal;
 
161
  DispRaw.Caption := regdlgRaw;
 
162
  DispDefault.Tag := ord(rdDefault);
 
163
  DispHex.Tag := ord(rdHex);
 
164
  DispBin.Tag := ord(rdBinary);
 
165
  DispOct.Tag := ord(rdOctal);
 
166
  DispDec.Tag := ord(rdDecimal);
 
167
  DispRaw.Tag := ord(rdRaw);
 
168
 
 
169
  PopDispDefault.Caption := dlgPasStringKeywordsOptDefault;
 
170
  PopDispHex.Caption := regdlgHex;
 
171
  PopDispBin.Caption := regdlgBinary;
 
172
  PopDispOct.Caption := regdlgOctal;
 
173
  PopDispDec.Caption := regdlgDecimal;
 
174
  PopDispRaw.Caption := regdlgRaw;
 
175
  PopDispDefault.Tag := ord(rdDefault);
 
176
  PopDispHex.Tag := ord(rdHex);
 
177
  PopDispBin.Tag := ord(rdBinary);
 
178
  PopDispOct.Tag := ord(rdOctal);
 
179
  PopDispDec.Tag := ord(rdDecimal);
 
180
  PopDispRaw.Tag := ord(rdRaw);
 
181
 
 
182
  popFormat.Caption := regdlgFormat;
 
183
 
 
184
  actCopyName.Caption := lisLocalsDlgCopyName;
 
185
  actCopyValue.Caption := lisLocalsDlgCopyValue;
 
186
 
 
187
  for i := low(COL_WIDTHS) to high(COL_WIDTHS) do
 
188
    lvRegisters.Column[i].Width := COL_WIDTHS[i];
83
189
end;
84
190
 
85
191
destructor TRegistersDlg.Destroy;
90
196
  inherited Destroy;
91
197
end;
92
198
 
 
199
procedure TRegistersDlg.actPowerExecute(Sender: TObject);
 
200
begin
 
201
  if ToolButtonPower.Down
 
202
  then begin
 
203
    actPower.ImageIndex := FPowerImgIdx;
 
204
    ToolButtonPower.ImageIndex := FPowerImgIdx;
 
205
    RegistersChanged(nil);
 
206
  end
 
207
  else begin
 
208
    actPower.ImageIndex := FPowerImgIdxGrey;
 
209
    ToolButtonPower.ImageIndex := FPowerImgIdxGrey;
 
210
  end;
 
211
end;
 
212
 
 
213
procedure TRegistersDlg.actCopyNameExecute(Sender: TObject);
 
214
begin
 
215
  Clipboard.Open;
 
216
  Clipboard.AsText := lvRegisters.Selected.Caption;
 
217
  Clipboard.Close;
 
218
end;
 
219
 
 
220
procedure TRegistersDlg.actCopyValueExecute(Sender: TObject);
 
221
begin
 
222
  Clipboard.Open;
 
223
  Clipboard.AsText := lvRegisters.Selected.SubItems[0];
 
224
  Clipboard.Close;
 
225
end;
 
226
 
 
227
procedure TRegistersDlg.DispDefaultClick(Sender: TObject);
 
228
var
 
229
  n, i: Integer;
 
230
  Item: TListItem;
 
231
begin
 
232
  ToolButtonPower.Down := True;
 
233
  FRegisters.BeginUpdate;
 
234
  try
 
235
    for n := 0 to lvRegisters.Items.Count -1 do
 
236
    begin
 
237
      Item := lvRegisters.Items[n];
 
238
      if Item.Selected then begin
 
239
        i := IndexOfName(Item.Caption);
 
240
        if i >= 0
 
241
        then FRegisters.Formats[i] := TRegisterDisplayFormat(TMenuItem(Sender).Tag);
 
242
      end;
 
243
    end;
 
244
  finally
 
245
    FRegisters.EndUpdate;
 
246
  end;
 
247
  lvRegistersSelectItem(nil, nil, True);
 
248
end;
 
249
 
 
250
procedure TRegistersDlg.lvRegistersSelectItem(Sender: TObject; Item: TListItem;
 
251
  Selected: Boolean);
 
252
var
 
253
  n, i, j: Integer;
 
254
  SelFormat: TRegisterDisplayFormat;
 
255
  MultiFormat: Boolean;
 
256
begin
 
257
  j := 0;
 
258
  MultiFormat := False;
 
259
  SelFormat := rdDefault;
 
260
  for n := 0 to lvRegisters.Items.Count -1 do
 
261
  begin
 
262
    Item := lvRegisters.Items[n];
 
263
    if Item.Selected then begin
 
264
      i := IndexOfName(Item.Caption);
 
265
      if i >= 0 then begin
 
266
        if j = 0
 
267
        then SelFormat := FRegisters.Formats[i];
 
268
        inc(j);
 
269
        if SelFormat <> FRegisters.Formats[i] then begin
 
270
          MultiFormat := True;
 
271
          break;
 
272
        end;
 
273
      end;
 
274
    end;
 
275
  end;
 
276
  ToolButtonDispType.Enabled := j > 0;
 
277
  popFormat.Enabled := j > 0;
 
278
  actCopyName.Enabled := j > 0;
 
279
  actCopyValue.Enabled := j > 0;
 
280
 
 
281
  PopDispDefault.Checked := False;
 
282
  PopDispHex.Checked := False;
 
283
  PopDispBin.Checked := False;
 
284
  PopDispOct.Checked := False;
 
285
  PopDispDec.Checked := False;
 
286
  PopDispRaw.Checked := False;
 
287
  if MultiFormat
 
288
  then ToolButtonDispType.Caption := '...'
 
289
  else begin
 
290
    case SelFormat of
 
291
      rdDefault: begin
 
292
          ToolButtonDispType.Caption := DispDefault.Caption;
 
293
          PopDispDefault.Checked := True;
 
294
        end;
 
295
      rdHex:     begin
 
296
          ToolButtonDispType.Caption := DispHex.Caption;
 
297
          PopDispHex.Checked := True;
 
298
        end;
 
299
      rdBinary:  begin
 
300
          ToolButtonDispType.Caption := DispBin.Caption;
 
301
          PopDispBin.Checked := True;
 
302
        end;
 
303
      rdOctal:   begin
 
304
          ToolButtonDispType.Caption := DispOct.Caption;
 
305
          PopDispOct.Checked := True;
 
306
        end;
 
307
      rdDecimal: begin
 
308
          ToolButtonDispType.Caption := DispDec.Caption;
 
309
          PopDispDec.Checked := True;
 
310
        end;
 
311
      rdRaw:     begin
 
312
          ToolButtonDispType.Caption := DispRaw.Caption;
 
313
          PopDispRaw.Checked := True;
 
314
        end;
 
315
    end;
 
316
  end;
 
317
end;
 
318
 
 
319
procedure TRegistersDlg.ToolButtonDispTypeClick(Sender: TObject);
 
320
begin
 
321
  ToolButtonDispType.CheckMenuDropdown;
 
322
end;
 
323
 
93
324
procedure TRegistersDlg.RegistersChanged(Sender: TObject);
94
325
var
95
 
  n, idx: Integer;                               
 
326
  n, idx: Integer;
96
327
  List: TStringList;
97
328
  Item: TListItem;
98
329
  S: String;
99
 
begin                                        
 
330
begin
 
331
  if (not ToolButtonPower.Down) then exit;
 
332
 
100
333
  List := TStringList.Create;
101
334
  try
102
335
    BeginUpdate;
148
381
  finally
149
382
    List.Free;
150
383
  end;
 
384
  lvRegistersSelectItem(nil, nil, True);
151
385
end;
152
386
 
153
387
procedure TRegistersDlg.SetRegisters(const AValue: TIDERegisters);
174
408
  end;
175
409
end;
176
410
 
 
411
function TRegistersDlg.IndexOfName(AName: String): Integer;
 
412
begin
 
413
  Result := FRegisters.Count - 1;
 
414
  while (Result >= 0) and (FRegisters.Names[Result] <> AName) do dec(Result);
 
415
end;
 
416
 
177
417
procedure TRegistersDlg.DoBeginUpdate;
178
418
begin
179
419
  lvRegisters.BeginUpdate;
184
424
  lvRegisters.EndUpdate;
185
425
end;
186
426
 
 
427
function TRegistersDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
 
428
begin
 
429
  if (AColId - 1 >= 0) and (AColId - 1 < lvRegisters.ColumnCount) then begin
 
430
    ASize := lvRegisters.Column[AColId - 1].Width;
 
431
    Result := ASize <> COL_WIDTHS[AColId - 1];
 
432
  end
 
433
  else
 
434
    Result := False;
 
435
end;
 
436
 
 
437
procedure TRegistersDlg.ColSizeSetter(AColId: Integer; ASize: Integer);
 
438
begin
 
439
  case AColId of
 
440
    COL_REGISTER_NAME:   lvRegisters.Column[0].Width := ASize;
 
441
    COL_REGISTER_VALUE:  lvRegisters.Column[1].Width := ASize;
 
442
  end;
 
443
end;
 
444
 
 
445
initialization
 
446
 
 
447
  RegisterDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtRegisters]);
 
448
  RegisterDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
 
449
  RegisterDlgWindowCreator.OnSetDividerSize := @RegisterDlgColSizeSetter;
 
450
  RegisterDlgWindowCreator.OnGetDividerSize := @RegisterDlgColSizeGetter;
 
451
  RegisterDlgWindowCreator.DividerTemplate.Add('RegisterName',  COL_REGISTER_NAME,  @drsColWidthName);
 
452
  RegisterDlgWindowCreator.DividerTemplate.Add('RegisterValue', COL_REGISTER_VALUE, @drsColWidthValue);
 
453
  RegisterDlgWindowCreator.CreateSimpleLayout;
 
454
 
187
455
end.
188
456