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

Debugger-Config: Allow "named" configs for the debugger.

Browse Source 
git-svn-id: trunk@61548 -
This commit is contained in:
martin 2019-07-08 23:01:18 +00:00
parent b37a477c7e
commit 358ce23913
16 changed files with 1593 additions and 518 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -5961,6 +5961,8 @@ debugger/exceptiondlg.lfm svneol=native#text/plain
debugger/exceptiondlg.pas svneol=native#text/pascal
debugger/feedbackdlg.lfm svneol=native#text/plain
debugger/feedbackdlg.pp svneol=native#text/pascal
debugger/frames/debugger_class_options.lfm svneol=native#text/plain
debugger/frames/debugger_class_options.pas svneol=native#text/pascal
debugger/frames/debugger_eventlog_options.lfm svneol=native#text/plain
debugger/frames/debugger_eventlog_options.pas svneol=native#text/pascal
debugger/frames/debugger_general_options.lfm svneol=native#text/plain

54
components/debuggerintf/dbgintfdebuggerbase.pp
View File

@ -1895,7 +1895,7 @@ type
// debugger properties
class function CreateProperties: TDebuggerProperties; virtual; // Creates debuggerproperties
class function GetProperties: TDebuggerProperties; // Get the current properties
class procedure SetProperties(const AProperties: TDebuggerProperties); // Set the current properties
//class procedure SetProperties(const AProperties: TDebuggerProperties); // Set the current properties
(* TODO:
This method is a workaround for http://bugs.freepascal.org/view.php?id=21834
@ -1988,6 +1988,8 @@ type
end;
TDebuggerClass = class of TDebuggerIntf;
{ TBaseDebugManagerIntf }
TBaseDebugManagerIntf = class(TComponent)
public type
TStringFunction = function(const aValue: string): string;
@ -1997,10 +1999,11 @@ type
function ValueFormatterKey(const aSymbolKind: TDBGSymbolKind;
const aTypeName: string): string;
protected
function GetDebuggerClass(const AIndex: Integer): TDebuggerClass;
class function GetDebuggerClass(const AIndex: Integer): TDebuggerClass;static;
class function GetDebuggerClassByName(const AIndex: String): TDebuggerClass; static;
function FindDebuggerClass(const Astring: String): TDebuggerClass;
public
function DebuggerCount: Integer;
class function DebuggerCount: Integer;
procedure RegisterValueFormatter(const aSymbolKind: TDBGSymbolKind;
const aTypeName: string; const aFunc: TStringFunction);
@ -2008,6 +2011,8 @@ type
const aTypeName, aValue: string): string;
function FormatValue(const aDBGType: TDBGType;
const aValue: string): string;
class property Debuggers[const AIndex: Integer]: TDebuggerClass read GetDebuggerClass;
class property DebuggersByClassName[const AIndex: String]: TDebuggerClass read GetDebuggerClassByName;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -2062,7 +2067,8 @@ var
procedure RegisterDebugger(const ADebuggerClass: TDebuggerClass);
begin
MDebuggerClasses.AddObject(ADebuggerClass.ClassName, TObject(Pointer(ADebuggerClass)));
if MDebuggerClasses.IndexOfObject(TObject(Pointer(ADebuggerClass))) < 0 then
MDebuggerClasses.AddObject(ADebuggerClass.ClassName, TObject(Pointer(ADebuggerClass)));
end;
function MinDbgPtr(a, b: TDBGPtr): TDBGPtr;
@ -6229,17 +6235,17 @@ begin
SetState(dsIdle);
end;
class procedure TDebuggerIntf.SetProperties(const AProperties: TDebuggerProperties);
var
Props: TDebuggerProperties;
begin
if AProperties = nil then Exit;
Props := GetProperties;
if Props = AProperties then Exit;
if Props = nil then Exit; // they weren't created ?
Props.Assign(AProperties);
end;
//class procedure TDebuggerIntf.SetProperties(const AProperties: TDebuggerProperties);
//var
// Props: TDebuggerProperties;
//begin
// if AProperties = nil then Exit;
// Props := GetProperties;
// if Props = AProperties then Exit;
//
// if Props = nil then Exit; // they weren't created ?
// Props.Assign(AProperties);
//end;
class function TDebuggerIntf.RequiresLocalExecutable: Boolean;
begin
@ -6370,7 +6376,7 @@ begin
FValueFormatterList.Duplicates := dupError;
end;
function TBaseDebugManagerIntf.DebuggerCount: Integer;
class function TBaseDebugManagerIntf.DebuggerCount: Integer;
begin
Result := MDebuggerClasses.Count;
end;
@ -6414,11 +6420,25 @@ begin
Result := FormatValue(aDBGType.Kind, aDBGType.TypeName, aValue);
end;
function TBaseDebugManagerIntf.GetDebuggerClass(const AIndex: Integer): TDebuggerClass;
class function TBaseDebugManagerIntf.GetDebuggerClass(const AIndex: Integer): TDebuggerClass;
begin
Result := TDebuggerClass(MDebuggerClasses.Objects[AIndex]);
end;
class function TBaseDebugManagerIntf.GetDebuggerClassByName(const AIndex: String
): TDebuggerClass;
var
i: Integer;
begin
i := MDebuggerClasses.Count - 1;
while i >= 0 do begin
if LowerCase(TDebuggerClass(MDebuggerClasses.Objects[i]).ClassName) = LowerCase(AIndex) then
exit(TDebuggerClass(MDebuggerClasses.Objects[i]));
dec(i);
end;
Result := nil;
end;
procedure TBaseDebugManagerIntf.RegisterValueFormatter(
const aSymbolKind: TDBGSymbolKind; const aTypeName: string;
const aFunc: TStringFunction);

1
components/ideintf/ideoptionsintf.pas
View File

@ -198,6 +198,7 @@ const
GroupDebugger = 400;
DbgOptionsGeneral = 100;
DbgOptionsClass = 150;
DbgOptionsEventLog = 200;
DbgOptionsLanguageExceptions = 300;
DbgOptionsSignals = 400;

58
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

@ -7687,34 +7687,36 @@ end;
procedure TGDBMIDebuggerPropertiesBase.Assign(Source: TPersistent);
begin
inherited Assign(Source);
FGDBOptions := TGDBMIDebuggerPropertiesBase(Source).FGDBOptions;
{$IFDEF UNIX}
FConsoleTty := TGDBMIDebuggerPropertiesBase(Source).FConsoleTty;
{$ENDIF}
FMaxDisplayLengthForString := TGDBMIDebuggerPropertiesBase(Source).FMaxDisplayLengthForString;
FMaxDisplayLengthForStaticArray := TGDBMIDebuggerPropertiesBase(Source).FMaxDisplayLengthForStaticArray;
FMaxLocalsLengthForStaticArray := TGDBMIDebuggerPropertiesBase(Source).FMaxLocalsLengthForStaticArray;
FTimeoutForEval := TGDBMIDebuggerPropertiesBase(Source).FTimeoutForEval;
FWarnOnTimeOut := TGDBMIDebuggerPropertiesBase(Source).FWarnOnTimeOut;
FWarnOnInternalError := TGDBMIDebuggerPropertiesBase(Source).FWarnOnInternalError;
FEncodeCurrentDirPath := TGDBMIDebuggerPropertiesBase(Source).FEncodeCurrentDirPath;
FEncodeExeFileName := TGDBMIDebuggerPropertiesBase(Source).FEncodeExeFileName;
FInternalStartBreak := TGDBMIDebuggerPropertiesBase(Source).FInternalStartBreak;
FUseAsyncCommandMode := TGDBMIDebuggerPropertiesBase(Source).FUseAsyncCommandMode;
FDisableLoadSymbolsForLibraries := TGDBMIDebuggerPropertiesBase(Source).FDisableLoadSymbolsForLibraries;
FUseNoneMiRunCommands := TGDBMIDebuggerPropertiesBase(Source).FUseNoneMiRunCommands;
FDisableForcedBreakpoint := TGDBMIDebuggerPropertiesBase(Source).FDisableForcedBreakpoint;
FWarnOnSetBreakpointError := TGDBMIDebuggerPropertiesBase(Source).FWarnOnSetBreakpointError;
FCaseSensitivity := TGDBMIDebuggerPropertiesBase(Source).FCaseSensitivity;
FGdbValueMemLimit := TGDBMIDebuggerPropertiesBase(Source).FGdbValueMemLimit;
FGdbLocalsValueMemLimit := TGDBMIDebuggerPropertiesBase(Source).FGdbLocalsValueMemLimit;
FAssemblerStyle := TGDBMIDebuggerPropertiesBase(Source).FAssemblerStyle;
FDisableStartupShell := TGDBMIDebuggerPropertiesBase(Source).FDisableStartupShell;
FFixStackFrameForFpcAssert := TGDBMIDebuggerPropertiesBase(Source).FFixStackFrameForFpcAssert;
FFixIncorrectStepOver := TGDBMIDebuggerPropertiesBase(Source).FFixIncorrectStepOver;
{$IFdef MSWindows}
FAggressiveWaitTime := TGDBMIDebuggerPropertiesBase(Source).FAggressiveWaitTime;
{$EndIf}
if Source is TGDBMIDebuggerPropertiesBase then begin
FGDBOptions := TGDBMIDebuggerPropertiesBase(Source).FGDBOptions;
{$IFDEF UNIX}
FConsoleTty := TGDBMIDebuggerPropertiesBase(Source).FConsoleTty;
{$ENDIF}
FMaxDisplayLengthForString := TGDBMIDebuggerPropertiesBase(Source).FMaxDisplayLengthForString;
FMaxDisplayLengthForStaticArray := TGDBMIDebuggerPropertiesBase(Source).FMaxDisplayLengthForStaticArray;
FMaxLocalsLengthForStaticArray := TGDBMIDebuggerPropertiesBase(Source).FMaxLocalsLengthForStaticArray;
FTimeoutForEval := TGDBMIDebuggerPropertiesBase(Source).FTimeoutForEval;
FWarnOnTimeOut := TGDBMIDebuggerPropertiesBase(Source).FWarnOnTimeOut;
FWarnOnInternalError := TGDBMIDebuggerPropertiesBase(Source).FWarnOnInternalError;
FEncodeCurrentDirPath := TGDBMIDebuggerPropertiesBase(Source).FEncodeCurrentDirPath;
FEncodeExeFileName := TGDBMIDebuggerPropertiesBase(Source).FEncodeExeFileName;
FInternalStartBreak := TGDBMIDebuggerPropertiesBase(Source).FInternalStartBreak;
FUseAsyncCommandMode := TGDBMIDebuggerPropertiesBase(Source).FUseAsyncCommandMode;
FDisableLoadSymbolsForLibraries := TGDBMIDebuggerPropertiesBase(Source).FDisableLoadSymbolsForLibraries;
FUseNoneMiRunCommands := TGDBMIDebuggerPropertiesBase(Source).FUseNoneMiRunCommands;
FDisableForcedBreakpoint := TGDBMIDebuggerPropertiesBase(Source).FDisableForcedBreakpoint;
FWarnOnSetBreakpointError := TGDBMIDebuggerPropertiesBase(Source).FWarnOnSetBreakpointError;
FCaseSensitivity := TGDBMIDebuggerPropertiesBase(Source).FCaseSensitivity;
FGdbValueMemLimit := TGDBMIDebuggerPropertiesBase(Source).FGdbValueMemLimit;
FGdbLocalsValueMemLimit := TGDBMIDebuggerPropertiesBase(Source).FGdbLocalsValueMemLimit;
FAssemblerStyle := TGDBMIDebuggerPropertiesBase(Source).FAssemblerStyle;
FDisableStartupShell := TGDBMIDebuggerPropertiesBase(Source).FDisableStartupShell;
FFixStackFrameForFpcAssert := TGDBMIDebuggerPropertiesBase(Source).FFixStackFrameForFpcAssert;
FFixIncorrectStepOver := TGDBMIDebuggerPropertiesBase(Source).FFixIncorrectStepOver;
{$IFdef MSWindows}
FAggressiveWaitTime := TGDBMIDebuggerPropertiesBase(Source).FAggressiveWaitTime;
{$EndIf}
end;
end;

8
components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas
View File

@ -558,9 +558,11 @@ end;
procedure TLldbDebuggerProperties.Assign(Source: TPersistent);
begin
inherited Assign(Source);
FLaunchNewTerminal := TLldbDebuggerProperties(Source).FLaunchNewTerminal;
FSkipGDBDetection := TLldbDebuggerProperties(Source).FSkipGDBDetection;
FIgnoreLaunchWarnings := TLldbDebuggerProperties(Source).FIgnoreLaunchWarnings;
if Source is TLldbDebuggerProperties then begin
FLaunchNewTerminal := TLldbDebuggerProperties(Source).FLaunchNewTerminal;
FSkipGDBDetection := TLldbDebuggerProperties(Source).FSkipGDBDetection;
FIgnoreLaunchWarnings := TLldbDebuggerProperties(Source).FIgnoreLaunchWarnings;
end;
end;
{ TLldbDebuggerCommandRun }

12
debugger/debugger.pp
View File

@ -98,7 +98,6 @@ type
TDebuggerConfigStore = class(TDebuggerConfigStoreBase)
private
FDebuggerClass: String;
FDlgCallStackConfig: TDebuggerCallStackDlgConfig;
FTDebuggerWatchesDlgConfig: TDebuggerWatchesDlgConfig;
public
@ -107,7 +106,6 @@ type
public
constructor Create;
destructor Destroy; override;
property DebuggerClass: String read FDebuggerClass write FDebuggerClass;
property DlgWatchesConfig: TDebuggerWatchesDlgConfig read FTDebuggerWatchesDlgConfig;
property DlgCallStackConfig: TDebuggerCallStackDlgConfig read FDlgCallStackConfig write FDlgCallStackConfig;
published
@ -1966,17 +1964,8 @@ procedure TDebuggerConfigStore.Load;
const
OLD_GDB_DBG_NAME = 'GNU debugger (gdb)';
OLD_SSH_DBG_NAME = 'GNU debugger through SSH (gdb)';
var
s: String;
begin
inherited;
FDebuggerClass := ConfigStore.GetValue('Class', '');
if FDebuggerClass='' then begin
// try old format
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;
@ -1996,7 +1985,6 @@ end;
procedure TDebuggerConfigStore.Save;
begin
inherited;
ConfigStore.SetDeleteValue('Class', FDebuggerClass, '');
ConfigStore.DeletePath('Type');
ConfigStore.AppendBasePath('WatchesDlg/');
try

244
debugger/frames/debugger_class_options.lfm Normal file
View File

@ -0,0 +1,244 @@
object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
Left = 0
Height = 427
Top = 0
Width = 519
ClientHeight = 427
ClientWidth = 519
TabOrder = 0
Visible = False
DesignLeft = 812
DesignTop = 313
object ToolBar1: TToolBar
Left = 0
Height = 26
Top = 0
Width = 519
ButtonHeight = 22
ButtonWidth = 60
DropDownWidth = 12
EdgeBorders = [ebBottom]
ShowCaptions = True
TabOrder = 0
object tbSelect: TToolButton
Left = 1
Top = 0
Caption = 'tbSelect'
DropdownMenu = tbDropMenu
OnClick = tbSelectClick
Style = tbsDropDown
end
object tbAddNew: TToolButton
Left = 78
Top = 0
Caption = 'tbAddNew'
OnClick = tbAddNewClick
end
object tbCopy: TToolButton
Left = 143
Top = 0
Caption = 'tbCopy'
OnClick = tbCopyClick
end
object ToolButton2: TToolButton
Left = 203
Height = 22
Top = 0
Caption = 'ToolButton2'
Style = tbsDivider
end
object tbDelete: TToolButton
Left = 208
Top = 0
Caption = 'tbDelete'
OnClick = tbDeleteClick
end
object ToolButton3: TToolButton
Left = 73
Height = 22
Top = 0
Caption = 'ToolButton3'
Style = tbsDivider
end
end
object Panel1: TPanel
Left = 0
Height = 401
Top = 26
Width = 519
Align = alClient
BevelOuter = bvNone
ClientHeight = 401
ClientWidth = 519
TabOrder = 1
object lblName: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = edName
AnchorSideTop.Side = asrCenter
Left = 10
Height = 15
Top = 10
Width = 45
BorderSpacing.Left = 10
Caption = 'lblName'
ParentColor = False
end
object edName: TEdit
AnchorSideLeft.Control = lblName
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 61
Height = 23
Top = 6
Width = 448
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Top = 6
BorderSpacing.Right = 10
OnEditingDone = edNameExit
OnExit = edNameExit
TabOrder = 0
end
object gbDebuggerType: TGroupBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = edName
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 0
Height = 84
Top = 35
Width = 519
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 6
Caption = 'Debugger type and path'
ClientHeight = 64
ClientWidth = 515
TabOrder = 1
object cmbDebuggerType: TComboBox
AnchorSideLeft.Control = gbDebuggerType
AnchorSideTop.Control = gbDebuggerType
AnchorSideRight.Control = gbDebuggerType
AnchorSideRight.Side = asrBottom
Left = 6
Height = 23
Top = 6
Width = 503
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
ItemHeight = 15
OnEditingDone = cmbDebuggerTypeEditingDone
OnSelect = cmbDebuggerTypeEditingDone
Style = csDropDownList
TabOrder = 0
end
object cmbDebuggerPath: TComboBox
AnchorSideLeft.Control = gbDebuggerType
AnchorSideTop.Control = cmbDebuggerType
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = cmdOpenDebuggerPath
Left = 6
Height = 23
Top = 35
Width = 480
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Top = 6
BorderSpacing.Bottom = 6
ItemHeight = 15
OnEditingDone = cmbDebuggerPathEditingDone
OnEnter = cmbDebuggerPathEditingDone
TabOrder = 1
end
object cmdOpenDebuggerPath: TButton
AnchorSideTop.Control = cmbDebuggerPath
AnchorSideRight.Control = gbDebuggerType
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = cmbDebuggerPath
AnchorSideBottom.Side = asrBottom
Left = 486
Height = 23
Top = 35
Width = 23
Anchors = [akTop, akRight, akBottom]
BorderSpacing.Right = 6
Caption = '…'
OnClick = cmdOpenDebuggerPathClick
TabOrder = 2
end
end
object gbAdditionalSearchPath: TGroupBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = gbDebuggerType
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 0
Height = 55
Top = 125
Width = 519
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 6
Caption = 'Additional search path'
ClientHeight = 35
ClientWidth = 515
TabOrder = 2
Visible = False
object txtAdditionalPath: TEdit
AnchorSideLeft.Control = gbAdditionalSearchPath
AnchorSideTop.Control = gbAdditionalSearchPath
AnchorSideRight.Control = cmdOpenAdditionalPath
Left = 6
Height = 23
Top = 6
Width = 480
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Top = 6
BorderSpacing.Bottom = 6
TabOrder = 0
end
object cmdOpenAdditionalPath: TButton
AnchorSideTop.Control = txtAdditionalPath
AnchorSideRight.Control = gbAdditionalSearchPath
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = txtAdditionalPath
AnchorSideBottom.Side = asrBottom
Left = 486
Height = 23
Top = 6
Width = 23
Anchors = [akTop, akRight, akBottom]
BorderSpacing.Right = 6
Caption = '…'
OnClick = cmdOpenAdditionalPathClick
TabOrder = 1
end
end
object gbDebuggerSpecific: TGroupBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = gbAdditionalSearchPath
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Panel1
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 215
Top = 186
Width = 519
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 6
Caption = 'Debugger specific options (depends on type of debugger)'
TabOrder = 3
end
end
object tbDropMenu: TPopupMenu
left = 294
top = 5
end
end

636
debugger/frames/debugger_class_options.pas Normal file
View File

@ -0,0 +1,636 @@
{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
}
unit debugger_class_options;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, TypInfo,
// LCL
Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs, ComCtrls, Menus,
// LazUtils
FileUtil, LazFileUtils, LazStringUtils, LazFileCache, LazLoggerBase,
// DebuggerIntf
DbgIntfDebuggerBase,
// IdeIntf
PropEdits, ObjectInspector, IDEOptionsIntf, IDEOptEditorIntf, IDEUtils,
GDBMIDebugger,
// IDE
TransferMacros, LazarusIDEStrConsts, PathEditorDlg, IDEProcs, DialogProcs,
InputHistory, EnvironmentOpts, BaseDebugManager, Debugger;
type
{ TDebuggerClassOptionsFrame }
TDebuggerClassOptionsFrame = class(TAbstractIDEOptionsEditor)
cmbDebuggerPath: TComboBox;
cmbDebuggerType: TComboBox;
cmdOpenAdditionalPath: TButton;
cmdOpenDebuggerPath: TButton;
edName: TEdit;
gbAdditionalSearchPath: TGroupBox;
gbDebuggerSpecific: TGroupBox;
gbDebuggerType: TGroupBox;
lblName: TLabel;
Panel1: TPanel;
tbDropMenu: TPopupMenu;
ToolBar1: TToolBar;
tbSelect: TToolButton;
tbAddNew: TToolButton;
ToolButton2: TToolButton;
tbDelete: TToolButton;
tbCopy: TToolButton;
ToolButton3: TToolButton;
txtAdditionalPath: TEdit;
procedure cmbDebuggerPathEditingDone(Sender: TObject);
procedure cmbDebuggerTypeEditingDone(Sender: TObject);
procedure cmdOpenAdditionalPathClick(Sender: TObject);
procedure cmdOpenDebuggerPathClick(Sender: TObject);
procedure edNameExit(Sender: TObject);
procedure tbAddNewClick(Sender: TObject);
procedure tbCopyClick(Sender: TObject);
procedure tbDeleteClick(Sender: TObject);
procedure tbSelectClick(Sender: TObject);
private
FInOdNameExit: Boolean;
PropertyGrid: TOIPropertyGrid;
FPropertyEditorHook: TPropertyEditorHook;
FCopiedDbgPropertiesConfigList: TDebuggerPropertiesConfigList;
FSelectedDbgPropertiesConfig: TDebuggerPropertiesConfig;
FLastCheckedDebuggerPath: String;
function SelectedDebuggerClass: TDebuggerClass; // currently shown debugger class
function SelectedDebuggerProperties: TDebuggerProperties;
procedure DoNameSelected(Sender: TObject);
procedure FillDebuggerClassDropDown;
procedure UpdateDebuggerClass;
procedure UpdateDebuggerClassDropDown;
procedure FetchDebuggerSpecificOptions;
function GetDebuggerClassFromDropDown: TDebuggerClass;
function GetUniqueName(AName: String): String;
procedure ClearDbgProperties;
procedure FillNameDropDown;
procedure HookGetCheckboxForBoolean(var Value: Boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Check: Boolean; override;
function GetTitle: String; override;
procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
procedure ReadSettings({%H-}AOptions: TAbstractIDEOptions); override;
procedure WriteSettings({%H-}AOptions: TAbstractIDEOptions); override;
class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
end;
implementation
{$R *.lfm}
{ TDebuggerClassOptionsFrame }
procedure TDebuggerClassOptionsFrame.cmbDebuggerPathEditingDone(Sender: TObject
);
var
ParsedFName: String;
begin
if FSelectedDbgPropertiesConfig = nil then
exit;
if assigned(SelectedDebuggerClass) and SelectedDebuggerClass.NeedsExePath and
(FSelectedDbgPropertiesConfig.DebuggerFilename <> cmbDebuggerPath.Text) and
(FLastCheckedDebuggerPath <> cmbDebuggerPath.Text)
then begin
FLastCheckedDebuggerPath := cmbDebuggerPath.Text;
ParsedFName := EnvironmentOptions.GetParsedValue(eopDebuggerFilename, FLastCheckedDebuggerPath);
if ParsedFName = '' then
ParsedFName := FLastCheckedDebuggerPath;
DebugLn(['############### ',ParsedFName]);
if not CheckExecutable(FSelectedDbgPropertiesConfig.DebuggerFilename, ParsedFName,
lisEnvOptDlgInvalidDebuggerFilename,
lisEnvOptDlgInvalidDebuggerFilenameMsg)
then
exit;
end;
DebugLn(['<<<<<<<<<< ###### ',FSelectedDbgPropertiesConfig.DebuggerFilename ,' << ', cmbDebuggerPath.Text]);
FSelectedDbgPropertiesConfig.DebuggerFilename := cmbDebuggerPath.Text;
end;
procedure TDebuggerClassOptionsFrame.cmdOpenAdditionalPathClick(
Sender: TObject);
begin
PathEditorDialog.Path:=txtAdditionalPath.Text;
PathEditorDialog.Templates:=GetForcedPathDelims(
'$(LazarusDir)/include/$(TargetOS)'
+';$(FPCSrcDir)/rtl/inc/'
+';$(FPCSrcDir)/rtl/$(SrcOS)'
+';$(FPCSrcDir)/rtl/$(TargetOS)'
);
if PathEditorDialog.ShowModal=mrOk then
txtAdditionalPath.Text:=PathEditorDialog.Path;
end;
procedure TDebuggerClassOptionsFrame.cmdOpenDebuggerPathClick(Sender: TObject);
var
OpenDialog: TOpenDialog;
AFilename, ParsedFName: string;
begin
if FSelectedDbgPropertiesConfig = nil then
exit;
OpenDialog:=TOpenDialog.Create(nil);
try
InputHistories.ApplyFileDialogSettings(OpenDialog);
OpenDialog.Options:=OpenDialog.Options+[ofPathMustExist];
OpenDialog.Title:=lisChooseDebuggerExecutable;
if OpenDialog.Execute then begin
AFilename:=CleanAndExpandFilename(OpenDialog.Filename);
ParsedFName := EnvironmentOptions.GetParsedValue(eopDebuggerFilename, AFilename);
if ParsedFName = '' then
ParsedFName := AFilename;
if CheckExecutable(FSelectedDbgPropertiesConfig.DebuggerFilename, ParsedFName,
lisEnvOptDlgInvalidDebuggerFilename,
lisEnvOptDlgInvalidDebuggerFilenameMsg)
then begin
SetComboBoxText(cmbDebuggerPath,AFilename,cstFilename);
FSelectedDbgPropertiesConfig.DebuggerFilename := AFilename;
end;
end;
InputHistories.StoreFileDialogSettings(OpenDialog);
finally
OpenDialog.Free;
end;
end;
procedure TDebuggerClassOptionsFrame.edNameExit(Sender: TObject);
var
n: String;
i: Integer;
begin
if FSelectedDbgPropertiesConfig = nil then
exit;
try
FInOdNameExit := True;
n := GetUniqueName(edName.Text);
if n <> edName.Text then
edName.Text := n;
if FSelectedDbgPropertiesConfig.ConfigName <> n then begin
FSelectedDbgPropertiesConfig.ConfigName := n;
i := FCopiedDbgPropertiesConfigList.IndexOfObject(FSelectedDbgPropertiesConfig);
FCopiedDbgPropertiesConfigList[i] := n;
FillNameDropDown;
end;
finally
FInOdNameExit := False;
end;
end;
procedure TDebuggerClassOptionsFrame.tbAddNewClick(Sender: TObject);
begin
edNameExit(nil);
UpdateDebuggerClass;
cmbDebuggerPathEditingDone(nil);
FSelectedDbgPropertiesConfig := TDebuggerPropertiesConfig.CreateForDebuggerClass(TGDBMIDebugger);
FSelectedDbgPropertiesConfig.ConfigName := GetUniqueName(lisNew);
FCopiedDbgPropertiesConfigList.AddObject(FSelectedDbgPropertiesConfig.ConfigName, FSelectedDbgPropertiesConfig);
FillNameDropDown;
UpdateDebuggerClassDropDown;
FetchDebuggerSpecificOptions;
end;
procedure TDebuggerClassOptionsFrame.tbCopyClick(Sender: TObject);
var
pc: TDebuggerPropertiesConfig;
s: String;
begin
if FSelectedDbgPropertiesConfig = nil then
exit;
edNameExit(nil);
UpdateDebuggerClass;
cmbDebuggerPathEditingDone(nil);
pc := FSelectedDbgPropertiesConfig;
s := pc.ConfigName;
if s = '' then
s := lisNew;
FSelectedDbgPropertiesConfig := TDebuggerPropertiesConfig.CreateCopy(pc);
FSelectedDbgPropertiesConfig.ConfigName := GetUniqueName(s);
FCopiedDbgPropertiesConfigList.AddObject(FSelectedDbgPropertiesConfig.ConfigName, FSelectedDbgPropertiesConfig);
FillNameDropDown;
UpdateDebuggerClassDropDown;
FetchDebuggerSpecificOptions;
end;
procedure TDebuggerClassOptionsFrame.tbDeleteClick(Sender: TObject);
var
i: Integer;
begin
if FSelectedDbgPropertiesConfig = nil then
exit;
i := FCopiedDbgPropertiesConfigList.IndexOfObject(FSelectedDbgPropertiesConfig);
FSelectedDbgPropertiesConfig.MarkAsDeleted;
FCopiedDbgPropertiesConfigList[i] := ''; // remove from named part of list
FillNameDropDown;
UpdateDebuggerClassDropDown;
FetchDebuggerSpecificOptions;
end;
procedure TDebuggerClassOptionsFrame.tbSelectClick(Sender: TObject);
begin
tbSelect.CheckMenuDropdown;
end;
function TDebuggerClassOptionsFrame.SelectedDebuggerClass: TDebuggerClass;
begin
if FSelectedDbgPropertiesConfig = nil then
Result := nil
else
Result := FSelectedDbgPropertiesConfig.DebuggerClass;
end;
function TDebuggerClassOptionsFrame.SelectedDebuggerProperties: TDebuggerProperties;
begin
if FSelectedDbgPropertiesConfig = nil then
Result := nil
else
Result := FSelectedDbgPropertiesConfig.DebuggerProperties;
end;
procedure TDebuggerClassOptionsFrame.FillDebuggerClassDropDown;
var
List: TStringList;
i: Integer;
d: TDebuggerClass;
begin
List := TStringList.Create;
for i := 0 to TBaseDebugManagerIntf.DebuggerCount - 1 do begin
d := TBaseDebugManagerIntf.Debuggers[i];
List.AddObject(d.Caption, TObject(d));
end;
List.Sorted := True;
cmbDebuggerType.Items.Assign(List);
FreeAndNil(List);
UpdateDebuggerClassDropDown;
end;
procedure TDebuggerClassOptionsFrame.cmbDebuggerTypeEditingDone(
Sender: TObject);
begin
UpdateDebuggerClass;
FetchDebuggerSpecificOptions;
end;
procedure TDebuggerClassOptionsFrame.UpdateDebuggerClass;
var
c: TDebuggerClass;
begin
if FSelectedDbgPropertiesConfig = nil then
exit;
c := GetDebuggerClassFromDropDown;
if SelectedDebuggerClass = c then
exit;
FSelectedDbgPropertiesConfig.ChangeDebuggerClass(c, True);
// TOOD: Ask user?
FSelectedDbgPropertiesConfig.ConfigName := GetUniqueName(FSelectedDbgPropertiesConfig.ConfigName);
try
FInOdNameExit := True;
edName.Text := FSelectedDbgPropertiesConfig.ConfigName;
finally
FInOdNameExit := False;
end;
FillNameDropDown;
end;
procedure TDebuggerClassOptionsFrame.UpdateDebuggerClassDropDown;
begin
if SelectedDebuggerClass = nil
then SetComboBoxText(cmbDebuggerType, '(none)',cstCaseInsensitive)
else SetComboBoxText(cmbDebuggerType, SelectedDebuggerClass.Caption,cstCaseInsensitive);
end;
procedure TDebuggerClassOptionsFrame.DoNameSelected(Sender: TObject);
var
idx: PtrInt;
begin
idx := TMenuItem(Sender).Tag;
edNameExit(nil);
UpdateDebuggerClass;
cmbDebuggerPathEditingDone(nil);
FSelectedDbgPropertiesConfig := FCopiedDbgPropertiesConfigList.Opt[idx];
FillNameDropDown;
UpdateDebuggerClassDropDown;
FetchDebuggerSpecificOptions;
end;
procedure TDebuggerClassOptionsFrame.FetchDebuggerSpecificOptions;
var
S, S2, S3: String;
Prop: TDebuggerProperties;
begin
PropertyGrid.Selection.Clear;
if FSelectedDbgPropertiesConfig = nil then begin
cmbDebuggerPath.Items.Clear;
cmbDebuggerPath.Text := '';
edName.Text := '';
exit;
end;
with cmbDebuggerPath.Items do begin
BeginUpdate;
Assign(EnvironmentOptions.DebuggerFileHistory);
if (Count = 0)
and (SelectedDebuggerClass <> nil)
then begin
S := SelectedDebuggerClass.ExePaths;
while S <> '' do
begin
S2 := GetPart([], [';'], S);
S3 := S2;
if GlobalMacroList.SubstituteStr(S2)
then Add(S2)
else Add(S3);
if S <> '' then System.Delete(S, 1, 1);
end;
end;
EndUpdate;
end;
debugln(['>>>### ',FSelectedDbgPropertiesConfig.DebuggerFilename,cstFilename]);
SetComboBoxText(cmbDebuggerPath,FSelectedDbgPropertiesConfig.DebuggerFilename,cstFilename,20);
edName.Text := FSelectedDbgPropertiesConfig.ConfigName;
// txtAdditionalPath.Text:=EnvironmentOptions.GetParsedDebuggerSearchPath;
// get ptoperties
Prop := SelectedDebuggerProperties;
if Prop<>nil then
PropertyGrid.Selection.Add(Prop);
PropertyGrid.BuildPropertyList;
end;
function TDebuggerClassOptionsFrame.GetDebuggerClassFromDropDown: TDebuggerClass;
var
idx: PtrInt;
begin
Result := nil;
idx := cmbDebuggerType.ItemIndex;
if idx = -1 then Exit;
Result := TDebuggerClass(cmbDebuggerType.Items.Objects[idx]);
end;
function TDebuggerClassOptionsFrame.GetUniqueName(AName: String): String;
function TrimNumber(s: string): string;
var
i: Integer;
begin
Result := s;
i := Length(s);
if (i=0) or (s[i] <> ')') then
exit;
dec(i);
while (i > 0) and (s[i] in ['0'..'9']) do
dec(i);
if (i=0) or (s[i] <> '(') then
exit;
dec(i);
if (i<=1) or (s[i] <> ' ') then
exit;
Result := copy(s, 1, i-1);
end;
var
i, j: Integer;
begin
Result := Trim(AName);
if Result = '' then begin
i := FCopiedDbgPropertiesConfigList.Count - 1;
while i >= 0 do
if (FCopiedDbgPropertiesConfigList[i] <> '') or
(FCopiedDbgPropertiesConfigList.Opt[i].DebuggerClass <> SelectedDebuggerClass) or
(FCopiedDbgPropertiesConfigList.Opt[i].IsDeleted) or
(FCopiedDbgPropertiesConfigList.Opt[i] = FSelectedDbgPropertiesConfig)
then
dec(i)
else
break;
if i < 0 then
exit;
end
else begin
i := FCopiedDbgPropertiesConfigList.IndexOf(Result);
if (i < 0) or (FCopiedDbgPropertiesConfigList.Opt[i] = FSelectedDbgPropertiesConfig) then
exit;
end;
Result := TrimNumber(Result);
i := 1;
repeat
inc(i);
j := FCopiedDbgPropertiesConfigList.IndexOf(Result+' ('+IntToStr(i)+')');
if (j >= 0) and (FCopiedDbgPropertiesConfigList.Opt[i]= FSelectedDbgPropertiesConfig)
then
j := -1;
until j < 0;
Result := Result+' ('+IntToStr(i)+')';
end;
procedure TDebuggerClassOptionsFrame.ClearDbgProperties;
begin
PropertyGrid.Selection.Clear;
FCopiedDbgPropertiesConfigList.ClearAll;
end;
procedure TDebuggerClassOptionsFrame.FillNameDropDown;
var
m: TMenuItem;
i: Integer;
begin
tbDropMenu.Items.Clear;
for i := 0 to FCopiedDbgPropertiesConfigList.Count - 1 do
if (not FCopiedDbgPropertiesConfigList.Opt[i].IsDeleted) and
(FCopiedDbgPropertiesConfigList.Opt[i].IsLoaded)
then begin
m := TMenuItem.Create(tbDropMenu);
m.Caption := FCopiedDbgPropertiesConfigList.Opt[i].DisplayName;
m.Tag := i;
m.OnClick := @DoNameSelected;
m.Checked := FCopiedDbgPropertiesConfigList.Opt[i] = FSelectedDbgPropertiesConfig;
tbDropMenu.Items.Add(m);
end;
if FSelectedDbgPropertiesConfig <> nil then
tbSelect.Caption := FSelectedDbgPropertiesConfig.DisplayName
else
tbSelect.Caption := '---';
tbSelect.Enabled := FCopiedDbgPropertiesConfigList.Count > 0;
Panel1.Enabled := FCopiedDbgPropertiesConfigList.Count > 0;
tbCopy.Enabled := FSelectedDbgPropertiesConfig <> nil;
tbDelete.Enabled := FSelectedDbgPropertiesConfig <> nil;
end;
procedure TDebuggerClassOptionsFrame.HookGetCheckboxForBoolean(var Value: Boolean);
begin
Value := EnvironmentOptions.ObjectInspectorOptions.CheckboxForBoolean;
end;
constructor TDebuggerClassOptionsFrame.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// create the PropertyEditorHook (the interface to the properties)
FPropertyEditorHook:=TPropertyEditorHook.Create(Self);
FPropertyEditorHook.AddHandlerGetCheckboxForBoolean(@HookGetCheckboxForBoolean);
FCopiedDbgPropertiesConfigList := TDebuggerPropertiesConfigList.Create;
FCopiedDbgPropertiesConfigList.CaseSensitive := False;
// create the PropertyGrid
PropertyGrid:=TOIPropertyGrid.CreateWithParams(Self,FPropertyEditorHook
,[tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat, tkSet{, tkMethod}
, tkSString, tkLString, tkAString, tkWString, tkVariant
{, tkArray, tkRecord, tkInterface}, tkClass, tkObject, tkWChar, tkBool
, tkInt64, tkQWord],
0);
with PropertyGrid do
begin
Name:='PropertyGrid';
Parent := gbDebuggerSpecific;
BorderSpacing.Around := 6;
Visible := True;
Align := alClient;
PreferredSplitterX := 200;
SplitterX := 200;
Layout := oilHorizontal;
end;
end;
destructor TDebuggerClassOptionsFrame.Destroy;
begin
ClearDbgProperties;
PropertyGrid.Selection.Clear;
FreeAndNil(FPropertyEditorHook);
FreeAndNil(FCopiedDbgPropertiesConfigList);
inherited Destroy;
end;
function TDebuggerClassOptionsFrame.Check: Boolean;
begin
if FSelectedDbgPropertiesConfig = nil then
exit(True);
edNameExit(nil);
UpdateDebuggerClass; // TODO: might edit the name
FLastCheckedDebuggerPath := 'X'+cmbDebuggerPath.Text; // ensure a new check is done
cmbDebuggerPathEditingDone(nil);
debugln(['############### >',FSelectedDbgPropertiesConfig.DebuggerFilename, '< ## >', cmbDebuggerPath.Text, '< #']);
Result := (FSelectedDbgPropertiesConfig.DebuggerFilename = cmbDebuggerPath.Text);
end;
function TDebuggerClassOptionsFrame.GetTitle: String;
begin
Result := lisDebugOptionsFrmBackend;
end;
procedure TDebuggerClassOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
begin
tbAddNew.Caption := lisAdd;
tbCopy.Caption := lisCopy;
tbDelete.Caption := lisDelete;
lblName.Caption := lisDebugOptionsFrmName;
gbDebuggerType.Caption := dlgDebugType;
gbAdditionalSearchPath.Caption := lisDebugOptionsFrmAdditionalSearchPath;
gbDebuggerSpecific.Caption := lisDebugOptionsFrmDebuggerSpecific;
end;
procedure TDebuggerClassOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
var
i: Integer;
begin
ClearDbgProperties;
with EnvironmentOptions do
begin
ObjectInspectorOptions.AssignTo(PropertyGrid);
FCopiedDbgPropertiesConfigList.ClearAll;
for i := 0 to DebuggerPropertiesConfigList.Count - 1 do
FCopiedDbgPropertiesConfigList.AddObject(DebuggerPropertiesConfigList[i],
TDebuggerPropertiesConfig.CreateCopy(DebuggerPropertiesConfigList.Opt[i], True, True) );
// Find our copy of the current entry
if CurrentDebuggerPropertiesConfig = nil then
FSelectedDbgPropertiesConfig := nil
else
FSelectedDbgPropertiesConfig := FCopiedDbgPropertiesConfigList.EntryByName(
CurrentDebuggerPropertiesConfig.ConfigName, CurrentDebuggerPropertiesConfig.ConfigClass);
FillNameDropDown;
FillDebuggerClassDropDown;
FetchDebuggerSpecificOptions;
end;
end;
procedure TDebuggerClassOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
var
i: Integer;
EnvConf: TDebuggerPropertiesConfigList;
begin
with EnvironmentOptions do
begin
DebuggerFileHistory.Assign(cmbDebuggerPath.Items);
// DebuggerSearchPath := TrimSearchPath(txtAdditionalPath.Text,'');
EnvConf := DebuggerPropertiesConfigList;
EnvConf.ClearAll;
for i := 0 to FCopiedDbgPropertiesConfigList.Count - 1 do
EnvConf.AddObject(FCopiedDbgPropertiesConfigList[i],
TDebuggerPropertiesConfig.CreateCopy(FCopiedDbgPropertiesConfigList.Opt[i], True, True) );
if FSelectedDbgPropertiesConfig = nil then
CurrentDebuggerPropertiesConfig := nil
else
CurrentDebuggerPropertiesConfig := DebuggerPropertiesConfigList.EntryByName(
FSelectedDbgPropertiesConfig.ConfigName, FSelectedDbgPropertiesConfig.ConfigClass);
end;
end;
class function TDebuggerClassOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
begin
Result := TDebuggerOptions;
end;
initialization
RegisterIDEOptionsEditor(GroupDebugger, TDebuggerClassOptionsFrame, DbgOptionsGeneral);
end.

93
debugger/frames/debugger_general_options.lfm
View File

@ -9,80 +9,14 @@ object DebuggerGeneralOptionsFrame: TDebuggerGeneralOptionsFrame
Visible = False
DesignLeft = 812
DesignTop = 313
object gbDebuggerType: TGroupBox
object gbAdditionalSearchPath: TGroupBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 0
Height = 84
Top = 0
Width = 519
Anchors = [akTop, akLeft, akRight]
AutoSize = True
Caption = 'Debugger type and path'
ClientHeight = 64
ClientWidth = 515
TabOrder = 0
object cmbDebuggerType: TComboBox
AnchorSideLeft.Control = gbDebuggerType
AnchorSideTop.Control = gbDebuggerType
AnchorSideRight.Control = gbDebuggerType
AnchorSideRight.Side = asrBottom
Left = 6
Height = 23
Top = 6
Width = 503
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
ItemHeight = 15
OnEditingDone = cmbDebuggerTypeEditingDone
OnSelect = cmbDebuggerTypeEditingDone
Style = csDropDownList
TabOrder = 0
end
object cmbDebuggerPath: TComboBox
AnchorSideLeft.Control = gbDebuggerType
AnchorSideTop.Control = cmbDebuggerType
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = cmdOpenDebuggerPath
Left = 6
Height = 23
Top = 35
Width = 480
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Top = 6
BorderSpacing.Bottom = 6
ItemHeight = 15
TabOrder = 1
end
object cmdOpenDebuggerPath: TButton
AnchorSideTop.Control = cmbDebuggerPath
AnchorSideRight.Control = gbDebuggerType
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = cmbDebuggerPath
AnchorSideBottom.Side = asrBottom
Left = 486
Height = 23
Top = 35
Width = 23
Anchors = [akTop, akRight, akBottom]
BorderSpacing.Right = 6
Caption = '…'
OnClick = cmdOpenDebuggerPathClick
TabOrder = 2
end
end
object gbAdditionalSearchPath: TGroupBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = gbDebuggerType
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 0
Height = 55
Top = 90
Top = 6
Width = 519
Anchors = [akTop, akLeft, akRight]
AutoSize = True
@ -90,7 +24,7 @@ object DebuggerGeneralOptionsFrame: TDebuggerGeneralOptionsFrame
Caption = 'Additional search path'
ClientHeight = 35
ClientWidth = 515
TabOrder = 1
TabOrder = 0
object txtAdditionalPath: TEdit
AnchorSideLeft.Control = gbAdditionalSearchPath
AnchorSideTop.Control = gbAdditionalSearchPath
@ -130,7 +64,7 @@ object DebuggerGeneralOptionsFrame: TDebuggerGeneralOptionsFrame
AnchorSideRight.Side = asrBottom
Left = 0
Height = 19
Top = 151
Top = 67
Width = 519
Anchors = [akTop, akLeft, akRight]
AutoFill = True
@ -145,23 +79,6 @@ object DebuggerGeneralOptionsFrame: TDebuggerGeneralOptionsFrame
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
TabOrder = 2
end
object gbDebuggerSpecific: TGroupBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = gcbDebuggerGeneralOptions
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 251
Top = 176
Width = 519
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 6
Caption = 'Debugger specific options (depends on type of debugger)'
TabOrder = 3
TabOrder = 1
end
end

264
debugger/frames/debugger_general_options.pas
View File

@ -25,53 +25,31 @@ unit debugger_general_options;
interface
uses
Classes, SysUtils, TypInfo,
SysUtils,
// LCL
Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs,
Controls, StdCtrls, ExtCtrls, Dialogs, Menus,
// LazUtils
FileUtil, LazFileUtils, LazStringUtils, LazFileCache,
// DebuggerIntf
DbgIntfDebuggerBase,
FileUtil, LazFileUtils,
// IdeIntf
PropEdits, ObjectInspector, IDEOptionsIntf, IDEOptEditorIntf, IDEUtils,
IDEOptionsIntf, IDEOptEditorIntf,
// IDE
TransferMacros, LazarusIDEStrConsts, PathEditorDlg, IDEProcs, DialogProcs,
InputHistory, EnvironmentOpts, BaseDebugManager, Debugger;
LazarusIDEStrConsts, PathEditorDlg, IDEProcs,
EnvironmentOpts, BaseDebugManager;
type
{ TDebuggerGeneralOptionsFrame }
TDebuggerGeneralOptionsFrame = class(TAbstractIDEOptionsEditor)
cmbDebuggerPath: TComboBox;
cmbDebuggerType: TComboBox;
cmdOpenAdditionalPath: TButton;
cmdOpenDebuggerPath: TButton;
gbAdditionalSearchPath: TGroupBox;
gbDebuggerSpecific: TGroupBox;
gbDebuggerType: TGroupBox;
gcbDebuggerGeneralOptions: TCheckGroup;
txtAdditionalPath: TEdit;
procedure cmbDebuggerTypeEditingDone(Sender: TObject);
procedure cmdOpenAdditionalPathClick(Sender: TObject);
procedure cmdOpenDebuggerPathClick(Sender: TObject);
private
PropertyGrid: TOIPropertyGrid;
FCurDebuggerClass: TDebuggerClass; // currently shown debugger class
FPropertyEditorHook: TPropertyEditorHook;
FOldDebuggerFilename: string;
fOldDebuggerSearchPath: string;
FCurrentDebPropertiesList: TStringList; // temporarilly modified
procedure FetchDebuggerClass;
procedure FetchDebuggerGeneralOptions;
procedure FetchDebuggerSpecificOptions;
function GetDebuggerClass: TDebuggerClass;
procedure SetDebuggerClass(const AClass: TDebuggerClass);
procedure ClearDbgProperties;
procedure HookGetCheckboxForBoolean(var Value: Boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Check: Boolean; override;
function GetTitle: String; override;
procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
@ -87,12 +65,6 @@ implementation
{ TDebuggerGeneralOptionsFrame }
procedure TDebuggerGeneralOptionsFrame.cmbDebuggerTypeEditingDone(
Sender: TObject);
begin
SetDebuggerClass(GetDebuggerClass);
end;
procedure TDebuggerGeneralOptionsFrame.cmdOpenAdditionalPathClick(
Sender: TObject);
begin
@ -107,218 +79,17 @@ begin
txtAdditionalPath.Text:=PathEditorDialog.Path;
end;
procedure TDebuggerGeneralOptionsFrame.cmdOpenDebuggerPathClick(Sender: TObject);
var
OpenDialog: TOpenDialog;
AFilename: string;
begin
OpenDialog:=TOpenDialog.Create(nil);
try
InputHistories.ApplyFileDialogSettings(OpenDialog);
OpenDialog.Options:=OpenDialog.Options+[ofPathMustExist];
OpenDialog.Title:=lisChooseDebuggerExecutable;
if OpenDialog.Execute then begin
AFilename:=CleanAndExpandFilename(OpenDialog.Filename);
SetComboBoxText(cmbDebuggerPath,AFilename,cstFilename);
CheckExecutable(FOldDebuggerFilename,AFilename,
lisEnvOptDlgInvalidDebuggerFilename,
lisEnvOptDlgInvalidDebuggerFilenameMsg);
end;
InputHistories.StoreFileDialogSettings(OpenDialog);
finally
OpenDialog.Free;
end;
end;
procedure TDebuggerGeneralOptionsFrame.FetchDebuggerClass;
var
n: PtrInt;
DbgClass, CurClass: TDebuggerClass;
List: TStringList;
begin
List := TStringList.Create;
List.Sorted := True;
CurClass := nil;
for n := 0 to DebugBoss.DebuggerCount - 1 do
begin
DbgClass := DebugBoss.Debuggers[n];
List.AddObject(DbgClass.Caption, TObject(n));
if (FCurDebuggerClass = nil)
and (CompareText(DbgClass.ClassName, EnvironmentOptions.DebuggerConfig.DebuggerClass) = 0)
then CurClass := DbgClass;
end;
cmbDebuggerType.Items.Assign(List);
FreeAndNil(List);
SetDebuggerClass(CurClass);
if FCurDebuggerClass = nil
then SetComboBoxText(cmbDebuggerType, '(none)',cstCaseInsensitive)
else SetComboBoxText(cmbDebuggerType, FCurDebuggerClass.Caption,cstCaseInsensitive);
txtAdditionalPath.Text:=EnvironmentOptions.GetParsedDebuggerSearchPath;
end;
procedure TDebuggerGeneralOptionsFrame.FetchDebuggerGeneralOptions;
begin
// IMPORTANT if more items are added the indexes must be updated here!
gcbDebuggerGeneralOptions.Checked[0] := EnvironmentOptions.DebuggerShowStopMessage;
gcbDebuggerGeneralOptions.Checked[1] := EnvironmentOptions.DebuggerResetAfterRun;
gcbDebuggerGeneralOptions.Checked[2] := EnvironmentOptions.DebuggerAutoCloseAsm;
end;
procedure TDebuggerGeneralOptionsFrame.FetchDebuggerSpecificOptions;
var
S, S2, S3: String;
i: Integer;
Filename: string;
NewFilename: string;
Prop: TDebuggerProperties;
begin
with cmbDebuggerPath.Items do begin
BeginUpdate;
Assign(EnvironmentOptions.DebuggerFileHistory);
if (Count = 0)
and (FCurDebuggerClass <> nil)
then begin
S := FCurDebuggerClass.ExePaths;
while S <> '' do
begin
S2 := GetPart([], [';'], S);
S3 := S2;
if GlobalMacroList.SubstituteStr(S2)
then Add(S2)
else Add(S3);
if S <> '' then System.Delete(S, 1, 1);
end;
end;
EndUpdate;
end;
Filename:=cmbDebuggerPath.Text;
if Filename='' then begin
for i:=0 to cmbDebuggerPath.Items.Count-1 do begin
NewFilename:=cmbDebuggerPath.Items[i];
if FileExistsCached(NewFilename) then begin
Filename:=NewFilename;
break;
end;
NewFilename:=FindDefaultExecutablePath(ExtractFileName(Filename));
if NewFilename<>'' then begin
Filename:=NewFilename;
break;
end;
end;
end;
SetComboBoxText(cmbDebuggerPath,Filename,cstFilename,20);
// get ptoperties
PropertyGrid.Selection.Clear;
if FCurDebuggerClass<>nil then begin
i := FCurrentDebPropertiesList.IndexOf(FCurDebuggerClass.ClassName);
if i < 0 then begin
Prop := TDebuggerPropertiesClass(FCurDebuggerClass.GetProperties.ClassType).Create;
EnvironmentOptions.LoadDebuggerProperties(FCurDebuggerClass.ClassName, Prop);
FCurrentDebPropertiesList.AddObject(FCurDebuggerClass.ClassName, Prop);
end
else
Prop := TDebuggerProperties(FCurrentDebPropertiesList.Objects[i]);
PropertyGrid.Selection.Add(Prop);
end;
PropertyGrid.BuildPropertyList;
end;
function TDebuggerGeneralOptionsFrame.GetDebuggerClass: TDebuggerClass;
var
idx: PtrInt;
begin
Result := nil;
idx := cmbDebuggerType.ItemIndex;
if idx = -1 then Exit;
idx := PtrInt(cmbDebuggerType.Items.Objects[idx]);
if idx = -1 then Exit;
Result := DebugBoss.Debuggers[idx];
end;
procedure TDebuggerGeneralOptionsFrame.SetDebuggerClass(
const AClass: TDebuggerClass);
begin
if FCurDebuggerClass = AClass then Exit;
FCurDebuggerClass := AClass;
FetchDebuggerSpecificOptions;
end;
procedure TDebuggerGeneralOptionsFrame.ClearDbgProperties;
var
i: Integer;
begin
PropertyGrid.Selection.Clear;
for i := 0 to FCurrentDebPropertiesList.Count - 1 do
FCurrentDebPropertiesList.Objects[i].Free;
FCurrentDebPropertiesList.Clear;
end;
procedure TDebuggerGeneralOptionsFrame.HookGetCheckboxForBoolean(var Value: Boolean);
begin
Value := EnvironmentOptions.ObjectInspectorOptions.CheckboxForBoolean;
end;
constructor TDebuggerGeneralOptionsFrame.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// create the PropertyEditorHook (the interface to the properties)
FPropertyEditorHook:=TPropertyEditorHook.Create(Self);
FPropertyEditorHook.AddHandlerGetCheckboxForBoolean(@HookGetCheckboxForBoolean);
FCurrentDebPropertiesList := TStringList.Create;
// create the PropertyGrid
PropertyGrid:=TOIPropertyGrid.CreateWithParams(Self,FPropertyEditorHook
,[tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat, tkSet{, tkMethod}
, tkSString, tkLString, tkAString, tkWString, tkVariant
{, tkArray, tkRecord, tkInterface}, tkClass, tkObject, tkWChar, tkBool
, tkInt64, tkQWord],
0);
with PropertyGrid do
begin
Name:='PropertyGrid';
Parent := gbDebuggerSpecific;
BorderSpacing.Around := 6;
Visible := True;
Align := alClient;
PreferredSplitterX := 200;
SplitterX := 200;
Layout := oilHorizontal;
end;
end;
destructor TDebuggerGeneralOptionsFrame.Destroy;
begin
ClearDbgProperties;
PropertyGrid.Selection.Clear;
FreeAndNil(FPropertyEditorHook);
FreeAndNil(FCurrentDebPropertiesList);
inherited Destroy;
txtAdditionalPath.Text:=EnvironmentOptions.GetParsedDebuggerSearchPath;
end;
function TDebuggerGeneralOptionsFrame.Check: Boolean;
begin
Result := false;
if assigned(FCurDebuggerClass) and FCurDebuggerClass.NeedsExePath
and (EnvironmentOptions.DebuggerFilename <> cmbDebuggerPath.Text)
then begin
EnvironmentOptions.DebuggerFilename := cmbDebuggerPath.Text;
if not CheckExecutable(FOldDebuggerFilename,
EnvironmentOptions.GetParsedDebuggerFilename,
lisEnvOptDlgInvalidDebuggerFilename,
lisEnvOptDlgInvalidDebuggerFilenameMsg)
then exit;
end;
Result := true;
end;
@ -329,52 +100,32 @@ end;
procedure TDebuggerGeneralOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
begin
gbDebuggerType.Caption := dlgDebugType;
gbAdditionalSearchPath.Caption := lisDebugOptionsFrmAdditionalSearchPath;
gcbDebuggerGeneralOptions.Caption := lisDebugOptionsFrmDebuggerGeneralOptions;
gcbDebuggerGeneralOptions.Items.Add(lisDebugOptionsFrmShowMessageOnStop);
gcbDebuggerGeneralOptions.Items.Add(lisDebugOptionsFrmResetDebuggerOnEachRun);
gcbDebuggerGeneralOptions.Items.Add(lisDebugOptionsFrmAutoCloseAsm);
gbDebuggerSpecific.Caption := lisDebugOptionsFrmDebuggerSpecific;
end;
procedure TDebuggerGeneralOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
begin
ClearDbgProperties;
with EnvironmentOptions do
begin
ObjectInspectorOptions.AssignTo(PropertyGrid);
FOldDebuggerFilename := DebuggerFilename;
fOldDebuggerSearchPath := DebuggerSearchPath;
cmbDebuggerPath.Text := FOldDebuggerFilename;
FetchDebuggerClass;
FetchDebuggerGeneralOptions;
end;
end;
procedure TDebuggerGeneralOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
var
i: Integer;
begin
with EnvironmentOptions do
begin
DebuggerFilename := cmbDebuggerPath.Text;
DebuggerFileHistory.Assign(cmbDebuggerPath.Items);
DebuggerSearchPath := TrimSearchPath(txtAdditionalPath.Text,'');
// IMPORTANT if more items are added the indexes must be updated here!
DebuggerShowStopMessage := gcbDebuggerGeneralOptions.Checked[0];
DebuggerResetAfterRun := gcbDebuggerGeneralOptions.Checked[1];
DebuggerAutoCloseAsm := gcbDebuggerGeneralOptions.Checked[2];
for i := 0 to FCurrentDebPropertiesList.Count - 1 do
SaveDebuggerProperties(FCurrentDebPropertiesList[i],
TDebuggerProperties(FCurrentDebPropertiesList.Objects[i]));
if FCurDebuggerClass = nil
then DebuggerConfig.DebuggerClass := ''
else DebuggerConfig.DebuggerClass := FCurDebuggerClass.ClassName;
end;
end;
@ -382,7 +133,6 @@ procedure TDebuggerGeneralOptionsFrame.RestoreSettings(
AOptions: TAbstractIDEOptions);
begin
with EnvironmentOptions do begin
DebuggerFilename := FOldDebuggerFilename;
DebuggerSearchPath := fOldDebuggerSearchPath;
end;
end;

1
ide/basedebugmanager.pas
View File

@ -221,7 +221,6 @@ type
DoDisableAutoSizing: boolean = false); virtual; abstract;
public
property Commands: TDBGCommands read GetCommands; // All current available commands of the debugger
property Debuggers[const AIndex: Integer]: TDebuggerClass read GetDebuggerClass;
property Destroying: boolean read FDestroying;
property State: TDBGState read GetState; // The current state of the debugger

9
ide/debugmanager.pas
View File

@ -2484,7 +2484,10 @@ begin
Exit;
end;
EnvironmentOptions.LoadDebuggerProperties(NewDebuggerClass.ClassName, FDebugger.GetProperties);
if (EnvironmentOptions.CurrentDebuggerPropertiesConfig <> nil) and
(EnvironmentOptions.CurrentDebuggerPropertiesConfig.DebuggerProperties <> nil)
then
FDebugger.GetProperties.Assign(EnvironmentOptions.CurrentDebuggerPropertiesConfig.DebuggerProperties);
ClearDebugOutputLog;
if EnvironmentOptions.DebuggerEventLogClearOnRun then
@ -2595,7 +2598,7 @@ function TDebugManager.DoSetBreakkPointWarnIfNoDebugger: boolean;
var
DbgClass: TDebuggerClass;
begin
DbgClass:=FindDebuggerClass(EnvironmentOptions.DebuggerConfig.DebuggerClass);
DbgClass:=EnvironmentOptions.CurrentDebuggerClass;
if (DbgClass=nil)
or (DbgClass.NeedsExePath
and (not FileIsExecutableCached(EnvironmentOptions.GetParsedDebuggerFilename)))
@ -3118,7 +3121,7 @@ end;
function TDebugManager.GetDebuggerClass: TDebuggerClass;
begin
Result := FindDebuggerClass(EnvironmentOptions.DebuggerConfig.DebuggerClass);
Result := EnvironmentOptions.CurrentDebuggerClass;
if Result = nil then
Result := TProcessDebugger;
end;

585
ide/environmentopts.pp
View File

@ -49,7 +49,7 @@ uses
ProjectIntf, ObjectInspector, IDEWindowIntf, IDEOptionsIntf, IDEOptEditorIntf,
ComponentReg, IDEExternToolIntf, MacroDefIntf, SrcEditorIntf,
// DebuggerIntf
DbgIntfDebuggerBase,
DbgIntfDebuggerBase, GDBMIDebugger,
// IDE
IDEProcs, DialogProcs, LazarusIDEStrConsts, IDETranslations, LazConf,
IDEOptionDefs, TransferMacros, ModeMatrixOpts, Debugger,
@ -291,6 +291,53 @@ type
type
TEnvironmentOptions = class;
{ TDebuggerPropertiesConfig }
TDebuggerPropertiesConfig = class(TPersistent)
private
FActive: Boolean;
FConfigClass: String;
FConfigName: String;
FDebuggerClass: TDebuggerClass;
FDebuggerFilename: string;
FIsFromOldXml: Boolean;
FXmlIndex: Integer;
FDebuggerProperties: TDebuggerProperties;
public
destructor Destroy; override;
constructor CreateFromXmlConf(AXMLCfg: TRttiXMLConfig; APath: String; AIndex: Integer);
constructor CreateFromOldXmlConf(AXMLCfg: TRttiXMLConfig; APath: String;
ADebuggerClass: TDebuggerClass; AForceLoad: Boolean = False);
constructor CreateFromOldXmlConf(AXMLCfg: TRttiXMLConfig; APath: String;
ADebuggerClassName: String; AForceLoad: Boolean = False);
constructor CreateForDebuggerClass(ADebuggerClass: TDebuggerClass);
constructor CreateCopy(ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean = True; ACopyXmlOrigin: Boolean = False);
procedure CopyFrom(ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean = True);
procedure AssignTo(Dest: TPersistent); override;
function DisplayName: String;
function NeedsExePath: Boolean;
procedure ChangeDebuggerClass(ADebuggerClass: TDebuggerClass; ACopyPropValues: Boolean = True);
procedure MarkAsDeleted;
function IsLoaded: Boolean;
function IsDeleted: Boolean;
function DebugText: String;
procedure DeleteFromXml(AXMLCfg: TRttiXMLConfig; APath: String); // uses FXmlIndex from last load/save. No prior sibling must have benn removed or inserted
procedure DeleteFromOldXml(AXMLCfg: TRttiXMLConfig; APath: String);
procedure SaveToXml(AXMLCfg: TRttiXMLConfig; APath: String; AIndex: Integer);
procedure SaveToOldXml(AXMLCfg: TRttiXMLConfig; APath: String);
property DebuggerClass: TDebuggerClass read FDebuggerClass;
property DebuggerProperties: TDebuggerProperties read FDebuggerProperties;
property IsFromOldXml: Boolean read FIsFromOldXml;
published
property ConfigName: String read FConfigName write FConfigName;
property ConfigClass: String read FConfigClass write FConfigClass;
property DebuggerFilename: string read FDebuggerFilename write FDebuggerFilename;
property Active: Boolean read FActive write FActive;
end;
TLastOpenPackagesList = class(TStringList)
public
function Remove(const aString: string): Boolean;
@ -468,10 +515,25 @@ type
property Path: String read FPath;
end;
{ TDebuggerPropertiesConfigList }
TDebuggerPropertiesConfigList = class(TStringList)
private
function GetOpt(Index: Integer): TDebuggerPropertiesConfig;
public
procedure ClearAll;
function EntryByName(AConfName, AConfClass: String): TDebuggerPropertiesConfig;
property Opt[Index: Integer]: TDebuggerPropertiesConfig read GetOpt;
end;
{ TEnvironmentOptions - class for storing environment options }
TEnvironmentOptions = class(TIDEEnvironmentOptions)
private const
XML_PATH_DEBUGGER_CONF = 'EnvironmentOptions/Debugger/Configs/Config[%d]/';
XML_PATH_DEBUGGER_CONF_OLD = 'EnvironmentOptions/Debugger/Class%s/%s/';
private
FCurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig;
fRegisteredSubConfig: TObjectList;
FDebuggerAutoCloseAsm: boolean;
// config file
@ -582,7 +644,8 @@ type
FDebuggerResetAfterRun: boolean;
FDebuggerConfig: TDebuggerConfigStore;
FDebuggerFileHistory: TStringList; // per debugger class
FDebuggerProperties: TStringList; // per debugger class
FDebuggerProperties: TDebuggerPropertiesConfigList; // named entries
FKnownDebuggerClassCount: Integer;
FDebuggerShowStopMessage: Boolean;
FDebuggerEventLogClearOnRun: Boolean;
FDebuggerEventLogCheckLineLimit: Boolean;
@ -652,6 +715,8 @@ type
function GetActiveDesktop: TDesktopOpt;
function GetCompilerFilename: string;
function GetCompilerMessagesFilename: string;
function GetCurrentDebuggerClass: TDebuggerClass;
function GetCurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig;
function GetDebugDesktop: TDesktopOpt;
function GetDebuggerEventLogColors(AIndex: TDBGEventType): TDebuggerEventLogColor;
function GetDebuggerFilename: string;
@ -669,12 +734,13 @@ type
procedure SaveNonDesktop(Path: String);
procedure SetCompilerFilename(const AValue: string);
procedure SetCompilerMessagesFilename(AValue: string);
procedure SetCurrentDebuggerPropertiesOpt(AValue: TDebuggerPropertiesConfig
);
procedure SetDebuggerEventLogColors(AIndex: TDBGEventType;
const AValue: TDebuggerEventLogColor);
procedure SetDebuggerSearchPath(const AValue: string);
procedure SetFPDocPaths(const AValue: string);
procedure SetMakeFilename(const AValue: string);
procedure SetDebuggerFilename(AValue: string);
procedure SetFPCSourceDirectory(const AValue: string);
procedure SetLazarusDirectory(const AValue: string);
procedure SetFppkgConfigFile(AValue: string);
@ -687,6 +753,7 @@ type
procedure InitXMLCfg(CleanConfig: boolean);
procedure FileUpdated;
procedure SetTestBuildDirectory(const AValue: string);
procedure LoadDebuggerProperties;
public
class function GetGroupCaption:string; override;
class function GetInstance: TAbstractIDEOptions; override;
@ -716,7 +783,7 @@ type
function GetParsedDebuggerFilename: string;
function GetParsedDebuggerSearchPath: string;
function GetParsedFppkgConfig: string; override;
function GetParsedValue(o: TEnvOptParseType): string;
function GetParsedValue(o: TEnvOptParseType; AUnparsedValue: String = ''): string;
// macros
procedure InitMacros(AMacroList: TTransferMacroList);
@ -823,7 +890,7 @@ type
property FPCSourceDirHistory: TStringList read FFPCSourceDirHistory;
property MakeFilename: string read GetMakeFilename write SetMakeFilename;
property MakeFileHistory: TStringList read FMakeFileHistory;
property DebuggerFilename: string read GetDebuggerFilename write SetDebuggerFilename;
property DebuggerFilename: string read GetDebuggerFilename;
property DebuggerFileHistory: TStringList read FDebuggerFileHistory;
property DebuggerSearchPath: string read GetDebuggerSearchPath write SetDebuggerSearchPath;
property DebuggerShowStopMessage: boolean read FDebuggerShowStopMessage write FDebuggerShowStopMessage;
@ -856,8 +923,9 @@ type
// Debugger
procedure SaveDebuggerPropertiesList;
procedure SaveDebuggerProperties(DebuggerClass: String; Properties: TDebuggerProperties);
procedure LoadDebuggerProperties(DebuggerClass: String; Properties: TDebuggerProperties);
function DebuggerPropertiesConfigList: TDebuggerPropertiesConfigList;
property CurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig read GetCurrentDebuggerPropertiesConfig write SetCurrentDebuggerPropertiesOpt;
property CurrentDebuggerClass: TDebuggerClass read GetCurrentDebuggerClass;
property DebuggerConfig: TDebuggerConfigStore read FDebuggerConfig;
// Debugger event log
@ -1114,6 +1182,288 @@ begin
WriteStr(Result, u);
end;
{ TDebuggerPropertiesConfigList }
function TDebuggerPropertiesConfigList.GetOpt(Index: Integer
): TDebuggerPropertiesConfig;
begin
Result := TDebuggerPropertiesConfig(Objects[Index]);
end;
procedure TDebuggerPropertiesConfigList.ClearAll;
var
i: Integer;
begin
for i := 0 to Count - 1 do
Objects[i].Free;
Clear;
end;
function TDebuggerPropertiesConfigList.EntryByName(AConfName, AConfClass: String
): TDebuggerPropertiesConfig;
var
i: Integer;
begin
Result := nil;
i := Count - 1;
while (i >= 0) and (
Opt[i].IsDeleted or (not Opt[i].IsLoaded) or
(Opt[i].ConfigName <> AConfName) or
(Opt[i].ConfigClass <> AConfClass)
)
do
dec(i);
if i >= 0 then
Result := Opt[i];
end;
{ TDebuggerPropertiesConfig }
destructor TDebuggerPropertiesConfig.Destroy;
begin
inherited Destroy;
FreeAndNil(FDebuggerProperties);
end;
constructor TDebuggerPropertiesConfig.CreateFromXmlConf(
AXMLCfg: TRttiXMLConfig; APath: String; AIndex: Integer);
begin
Create;
FIsFromOldXml := False;
APath := Format(APath, [AIndex]);
AXMLCfg.ReadObject(APath, Self);
FXmlIndex := AIndex;
FDebuggerClass := TBaseDebugManagerIntf.DebuggersByClassName[ConfigClass];
if FDebuggerClass <> nil then begin
FDebuggerProperties := FDebuggerClass.CreateProperties;
AXMLCfg.ReadObject(APath + 'Properties/', FDebuggerProperties);
end;
end;
constructor TDebuggerPropertiesConfig.CreateFromOldXmlConf(
AXMLCfg: TRttiXMLConfig; APath: String; ADebuggerClass: TDebuggerClass;
AForceLoad: Boolean);
var
p: String;
begin
Create;
FIsFromOldXml := True;
p := Format(APath, [ADebuggerClass.ClassName, 'Config']);
if AXMLCfg.HasPath(p, False) then
AForceLoad := True;
// Read first, so any (invalid) Class/Name will be cleared after reading
AXMLCfg.ReadObject(p, Self); // read FDebuggerFilename;
FConfigClass := ADebuggerClass.ClassName;
FConfigName := '';
FXmlIndex := -1;
APath := Format(APath, [FConfigClass, 'Properties']);
if AForceLoad or AXMLCfg.HasPath(APath, False) then begin
FDebuggerClass := ADebuggerClass;
FDebuggerProperties := ADebuggerClass.CreateProperties;
AXMLCfg.ReadObject(APath, FDebuggerProperties);
end;
end;
constructor TDebuggerPropertiesConfig.CreateFromOldXmlConf(
AXMLCfg: TRttiXMLConfig; APath: String; ADebuggerClassName: String;
AForceLoad: Boolean);
var
p: String;
begin
Create;
FIsFromOldXml := True;
p := Format(APath, [ADebuggerClassName, 'Config']);
if AXMLCfg.HasPath(p, False) then
AForceLoad := True;
// Read first, so any (invalid) Class/Name will be cleared after reading
AXMLCfg.ReadObject(p, Self); // read FDebuggerFilename;
FConfigClass := ADebuggerClassName;
FConfigName := '';
FXmlIndex := -1;
FDebuggerClass := TBaseDebugManagerIntf.DebuggersByClassName[ConfigClass];
APath := Format(APath, [FConfigClass, 'Properties']);
if (FDebuggerClass <> nil) and (AForceLoad or AXMLCfg.HasPath(APath, False)) then begin
FDebuggerProperties := FDebuggerClass.CreateProperties;
AXMLCfg.ReadObject(APath, FDebuggerProperties);
end;
end;
constructor TDebuggerPropertiesConfig.CreateForDebuggerClass(
ADebuggerClass: TDebuggerClass);
begin
Create;
FIsFromOldXml := False;
FXmlIndex := -1;
FDebuggerClass := ADebuggerClass;
FConfigClass := ADebuggerClass.ClassName;
FConfigName := '';
FDebuggerProperties := ADebuggerClass.CreateProperties;
end;
constructor TDebuggerPropertiesConfig.CreateCopy(
ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean;
ACopyXmlOrigin: Boolean);
begin
Create;
CopyFrom(ASource, ACopyPropValues);
if ACopyXmlOrigin then begin
FIsFromOldXml := ASource.FIsFromOldXml;
FXmlIndex := ASource.FXmlIndex;
end
else begin
FIsFromOldXml := False;
FXmlIndex := -1;
end;
end;
procedure TDebuggerPropertiesConfig.CopyFrom(
ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean);
begin
FConfigClass := ASource.FConfigClass;
FConfigName := ASource.FConfigName;
FDebuggerClass := ASource.FDebuggerClass;
FDebuggerFilename := ASource.FDebuggerFilename;
FreeAndNil(FDebuggerProperties);
if ASource.DebuggerClass <> nil then
FDebuggerProperties := ASource.DebuggerClass.CreateProperties;
if ACopyPropValues and (ASource.FDebuggerProperties <> nil) then
FDebuggerProperties.Assign(ASource.FDebuggerProperties);
end;
procedure TDebuggerPropertiesConfig.AssignTo(Dest: TPersistent);
begin
TDebuggerPropertiesConfig(Dest).CopyFrom(Self);
end;
function TDebuggerPropertiesConfig.DisplayName: String;
begin
if FDebuggerClass <> nil then
Result := FDebuggerClass.Caption
else
Result := FConfigClass;
if FConfigName <> '' then
Result := FConfigName + ' [' + Result + ']'
else
Result := '[' + Result + ']';
end;
function TDebuggerPropertiesConfig.NeedsExePath: Boolean;
begin
Result := (FDebuggerClass <> nil) and FDebuggerClass.NeedsExePath;
end;
procedure TDebuggerPropertiesConfig.ChangeDebuggerClass(
ADebuggerClass: TDebuggerClass; ACopyPropValues: Boolean);
var
p: TDebuggerProperties;
begin
FDebuggerClass := ADebuggerClass;
FConfigClass := ADebuggerClass.ClassName;
p := FDebuggerProperties;
FDebuggerProperties := ADebuggerClass.CreateProperties;
if ACopyPropValues and (p <> nil) then
FDebuggerProperties.Assign(p);
p.Free;
end;
procedure TDebuggerPropertiesConfig.MarkAsDeleted;
begin
FreeAndNil(FDebuggerProperties);
end;
function TDebuggerPropertiesConfig.IsLoaded: Boolean;
begin
Result := (FDebuggerClass <> nil) and (FDebuggerProperties <> nil);
end;
function TDebuggerPropertiesConfig.IsDeleted: Boolean;
begin
Result := (FDebuggerClass <> nil) and (FDebuggerProperties = nil);
end;
function TDebuggerPropertiesConfig.DebugText: String;
begin
if Self = nil then
exit('NIL');
Result := Format('C-Name: %s, C-Class: %s, Class %s, Prop %s, Xml: %d %s, Path: %s',
[FConfigName, FConfigClass, DbgSName(FDebuggerClass), dbgs(FDebuggerProperties),
FXmlIndex, dbgs(FIsFromOldXml), FDebuggerFilename]);
end;
procedure TDebuggerPropertiesConfig.DeleteFromXml(AXMLCfg: TRttiXMLConfig;
APath: String);
begin
if FXmlIndex < 0 then
exit;
APath := Format(APath, [FXmlIndex]);
FXmlIndex := -1;
AXMLCfg.DeletePath(APath);
end;
procedure TDebuggerPropertiesConfig.DeleteFromOldXml(AXMLCfg: TRttiXMLConfig;
APath: String);
begin
AXMLCfg.DeletePath(Format(APath, [FConfigClass, 'Config']));
AXMLCfg.DeletePath(Format(APath, [FConfigClass, 'Properties']));
FXmlIndex := -1;
FIsFromOldXml := False;
end;
procedure TDebuggerPropertiesConfig.SaveToXml(AXMLCfg: TRttiXMLConfig;
APath: String; AIndex: Integer);
var
PropDef: TDebuggerProperties;
OptDef: TDebuggerPropertiesConfig;
begin
APath := Format(APath, [AIndex]);
FIsFromOldXml := False;
FXmlIndex := AIndex;
OptDef := TDebuggerPropertiesConfig.Create;
AXMLCfg.WriteObject(APath, Self, OptDef);
OptDef.Free;
if FDebuggerProperties <> nil then begin
PropDef := FDebuggerClass.CreateProperties;
AXMLCfg.WriteObject(APath + 'Properties/', FDebuggerProperties, PropDef);
PropDef.Free;
end;
end;
procedure TDebuggerPropertiesConfig.SaveToOldXml(AXMLCfg: TRttiXMLConfig;
APath: String);
var
PropDef: TDebuggerProperties;
OptDef: TDebuggerPropertiesConfig;
begin
FIsFromOldXml := True;
FXmlIndex := -1;
OptDef := TDebuggerPropertiesConfig.Create;
OptDef.ConfigName := ConfigName; // Do not write Name
// ConfigClass will differ and be written. This ensures that even an unmodified config is written (to preserve its existence)
AXMLCfg.WriteObject(Format(APath, [FConfigClass, 'Config']), Self, OptDef);
OptDef.Free;
if FDebuggerProperties <> nil then begin
APath := Format(APath, [FConfigClass, 'Properties']);
PropDef := FDebuggerClass.CreateProperties;
AXMLCfg.WriteObject(APath, FDebuggerProperties, PropDef);
PropDef.Free;
end;
end;
{ TIDESubOptions }
procedure TIDESubOptions.ReadFromXml(AnXmlConf: TRttiXMLConfig);
@ -1750,9 +2100,8 @@ begin
FFPCSourceDirHistory:=TStringList.Create;
MakeFilename:=DefaultMakefilename;
FMakeFileHistory:=TStringList.Create;
DebuggerFilename:='';
FDebuggerFileHistory:=TStringList.Create;
FDebuggerProperties := TStringList.Create;
FDebuggerProperties := TDebuggerPropertiesConfigList.Create;
FDebuggerEventLogColors:=DebuggerDefaultColors;
FppkgConfigFile:='';
FFppkgConfigFileHistory:=TStringList.Create;
@ -1818,8 +2167,6 @@ begin
end;
destructor TEnvironmentOptions.Destroy;
var
i: Integer;
begin
FreeAndNil(fRegisteredSubConfig);
FreeAndNil(FDesktops);
@ -1836,11 +2183,10 @@ begin
FreeAndNil(FCompilerFileHistory);
FreeAndNil(FFPCSourceDirHistory);
FreeAndNil(FMakeFileHistory);
FreeAndNil(FDebuggerFileHistory);
for i := 0 to FDebuggerProperties.Count - 1 do
FDebuggerProperties.Objects[i].Free;
FreeAndNil(FManyBuildModesSelection);
FDebuggerProperties.ClearAll;
FreeAndNil(FDebuggerProperties);
FreeAndNil(FDebuggerFileHistory);
FreeAndNil(FManyBuildModesSelection);
FreeAndNil(FTestBuildDirHistory);
FreeAndNil(FCompilerMessagesFileHistory);
FreeAndNil(FDebuggerConfig);
@ -2040,8 +2386,8 @@ begin
LoadBackupInfo(FBackupInfoOtherFiles,Path+'BackupOtherFiles/',DefaultBackupTypeOther);
// Debugger
// DO not call LoadDebuggerProperties; => not all debuggers are registered when this is first called
FDebuggerConfig.Load;
DebuggerFilename:=FXMLCfg.GetValue(Path+'DebuggerFilename/Value','');
LoadRecentList(FXMLCfg,FDebuggerFileHistory,Path+'DebuggerFilename/History/',rltFile);
DebuggerSearchPath:=FXMLCfg.GetValue(Path+'DebuggerSearchPath/Value','');
// Debugger General Options
@ -2432,7 +2778,6 @@ begin
// debugger
FDebuggerConfig.Save;
SaveDebuggerPropertiesList;
FXMLCfg.SetDeleteValue(Path+'DebuggerFilename/Value',DebuggerFilename,'');
FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/ShowStopMessage/Value',
FDebuggerShowStopMessage, True);
FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/DebuggerResetAfterRun/Value',
@ -2813,6 +3158,9 @@ end;
function TEnvironmentOptions.GetParsedDebuggerFilename: string;
begin
if FParseValues[eopDebuggerFilename].UnparsedValue <> DebuggerFilename then
SetParseValue(eopDebuggerFilename,UTF8Trim(DebuggerFilename));
Result:=GetParsedValue(eopDebuggerFilename);
end;
@ -2826,12 +3174,26 @@ begin
Result:=GetParsedValue(eopFppkgConfigFile);
end;
function TEnvironmentOptions.GetParsedValue(o: TEnvOptParseType): string;
function TEnvironmentOptions.GetParsedValue(o: TEnvOptParseType;
AUnparsedValue: String): string;
type
PParseString = ^TParseString;
var
SpacePos: SizeInt;
CurParams: String;
TempValue: TParseString;
VP: PParseString;
begin
with FParseValues[o] do begin
if AUnparsedValue <> '' then begin
TempValue.UnparsedValue := AUnparsedValue;
TempValue.ParseStamp := CTInvalidChangeStamp;
TempValue.Parsing := False;
VP := @TempValue;
end
else
VP := @FParseValues[o];
with VP^ do begin
if (ParseStamp<>CompilerParseStamp)
or (CompilerParseStamp=CTInvalidChangeStamp) then begin
if Parsing then begin
@ -3001,50 +3363,155 @@ end;
procedure TEnvironmentOptions.SaveDebuggerPropertiesList;
var
DProp, DDef: TDebuggerProperties;
i: Integer;
i, ConfCount: Integer;
Entry: TDebuggerPropertiesConfig;
begin
for i := FDebuggerProperties.Count - 1 downto 0 do begin
// Delete last entry first
Entry := FDebuggerProperties.Opt[i];
if not Entry.IsLoaded then
Continue;
if (not Entry.IsFromOldXml) then
Entry.DeleteFromXml(FXMLCfg, XML_PATH_DEBUGGER_CONF)
else
if (Entry.DebuggerProperties = nil) or // Entry without DebuggerProperty are a marker for entries to be deleted
(Entry.ConfigName <> '') // Moved to named list
then
Entry.DeleteFromOldXml(FXMLCfg, XML_PATH_DEBUGGER_CONF_OLD);
if Entry.IsDeleted then begin
Entry.Free;
FDebuggerProperties.Delete(i);
end;
end;
ConfCount := FXMLCfg.GetListItemCount('EnvironmentOptions/Debugger/Configs/', 'Config', False) + 1;
for i := 0 to FDebuggerProperties.Count - 1 do begin
DProp := TDebuggerProperties(FDebuggerProperties.Objects[i]);
DDef := TDebuggerPropertiesClass(DProp.ClassType).Create;
FXMLCfg.WriteObject(
'EnvironmentOptions/Debugger/Class' + FDebuggerProperties[i] + '/Properties/',
DProp, DDef);
DDef.Free;
Entry := FDebuggerProperties.Opt[i];
if not Entry.IsLoaded then
Continue;
Entry.Active := Entry = FCurrentDebuggerPropertiesConfig;
if(Entry.ConfigName <> '') then begin
Entry.SaveToXml(FXMLCfg, XML_PATH_DEBUGGER_CONF, ConfCount);
inc(ConfCount);
end
else begin
Entry.SaveToOldXml(FXMLCfg, XML_PATH_DEBUGGER_CONF_OLD);
// For compatibility
if Entry.Active then
FXMLCfg.SetDeleteValue('EnvironmentOptions/DebuggerFilename/Value', Entry.DebuggerFilename,'');
end;
end;
// compatibility
if (FCurrentDebuggerPropertiesConfig <> nil) and (FCurrentDebuggerPropertiesConfig.ConfigName = '') then
FXMLCfg.SetValue('EnvironmentOptions/Debugger/Class', CurrentDebuggerPropertiesConfig.ConfigClass)
else
FXMLCfg.DeleteValue('EnvironmentOptions/Debugger/Class')
end;
procedure TEnvironmentOptions.LoadDebuggerProperties;
var
ConfCount, i: Integer;
DbgClassType: TDebuggerClass;
Entry, UnloadedCurrent: TDebuggerPropertiesConfig;
ActiveClassName, CurFilename: String;
ActiveClassSeen: Boolean;
begin
if (FDebuggerProperties.Count > 0) and
(TBaseDebugManagerIntf.DebuggerCount = FKnownDebuggerClassCount)
then
exit;
FKnownDebuggerClassCount := TBaseDebugManagerIntf.DebuggerCount;
FDebuggerProperties.ClearAll;
FCurrentDebuggerPropertiesConfig := nil;
UnloadedCurrent := nil;
// Load new style entries
ConfCount := FXMLCfg.GetListItemCount('EnvironmentOptions/Debugger/Configs/', 'Config', False);
for i := 1 to ConfCount do begin
Entry := TDebuggerPropertiesConfig.CreateFromXmlConf(FXMLCfg, XML_PATH_DEBUGGER_CONF, i);
FDebuggerProperties.AddObject(Entry.ConfigName, Entry);
if Entry.Active and Entry.IsLoaded and (FCurrentDebuggerPropertiesConfig = nil) then
FCurrentDebuggerPropertiesConfig := Entry;
if Entry.Active and (UnloadedCurrent = nil) then
UnloadedCurrent := Entry;
end;
if FCurrentDebuggerPropertiesConfig = nil then
FCurrentDebuggerPropertiesConfig := UnloadedCurrent;
// Read old style, per class
ActiveClassName := '';
ActiveClassSeen := False;
if FCurrentDebuggerPropertiesConfig = nil then
ActiveClassName := FXMLCfg.GetValue('EnvironmentOptions/Debugger/Class', '');
// There is only one filename for all classes
CurFilename:=FXMLCfg.GetValue('EnvironmentOptions/DebuggerFilename/Value','');
for i := 0 to TBaseDebugManagerIntf.DebuggerCount -1 do begin
DbgClassType := TBaseDebugManagerIntf.Debuggers[i];
ActiveClassSeen := ActiveClassSeen or (LowerCase(DbgClassType.ClassName) = LowerCase(ActiveClassName));
Entry := TDebuggerPropertiesConfig.CreateFromOldXmlConf(FXMLCfg, XML_PATH_DEBUGGER_CONF_OLD,
DbgClassType, LowerCase(DbgClassType.ClassName) = LowerCase(ActiveClassName));
if not Entry.IsLoaded then begin
Entry.Free;
Continue;
end;
if (Entry.DebuggerFilename = '') and (Entry.NeedsExePath or (not Entry.IsLoaded)) then
Entry.DebuggerFilename := CurFilename;
FDebuggerProperties.AddObject(Entry.ConfigName, Entry);
if (Entry.ConfigClass = ActiveClassName) and (FCurrentDebuggerPropertiesConfig = nil) then
FCurrentDebuggerPropertiesConfig := Entry;
end;
// current active debugger was not found / may not an unknown class
// InitialSetupDlg depends on having a debugger loaded, with the ONLY exception: ActiveClassName = ''
if (not ActiveClassSeen) and (ActiveClassName <> '') then begin
Entry := TDebuggerPropertiesConfig.CreateFromOldXmlConf(FXMLCfg, XML_PATH_DEBUGGER_CONF_OLD, ActiveClassName, True);
if (Entry.DebuggerFilename = '') and (Entry.NeedsExePath or (not Entry.IsLoaded)) then
Entry.DebuggerFilename := CurFilename;
FDebuggerProperties.AddObject(Entry.ConfigName, Entry);
// FCurrentDebuggerPropertiesConfig may NOT be loaded !!!
FCurrentDebuggerPropertiesConfig := Entry;
end;
end;
procedure TEnvironmentOptions.SaveDebuggerProperties(DebuggerClass: String;
Properties: TDebuggerProperties);
var
i: Integer;
Prop: TDebuggerProperties;
function TEnvironmentOptions.GetCurrentDebuggerClass: TDebuggerClass;
begin
i := FDebuggerProperties.IndexOf(DebuggerClass);
if i < 0 then begin
Prop := TDebuggerPropertiesClass(Properties.ClassType).Create;
Prop.Assign(Properties);
FDebuggerProperties.AddObject(DebuggerClass, Prop);
end
else
TDebuggerProperties(FDebuggerProperties.Objects[i]).Assign(Properties);
LoadDebuggerProperties;
Result := nil;
if CurrentDebuggerPropertiesConfig <> nil then
Result := CurrentDebuggerPropertiesConfig.DebuggerClass;
end;
procedure TEnvironmentOptions.LoadDebuggerProperties(DebuggerClass: String;
Properties: TDebuggerProperties);
var
i: Integer;
DDef: TDebuggerProperties;
function TEnvironmentOptions.GetCurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig;
begin
i := FDebuggerProperties.IndexOf(DebuggerClass);
if i < 0 then begin
DDef := TDebuggerPropertiesClass(Properties.ClassType).Create;
FXMLCfg.ReadObject('EnvironmentOptions/Debugger/Class' + DebuggerClass + '/Properties/',
Properties, DDef);
DDef.Free;
end
else
Properties.Assign(TDebuggerProperties(FDebuggerProperties.Objects[i]));
LoadDebuggerProperties;
Result := FCurrentDebuggerPropertiesConfig;
end;
procedure TEnvironmentOptions.SetCurrentDebuggerPropertiesOpt(
AValue: TDebuggerPropertiesConfig);
begin
LoadDebuggerProperties;
if FCurrentDebuggerPropertiesConfig = AValue then Exit;
if (FDebuggerProperties.IndexOfObject(AValue) < 0) then
FDebuggerProperties.AddObject(AValue.ConfigName, AValue);
FCurrentDebuggerPropertiesConfig := AValue;
end;
function TEnvironmentOptions.DebuggerPropertiesConfigList: TDebuggerPropertiesConfigList;
begin
LoadDebuggerProperties;
Result := FDebuggerProperties;
end;
function TEnvironmentOptions.FileHasChangedOnDisk: boolean;
@ -3239,7 +3706,10 @@ end;
function TEnvironmentOptions.GetDebuggerFilename: string;
begin
Result:=FParseValues[eopDebuggerFilename].UnparsedValue;
Result := '';
LoadDebuggerProperties;
if CurrentDebuggerPropertiesConfig <> nil then
Result:=CurrentDebuggerPropertiesConfig.DebuggerFilename;
end;
function TEnvironmentOptions.GetDebuggerSearchPath: string;
@ -3336,11 +3806,6 @@ begin
SetParseValue(eopMakeFilename,TrimFilename(AValue));
end;
procedure TEnvironmentOptions.SetDebuggerFilename(AValue: string);
begin
SetParseValue(eopDebuggerFilename,UTF8Trim(AValue));
end;
procedure TEnvironmentOptions.SetFppkgConfigFile(AValue: string);
begin
SetParseValue(eopFppkgConfigFile,UTF8Trim(AValue));

115
ide/initialsetupdlgs.pas
View File

@ -156,6 +156,7 @@ type
procedure FppkgBrowseButtonClick(Sender: TObject);
procedure FppkgWriteConfigButtonClick(Sender: TObject);
private
FSkipDebugger: Boolean;
FFlags: TSDFlags;
FLastParsedLazDir: string;
fLastParsedCompiler: string;
@ -214,7 +215,7 @@ function ShowInitialSetupDialog: TModalResult;
// Debugger
// Checks a given file to see if it is a valid debugger (only gdb supported for now)
function CheckDebuggerQuality(AFilename: string; out Note: string): TSDFilenameQuality;
function CheckDebuggerQuality(AFilename: string; out Note: string; ASkip: Boolean = False): TSDFilenameQuality;
// Search debugger candidates and add them to list, including quality level
function SearchDebuggerCandidates(StopIfFits: boolean): TSDFileInfoList;
@ -237,8 +238,17 @@ type
LazarusDir: string;
end;
function CheckDebuggerQuality(AFilename: string; out Note: string): TSDFilenameQuality;
function CheckDebuggerQuality(AFilename: string; out Note: string;
ASkip: Boolean): TSDFilenameQuality;
begin
Note := '';
Result:=sddqCompatible;
if ASkip and // assume compatible
( (EnvironmentOptions.CurrentDebuggerPropertiesConfig = nil) or
(EnvironmentOptions.DebuggerFilename = AFilename) // unless the user edited the filename
)
then
exit;
Result:=sddqInvalid;
AFilename:=TrimFilename(AFilename);
if not FileExistsCached(AFilename) then
@ -275,8 +285,7 @@ function SearchDebuggerCandidates(StopIfFits: boolean): TSDFileInfoList;
ForcePathDelims(AFilename);
// check if already checked
if Assigned(List) and List.CaptionExists(AFilename) then exit;
EnvironmentOptions.DebuggerFilename:=AFilename;
RealFilename:=EnvironmentOptions.GetParsedDebuggerFilename;
RealFilename:=EnvironmentOptions.GetParsedValue(eopDebuggerFilename, AFilename);
debugln(['SearchDebuggerCandidates Value=',AFilename,' File=',RealFilename]);
if RealFilename='' then exit;
// check if exists
@ -292,36 +301,52 @@ function SearchDebuggerCandidates(StopIfFits: boolean): TSDFileInfoList;
const
DebuggerFileName='gdb'; //For Windows, .exe will be appended
var
OldDebuggerFilename: String;
s, AFilename: String;
s, AFilename, XmlClassName, CurDbgClassName: String;
Files: TStringList;
i: Integer;
begin
Result:=nil;
OldDebuggerFilename:=EnvironmentOptions.DebuggerFilename;
try
// check current setting
if CheckFile(EnvironmentOptions.DebuggerFilename,Result) then exit;
// check current setting
if CheckFile(EnvironmentOptions.DebuggerFilename,Result) then exit;
// check the primary options
if EnvironmentOptions.CurrentDebuggerPropertiesConfig <> nil then
CurDbgClassName := UpperCase(EnvironmentOptions.CurrentDebuggerPropertiesConfig.ConfigClass)
else
CurDbgClassName := UpperCase(DefaultDebuggerClass.ClassName);
// check the primary options
XmlClassName :=GetValueFromPrimaryConfig(EnvOptsConfFileName,
'EnvironmentOptions/Debugger/Class');
if UpperCase(XmlClassName) = CurDbgClassName then begin
AFilename:=GetValueFromPrimaryConfig(EnvOptsConfFileName,
'EnvironmentOptions/DebuggerFilename/Value');
if CheckFile(AFilename,Result) then exit;
end;
// check the secondary options
// check the secondary options
XmlClassName :=GetValueFromSecondaryConfig(EnvOptsConfFileName,
'EnvironmentOptions/Debugger/Class');
if UpperCase(XmlClassName) = CurDbgClassName then begin
AFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
'EnvironmentOptions/DebuggerFilename/Value');
if CheckFile(AFilename,Result) then exit;
end;
// Check locations proposed by debugger class
// Check locations proposed by debugger class
if EnvironmentOptions.CurrentDebuggerClass <> nil then
s := EnvironmentOptions.CurrentDebuggerClass.ExePaths
else
s := DefaultDebuggerClass.ExePaths;
while s <> '' do begin
AFilename := GetPart([], [';'], s);
if CheckFile(AFilename, Result) then exit;
if s <> '' then delete(s, 1, 1);
end;
while s <> '' do begin
AFilename := GetPart([], [';'], s);
if CheckFile(AFilename, Result) then exit;
if s <> '' then delete(s, 1, 1);
end;
// Search for gdb
// only if TGDBMIDebugger
if CurDbgClassName = UpperCase(DefaultDebuggerClass.ClassName) then begin
// Windows-only locations:
if (GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)='win') then begin
@ -339,13 +364,11 @@ begin
// check PATH
AFilename:=DebuggerFileName+GetExecutableExt;
if CheckFile(AFilename,Result) then exit;
// There are no common directories apart from the PATH
// where gdb would be installed. Otherwise we could do something similar as
// in SearchMakeExeCandidates.
finally
EnvironmentOptions.DebuggerFilename:=OldDebuggerFilename;
end;
// There are no common directories apart from the PATH
// where gdb would be installed. Otherwise we could do something similar as
// in SearchMakeExeCandidates.
end;
function ShowInitialSetupDialog: TModalResult;
@ -720,11 +743,15 @@ begin
s:=MakeExeComboBox.Text;
if s<>'' then
EnvironmentOptions.MakeFilename:=s;
s:=DebuggerComboBox.Text;
if s<>'' then begin
EnvironmentOptions.DebuggerFilename:=s;
if s <> FInitialDebuggerFileName then
EnvironmentOptions.DebuggerConfig.DebuggerClass := 'TGDBMIDebugger';
if not (FSkipDebugger and (EnvironmentOptions.CurrentDebuggerPropertiesConfig = nil))
then begin
s:=DebuggerComboBox.Text;
if s<>'' then begin
if EnvironmentOptions.CurrentDebuggerPropertiesConfig = nil then
EnvironmentOptions.CurrentDebuggerPropertiesConfig :=
TDebuggerPropertiesConfig.CreateForDebuggerClass(TGDBMIDebugger);
EnvironmentOptions.CurrentDebuggerPropertiesConfig.DebuggerFilename:=s;
end;
end;
ModalResult:=mrOk;
@ -1125,25 +1152,25 @@ var
CurCaption: String;
Note: string;
Quality: TSDFilenameQuality;
s: String;
s, ParsedFName: String;
ImageIndex: Integer;
begin
if csDestroying in ComponentState then exit;
CurCaption:=DebuggerComboBox.Text;
EnvironmentOptions.DebuggerFilename:=CurCaption;
if fLastParsedDebugger=EnvironmentOptions.GetParsedDebuggerFilename then exit;
fLastParsedDebugger:=EnvironmentOptions.GetParsedDebuggerFilename;
ParsedFName := EnvironmentOptions.GetParsedValue(eopDebuggerFilename, CurCaption);
if fLastParsedDebugger=ParsedFName then exit;
fLastParsedDebugger:=ParsedFName;
//debugln(['TInitialSetupDialog.UpdateDebuggerNote ',fLastParsedDebugger]);
Quality:=CheckDebuggerQuality(fLastParsedDebugger,Note);
Quality:=CheckDebuggerQuality(fLastParsedDebugger,Note, FSkipDebugger);
case Quality of
sddqInvalid: s:=lisError;
sddqCompatible: s:='';
else s:=lisWarning;
end;
if EnvironmentOptions.DebuggerFilename<>EnvironmentOptions.GetParsedDebuggerFilename
if CurCaption<>ParsedFName
then
s:=lisFile2+EnvironmentOptions.GetParsedDebuggerFilename+LineEnding+
s:=lisFile2+ParsedFName+LineEnding+
LineEnding+s;
DebuggerMemo.Text:=s+Note;
@ -1342,15 +1369,25 @@ begin
fLastParsedMakeExe:='. .';
UpdateMakeExeNote;
RegisterDebugger(TGDBMIDebugger); // make sure we can read the config
FSkipDebugger := (EnvironmentOptions.CurrentDebuggerPropertiesConfig <> nil) and ( // Has a debugger
(EnvironmentOptions.CurrentDebuggerClass = nil) or // Unknown existing debugger class
(not EnvironmentOptions.CurrentDebuggerPropertiesConfig.NeedsExePath) // Does not need an exe
);
// Debugger
FInitialDebuggerFileName := EnvironmentOptions.DebuggerFilename;
UpdateDebuggerCandidates;
if IsFirstStart or (not FileExistsCached(EnvironmentOptions.GetParsedDebuggerFilename))
if (not FSkipDebugger) and
( IsFirstStart or (not FileExistsCached(EnvironmentOptions.GetParsedDebuggerFilename)) )
then begin
// first start => choose first best candidate
Candidate:=GetFirstCandidate(FCandidates[sddtDebuggerFilename]);
if Candidate<>nil then
EnvironmentOptions.DebuggerFilename:=Candidate.Caption;
if Candidate<>nil then begin
if EnvironmentOptions.CurrentDebuggerPropertiesConfig = nil then
EnvironmentOptions.CurrentDebuggerPropertiesConfig :=
TDebuggerPropertiesConfig.CreateForDebuggerClass(TGDBMIDebugger);
EnvironmentOptions.CurrentDebuggerPropertiesConfig.DebuggerFilename:=Candidate.Caption;
end;
end;
DebuggerComboBox.Text:=EnvironmentOptions.DebuggerFilename;
fLastParsedDebugger:='. .';

2
ide/lazarusidestrconsts.pas
View File

@ -5365,6 +5365,7 @@ resourcestring
lisAnchorEditorNoControlSelected = 'Anchor Editor - no control selected';
lisAnchorsOfSelectedControls = 'Anchors of selected controls';
lisAnchorsOf = 'Anchors of %s';
lisDebugOptionsFrmName = 'Name:';
lisDebugOptionsFrmAdditionalSearchPath = 'Additional search path';
lisDebugOptionsFrmDebuggerGeneralOptions = 'Debugger general options';
lisDebugOptionsFrmShowMessageOnStop = 'Show message on stop';
@ -6591,6 +6592,7 @@ resourcestring
UnitDepOptionsForPackage = 'Options for Package graph';
UnitDepOptionsForUnit = 'Options for Unit graph';
LvlGraphReduceBackedges = 'Reduce backedges';
lisDebugOptionsFrmBackend = 'Backend';
implementation

27
ide/main.pp
View File

@ -99,7 +99,7 @@ uses
// LRT stuff
Translations,
// debugger
LazDebuggerGdbmi,
LazDebuggerGdbmi, GDBMIDebugger,
RunParamsOpts, BaseDebugManager, DebugManager, debugger, DebuggerDlg,
DebugAttachDialog, DbgIntfBaseTypes, DbgIntfDebuggerBase,
// packager
@ -124,7 +124,7 @@ uses
codetools_classcompletion_options,
codetools_wordpolicy_options, codetools_linesplitting_options,
codetools_space_options, codetools_identifiercompletion_options,
debugger_general_options, debugger_eventlog_options,
debugger_general_options, debugger_class_options, debugger_eventlog_options,
debugger_language_exceptions_options, debugger_signals_options,
codeexplorer_update_options, codeexplorer_categories_options,
codeobserver_options, help_general_options, env_file_filters,
@ -1428,13 +1428,20 @@ begin
end;
// check debugger
if (not ShowSetupDialog)
and ((EnvironmentOptions.DebuggerConfig.DebuggerClass='')
or (EnvironmentOptions.DebuggerConfig.DebuggerClass='TGDBMIDebugger'))
and (CheckDebuggerQuality(EnvironmentOptions.GetParsedDebuggerFilename, Note)<>sddqCompatible)
then begin
debugln(['Warning: (lazarus) missing GDB exe',EnvironmentOptions.GetParsedLazarusDirectory]);
ShowSetupDialog:=true;
if (not ShowSetupDialog) then begin
// PackageBoss is not yet loaded...
RegisterDebugger(TGDBMIDebugger); // make sure we can read the config
// Todo: add LldbFpDebugger for Mac
// If the default debugger is of a class that is not yet Registered, then the dialog is not shown
if (EnvironmentOptions.CurrentDebuggerPropertiesConfig = nil) // no debugger at all / not even with unknown class
or ( (EnvironmentOptions.CurrentDebuggerClass <> nil) // Debugger with known class
and (EnvironmentOptions.CurrentDebuggerPropertiesConfig.NeedsExePath) // Which does need an exe
and (CheckDebuggerQuality(EnvironmentOptions.GetParsedDebuggerFilename, Note)<>sddqCompatible)
)
then begin
debugln(['Warning: (lazarus) missing GDB exe',EnvironmentOptions.GetParsedLazarusDirectory]);
ShowSetupDialog:=true;
end;
end;
// check 'make' utility
@ -7428,7 +7435,7 @@ begin
Result := mrAbort;
Exit;
end;
debugln('Hint: (lazarus) [TMainIDE.DoRunProject] Debugger=',EnvironmentOptions.DebuggerConfig.DebuggerClass);
debugln('Hint: (lazarus) [TMainIDE.DoRunProject] Debugger=',DbgSName(EnvironmentOptions.CurrentDebuggerClass));
try
Result:=mrCancel;