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

Debugger, Watches: Store column width

Browse Source 
git-svn-id: trunk@32382 -
This commit is contained in:
martin 2011-09-17 13:25:19 +00:00
parent b93cbd8178
commit d0c22113e6
2 changed files with 123 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

128
debugger/debugger.pp
View File

@ -167,16 +167,45 @@ type
{ TDebuggerConfigStore }
(* TODO: maybe revert relations. Create this in Debugger, and call environmentoptions for the configstore only? *)
TDebuggerConfigStore = class
{ TDebuggerConfigStoreBase }
TDebuggerConfigStoreBase = class(TPersistent)
private
FConfigStore: TConfigStorage;
FDebuggerClass: String;
public
property ConfigStore: TConfigStorage read FConfigStore write FConfigStore;
procedure Load;
procedure Save;
procedure Load; virtual;
procedure Save; virtual;
end;
{ TDebuggerWatchesDlgConfig }
TDebuggerWatchesDlgConfig = class(TDebuggerConfigStoreBase)
private
FColumnNameWidth: Integer;
FColumnValueWidth: Integer;
public
constructor Create;
procedure Init;
procedure Load; override;
procedure Save; override;
published
property ColumnNameWidth: Integer read FColumnNameWidth write FColumnNameWidth;
property ColumnValueWidth: Integer read FColumnValueWidth write FColumnValueWidth;
end;
TDebuggerConfigStore = class(TDebuggerConfigStoreBase)
private
FDebuggerClass: String;
FTDebuggerWatchesDlgConfig: TDebuggerWatchesDlgConfig;
public
procedure Load; override;
procedure Save; override;
public
constructor Create;
destructor Destroy; override;
property DebuggerClass: String read FDebuggerClass write FDebuggerClass;
property DlgWatchesConfig: TDebuggerWatchesDlgConfig read FTDebuggerWatchesDlgConfig;
end;
{ TRefCountedObject }
@ -2863,40 +2892,89 @@ begin
Result:=bpaStop;
end;
{ TDebuggerWatchesDlgConfig }
constructor TDebuggerWatchesDlgConfig.Create;
begin
Init;
end;
procedure TDebuggerWatchesDlgConfig.Init;
begin
FColumnNameWidth := -1;
FColumnValueWidth := -1;
end;
procedure TDebuggerWatchesDlgConfig.Load;
begin
Init;
ConfigStore.ReadObject('', self);
end;
procedure TDebuggerWatchesDlgConfig.Save;
begin
ConfigStore.WriteObject('', self);
end;
{ TDebuggerConfigStoreBase }
procedure TDebuggerConfigStoreBase.Load;
begin
//
end;
procedure TDebuggerConfigStoreBase.Save;
begin
//
end;
{ TDebuggerConfigStore }
procedure TDebuggerConfigStore.Load;
type
TDebuggerType = (dtNone, dtGnuDebugger, dtSSHGNUDebugger);
const
DebuggerName: array[TDebuggerType] of string = (
'(None)','GNU debugger (gdb)', 'GNU debugger through SSH (gdb)'
);
function DebuggerNameToType(const s: string): TDebuggerType;
begin
for Result:=Low(TDebuggerType) to High(TDebuggerType) do
if CompareText(DebuggerName[Result],s)=0 then exit;
Result:=dtNone;
end;
OLD_GDB_DBG_NAME = 'GNU debugger (gdb)';
OLD_SSH_DBG_NAME = 'GNU debugger through SSH (gdb)';
var
OldDebuggerType: TDebuggerType;
s: String;
begin
FDebuggerClass := FConfigStore.GetValue('Class', '');
FDebuggerClass := ConfigStore.GetValue('Class', '');
if FDebuggerClass='' then begin
// try old format
OldDebuggerType := DebuggerNameToType(FConfigStore.GetValue('Type', ''));
if OldDebuggerType=dtGnuDebugger then
FDebuggerClass:='TGDBMIDEBUGGER';
s := ConfigStore.GetValue('Type', '');
if s = OLD_GDB_DBG_NAME then FDebuggerClass:='TGDBMIDEBUGGER';
if s = OLD_SSH_DBG_NAME then FDebuggerClass:='TSSHGDBMIDEBUGGER';
end;
ConfigStore.AppendBasePath('WatchesDlg/');
try
FTDebuggerWatchesDlgConfig.ConfigStore := ConfigStore;
FTDebuggerWatchesDlgConfig.Load;
finally
ConfigStore.UndoAppendBasePath;
end;
end;
procedure TDebuggerConfigStore.Save;
begin
FConfigStore.SetDeleteValue('Class', FDebuggerClass, '');
FConfigStore.DeletePath('Type');
ConfigStore.SetDeleteValue('Class', FDebuggerClass, '');
ConfigStore.DeletePath('Type');
ConfigStore.AppendBasePath('WatchesDlg/');
try
FTDebuggerWatchesDlgConfig.ConfigStore := ConfigStore;
FTDebuggerWatchesDlgConfig.Save;
finally
ConfigStore.UndoAppendBasePath;
end;
end;
constructor TDebuggerConfigStore.Create;
begin
FTDebuggerWatchesDlgConfig := TDebuggerWatchesDlgConfig.Create;
end;
destructor TDebuggerConfigStore.Destroy;
begin
inherited Destroy;
FreeAndNil(FTDebuggerWatchesDlgConfig);
end;
{ TDebuggerUnitInfoProvider }

21
debugger/watchesdlg.pp
View File

@ -40,7 +40,7 @@ interface
uses
Classes, SysUtils, LCLProc, Forms, Controls, Graphics, Dialogs, math,
StdCtrls, Buttons, Menus, ComCtrls, LCLType, ActnList, IDEImagesIntf,
LazarusIDEStrConsts, Debugger, DebuggerDlg, BaseDebugManager;
EnvironmentOpts, LazarusIDEStrConsts, Debugger, DebuggerDlg, BaseDebugManager;
type
@ -108,6 +108,7 @@ type
function GetWatches: TWatches;
procedure ContextChanged(Sender: TObject);
procedure SnapshotChanged(Sender: TObject);
procedure SaveColumnWidths;
private
FWatchesInView: TWatches;
FPowerImgIdx, FPowerImgIdxGrey: Integer;
@ -340,18 +341,27 @@ begin
end;
procedure TWatchesDlg.FormShow(Sender: TObject);
var
Conf: TDebuggerWatchesDlgConfig;
begin
UpdateAll;
Conf := EnvironmentOptions.DebuggerConfig.DlgWatchesConfig;
if Conf.ColumnNameWidth > 0 then
lvWatches.Column[0].Width := Conf.ColumnNameWidth;
if Conf.ColumnValueWidth > 0 then
lvWatches.Column[1].Width := Conf.ColumnValueWidth;
end;
procedure TWatchesDlg.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
//DebugLn('TWatchesDlg.FormCloseQuery ',dbgs(CanClose));
SaveColumnWidths;
end;
procedure TWatchesDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
//DebugLn('TWatchesDlg.FormClose ',dbgs(ord(CloseAction)));
SaveColumnWidths;
end;
procedure TWatchesDlg.actPowerExecute(Sender: TObject);
@ -453,6 +463,15 @@ begin
end;
end;
procedure TWatchesDlg.SaveColumnWidths;
var
Conf: TDebuggerWatchesDlgConfig;
begin
Conf := EnvironmentOptions.DebuggerConfig.DlgWatchesConfig;
Conf.ColumnNameWidth := lvWatches.Column[0].Width;
Conf.ColumnValueWidth := lvWatches.Column[1].Width;
end;
function TWatchesDlg.GetWatches: TWatches;
var
Snap: TSnapshot;