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