mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 17:57:54 +02:00
IDE, Debugger, Project: Allow setting up project specific debugger backends
This commit is contained in:
Martin
parent
bf105af56c
commit
eea8b2cd21
@ -218,7 +218,7 @@ const
|
||||
ProjectOptionsResources = 550;
|
||||
ProjectOptionsI18N = 600;
|
||||
ProjectOptionsMisc = 700;
|
||||
ProjectOptionsDebug = 700;
|
||||
ProjectOptionsDebug = 800;
|
||||
DbgOptionsLanguageExceptions = 900;
|
||||
|
||||
GroupPackage = 200100;
|
||||
|
||||
@ -56,7 +56,7 @@ type
|
||||
|
||||
{ TCodeBufXMLConfig }
|
||||
|
||||
TCodeBufXMLConfig = class(TXMLConfig)
|
||||
TCodeBufXMLConfig = class(TRttiXMLConfig)
|
||||
private
|
||||
FCodeCache: TCodeCache;
|
||||
protected
|
||||
|
||||
@ -76,21 +76,23 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 10
|
||||
Height = 15
|
||||
Top = 10
|
||||
Top = 31
|
||||
Width = 45
|
||||
BorderSpacing.Left = 10
|
||||
Caption = 'lblName'
|
||||
Color = clDefault
|
||||
ParentColor = False
|
||||
end
|
||||
object edName: TEdit
|
||||
AnchorSideLeft.Control = lblName
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Panel1
|
||||
AnchorSideTop.Control = lblWarningProject
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Panel1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 61
|
||||
Height = 23
|
||||
Top = 6
|
||||
Top = 27
|
||||
Width = 448
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 6
|
||||
@ -108,7 +110,7 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 105
|
||||
Top = 35
|
||||
Top = 56
|
||||
Width = 519
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
AutoSize = True
|
||||
@ -196,6 +198,7 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'LblWarnClassChange'
|
||||
Color = clDefault
|
||||
Font.Color = clRed
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
@ -211,7 +214,7 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 55
|
||||
Top = 146
|
||||
Top = 167
|
||||
Width = 519
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
AutoSize = True
|
||||
@ -261,14 +264,30 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
|
||||
AnchorSideBottom.Control = Panel1
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 194
|
||||
Top = 207
|
||||
Height = 173
|
||||
Top = 228
|
||||
Width = 519
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Top = 6
|
||||
Caption = 'Debugger specific options (depends on type of debugger)'
|
||||
TabOrder = 3
|
||||
end
|
||||
object lblWarningProject: TLabel
|
||||
AnchorSideLeft.Control = Panel1
|
||||
AnchorSideTop.Control = Panel1
|
||||
AnchorSideRight.Control = Panel1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 15
|
||||
Top = 6
|
||||
Width = 507
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'lblWarningProject'
|
||||
Font.Color = clRed
|
||||
ParentFont = False
|
||||
Visible = False
|
||||
end
|
||||
end
|
||||
object tbDropMenu: TPopupMenu
|
||||
Left = 294
|
||||
|
||||
@ -37,7 +37,8 @@ uses
|
||||
GDBMIDebugger,
|
||||
// IDE
|
||||
TransferMacros, LazarusIDEStrConsts, PathEditorDlg, IDEProcs, DialogProcs,
|
||||
InputHistory, EnvironmentOpts, BaseDebugManager, Debugger, IdeDebuggerOpts;
|
||||
InputHistory, EnvironmentOpts, BaseDebugManager, Project, Debugger,
|
||||
IdeDebuggerOpts;
|
||||
|
||||
type
|
||||
|
||||
@ -53,6 +54,7 @@ type
|
||||
gbAdditionalSearchPath: TGroupBox;
|
||||
gbDebuggerSpecific: TGroupBox;
|
||||
gbDebuggerType: TGroupBox;
|
||||
lblWarningProject: TLabel;
|
||||
LblWarnClassChange: TLabel;
|
||||
lblName: TLabel;
|
||||
Panel1: TPanel;
|
||||
@ -77,6 +79,8 @@ type
|
||||
private
|
||||
FDebuggerFileHistory: TStringList;
|
||||
FInOdNameExit: Boolean;
|
||||
FOnModifiedDbgPropertiesCountChanged: TNotifyEvent;
|
||||
FShowWarningOverridenByProject: boolean;
|
||||
PropertyGrid: TOIPropertyGrid;
|
||||
FPropertyEditorHook: TPropertyEditorHook;
|
||||
FCopiedDbgPropertiesConfigList: TDebuggerPropertiesConfigList;
|
||||
@ -96,6 +100,7 @@ type
|
||||
procedure ClearDbgProperties;
|
||||
procedure FillNameDropDown;
|
||||
procedure HookGetCheckboxForBoolean(var Value: Boolean);
|
||||
procedure DoModifiedDbgPropertiesCountChanged;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -103,8 +108,13 @@ type
|
||||
function GetTitle: String; override;
|
||||
procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
|
||||
procedure ReadSettings({%H-}AOptions: TAbstractIDEOptions); override;
|
||||
procedure ReadSettings(ADbgConf: TDebuggerPropertiesConfigList);
|
||||
procedure WriteSettings({%H-}AOptions: TAbstractIDEOptions); override;
|
||||
procedure WriteSettings(ADbgConf: TDebuggerPropertiesConfigList);
|
||||
class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
|
||||
property ModifiedDbgPropertiesConfigList: TDebuggerPropertiesConfigList read FCopiedDbgPropertiesConfigList;
|
||||
property ShowWarningOverridenByProject: boolean read FShowWarningOverridenByProject write FShowWarningOverridenByProject;
|
||||
property OnModifiedDbgPropertiesCountChanged: TNotifyEvent read FOnModifiedDbgPropertiesCountChanged write FOnModifiedDbgPropertiesCountChanged;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -245,6 +255,7 @@ begin
|
||||
cmbDebuggerType.Enabled := True;
|
||||
BtnEditClass.Visible := False;
|
||||
LblWarnClassChange.Visible := False;
|
||||
DoModifiedDbgPropertiesCountChanged;
|
||||
end;
|
||||
|
||||
procedure TDebuggerClassOptionsFrame.tbCopyClick(Sender: TObject);
|
||||
@ -275,6 +286,7 @@ begin
|
||||
cmbDebuggerType.Enabled := True;
|
||||
BtnEditClass.Visible := False;
|
||||
LblWarnClassChange.Visible := False;
|
||||
DoModifiedDbgPropertiesCountChanged;
|
||||
end;
|
||||
|
||||
procedure TDebuggerClassOptionsFrame.tbDeleteClick(Sender: TObject);
|
||||
@ -292,6 +304,7 @@ begin
|
||||
FillNameDropDown;
|
||||
UpdateDebuggerClassDropDown;
|
||||
FetchDebuggerSpecificOptions;
|
||||
DoModifiedDbgPropertiesCountChanged;
|
||||
end;
|
||||
|
||||
function TDebuggerClassOptionsFrame.SelectedDebuggerClass: TDebuggerClass;
|
||||
@ -541,6 +554,7 @@ procedure TDebuggerClassOptionsFrame.ClearDbgProperties;
|
||||
begin
|
||||
PropertyGrid.Selection.Clear;
|
||||
FCopiedDbgPropertiesConfigList.ClearAll;
|
||||
DoModifiedDbgPropertiesCountChanged;
|
||||
end;
|
||||
|
||||
procedure TDebuggerClassOptionsFrame.FillNameDropDown;
|
||||
@ -573,6 +587,13 @@ begin
|
||||
Panel1.Enabled := FSelectedDbgPropertiesConfig <> nil;
|
||||
tbCopy.Enabled := FSelectedDbgPropertiesConfig <> nil;
|
||||
tbDelete.Enabled := FSelectedDbgPropertiesConfig <> nil;
|
||||
|
||||
if ShowWarningOverridenByProject then
|
||||
lblWarningProject.Visible := (
|
||||
(Project1.DebuggerBackend <> FSelectedDbgPropertiesConfig.UID) and
|
||||
(Project1.DebuggerBackend <> 'IDE') and
|
||||
not( (Project1.DebuggerBackend = '') and (Project1.DebuggerPropertiesConfigList.CountWithoutDeleted > 0) )
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TDebuggerClassOptionsFrame.HookGetCheckboxForBoolean(var Value: Boolean);
|
||||
@ -580,6 +601,12 @@ begin
|
||||
Value := EnvironmentOptions.ObjectInspectorOptions.CheckboxForBoolean;
|
||||
end;
|
||||
|
||||
procedure TDebuggerClassOptionsFrame.DoModifiedDbgPropertiesCountChanged;
|
||||
begin
|
||||
if FOnModifiedDbgPropertiesCountChanged <> nil then
|
||||
FOnModifiedDbgPropertiesCountChanged(Self);
|
||||
end;
|
||||
|
||||
constructor TDebuggerClassOptionsFrame.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
@ -644,6 +671,7 @@ begin
|
||||
tbCopy.Caption := lisCopy;
|
||||
tbDelete.Caption := lisDelete;
|
||||
lblName.Caption := lisDebugOptionsFrmName;
|
||||
lblWarningProject.Caption := 'The project options have been set to use a different debugger backend';
|
||||
BtnEditClass.Caption := lisDebugOptionsFrmEditClass;
|
||||
LblWarnClassChange.Caption := lisDebugOptionsFrmEditClassWarn;
|
||||
gbDebuggerType.Caption := dlgDebugType;
|
||||
@ -652,57 +680,63 @@ begin
|
||||
end;
|
||||
|
||||
procedure TDebuggerClassOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
|
||||
begin
|
||||
ShowWarningOverridenByProject := True;
|
||||
ReadSettings(EnvironmentOptions.DebuggerPropertiesConfigList);
|
||||
end;
|
||||
|
||||
procedure TDebuggerClassOptionsFrame.ReadSettings(
|
||||
ADbgConf: TDebuggerPropertiesConfigList);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
EnvironmentOptions.ObjectInspectorOptions.AssignTo(PropertyGrid);
|
||||
|
||||
ClearDbgProperties;
|
||||
with EnvironmentOptions do
|
||||
begin
|
||||
ObjectInspectorOptions.AssignTo(PropertyGrid);
|
||||
FDebuggerFileHistory.Clear;
|
||||
FCopiedDbgPropertiesConfigList.ClearAll;
|
||||
for i := 0 to ADbgConf.Count - 1 do
|
||||
FCopiedDbgPropertiesConfigList.AddObject(ADbgConf[i],
|
||||
TDebuggerPropertiesConfig.CreateCopy(ADbgConf.Opt[i], True, True) );
|
||||
// Find our copy of the current entry
|
||||
if ADbgConf.CurrentDebuggerPropertiesConfig = nil then
|
||||
FSelectedDbgPropertiesConfig := nil
|
||||
else
|
||||
FSelectedDbgPropertiesConfig := FCopiedDbgPropertiesConfigList.EntryByName(
|
||||
ADbgConf.CurrentDebuggerPropertiesConfig.ConfigName, ADbgConf.CurrentDebuggerPropertiesConfig.ConfigClass);
|
||||
|
||||
FDebuggerFileHistory.Clear;
|
||||
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;
|
||||
FillNameDropDown;
|
||||
FillDebuggerClassDropDown;
|
||||
FetchDebuggerSpecificOptions;
|
||||
DoModifiedDbgPropertiesCountChanged;
|
||||
end;
|
||||
|
||||
procedure TDebuggerClassOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
|
||||
begin
|
||||
WriteSettings(EnvironmentOptions.DebuggerPropertiesConfigList);
|
||||
EnvironmentOptions.SaveDebuggerPropertiesList; // Update XML
|
||||
end;
|
||||
|
||||
procedure TDebuggerClassOptionsFrame.WriteSettings(
|
||||
ADbgConf: TDebuggerPropertiesConfigList);
|
||||
var
|
||||
i: Integer;
|
||||
EnvConf: TDebuggerPropertiesConfigList;
|
||||
begin
|
||||
UpdateDebuggerPathHistory;
|
||||
with EnvironmentOptions do
|
||||
begin
|
||||
for i := 0 to FDebuggerFileHistory.Count - 1 do
|
||||
DebuggerFileHistory[FDebuggerFileHistory[i]].Assign(TStringList(FDebuggerFileHistory.Objects[i]));
|
||||
for i := 0 to FDebuggerFileHistory.Count - 1 do
|
||||
EnvironmentOptions.DebuggerFileHistory[FDebuggerFileHistory[i]].Assign(TStringList(FDebuggerFileHistory.Objects[i]));
|
||||
|
||||
// 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);
|
||||
SaveDebuggerPropertiesList; // Update XML
|
||||
end;
|
||||
ADbgConf.ClearAll;
|
||||
for i := 0 to FCopiedDbgPropertiesConfigList.Count - 1 do
|
||||
ADbgConf.AddObject(FCopiedDbgPropertiesConfigList[i],
|
||||
TDebuggerPropertiesConfig.CreateCopy(FCopiedDbgPropertiesConfigList.Opt[i], True, True) );
|
||||
if FSelectedDbgPropertiesConfig = nil then
|
||||
ADbgConf.CurrentDebuggerPropertiesConfig := nil
|
||||
else
|
||||
ADbgConf.CurrentDebuggerPropertiesConfig := ADbgConf.EntryByName(
|
||||
FSelectedDbgPropertiesConfig.ConfigName, FSelectedDbgPropertiesConfig.ConfigClass);
|
||||
end;
|
||||
|
||||
class function TDebuggerClassOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
|
||||
|
||||
@ -204,6 +204,6 @@ begin
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterIDEOptionsEditor(GroupProject, TDebuggerLanguageExceptionsOptions, DbgOptionsLanguageExceptions);
|
||||
RegisterIDEOptionsEditor(GroupProject, TDebuggerLanguageExceptionsOptions, DbgOptionsLanguageExceptions, ProjectOptionsDebug);
|
||||
end.
|
||||
|
||||
|
||||
@ -58,9 +58,10 @@ uses
|
||||
BreakPointsdlg, BreakPropertyDlg, LocalsDlg, WatchPropertyDlg, CallStackDlg,
|
||||
EvaluateDlg, RegistersDlg, AssemblerDlg, DebugOutputForm, ExceptionDlg,
|
||||
InspectDlg, DebugEventsForm, PseudoTerminalDlg, FeedbackDlg, ThreadDlg,
|
||||
HistoryDlg, ProcessDebugger, IdeDebuggerBase, DbgIntfBaseTypes,
|
||||
DbgIntfDebuggerBase, DbgIntfMiscClasses, DbgIntfPseudoTerminal,
|
||||
LazDebuggerIntf, LazDebuggerIntfBaseTypes, BaseDebugManager;
|
||||
HistoryDlg, ProcessDebugger, IdeDebuggerBase, IdeDebuggerOpts,
|
||||
DbgIntfBaseTypes, DbgIntfDebuggerBase, DbgIntfMiscClasses,
|
||||
DbgIntfPseudoTerminal, LazDebuggerIntf, LazDebuggerIntfBaseTypes,
|
||||
BaseDebugManager;
|
||||
|
||||
|
||||
type
|
||||
@ -2478,15 +2479,15 @@ begin
|
||||
|
||||
// check if debugger needs an Exe and the exe is there
|
||||
if (NewDebuggerClass.NeedsExePath)
|
||||
and not FileIsExecutable(EnvironmentOptions.GetParsedDebuggerFilename(Project1))
|
||||
and not FileIsExecutable(Project1.GetParsedDebuggerFilename)
|
||||
then begin
|
||||
if not PromptOnError then
|
||||
ClearPathAndExe
|
||||
else begin
|
||||
debugln(['Info: (lazarus) [TDebugManager.GetLaunchPathAndExe] EnvironmentOptions.DebuggerFilename="',EnvironmentOptions.DebuggerFilename,'"']);
|
||||
debugln(['Info: (lazarus) [TDebugManager.GetLaunchPathAndExe] Project1.DebuggerFilename="',Project1.DebuggerFilename,'"']);
|
||||
IDEMessageDialog(lisDebuggerInvalid,
|
||||
Format(lisTheDebuggerDoesNotExistsOrIsNotExecutableSeeEnviro,
|
||||
[EnvironmentOptions.DebuggerFilename(Project1), LineEnding, LineEnding+LineEnding]),
|
||||
[Project1.DebuggerFilename, LineEnding, LineEnding+LineEnding]),
|
||||
mtError,[mbOK]);
|
||||
Exit;
|
||||
end;
|
||||
@ -2501,6 +2502,7 @@ var
|
||||
LaunchingCmdLine, LaunchingApplication, LaunchingParams: String;
|
||||
NewWorkingDir: String;
|
||||
NewDebuggerClass: TDebuggerClass;
|
||||
DbgCfg: TDebuggerPropertiesConfig;
|
||||
begin
|
||||
{$ifdef VerboseDebugger}
|
||||
DebugLn('[TDebugManager.DoInitDebugger] A');
|
||||
@ -2535,7 +2537,7 @@ begin
|
||||
// check if debugger is already created with the right type
|
||||
if (FDebugger <> nil)
|
||||
and (not (FDebugger.ClassType = NewDebuggerClass) // exact class match
|
||||
or (FDebugger.ExternalDebugger <> EnvironmentOptions.GetParsedDebuggerFilename(Project1))
|
||||
or (FDebugger.ExternalDebugger <> Project1.GetParsedDebuggerFilename)
|
||||
or (FDebugger.State in [dsError])
|
||||
)
|
||||
then begin
|
||||
@ -2546,7 +2548,7 @@ begin
|
||||
|
||||
// create debugger object
|
||||
if FDebugger = nil
|
||||
then SetDebugger(NewDebuggerClass.Create(EnvironmentOptions.GetParsedDebuggerFilename(Project1)));
|
||||
then SetDebugger(NewDebuggerClass.Create(Project1.GetParsedDebuggerFilename));
|
||||
|
||||
if FDebugger = nil
|
||||
then begin
|
||||
@ -2554,10 +2556,10 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if (EnvironmentOptions.CurrentDebuggerPropertiesConfigEx(Project1) <> nil) and
|
||||
(EnvironmentOptions.CurrentDebuggerPropertiesConfigEx(Project1).DebuggerProperties <> nil)
|
||||
then
|
||||
FDebugger.GetProperties.Assign(EnvironmentOptions.CurrentDebuggerPropertiesConfigEx(Project1).DebuggerProperties);
|
||||
DbgCfg := Project1.CurrentDebuggerPropertiesConfig;
|
||||
|
||||
if (DbgCfg <> nil) and (DbgCfg.DebuggerProperties <> nil) then
|
||||
FDebugger.GetProperties.Assign(DbgCfg.DebuggerProperties);
|
||||
|
||||
ClearDebugOutputLog;
|
||||
if EnvironmentOptions.DebuggerEventLogClearOnRun then
|
||||
@ -2668,10 +2670,10 @@ function TDebugManager.DoSetBreakkPointWarnIfNoDebugger: boolean;
|
||||
var
|
||||
DbgClass: TDebuggerClass;
|
||||
begin
|
||||
DbgClass:=EnvironmentOptions.CurrentDebuggerClass(Project1);
|
||||
DbgClass := Project1.CurrentDebuggerClass;
|
||||
if (DbgClass=nil)
|
||||
or (DbgClass.NeedsExePath
|
||||
and (not FileIsExecutableCached(EnvironmentOptions.GetParsedDebuggerFilename(Project1))))
|
||||
and (not FileIsExecutableCached(Project1.GetParsedDebuggerFilename)))
|
||||
then begin
|
||||
if IDEQuestionDialog(lisDbgMangNoDebuggerSpecified,
|
||||
Format(lisDbgMangThereIsNoDebuggerSpecifiedSettingBreakpointsHaveNo,[LineEnding]),
|
||||
@ -3227,7 +3229,7 @@ end;
|
||||
|
||||
function TDebugManager.GetDebuggerClass: TDebuggerClass;
|
||||
begin
|
||||
Result := EnvironmentOptions.CurrentDebuggerClass(Project1);
|
||||
Result := Project1.CurrentDebuggerClass;
|
||||
if Result = nil then
|
||||
Result := TProcessDebugger;
|
||||
end;
|
||||
|
||||
@ -785,7 +785,7 @@ type
|
||||
function GetParsedMakeFilename: string;
|
||||
function GetParsedCompilerMessagesFilename: string;
|
||||
function GetParsedFPDocPaths: string;
|
||||
function GetParsedDebuggerFilename(TheProject: TLazProject = nil): string;
|
||||
function GetParsedDebuggerFilename(AProjectDbgFileName: String = ''): string;
|
||||
function GetParsedDebuggerSearchPath: string;
|
||||
function GetParsedFppkgConfig: string; override;
|
||||
function GetParsedValue(o: TEnvOptParseType; AUnparsedValue: String = ''): string;
|
||||
@ -893,7 +893,7 @@ type
|
||||
property FPCSourceDirHistory: TStringList read FFPCSourceDirHistory;
|
||||
property MakeFilename: string read GetMakeFilename write SetMakeFilename;
|
||||
property MakeFileHistory: TStringList read FMakeFileHistory;
|
||||
function DebuggerFilename(TheProject: TLazProject = nil): string;
|
||||
function DebuggerFilename: string;
|
||||
property DebuggerFileHistory[AnIndex: String]: TStringList read GetNamedDebuggerFileHistory;
|
||||
property DebuggerSearchPath: string read GetDebuggerSearchPath write SetDebuggerSearchPath;
|
||||
property DebuggerShowStopMessage: boolean read FDebuggerShowStopMessage write FDebuggerShowStopMessage;
|
||||
@ -930,9 +930,9 @@ type
|
||||
|
||||
// Debugger
|
||||
procedure SaveDebuggerPropertiesList;
|
||||
function CurrentDebuggerClass(TheProject: TLazProject = nil): TDebuggerClass;
|
||||
function DebuggerPropertiesConfigList: TDebuggerPropertiesConfigList;
|
||||
function CurrentDebuggerPropertiesConfigEx(TheProject: TLazProject): TDebuggerPropertiesConfig;
|
||||
function CurrentDebuggerClass: TDebuggerClass;
|
||||
function CurrentDebuggerPropertiesConfigEx(AnUID: String = ''): TDebuggerPropertiesConfig;
|
||||
property CurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig read GetCurrentDebuggerPropertiesConfig write SetCurrentDebuggerPropertiesOpt;
|
||||
property HasActiveDebuggerEntry: Boolean read FHasActiveDebuggerEntry write FHasActiveDebuggerEntry; // for the initial setup dialog / entry may be of unknown class
|
||||
property DebuggerConfig: TDebuggerConfigStore read FDebuggerConfig;
|
||||
@ -3023,11 +3023,14 @@ begin
|
||||
Result:=GetParsedValue(eopFPDocPaths);
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.GetParsedDebuggerFilename(TheProject: TLazProject
|
||||
): string;
|
||||
function TEnvironmentOptions.GetParsedDebuggerFilename(
|
||||
AProjectDbgFileName: String): string;
|
||||
begin
|
||||
if FParseValues[eopDebuggerFilename].UnparsedValue <> DebuggerFilename(TheProject) then
|
||||
SetParseValue(eopDebuggerFilename,UTF8Trim(DebuggerFilename(TheProject)));
|
||||
if AProjectDbgFileName = '' then
|
||||
AProjectDbgFileName := DebuggerFilename;
|
||||
|
||||
if FParseValues[eopDebuggerFilename].UnparsedValue <> AProjectDbgFileName then
|
||||
SetParseValue(eopDebuggerFilename,UTF8Trim(AProjectDbgFileName));
|
||||
|
||||
Result:=GetParsedValue(eopDebuggerFilename);
|
||||
end;
|
||||
@ -3231,7 +3234,7 @@ end;
|
||||
|
||||
procedure TEnvironmentOptions.SaveDebuggerPropertiesList;
|
||||
begin
|
||||
FDebuggerProperties.LoadFromXml(FXMLCfg, 'EnvironmentOptions/Debugger/', 'EnvironmentOptions/DebuggerFilename/Value');
|
||||
FDebuggerProperties.SaveToXml(FXMLCfg, 'EnvironmentOptions/Debugger/', 'EnvironmentOptions/DebuggerFilename/Value');
|
||||
end;
|
||||
|
||||
procedure TEnvironmentOptions.LoadDebuggerProperties;
|
||||
@ -3240,14 +3243,14 @@ begin
|
||||
HasActiveDebuggerEntry := FDebuggerProperties.HasActiveDebuggerEntry;
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.CurrentDebuggerClass(TheProject: TLazProject): TDebuggerClass;
|
||||
function TEnvironmentOptions.CurrentDebuggerClass: TDebuggerClass;
|
||||
var
|
||||
Cfg: TDebuggerPropertiesConfig;
|
||||
begin
|
||||
LoadDebuggerProperties;
|
||||
|
||||
Result := nil;
|
||||
Cfg := CurrentDebuggerPropertiesConfigEx(TheProject);
|
||||
Cfg := CurrentDebuggerPropertiesConfig;
|
||||
if Cfg<> nil then
|
||||
Result := Cfg.DebuggerClass;
|
||||
end;
|
||||
@ -3272,12 +3275,11 @@ begin
|
||||
Result := FDebuggerProperties;
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.CurrentDebuggerPropertiesConfigEx(
|
||||
TheProject: TLazProject): TDebuggerPropertiesConfig;
|
||||
function TEnvironmentOptions.CurrentDebuggerPropertiesConfigEx(AnUID: String): TDebuggerPropertiesConfig;
|
||||
begin
|
||||
Result := nil;
|
||||
if (TheProject <> nil) and (TheProject.CurrentDebuggerBackend <> '') then
|
||||
Result := FDebuggerProperties.EntryByUid(TheProject.CurrentDebuggerBackend);
|
||||
if AnUID <> '' then
|
||||
Result := FDebuggerProperties.EntryByUid(AnUID);
|
||||
|
||||
if Result = nil then
|
||||
Result := CurrentDebuggerPropertiesConfig;
|
||||
@ -3471,12 +3473,14 @@ begin
|
||||
Result := FDebuggerEventLogColors[AIndex];
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.DebuggerFilename(TheProject: TLazProject): string;
|
||||
function TEnvironmentOptions.DebuggerFilename: string;
|
||||
var
|
||||
DbgCfg: TDebuggerPropertiesConfig;
|
||||
begin
|
||||
Result := '';
|
||||
LoadDebuggerProperties;
|
||||
if CurrentDebuggerPropertiesConfigEx(TheProject) <> nil then
|
||||
Result:=CurrentDebuggerPropertiesConfigEx(TheProject).DebuggerFilename;
|
||||
DbgCfg := CurrentDebuggerPropertiesConfig;
|
||||
if DbgCfg <> nil then
|
||||
Result := DbgCfg.DebuggerFilename;
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.GetDebuggerSearchPath: string;
|
||||
|
||||
@ -8,32 +8,82 @@ object ProjectDebugOptionsFrame: TProjectDebugOptionsFrame
|
||||
TabOrder = 0
|
||||
DesignLeft = 617
|
||||
DesignTop = 390
|
||||
object lbProjectDebugger: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = cbProjectDebugger
|
||||
AnchorSideTop.Side = asrCenter
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 56
|
||||
Top = 0
|
||||
Width = 320
|
||||
Align = alTop
|
||||
AutoSize = True
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 56
|
||||
ClientWidth = 320
|
||||
TabOrder = 0
|
||||
object lbProjectDebugger: TLabel
|
||||
AnchorSideLeft.Control = Panel1
|
||||
AnchorSideTop.Control = cbProjectDebugger
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 6
|
||||
Height = 15
|
||||
Top = 10
|
||||
Width = 99
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'lbProjectDebugger'
|
||||
Color = clDefault
|
||||
ParentColor = False
|
||||
end
|
||||
object cbProjectDebugger: TComboBox
|
||||
AnchorSideLeft.Control = lbProjectDebugger
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideRight.Control = Panel1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 111
|
||||
Height = 23
|
||||
Top = 6
|
||||
Width = 203
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 6
|
||||
ItemHeight = 15
|
||||
OnChange = cbProjectDebuggerChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 0
|
||||
end
|
||||
object chkStoreInSession: TCheckBox
|
||||
AnchorSideLeft.Control = Panel1
|
||||
AnchorSideTop.Control = lbProjectDebugger
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 19
|
||||
Top = 31
|
||||
Width = 113
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'chkStoreInSession'
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object DividerBevel1: TDividerBevel
|
||||
Left = 3
|
||||
Height = 15
|
||||
Top = 59
|
||||
Width = 314
|
||||
Align = alTop
|
||||
BorderSpacing.Around = 3
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
end
|
||||
object lblResolvedDebuggerHint: TLabel
|
||||
Left = 6
|
||||
Height = 15
|
||||
Top = 10
|
||||
Width = 99
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'lbProjectDebugger'
|
||||
ParentColor = False
|
||||
end
|
||||
object cbProjectDebugger: TComboBox
|
||||
AnchorSideLeft.Control = lbProjectDebugger
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 111
|
||||
Height = 23
|
||||
Top = 6
|
||||
Width = 203
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 6
|
||||
ItemHeight = 15
|
||||
Style = csDropDownList
|
||||
TabOrder = 0
|
||||
Top = 77
|
||||
Width = 308
|
||||
Align = alTop
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 3
|
||||
BorderSpacing.Right = 6
|
||||
BorderSpacing.Bottom = 6
|
||||
Caption = 'ResolvedDebuggerHint'
|
||||
Font.Color = clRed
|
||||
ParentFont = False
|
||||
Visible = False
|
||||
end
|
||||
end
|
||||
|
||||
@ -11,9 +11,10 @@ uses
|
||||
// LCL
|
||||
Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
|
||||
// IdeIntf
|
||||
IDEOptionsIntf, IDEOptEditorIntf, ProjectIntf,
|
||||
IDEOptionsIntf, IDEOptEditorIntf, ProjectIntf, DividerBevel,
|
||||
// IDE
|
||||
Project, LazarusIDEStrConsts, EnvironmentOpts, IdeDebuggerOpts, Classes;
|
||||
Project, LazarusIDEStrConsts, EnvironmentOpts, debugger_class_options,
|
||||
IdeDebuggerOpts, Classes;
|
||||
|
||||
type
|
||||
|
||||
@ -21,11 +22,24 @@ type
|
||||
|
||||
TProjectDebugOptionsFrame = class(TAbstractIDEOptionsEditor)
|
||||
cbProjectDebugger: TComboBox;
|
||||
chkStoreInSession: TCheckBox;
|
||||
DividerBevel1: TDividerBevel;
|
||||
lblResolvedDebuggerHint: TLabel;
|
||||
lbProjectDebugger: TLabel;
|
||||
Panel1: TPanel;
|
||||
procedure cbProjectDebuggerChange(Sender: TObject);
|
||||
private
|
||||
fProject: TProject;
|
||||
FDebuggerBackend: String;
|
||||
FDebuggerBackend, FDebuggerBackendUnknown: String;
|
||||
FDebuggerBackendIdx: Integer;
|
||||
FClassOpts: TDebuggerClassOptionsFrame;
|
||||
procedure ClassCountChanged(Sender: TObject);
|
||||
procedure UpdateDebuggerBackend;
|
||||
procedure FillProjectDebuggerDropDown;
|
||||
procedure UpdateResolvedDebuggerHint;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
function GetTitle: string; override;
|
||||
procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
|
||||
procedure ReadSettings(AOptions: TAbstractIDEOptions); override;
|
||||
@ -36,10 +50,133 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
DBG_IDX_UNKNOWN = -99; // will use "project debugger"
|
||||
DBG_IDX_PROJECT = -2;
|
||||
DBG_IDX_IDE = -1;
|
||||
DBG_TOKEN_IDE = 'IDE';
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TProjectDebugOptionsFrame }
|
||||
|
||||
procedure TProjectDebugOptionsFrame.cbProjectDebuggerChange(Sender: TObject);
|
||||
begin
|
||||
UpdateResolvedDebuggerHint;
|
||||
end;
|
||||
|
||||
procedure TProjectDebugOptionsFrame.ClassCountChanged(Sender: TObject);
|
||||
begin
|
||||
UpdateResolvedDebuggerHint
|
||||
end;
|
||||
|
||||
procedure TProjectDebugOptionsFrame.UpdateDebuggerBackend;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if cbProjectDebugger.Items.Count = 0 then
|
||||
exit;
|
||||
|
||||
FDebuggerBackend := '';
|
||||
FDebuggerBackendIdx := DBG_IDX_PROJECT;
|
||||
|
||||
i := cbProjectDebugger.ItemIndex;
|
||||
if i >= 0 then begin
|
||||
FDebuggerBackendIdx := PtrInt(cbProjectDebugger.Items.Objects[i]);
|
||||
if FDebuggerBackendIdx = DBG_IDX_IDE then
|
||||
FDebuggerBackend := DBG_TOKEN_IDE
|
||||
else
|
||||
if FDebuggerBackendIdx = DBG_IDX_UNKNOWN then
|
||||
FDebuggerBackend := FDebuggerBackendUnknown
|
||||
else
|
||||
if FDebuggerBackendIdx >= 0 then
|
||||
FDebuggerBackend := EnvironmentOptions.DebuggerPropertiesConfigList.Opt[FDebuggerBackendIdx].UID;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TProjectDebugOptionsFrame.FillProjectDebuggerDropDown;
|
||||
const
|
||||
DBG_IDX_OFFSET = 2; // 2 Hardcoded items (project, ide) // Offset for DropDown.ItemIndex
|
||||
var
|
||||
i, sel: Integer;
|
||||
dbg: TDebuggerPropertiesConfigList;
|
||||
begin
|
||||
cbProjectDebugger.Clear;
|
||||
sel := -1;
|
||||
cbProjectDebugger.AddItem(lisDebugOptionsFrmUseProjectDebugger, TObject(PtrUInt(DBG_IDX_PROJECT)));
|
||||
cbProjectDebugger.AddItem(lisDebugOptionsFrmUseIDEDebugger, TObject(PtrUInt(DBG_IDX_IDE)));
|
||||
if FDebuggerBackend = '' then
|
||||
sel := 0
|
||||
else
|
||||
if FDebuggerBackend = DBG_TOKEN_IDE then
|
||||
sel := 1;
|
||||
|
||||
dbg := EnvironmentOptions.DebuggerPropertiesConfigList;
|
||||
for i := 0 to dbg.Count - 1 do begin
|
||||
cbProjectDebugger.AddItem(dbg.Opt[i].DisplayName, TObject(PtrUInt(i)));
|
||||
if dbg.Opt[i].UID = FDebuggerBackend then
|
||||
sel := i + DBG_IDX_OFFSET;
|
||||
end;
|
||||
|
||||
if sel < 0 then begin
|
||||
sel := cbProjectDebugger.Items.AddObject(Format(
|
||||
lisDebugOptionsFrmUnknownDebuggerBacke, [FDebuggerBackend]), TObject(PtrUInt(DBG_IDX_UNKNOWN)));
|
||||
FDebuggerBackendUnknown := FDebuggerBackend;
|
||||
end;
|
||||
cbProjectDebugger.ItemIndex := sel;
|
||||
end;
|
||||
|
||||
procedure TProjectDebugOptionsFrame.UpdateResolvedDebuggerHint;
|
||||
begin
|
||||
UpdateDebuggerBackend;
|
||||
|
||||
lblResolvedDebuggerHint.Visible := False;
|
||||
case FDebuggerBackendIdx of
|
||||
DBG_IDX_PROJECT: begin
|
||||
if FClassOpts.ModifiedDbgPropertiesConfigList.CountWithoutDeleted = 0 then begin
|
||||
lblResolvedDebuggerHint.Caption := drsUsingIDEDefaultDebuggerSe;
|
||||
lblResolvedDebuggerHint.Visible := True;
|
||||
end;
|
||||
end;
|
||||
DBG_IDX_IDE: begin
|
||||
if FClassOpts.ModifiedDbgPropertiesConfigList.CountWithoutDeleted > 0 then begin
|
||||
lblResolvedDebuggerHint.Caption := drsUsingIDEDefaultDebuggerSe;
|
||||
lblResolvedDebuggerHint.Caption := lblResolvedDebuggerHint.Caption + drsIgnoringProjectDebuggerSettings;
|
||||
lblResolvedDebuggerHint.Visible := True;
|
||||
end;
|
||||
end;
|
||||
DBG_IDX_UNKNOWN: begin
|
||||
lblResolvedDebuggerHint.Caption := drsUsingIDEDefaultDebuggerSe;
|
||||
if FClassOpts.ModifiedDbgPropertiesConfigList.CountWithoutDeleted > 0 then
|
||||
lblResolvedDebuggerHint.Caption := lblResolvedDebuggerHint.Caption + drsIgnoringProjectDebuggerSettings;
|
||||
lblResolvedDebuggerHint.Visible := True;
|
||||
end;
|
||||
otherwise begin
|
||||
if FClassOpts.ModifiedDbgPropertiesConfigList.CountWithoutDeleted > 0 then begin
|
||||
lblResolvedDebuggerHint.Caption := drsUsingSelectedIDEDebuggerS;
|
||||
lblResolvedDebuggerHint.Caption := lblResolvedDebuggerHint.Caption + drsIgnoringProjectDebuggerSettings;
|
||||
lblResolvedDebuggerHint.Visible := True;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TProjectDebugOptionsFrame.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FClassOpts := TDebuggerClassOptionsFrame.Create(AOwner);
|
||||
FClassOpts.Parent := Self;
|
||||
FClassOpts.Align := alClient;
|
||||
FClassOpts.Visible := True;
|
||||
FClassOpts.OnModifiedDbgPropertiesCountChanged := @ClassCountChanged;
|
||||
end;
|
||||
|
||||
destructor TProjectDebugOptionsFrame.Destroy;
|
||||
begin
|
||||
FClassOpts.OnModifiedDbgPropertiesCountChanged := nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TProjectDebugOptionsFrame.GetTitle: string;
|
||||
begin
|
||||
Result := dlgPODebugger;
|
||||
@ -48,56 +185,39 @@ end;
|
||||
procedure TProjectDebugOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
|
||||
begin
|
||||
lbProjectDebugger.Caption := lisDebugOptionsFrmDebuggerBackend;
|
||||
chkStoreInSession.Caption := drsStoreProjectDebuggerConfi;
|
||||
chkStoreInSession.Hint := drsTheDebuggerBackendSelecti;
|
||||
FClassOpts.Setup(ADialog);
|
||||
end;
|
||||
|
||||
procedure TProjectDebugOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
|
||||
var
|
||||
i, sel: Integer;
|
||||
dbg: TDebuggerPropertiesConfigList;
|
||||
begin
|
||||
if not (AOptions is TProjectIDEOptions) then exit;
|
||||
fProject:=(AOptions as TProjectIDEOptions).Project;
|
||||
with fProject do
|
||||
begin
|
||||
Self.FDebuggerBackend := DebuggerBackend;
|
||||
chkStoreInSession.Checked := StoreDebuggerClassConfInSession;
|
||||
FClassOpts.ReadSettings(DebuggerPropertiesConfigList);
|
||||
end;
|
||||
|
||||
cbProjectDebugger.Clear;
|
||||
sel := -1;
|
||||
cbProjectDebugger.AddItem(lisDebugOptionsFrmUseIDEDebugger, TObject(-1));
|
||||
if FDebuggerBackend = '' then
|
||||
sel := 0;
|
||||
|
||||
dbg := EnvironmentOptions.DebuggerPropertiesConfigList;
|
||||
for i := 0 to dbg.Count - 1 do begin
|
||||
cbProjectDebugger.AddItem(dbg.Opt[i].DisplayName, TObject(PtrUInt((i))));
|
||||
if dbg.Opt[i].UID = FDebuggerBackend then
|
||||
sel := i+1;
|
||||
end;
|
||||
if sel < 0 then
|
||||
sel := cbProjectDebugger.Items.AddObject(Format(
|
||||
lisDebugOptionsFrmUnknownDebuggerBacke, [FDebuggerBackend]), TObject(PtrUInt(( - 2))));
|
||||
cbProjectDebugger.ItemIndex := sel;
|
||||
FillProjectDebuggerDropDown;
|
||||
end;
|
||||
|
||||
procedure TProjectDebugOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if not (AOptions is TProjectIDEOptions) then exit;
|
||||
|
||||
i := cbProjectDebugger.ItemIndex;
|
||||
if i >= 0 then begin
|
||||
FDebuggerBackend := ''; // -1
|
||||
i := PtrInt(cbProjectDebugger.Items.Objects[i]);
|
||||
if i >= 0 then
|
||||
FDebuggerBackend := EnvironmentOptions.DebuggerPropertiesConfigList.Opt[i].UID;
|
||||
end;
|
||||
UpdateDebuggerBackend;
|
||||
|
||||
with (AOptions as TProjectIDEOptions).Project do
|
||||
begin
|
||||
DebuggerBackend := FDebuggerBackend;
|
||||
StoreDebuggerClassConfInSession := chkStoreInSession.Checked;
|
||||
FClassOpts.WriteSettings(DebuggerPropertiesConfigList);
|
||||
MarkDebuggerClassConfAsModified;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
class function TProjectDebugOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
|
||||
|
||||
@ -6640,6 +6640,7 @@ resourcestring
|
||||
lisDebugOptionsFrmBackend = 'Debugger backend';
|
||||
dlgPODebugger = 'Debugger';
|
||||
lisDebugOptionsFrmDebuggerBackend = 'Debugger Backend:';
|
||||
lisDebugOptionsFrmUseProjectDebugger = '-- Use project Debugger --';
|
||||
lisDebugOptionsFrmUseIDEDebugger = '-- Use IDE default Debugger --';
|
||||
lisDebugOptionsFrmUnknownDebuggerBacke = 'Unknown Debugger backend "%s"';
|
||||
lisDynPkgAutoScrollOnDeletePa = 'Auto Scroll on delete past left border';
|
||||
@ -6649,6 +6650,13 @@ resourcestring
|
||||
lisDynPkgAmountToScrollIn = 'Amount to scroll in';
|
||||
lisDynPkgAmountToScrollIn2 = 'Amount to scroll in (%)';
|
||||
lisDynPkgAmountToScrollInMax = 'Amount to scroll in (Max)';
|
||||
drsUsingIDEDefaultDebuggerSe = 'Using IDE default debugger settings';
|
||||
drsUsingSelectedIDEDebuggerS = 'Using selected IDE debugger settings';
|
||||
drsIgnoringProjectDebuggerSettings = ' (Ignoring project settings below)';
|
||||
drsStoreProjectDebuggerConfi = 'Store project debugger configs in session';
|
||||
drsTheDebuggerBackendSelecti = 'The "Debugger Backend" selection from the '
|
||||
+'dropdown (list of IDE debugger backends) is always stored in the session'
|
||||
+'. The project specific backends (below) are by default stored in the LPI.';
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -84,6 +84,7 @@ type
|
||||
procedure SaveToXml(AXMLCfg: TRttiXMLConfig; APath: String; AnOldFileNamePath: String = '');
|
||||
|
||||
procedure ClearAll;
|
||||
function CountWithoutDeleted: Integer;
|
||||
function EntryByName(AConfName, AConfClass: String): TDebuggerPropertiesConfig;
|
||||
function EntryByUid(AnUid: String): TDebuggerPropertiesConfig;
|
||||
property Opt[Index: Integer]: TDebuggerPropertiesConfig read GetOpt;
|
||||
@ -490,28 +491,30 @@ begin
|
||||
FCurrentDebuggerPropertiesConfig := UnloadedCurrent;
|
||||
|
||||
// Read old style, per class
|
||||
ActiveClassName := '';
|
||||
ActiveClassSeen := False;
|
||||
if FCurrentDebuggerPropertiesConfig = nil then
|
||||
ActiveClassName := AXMLCfg.GetValue(APath + 'Class', '');
|
||||
HasActiveDebuggerEntry := HasActiveDebuggerEntry or (ActiveClassName <> '');
|
||||
// There is only one filename for all classes
|
||||
CurFilename:=AXMLCfg.GetValue(AnOldFileNamePath, '');
|
||||
if (AnOldFileNamePath <> '') then begin
|
||||
ActiveClassName := '';
|
||||
ActiveClassSeen := False;
|
||||
if FCurrentDebuggerPropertiesConfig = nil then
|
||||
ActiveClassName := AXMLCfg.GetValue(APath + 'Class', '');
|
||||
HasActiveDebuggerEntry := HasActiveDebuggerEntry or (ActiveClassName <> '');
|
||||
// There is only one filename for all classes
|
||||
CurFilename:=AXMLCfg.GetValue(AnOldFileNamePath, '');
|
||||
|
||||
for i := 0 to TBaseDebugManagerIntf.DebuggerCount -1 do begin
|
||||
DbgClassType := TBaseDebugManagerIntf.Debuggers[i];
|
||||
ActiveClassSeen := ActiveClassSeen or (CompareText(DbgClassType.ClassName, ActiveClassName)=0);
|
||||
Entry := TDebuggerPropertiesConfig.CreateFromOldXmlConf(AXMLCfg, APath + XML_PATH_DEBUGGER_CONF_OLD,
|
||||
DbgClassType, CompareText(DbgClassType.ClassName, ActiveClassName)=0);
|
||||
if not Entry.IsLoaded then begin
|
||||
Entry.Free;
|
||||
Continue;
|
||||
for i := 0 to TBaseDebugManagerIntf.DebuggerCount -1 do begin
|
||||
DbgClassType := TBaseDebugManagerIntf.Debuggers[i];
|
||||
ActiveClassSeen := ActiveClassSeen or (CompareText(DbgClassType.ClassName, ActiveClassName)=0);
|
||||
Entry := TDebuggerPropertiesConfig.CreateFromOldXmlConf(AXMLCfg, APath + XML_PATH_DEBUGGER_CONF_OLD,
|
||||
DbgClassType, CompareText(DbgClassType.ClassName, ActiveClassName)=0);
|
||||
if not Entry.IsLoaded then begin
|
||||
Entry.Free;
|
||||
Continue;
|
||||
end;
|
||||
if (Entry.DebuggerFilename = '') and (Entry.NeedsExePath or (not Entry.IsLoaded)) then
|
||||
Entry.DebuggerFilename := CurFilename;
|
||||
AddObject(Entry.ConfigName, Entry);
|
||||
if (Entry.ConfigClass = ActiveClassName) and (FCurrentDebuggerPropertiesConfig = nil) then
|
||||
FCurrentDebuggerPropertiesConfig := Entry;
|
||||
end;
|
||||
if (Entry.DebuggerFilename = '') and (Entry.NeedsExePath or (not Entry.IsLoaded)) then
|
||||
Entry.DebuggerFilename := CurFilename;
|
||||
AddObject(Entry.ConfigName, Entry);
|
||||
if (Entry.ConfigClass = ActiveClassName) and (FCurrentDebuggerPropertiesConfig = nil) then
|
||||
FCurrentDebuggerPropertiesConfig := Entry;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -563,7 +566,7 @@ begin
|
||||
else begin
|
||||
Entry.SaveToOldXml(AXMLCfg, APath + XML_PATH_DEBUGGER_CONF_OLD);
|
||||
// For compatibility
|
||||
if Entry.Active then
|
||||
if Entry.Active and (AnOldFileNamePath <> '') then
|
||||
AXMLCfg.SetDeleteValue(AnOldFileNamePath, Entry.DebuggerFilename,'');
|
||||
end;
|
||||
end;
|
||||
@ -584,6 +587,16 @@ begin
|
||||
Clear;
|
||||
end;
|
||||
|
||||
function TDebuggerPropertiesConfigList.CountWithoutDeleted: Integer;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
for i := 0 to Count - 1 do
|
||||
if not Opt[i].IsDeleted then
|
||||
inc(Result);
|
||||
end;
|
||||
|
||||
function TDebuggerPropertiesConfigList.EntryByName(AConfName, AConfClass: String
|
||||
): TDebuggerPropertiesConfig;
|
||||
var
|
||||
|
||||
124
ide/project.pp
124
ide/project.pp
@ -60,7 +60,10 @@ uses
|
||||
PropEdits, UnitResources, EditorSyntaxHighlighterDef,
|
||||
CompOptsIntf, ProjectIntf, MacroIntf, MacroDefIntf, SrcEditorIntf,
|
||||
IDEOptionsIntf, IDEOptEditorIntf, IDEDialogs, LazIDEIntf, PackageIntf,
|
||||
// DebuggerIntf
|
||||
DbgIntfDebuggerBase, IdeDebuggerOpts,
|
||||
// IDE
|
||||
EnvironmentOpts,
|
||||
CompOptsModes, ProjectResources, LazConf, ProjectIcon,
|
||||
IDECmdLine, IDEProcs, CompilerOptions, RunParamsOpts, ModeMatrixOpts,
|
||||
TransferMacros, ProjectDefs, EditDefineTree,
|
||||
@ -721,11 +724,14 @@ type
|
||||
FAutoCreateForms: boolean;
|
||||
FChangeStampSaved: integer;
|
||||
FDebuggerBackend: String;
|
||||
FDebuggerProperties: TDebuggerPropertiesConfigList; // named entries
|
||||
FEnableI18NForLFM: boolean;
|
||||
FHistoryLists: THistoryLists;
|
||||
FLastCompileComplete: boolean;
|
||||
FMacroEngine: TTransferMacroList;
|
||||
FOnLoadSafeCustomData: TLazLoadSaveCustomDataEvent;
|
||||
FStoreDebuggerClassConfInSession: boolean;
|
||||
FDebuggerClassConfWasFromSession, FDebuggerClassConfWasFromLPI: boolean;
|
||||
FTmpAutoCreatedForms: TStrings; // temporary, used to apply auto create forms changes
|
||||
FAutoOpenDesignerFormsDisabled: boolean;
|
||||
FBookmarks: TProjectBookmarkList;
|
||||
@ -778,7 +784,7 @@ type
|
||||
FUpdateLock: integer;
|
||||
FUseAsDefault: Boolean;
|
||||
// Variables used by ReadProject / WriteProject
|
||||
FXMLConfig: TXMLConfig;
|
||||
FXMLConfig: TRttiXMLConfig;
|
||||
FLoadAllOptions: Boolean; // All options / just options used as default for new projects
|
||||
FFileVersion: Integer;
|
||||
FNewMainUnitID: LongInt;
|
||||
@ -808,6 +814,7 @@ type
|
||||
procedure EmbeddedObjectModified(Sender: TObject);
|
||||
function FileBackupHandler(const Filename: string): TModalResult;
|
||||
procedure LoadSaveFilenameHandler(var AFilename: string; Load: boolean);
|
||||
procedure SetStoreDebuggerClassConfInSession(AValue: boolean);
|
||||
procedure UnitNameChangeHandler(AnUnitInfo: TUnitInfo;
|
||||
const OldUnitName, NewUnitName: string;
|
||||
CheckIfAllowed: boolean; var Allowed: boolean);
|
||||
@ -1137,6 +1144,16 @@ type
|
||||
property UseAsDefault: Boolean read FUseAsDefault write FUseAsDefault; // for dialog only (used to store options once)
|
||||
|
||||
property DebuggerBackend: String read FDebuggerBackend write SetDebuggerBackend;
|
||||
|
||||
// Debugger
|
||||
function DebuggerPropertiesConfigList: TDebuggerPropertiesConfigList;
|
||||
function CurrentDebuggerClass: TDebuggerClass;
|
||||
function DebuggerFilename: string;
|
||||
function GetParsedDebuggerFilename: string;
|
||||
function CurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig;
|
||||
procedure MarkDebuggerClassConfAsModified;
|
||||
property StoreDebuggerClassConfInSession: boolean read FStoreDebuggerClassConfInSession write SetStoreDebuggerClassConfInSession;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
@ -2801,6 +2818,8 @@ begin
|
||||
ProjResources.OnModified := @EmbeddedObjectModified;
|
||||
|
||||
FHistoryLists := THistoryLists.Create;
|
||||
|
||||
FDebuggerProperties := TDebuggerPropertiesConfigList.Create;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2830,6 +2849,8 @@ begin
|
||||
FreeThenNil(FRunParameters);
|
||||
FreeThenNil(FDefineTemplates);
|
||||
FreeThenNil(FHistoryLists);
|
||||
FDebuggerProperties.ClearAll;
|
||||
FreeAndNil(FDebuggerProperties);
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
@ -3042,6 +3063,12 @@ begin
|
||||
// load session info
|
||||
LoadSessionInfo(Path,false);
|
||||
|
||||
FStoreDebuggerClassConfInSession := FXMLConfig.GetValue(Path+'Debugger/StoreDebuggerClassConfInSession/Value', False);
|
||||
if not FStoreDebuggerClassConfInSession then begin
|
||||
FDebuggerProperties.LoadFromXml(FXMLConfig, Path+'Debugger/ClassConfig/');
|
||||
FDebuggerClassConfWasFromLPI := True;
|
||||
end;
|
||||
|
||||
// This is for backward compatibility (only trunk 2.1 did use this / Can be removed in some time after 2.2 / but needs LoadFromSession to change default to '')
|
||||
FDebuggerBackend := FXMLConfig.GetValue(Path+'Debugger/Backend/Value', '');
|
||||
|
||||
@ -3079,6 +3106,11 @@ begin
|
||||
|
||||
// Load from LPI will have been called first => so if session has no value, we keep the LPI value (as for some time, the data was stored in the LPI)
|
||||
FDebuggerBackend := FXMLConfig.GetValue(Path+'Debugger/Backend/Value', FDebuggerBackend);
|
||||
if FStoreDebuggerClassConfInSession then begin
|
||||
FDebuggerProperties.LoadFromXml(FXMLConfig, Path+'Debugger/ClassConfig/');
|
||||
FDebuggerClassConfWasFromSession := True;
|
||||
end;
|
||||
|
||||
|
||||
// call hooks to read their info (e.g. DebugBoss)
|
||||
if Assigned(OnLoadProjectInfo) then
|
||||
@ -3222,6 +3254,8 @@ begin
|
||||
Result := mrCancel;
|
||||
BeginUpdate(true);
|
||||
try
|
||||
FDebuggerClassConfWasFromSession := False;
|
||||
FDebuggerClassConfWasFromLPI := False;
|
||||
BuildModes.FGlobalMatrixOptions := GlobalMatrixOptions;
|
||||
FLoadAllOptions := LoadAllOptions;
|
||||
|
||||
@ -3393,7 +3427,17 @@ begin
|
||||
// save units
|
||||
SaveUnits(Path,FSaveSessionInLPI);
|
||||
|
||||
FXMLConfig.DeletePath(Path+'Debugger'); // remove old value from trunk 2.1
|
||||
FXMLConfig.DeletePath(Path+'Debugger/Backend'); // remove old value from trunk 2.1
|
||||
FXMLConfig.SetDeleteValue(Path+'Debugger/StoreDebuggerClassConfInSession/Value', FStoreDebuggerClassConfInSession, False);
|
||||
|
||||
if not FStoreDebuggerClassConfInSession then
|
||||
FDebuggerProperties.SaveToXml(FXMLConfig, Path+'Debugger/ClassConfig/')
|
||||
else
|
||||
if FDebuggerClassConfWasFromLPI then
|
||||
FXMLConfig.DeletePath(Path+'Debugger/ClassConfig');
|
||||
FDebuggerClassConfWasFromSession := False;
|
||||
FDebuggerClassConfWasFromLPI := False;
|
||||
|
||||
|
||||
if FSaveSessionInLPI then begin
|
||||
// save defines used for custom options
|
||||
@ -3450,6 +3494,14 @@ begin
|
||||
SaveUnits(Path,true);
|
||||
|
||||
FXMLConfig.SetDeleteValue(Path+'Debugger/Backend/Value', DebuggerBackend, '');
|
||||
if FStoreDebuggerClassConfInSession then
|
||||
FDebuggerProperties.SaveToXml(FXMLConfig, Path+'Debugger/ClassConfig/')
|
||||
else
|
||||
if FDebuggerClassConfWasFromSession then
|
||||
FXMLConfig.DeletePath(Path+'Debugger/ClassConfig');
|
||||
FDebuggerClassConfWasFromSession := False;
|
||||
FDebuggerClassConfWasFromLPI := False;
|
||||
|
||||
// save defines used for custom options
|
||||
SaveOtherDefines(Path);
|
||||
// save session info
|
||||
@ -3623,7 +3675,7 @@ begin
|
||||
else if SysUtils.CompareText(SourceType,'Package')=0 then
|
||||
ExecutableType:=petPackage
|
||||
else
|
||||
ExecutableType:=petNone;
|
||||
ExecutableType:=ProjectIntf.petNone;
|
||||
end;
|
||||
|
||||
procedure TProject.BackupSession;
|
||||
@ -4565,6 +4617,14 @@ begin
|
||||
//debugln('TProject.OnLoadSaveFilename END "',AFilename,'" FileWasAbsolute=',dbgs(FileWasAbsolute));
|
||||
end;
|
||||
|
||||
procedure TProject.SetStoreDebuggerClassConfInSession(AValue: boolean);
|
||||
begin
|
||||
if FStoreDebuggerClassConfInSession = AValue then Exit;
|
||||
FStoreDebuggerClassConfInSession := AValue;
|
||||
Modified := True;
|
||||
SessionModified := True;
|
||||
end;
|
||||
|
||||
function TProject.RemoveProjectPathFromFilename(const AFilename: string): string;
|
||||
var
|
||||
ProjectPath:string;
|
||||
@ -5360,6 +5420,64 @@ begin
|
||||
SessionModified := true;
|
||||
end;
|
||||
|
||||
function TProject.DebuggerPropertiesConfigList: TDebuggerPropertiesConfigList;
|
||||
begin
|
||||
Result := FDebuggerProperties;
|
||||
end;
|
||||
|
||||
function TProject.CurrentDebuggerClass: TDebuggerClass;
|
||||
var
|
||||
DbgCfg: TDebuggerPropertiesConfig;
|
||||
begin
|
||||
Result := nil;
|
||||
DbgCfg := CurrentDebuggerPropertiesConfig;
|
||||
if DbgCfg<> nil then
|
||||
Result := DbgCfg.DebuggerClass;
|
||||
end;
|
||||
|
||||
function TProject.DebuggerFilename: string;
|
||||
var
|
||||
DbgCfg: TDebuggerPropertiesConfig;
|
||||
begin
|
||||
Result := '';
|
||||
DbgCfg := CurrentDebuggerPropertiesConfig;
|
||||
if DbgCfg <> nil then
|
||||
Result := DbgCfg.DebuggerFilename;
|
||||
end;
|
||||
|
||||
function TProject.GetParsedDebuggerFilename: string;
|
||||
begin
|
||||
Result := EnvironmentOptions.GetParsedDebuggerFilename(DebuggerFilename);
|
||||
end;
|
||||
|
||||
function TProject.CurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig;
|
||||
begin
|
||||
if Self = nil then
|
||||
exit(EnvironmentOptions.CurrentDebuggerPropertiesConfig);
|
||||
|
||||
Result := nil;
|
||||
if (CurrentDebuggerBackend <> '') then
|
||||
if (CurrentDebuggerBackend = 'IDE') then
|
||||
Result := EnvironmentOptions.CurrentDebuggerPropertiesConfig
|
||||
else
|
||||
Result := EnvironmentOptions.CurrentDebuggerPropertiesConfigEx(CurrentDebuggerBackend);
|
||||
|
||||
if Result = nil then
|
||||
Result := FDebuggerProperties.CurrentDebuggerPropertiesConfig;
|
||||
|
||||
// No project config?
|
||||
if Result = nil then
|
||||
Result := EnvironmentOptions.CurrentDebuggerPropertiesConfig;
|
||||
end;
|
||||
|
||||
procedure TProject.MarkDebuggerClassConfAsModified;
|
||||
begin
|
||||
if FStoreDebuggerClassConfInSession then
|
||||
SessionModified := True
|
||||
else
|
||||
Modified := True;
|
||||
end;
|
||||
|
||||
procedure TProject.UnitNameChangeHandler(AnUnitInfo: TUnitInfo;
|
||||
const OldUnitName, NewUnitName: string; CheckIfAllowed: boolean;
|
||||
var Allowed: boolean);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user