1{ $Id$ }
2{               ----------------------------------------------
3                 registersdlg.pp  -  Overview of registers
4                ----------------------------------------------
5
6 @created(Sun Nov 16th WET 2008)
7 @lastmod($Date$)
8 @author(Marc Weustink <marc@@dommelstein.net>)
9
10 This unit contains the registers debugger dialog.
11
12
13 ***************************************************************************
14 *                                                                         *
15 *   This source is free software; you can redistribute it and/or modify   *
16 *   it under the terms of the GNU General Public License as published by  *
17 *   the Free Software Foundation; either version 2 of the License, or     *
18 *   (at your option) any later version.                                   *
19 *                                                                         *
20 *   This code is distributed in the hope that it will be useful, but      *
21 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
22 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
23 *   General Public License for more details.                              *
24 *                                                                         *
25 *   A copy of the GNU General Public License is available on the World    *
26 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
27 *   obtain it by writing to the Free Software Foundation,                 *
28 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
29 *                                                                         *
30 ***************************************************************************
31}
32unit RegistersDlg;
33
34{$mode objfpc}{$H+}
35
36interface
37
38uses
39  SysUtils, Classes, Types,
40  // LCL
41  Controls, Forms, Clipbrd, ComCtrls, ActnList, Menus, Grids,
42  // LazUtils
43  LazUTF8,
44  // IdeIntf
45  IDEWindowIntf, IDEImagesIntf,
46  // DebuggerIntf
47  DbgIntfDebuggerBase,
48  // IDE
49  BaseDebugManager, LazarusIDEStrConsts, DebuggerStrConst, Debugger, DebuggerDlg;
50
51type
52
53  { TStringGridAllowRightMouse }
54
55  TStringGridAllowRightMouse = class(TStringGrid)
56  protected
57    FAllowRightButton: Boolean;
58    function MouseButtonAllowed(Button: TMouseButton): boolean; override;
59    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
60  end;
61
62  { TRegistersDlg }
63
64  TRegistersDlg = class(TDebuggerDlg)
65    actCopyName: TAction;
66    actCopyValue: TAction;
67    actCopyNameValue: TAction;
68    actCopyAll: TAction;
69    actPower: TAction;
70    ActionList1: TActionList;
71    ImageList1: TImageList;
72    lvRegisters: TStringGridAllowRightMouse;
73    DispDefault: TMenuItem;
74    DispHex: TMenuItem;
75    DispBin: TMenuItem;
76    DispOct: TMenuItem;
77    DispDec: TMenuItem;
78    DispRaw: TMenuItem;
79    popCopyAll: TMenuItem;
80    popCopyNameValue: TMenuItem;
81    PopDispDefault: TMenuItem;
82    PopDispHex: TMenuItem;
83    PopDispBin: TMenuItem;
84    PopDispOct: TMenuItem;
85    PopDispDec: TMenuItem;
86    PopDispRaw: TMenuItem;
87    popCopyValue: TMenuItem;
88    popCopyName: TMenuItem;
89    popFormat: TMenuItem;
90    popL1: TMenuItem;
91    PopupDispType: TPopupMenu;
92    PopupMenu1: TPopupMenu;
93    ToolBar1: TToolBar;
94    ToolButton1: TToolButton;
95    ToolButtonDispType: TToolButton;
96    ToolButtonPower: TToolButton;
97    procedure actCopyAllExecute(Sender: TObject);
98    procedure actCopyNameExecute(Sender: TObject);
99    procedure actCopyNameValueExecute(Sender: TObject);
100    procedure actCopyValueExecute(Sender: TObject);
101    procedure actPowerExecute(Sender: TObject);
102    procedure DispDefaultClick(Sender: TObject);
103    procedure lvRegistersDrawCell(Sender: TObject; aCol, aRow: Integer;
104      aRect: TRect; {%H-}aState: TGridDrawState);
105    procedure lvRegistersSelection(Sender: TObject; {%H-}aCol, {%H-}aRow: Integer);
106    procedure ToolButtonDispTypeClick(Sender: TObject);
107    function GetCurrentRegisters: TRegisters;
108  private
109    FNeedUpdateAgain: Boolean;
110    FPowerImgIdx, FPowerImgIdxGrey: Integer;
111    procedure RegistersChanged(Sender: TObject);
112  protected
113    procedure DoRegistersChanged; override;
114    procedure DoBeginUpdate; override;
115    procedure DoEndUpdate; override;
116    function  ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
117    procedure ColSizeSetter(AColId: Integer; ASize: Integer);
118  public
119    constructor Create(AOwner: TComponent); override;
120    destructor Destroy; override;
121
122    property RegistersMonitor;
123    property ThreadsMonitor;
124    property CallStackMonitor;
125    //property SnapshotManager;
126  end;
127
128
129implementation
130
131{$R *.lfm}
132
133var
134  RegisterDlgWindowCreator: TIDEWindowCreator;
135
136const
137  COL_REGISTER_NAME   = 1;
138  COL_REGISTER_VALUE  = 2;
139  COL_WIDTHS: Array[0..2] of integer = (18, 50, 350);
140
141function RegisterDlgColSizeGetter(AForm: TCustomForm; AColId: Integer; var ASize: Integer): Boolean;
142begin
143  Result := AForm is TRegistersDlg;
144  if Result then
145    Result := TRegistersDlg(AForm).ColSizeGetter(AColId, ASize);
146end;
147
148procedure RegisterDlgColSizeSetter(AForm: TCustomForm; AColId: Integer; ASize: Integer);
149begin
150  if AForm is TRegistersDlg then
151    TRegistersDlg(AForm).ColSizeSetter(AColId, ASize);
152end;
153
154{ TStringGridAllowRightMouse }
155
156function TStringGridAllowRightMouse.MouseButtonAllowed(Button: TMouseButton
157  ): boolean;
158begin
159  Result := inherited MouseButtonAllowed(Button);
160  if (not Result) and (Button = mbRight) then
161    Result := FAllowRightButton;
162end;
163
164procedure TStringGridAllowRightMouse.MouseDown(Button: TMouseButton;
165  Shift: TShiftState; X, Y: Integer);
166var
167  p: TPoint;
168begin
169  FAllowRightButton := False;
170  if Button = mbRight then begin
171    p := MouseToCell(Point(X,Y));
172    FAllowRightButton := not IsCellSelected[p.X, p.Y];
173  end;
174  inherited MouseDown(Button, Shift, X, Y);
175end;
176
177{ TRegistersDlg }
178
179constructor TRegistersDlg.Create(AOwner: TComponent);
180var
181  i: Integer;
182begin
183  inherited Create(AOwner);
184  ThreadsNotification.OnCurrent   := @RegistersChanged;
185  CallstackNotification.OnCurrent := @RegistersChanged;
186  RegistersNotification.OnChange  := @RegistersChanged;
187
188  Caption:= lisRegisters;
189  lvRegisters.Columns[1].Title.Caption:= lisName;
190  lvRegisters.Columns[2].Title.Caption:= lisValue;
191  lvRegisters.RangeSelectMode := rsmMulti;
192
193  ActionList1.Images := IDEImages.Images_16;
194  ToolBar1.Images := IDEImages.Images_16;
195
196  FPowerImgIdx := IDEImages.LoadImage('debugger_power');
197  FPowerImgIdxGrey := IDEImages.LoadImage('debugger_power_grey');
198  actPower.ImageIndex := FPowerImgIdx;
199  //actPower.Caption := lisDbgWinPower;
200  actPower.Hint := lisDbgWinPowerHint;
201
202  actCopyName.Caption := lisLocalsDlgCopyName;
203  actCopyValue.Caption := lisLocalsDlgCopyValue;
204  actCopyNameValue.Caption := lisLocalsDlgCopyNameValue;
205  actCopyAll.Caption := lisLocalsDlgCopyAll;
206
207  ToolButtonDispType.Hint := regdlgDisplayTypeForSelectedRegisters;
208
209  DispDefault.Caption := dlgPasStringKeywordsOptDefault;
210  DispHex.Caption := regdlgHex;
211  DispBin.Caption := regdlgBinary;
212  DispOct.Caption := regdlgOctal;
213  DispDec.Caption := regdlgDecimal;
214  DispRaw.Caption := regdlgRaw;
215  DispDefault.Tag := ord(rdDefault);
216  DispHex.Tag := ord(rdHex);
217  DispBin.Tag := ord(rdBinary);
218  DispOct.Tag := ord(rdOctal);
219  DispDec.Tag := ord(rdDecimal);
220  DispRaw.Tag := ord(rdRaw);
221
222  PopDispDefault.Caption := dlgPasStringKeywordsOptDefault;
223  PopDispHex.Caption := regdlgHex;
224  PopDispBin.Caption := regdlgBinary;
225  PopDispOct.Caption := regdlgOctal;
226  PopDispDec.Caption := regdlgDecimal;
227  PopDispRaw.Caption := regdlgRaw;
228  PopDispDefault.Tag := ord(rdDefault);
229  PopDispHex.Tag := ord(rdHex);
230  PopDispBin.Tag := ord(rdBinary);
231  PopDispOct.Tag := ord(rdOctal);
232  PopDispDec.Tag := ord(rdDecimal);
233  PopDispRaw.Tag := ord(rdRaw);
234
235  popFormat.Caption := regdlgFormat;
236
237  for i := low(COL_WIDTHS) to high(COL_WIDTHS) do
238    lvRegisters.Columns[i].Width := COL_WIDTHS[i];
239end;
240
241destructor TRegistersDlg.Destroy;
242begin
243  inherited Destroy;
244end;
245
246procedure TRegistersDlg.actPowerExecute(Sender: TObject);
247begin
248  if ToolButtonPower.Down
249  then begin
250    actPower.ImageIndex := FPowerImgIdx;
251    ToolButtonPower.ImageIndex := FPowerImgIdx;
252    RegistersChanged(nil);
253  end
254  else begin
255    actPower.ImageIndex := FPowerImgIdxGrey;
256    ToolButtonPower.ImageIndex := FPowerImgIdxGrey;
257  end;
258end;
259
260procedure TRegistersDlg.actCopyNameExecute(Sender: TObject);
261var
262  s: String;
263  i: Integer;
264begin
265  s := '';
266  for i := 1 to lvRegisters.RowCount - 1 do
267    if lvRegisters.IsCellSelected[0,i] then begin
268      if s <> '' then
269        s := s + LineEnding;
270      s := s + lvRegisters.Cells[1, i];
271    end;
272  Clipboard.Open;
273  Clipboard.AsText := s;
274  Clipboard.Close;
275end;
276
277procedure TRegistersDlg.actCopyValueExecute(Sender: TObject);
278var
279  s: String;
280  i: Integer;
281begin
282  s := '';
283  for i := 1 to lvRegisters.RowCount - 1 do
284    if lvRegisters.IsCellSelected[0,i] then begin
285      if s <> '' then
286        s := s + LineEnding;
287      s := s + lvRegisters.Cells[2,i];
288    end;
289  Clipboard.Open;
290  Clipboard.AsText := s;
291  Clipboard.Close;
292end;
293
294procedure TRegistersDlg.actCopyNameValueExecute(Sender: TObject);
295var
296  s: String;
297  i: Integer;
298begin
299  s := '';
300  for i := 1 to lvRegisters.RowCount - 1 do
301    if lvRegisters.IsCellSelected[0,i] then begin
302      if s <> '' then
303        s := s + LineEnding;
304      s := s + lvRegisters.Cells[1, i] + '=' + lvRegisters.Cells[2,i];
305    end;
306  Clipboard.Open;
307  Clipboard.AsText := s;
308  Clipboard.Close;
309end;
310
311procedure TRegistersDlg.actCopyAllExecute(Sender: TObject);
312var
313  s: String;
314  i: Integer;
315begin
316  s := '';
317  for i := 1 to lvRegisters.RowCount - 1 do
318    s := Concat(s, lvRegisters.Cells[1, i], '=', lvRegisters.Cells[2,i], sLineBreak);
319  Clipboard.Open;
320  Clipboard.AsText := s;
321  Clipboard.Close;
322end;
323
324procedure TRegistersDlg.DispDefaultClick(Sender: TObject);
325var
326  n: Integer;
327  Reg: TRegisters;
328  RegVal: TRegisterValue;
329begin
330  ToolButtonPower.Down := True;
331  Reg := GetCurrentRegisters;
332  if Reg = nil then exit;
333
334  for n := 1 to lvRegisters.RowCount - 1 do
335    if lvRegisters.IsCellSelected[0,n] then begin
336      RegVal := Reg.EntriesByName[lvRegisters.Cells[1,n]];
337      if RegVal <> nil then
338        RegVal.DisplayFormat := TRegisterDisplayFormat(TMenuItem(Sender).Tag);
339    end;
340  lvRegistersSelection(nil, -1, -1);
341end;
342
343procedure TRegistersDlg.lvRegistersDrawCell(Sender: TObject; aCol,
344  aRow: Integer; aRect: TRect; aState: TGridDrawState);
345var
346  sz: TSize;
347begin
348  if (aCol = 0) and (aRow > 0) and
349     (lvRegisters.Objects[0, aRow] <> nil)
350  then begin
351    sz := ImageList1.SizeForPPI[ImageList1.Width, Font.PixelsPerInch];
352    ImageList1.DrawForPPI(
353      lvRegisters.Canvas,
354      (aRect.Left + aRect.Right - sz.CX) div 2,
355      (aRect.Top + aRect.Bottom - sz.CY) div 2,
356      0,
357      ImageList1.Width,
358      Font.PixelsPerInch,
359      GetCanvasScaleFactor
360    );
361  end;
362end;
363
364{
365procedure TRegistersDlg.lvRegistersDrawCell(Sender: TObject; aCol,
366  aRow: Integer; aRect: TRect; aState: TGridDrawState);
367begin
368  if (aCol = 0) and (aRow > 0) and
369     (lvRegisters.Objects[0, aRow] <> nil)
370  then begin
371    ImageList1.Draw(lvRegisters.Canvas, (aRect.Left + aRect.Right - ImageList1.Width) div 2,
372                                        (aRect.Top + aRect.Bottom - ImageList1.Height) div 2, 0);
373  end;
374end;
375}
376procedure TRegistersDlg.lvRegistersSelection(Sender: TObject; aCol,
377  aRow: Integer);
378var
379  n, j: Integer;
380  SelFormat: TRegisterDisplayFormat;
381  MultiFormat: Boolean;
382  Reg: TRegisters;
383  RegVal: TRegisterValue;
384begin
385  j := 0;
386  MultiFormat := False;
387  SelFormat := rdDefault;
388  Reg := GetCurrentRegisters;
389  if Reg = nil then exit;
390
391  for n := 1 to lvRegisters.RowCount - 1 do
392    if lvRegisters.IsCellSelected[0,n] then begin
393      RegVal := Reg.EntriesByName[lvRegisters.Cells[1,n]];
394      if RegVal <> nil then begin
395        if j = 0
396        then SelFormat := RegVal.DisplayFormat;
397        inc(j);
398        if SelFormat <> RegVal.DisplayFormat then begin
399          MultiFormat := True;
400          break;
401        end;
402      end;
403    end;
404  ToolButtonDispType.Enabled := j > 0;
405  popFormat.Enabled := j > 0;
406  actCopyName.Enabled := j > 0;
407  actCopyValue.Enabled := j > 0;
408  actCopyNameValue.Enabled := j > 0;
409  actCopyAll.Enabled := lvRegisters.RowCount > 1;
410
411  PopDispDefault.Checked := False;
412  PopDispHex.Checked := False;
413  PopDispBin.Checked := False;
414  PopDispOct.Checked := False;
415  PopDispDec.Checked := False;
416  PopDispRaw.Checked := False;
417  if MultiFormat
418  then ToolButtonDispType.Caption := '...'
419  else begin
420    case SelFormat of
421      rdDefault: begin
422          ToolButtonDispType.Caption := DispDefault.Caption;
423          PopDispDefault.Checked := True;
424        end;
425      rdHex:     begin
426          ToolButtonDispType.Caption := DispHex.Caption;
427          PopDispHex.Checked := True;
428        end;
429      rdBinary:  begin
430          ToolButtonDispType.Caption := DispBin.Caption;
431          PopDispBin.Checked := True;
432        end;
433      rdOctal:   begin
434          ToolButtonDispType.Caption := DispOct.Caption;
435          PopDispOct.Checked := True;
436        end;
437      rdDecimal: begin
438          ToolButtonDispType.Caption := DispDec.Caption;
439          PopDispDec.Checked := True;
440        end;
441      rdRaw:     begin
442          ToolButtonDispType.Caption := DispRaw.Caption;
443          PopDispRaw.Checked := True;
444        end;
445    end;
446  end;
447end;
448
449procedure TRegistersDlg.ToolButtonDispTypeClick(Sender: TObject);
450begin
451  ToolButtonDispType.CheckMenuDropdown;
452end;
453
454function TRegistersDlg.GetCurrentRegisters: TRegisters;
455var
456  CurThreadId, CurStackFrame: Integer;
457begin
458  Result := nil;
459  if (ThreadsMonitor = nil) or
460     (ThreadsMonitor.CurrentThreads = nil) or
461     (CallStackMonitor = nil) or
462     (CallStackMonitor.CurrentCallStackList = nil) or
463     (RegistersMonitor = nil)
464  then
465    exit;
466
467  CurThreadId := ThreadsMonitor.CurrentThreads.CurrentThreadId;
468  if (CallStackMonitor.CurrentCallStackList.EntriesForThreads[CurThreadId] = nil) then
469    exit;
470
471  CurStackFrame := CallStackMonitor.CurrentCallStackList.EntriesForThreads[CurThreadId].CurrentIndex;
472  Result := RegistersMonitor.CurrentRegistersList[CurThreadId, CurStackFrame];
473end;
474
475procedure TRegistersDlg.RegistersChanged(Sender: TObject);
476var
477  n, i, idx, Cnt: Integer;
478  List: TStringListUTF8Fast;
479  Reg: TRegisters;
480begin
481  if (not ToolButtonPower.Down) then exit;
482
483  if IsUpdating then begin
484    FNeedUpdateAgain := True;
485    exit;
486  end;
487  FNeedUpdateAgain := False;
488
489  BeginUpdate;
490  try
491    Reg := GetCurrentRegisters;
492    if (Reg = nil) or (reg.DataValidity<> ddsValid) then begin
493      if (DebugBoss = nil) or not (DebugBoss.State in [dsPause, dsInternalPause, dsRun]) then
494        lvRegisters.RowCount := 1;
495
496      if (reg <> nil) then
497        reg.Count;
498      for n := 1 to lvRegisters.RowCount - 1 do
499        lvRegisters.Cells[2, n] := '<Unavailable>';
500      exit;
501    end;
502
503    List := TStringListUTF8Fast.Create;
504    try
505      //Get existing items
506      for n := 1 to lvRegisters.RowCount - 1 do
507        List.AddObject(lvRegisters.Cells[1,n], TObject(PtrUInt(n)));
508
509      // add/update entries
510      Cnt := Reg.Count;          // Count may trigger changes
511      FNeedUpdateAgain := False; // changes after this point, and we must update again
512
513      for n := 0 to Cnt - 1 do
514      begin
515        idx := List.IndexOf(Reg[n].Name);
516        if idx = -1
517        then begin
518          // New entry
519          i := lvRegisters.RowCount;
520          lvRegisters.RowCount := i + 1;
521          lvRegisters.Cells[1, i] := Reg[n].Name;
522          lvRegisters.Cells[2, i] := Reg[n].Value;
523        end
524        else begin
525          // Existing entry
526          i := PtrUInt(List.Objects[idx]);
527          List.Delete(idx);
528          lvRegisters.Cells[1, i] := Reg[n].Name;
529          lvRegisters.Cells[2, i] := Reg[n].Value;
530        end;
531        if Reg[n].Modified
532        then lvRegisters.Objects[0, i] := TObject(ptruint(1)) //Item.ImageIndex := 0
533        else lvRegisters.Objects[0, i] := nil;  //Item.ImageIndex := -1;
534      end;
535
536      // remove obsolete entries
537      for n := List.Count - 1 downto 0 do
538        lvRegisters.DeleteRow(PtrUInt(List.Objects[n]));
539      lvRegisters.Invalidate;
540
541    finally
542      List.Free;
543    end;
544  finally
545    EndUpdate;
546  end;
547
548  lvRegistersSelection(nil, -1, -1);
549end;
550
551procedure TRegistersDlg.DoRegistersChanged;
552begin
553  RegistersChanged(nil);
554end;
555
556procedure TRegistersDlg.DoBeginUpdate;
557begin
558  {$IFnDEF WINDOWS}
559  lvRegisters.BeginUpdate;
560  {$ENDIF}
561end;
562
563procedure TRegistersDlg.DoEndUpdate;
564begin
565  {$IFnDEF WINDOWS}
566  lvRegisters.EndUpdate;
567  {$ENDIF}
568  if FNeedUpdateAgain then RegistersChanged(nil);
569end;
570
571function TRegistersDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
572begin
573  if (AColId >= 0) and (AColId < lvRegisters.Columns.Count) then begin
574    ASize := lvRegisters.Columns[AColId].Width;
575    Result := ASize <> COL_WIDTHS[AColId];
576  end
577  else
578    Result := False;
579end;
580
581procedure TRegistersDlg.ColSizeSetter(AColId: Integer; ASize: Integer);
582begin
583  case AColId of
584    COL_REGISTER_NAME:   lvRegisters.Columns[1].Width := ASize;
585    COL_REGISTER_VALUE:  lvRegisters.Columns[2].Width := ASize;
586  end;
587end;
588
589initialization
590
591  RegisterDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtRegisters]);
592  RegisterDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
593  RegisterDlgWindowCreator.OnSetDividerSize := @RegisterDlgColSizeSetter;
594  RegisterDlgWindowCreator.OnGetDividerSize := @RegisterDlgColSizeGetter;
595  RegisterDlgWindowCreator.DividerTemplate.Add('RegisterName',  COL_REGISTER_NAME,  @drsColWidthName);
596  RegisterDlgWindowCreator.DividerTemplate.Add('RegisterValue', COL_REGISTER_VALUE, @drsColWidthValue);
597  RegisterDlgWindowCreator.CreateSimpleLayout;
598
599end.
600
601