mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-21 17:59:31 +02:00
Debugger: Allow project to override selected debugger.
git-svn-id: trunk@61673 -
This commit is contained in:
martin
parent
3356170ca6
commit
5e7fd9a4fa
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -7431,6 +7431,8 @@ ide/frames/oi_options.lfm svneol=native#text/plain
|
||||
ide/frames/oi_options.pas svneol=native#text/pascal
|
||||
ide/frames/project_application_options.lfm svneol=native#text/plain
|
||||
ide/frames/project_application_options.pas svneol=native#text/plain
|
||||
ide/frames/project_debug_options.lfm svneol=native#text/plain
|
||||
ide/frames/project_debug_options.pas svneol=native#text/plain
|
||||
ide/frames/project_forms_options.lfm svneol=native#text/plain
|
||||
ide/frames/project_forms_options.pas svneol=native#text/plain
|
||||
ide/frames/project_i18n_options.lfm svneol=native#text/plain
|
||||
|
||||
@ -215,7 +215,8 @@ const
|
||||
ProjectOptionsResources = 550;
|
||||
ProjectOptionsI18N = 600;
|
||||
ProjectOptionsMisc = 700;
|
||||
DbgOptionsLanguageExceptions = 800;
|
||||
ProjectOptionsDebug = 700;
|
||||
DbgOptionsLanguageExceptions = 900;
|
||||
|
||||
GroupPackage = 200100;
|
||||
PackageOptionsUsage = 100;
|
||||
|
||||
@ -530,6 +530,7 @@ type
|
||||
procedure SetSessionStorage(const AValue: TProjectSessionStorage); virtual;
|
||||
procedure SetTitle(const AValue: String); virtual;
|
||||
procedure SetUseManifest(AValue: boolean); virtual; abstract;
|
||||
function GetCurrentDebuggerBackend: String; virtual; abstract;
|
||||
public
|
||||
constructor Create({%H-}ProjectDescription: TProjectDescriptor); virtual; reintroduce;
|
||||
destructor Destroy; override;
|
||||
@ -588,6 +589,7 @@ type
|
||||
property Resources: TObject read FResources; // TAbstractProjectResources
|
||||
property UseManifest: boolean read GetUseManifest write SetUseManifest;
|
||||
property RunParameters: TAbstractRunParamsOptions read FRunParameters;
|
||||
property CurrentDebuggerBackend: String read GetCurrentDebuggerBackend;
|
||||
end;
|
||||
|
||||
TLazProjectClass = class of TLazProject;
|
||||
|
||||
@ -2409,14 +2409,14 @@ begin
|
||||
|
||||
// check if debugger needs an Exe and the exe is there
|
||||
if (NewDebuggerClass.NeedsExePath)
|
||||
and not FileIsExecutable(EnvironmentOptions.GetParsedDebuggerFilename)
|
||||
and not FileIsExecutable(EnvironmentOptions.GetParsedDebuggerFilename(Project1))
|
||||
then begin
|
||||
if not PromptOnError then
|
||||
ClearPathAndExe
|
||||
else begin
|
||||
IDEMessageDialog(lisDebuggerInvalid,
|
||||
Format(lisTheDebuggerDoesNotExistsOrIsNotExecutableSeeEnviro,
|
||||
[EnvironmentOptions.DebuggerFilename, LineEnding, LineEnding+LineEnding]),
|
||||
[EnvironmentOptions.DebuggerFilename(Project1), LineEnding, LineEnding+LineEnding]),
|
||||
mtError,[mbOK]);
|
||||
Exit;
|
||||
end;
|
||||
@ -2465,7 +2465,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)
|
||||
or (FDebugger.ExternalDebugger <> EnvironmentOptions.GetParsedDebuggerFilename(Project1))
|
||||
or (FDebugger.State in [dsError])
|
||||
)
|
||||
then begin
|
||||
@ -2476,7 +2476,7 @@ begin
|
||||
|
||||
// create debugger object
|
||||
if FDebugger = nil
|
||||
then SetDebugger(NewDebuggerClass.Create(EnvironmentOptions.GetParsedDebuggerFilename));
|
||||
then SetDebugger(NewDebuggerClass.Create(EnvironmentOptions.GetParsedDebuggerFilename(Project1)));
|
||||
|
||||
if FDebugger = nil
|
||||
then begin
|
||||
@ -2484,10 +2484,10 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if (EnvironmentOptions.CurrentDebuggerPropertiesConfig <> nil) and
|
||||
(EnvironmentOptions.CurrentDebuggerPropertiesConfig.DebuggerProperties <> nil)
|
||||
if (EnvironmentOptions.CurrentDebuggerPropertiesConfigEx(Project1) <> nil) and
|
||||
(EnvironmentOptions.CurrentDebuggerPropertiesConfigEx(Project1).DebuggerProperties <> nil)
|
||||
then
|
||||
FDebugger.GetProperties.Assign(EnvironmentOptions.CurrentDebuggerPropertiesConfig.DebuggerProperties);
|
||||
FDebugger.GetProperties.Assign(EnvironmentOptions.CurrentDebuggerPropertiesConfigEx(Project1).DebuggerProperties);
|
||||
|
||||
ClearDebugOutputLog;
|
||||
if EnvironmentOptions.DebuggerEventLogClearOnRun then
|
||||
@ -2598,10 +2598,10 @@ function TDebugManager.DoSetBreakkPointWarnIfNoDebugger: boolean;
|
||||
var
|
||||
DbgClass: TDebuggerClass;
|
||||
begin
|
||||
DbgClass:=EnvironmentOptions.CurrentDebuggerClass;
|
||||
DbgClass:=EnvironmentOptions.CurrentDebuggerClass(Project1);
|
||||
if (DbgClass=nil)
|
||||
or (DbgClass.NeedsExePath
|
||||
and (not FileIsExecutableCached(EnvironmentOptions.GetParsedDebuggerFilename)))
|
||||
and (not FileIsExecutableCached(EnvironmentOptions.GetParsedDebuggerFilename(Project1))))
|
||||
then begin
|
||||
if IDEQuestionDialog(lisDbgMangNoDebuggerSpecified,
|
||||
Format(lisDbgMangThereIsNoDebuggerSpecifiedSettingBreakpointsHaveNo,[LineEnding]),
|
||||
@ -3121,7 +3121,7 @@ end;
|
||||
|
||||
function TDebugManager.GetDebuggerClass: TDebuggerClass;
|
||||
begin
|
||||
Result := EnvironmentOptions.CurrentDebuggerClass;
|
||||
Result := EnvironmentOptions.CurrentDebuggerClass(Project1);
|
||||
if Result = nil then
|
||||
Result := TProcessDebugger;
|
||||
end;
|
||||
|
||||
@ -301,8 +301,11 @@ type
|
||||
FDebuggerClass: TDebuggerClass;
|
||||
FDebuggerFilename: string;
|
||||
FIsFromOldXml: Boolean;
|
||||
FUID: String;
|
||||
FXmlIndex: Integer;
|
||||
FDebuggerProperties: TDebuggerProperties;
|
||||
|
||||
procedure InitUID;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
constructor CreateFromXmlConf(AXMLCfg: TRttiXMLConfig; APath: String; AIndex: Integer);
|
||||
@ -336,6 +339,7 @@ type
|
||||
property ConfigClass: String read FConfigClass write FConfigClass;
|
||||
property DebuggerFilename: string read FDebuggerFilename write FDebuggerFilename;
|
||||
property Active: Boolean read FActive write FActive;
|
||||
property UID: String read FUID write FUID;
|
||||
end;
|
||||
|
||||
TLastOpenPackagesList = class(TStringList)
|
||||
@ -523,6 +527,7 @@ type
|
||||
public
|
||||
procedure ClearAll;
|
||||
function EntryByName(AConfName, AConfClass: String): TDebuggerPropertiesConfig;
|
||||
function EntryByUid(AnUid: String): TDebuggerPropertiesConfig;
|
||||
property Opt[Index: Integer]: TDebuggerPropertiesConfig read GetOpt;
|
||||
end;
|
||||
|
||||
@ -716,11 +721,9 @@ 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;
|
||||
function GetDebuggerSearchPath: string;
|
||||
function GetFPCSourceDirectory: string;
|
||||
function GetFPDocPaths: string;
|
||||
@ -782,7 +785,7 @@ type
|
||||
function GetParsedMakeFilename: string;
|
||||
function GetParsedCompilerMessagesFilename: string;
|
||||
function GetParsedFPDocPaths: string;
|
||||
function GetParsedDebuggerFilename: string;
|
||||
function GetParsedDebuggerFilename(TheProject: TLazProject = nil): string;
|
||||
function GetParsedDebuggerSearchPath: string;
|
||||
function GetParsedFppkgConfig: string; override;
|
||||
function GetParsedValue(o: TEnvOptParseType; AUnparsedValue: String = ''): string;
|
||||
@ -892,7 +895,7 @@ type
|
||||
property FPCSourceDirHistory: TStringList read FFPCSourceDirHistory;
|
||||
property MakeFilename: string read GetMakeFilename write SetMakeFilename;
|
||||
property MakeFileHistory: TStringList read FMakeFileHistory;
|
||||
property DebuggerFilename: string read GetDebuggerFilename;
|
||||
function DebuggerFilename(TheProject: TLazProject = nil): string;
|
||||
property DebuggerFileHistory[AnIndex: String]: TStringList read GetNamedDebuggerFileHistory;
|
||||
property DebuggerSearchPath: string read GetDebuggerSearchPath write SetDebuggerSearchPath;
|
||||
property DebuggerShowStopMessage: boolean read FDebuggerShowStopMessage write FDebuggerShowStopMessage;
|
||||
@ -925,9 +928,10 @@ type
|
||||
|
||||
// Debugger
|
||||
procedure SaveDebuggerPropertiesList;
|
||||
function CurrentDebuggerClass(TheProject: TLazProject = nil): TDebuggerClass;
|
||||
function DebuggerPropertiesConfigList: TDebuggerPropertiesConfigList;
|
||||
function CurrentDebuggerPropertiesConfigEx(TheProject: TLazProject): TDebuggerPropertiesConfig;
|
||||
property CurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig read GetCurrentDebuggerPropertiesConfig write SetCurrentDebuggerPropertiesOpt;
|
||||
property CurrentDebuggerClass: TDebuggerClass read GetCurrentDebuggerClass;
|
||||
property HasActiveDebuggerEntry: Boolean read FHasActiveDebuggerEntry write FHasActiveDebuggerEntry; // for the initial setup dialog / entry may be of unknown class
|
||||
property DebuggerConfig: TDebuggerConfigStore read FDebuggerConfig;
|
||||
|
||||
@ -1220,8 +1224,34 @@ begin
|
||||
Result := Opt[i];
|
||||
end;
|
||||
|
||||
function TDebuggerPropertiesConfigList.EntryByUid(AnUid: String
|
||||
): TDebuggerPropertiesConfig;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
i := Count - 1;
|
||||
while (i >= 0) and (Opt[i].UID <> AnUid) do
|
||||
dec(i);
|
||||
if i >= 0 then
|
||||
Result := Opt[i];
|
||||
end;
|
||||
|
||||
{ TDebuggerPropertiesConfig }
|
||||
|
||||
procedure TDebuggerPropertiesConfig.InitUID;
|
||||
var
|
||||
g: TGUID;
|
||||
begin
|
||||
if FUID <> '' then
|
||||
exit;
|
||||
|
||||
if CreateGUID(g) = 0 then
|
||||
FUID := GUIDToString(g)
|
||||
else
|
||||
FUID := IntToHex(Random($100000000), 8)+'-'+IntToHex(Random($100000000), 8)+'-'+IntToHex(Random($100000000), 8);
|
||||
end;
|
||||
|
||||
destructor TDebuggerPropertiesConfig.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
@ -1243,6 +1273,8 @@ begin
|
||||
FDebuggerProperties := FDebuggerClass.CreateProperties;
|
||||
AXMLCfg.ReadObject(APath + 'Properties/', FDebuggerProperties);
|
||||
end;
|
||||
|
||||
InitUID;
|
||||
end;
|
||||
|
||||
constructor TDebuggerPropertiesConfig.CreateFromOldXmlConf(
|
||||
@ -1270,6 +1302,8 @@ begin
|
||||
FDebuggerProperties := ADebuggerClass.CreateProperties;
|
||||
AXMLCfg.ReadObject(APath, FDebuggerProperties);
|
||||
end;
|
||||
|
||||
InitUID;
|
||||
end;
|
||||
|
||||
constructor TDebuggerPropertiesConfig.CreateFromOldXmlConf(
|
||||
@ -1297,6 +1331,8 @@ begin
|
||||
FDebuggerProperties := FDebuggerClass.CreateProperties;
|
||||
AXMLCfg.ReadObject(APath, FDebuggerProperties);
|
||||
end;
|
||||
|
||||
InitUID;
|
||||
end;
|
||||
|
||||
constructor TDebuggerPropertiesConfig.CreateForDebuggerClass(
|
||||
@ -1310,6 +1346,8 @@ begin
|
||||
FConfigClass := ADebuggerClass.ClassName;
|
||||
FConfigName := '';
|
||||
FDebuggerProperties := ADebuggerClass.CreateProperties;
|
||||
|
||||
InitUID;
|
||||
end;
|
||||
|
||||
constructor TDebuggerPropertiesConfig.CreateCopy(
|
||||
@ -1321,6 +1359,7 @@ begin
|
||||
if ACopyXmlOrigin then begin
|
||||
FIsFromOldXml := ASource.FIsFromOldXml;
|
||||
FXmlIndex := ASource.FXmlIndex;
|
||||
FUID := ASource.FUID;
|
||||
end
|
||||
else begin
|
||||
FIsFromOldXml := False;
|
||||
@ -1341,6 +1380,9 @@ begin
|
||||
FDebuggerProperties := ASource.DebuggerClass.CreateProperties;
|
||||
if ACopyPropValues and (ASource.FDebuggerProperties <> nil) then
|
||||
FDebuggerProperties.Assign(ASource.FDebuggerProperties);
|
||||
|
||||
FUID := '';
|
||||
InitUID;
|
||||
end;
|
||||
|
||||
procedure TDebuggerPropertiesConfig.AssignTo(Dest: TPersistent);
|
||||
@ -3169,10 +3211,11 @@ begin
|
||||
Result:=GetParsedValue(eopFPDocPaths);
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.GetParsedDebuggerFilename: string;
|
||||
function TEnvironmentOptions.GetParsedDebuggerFilename(TheProject: TLazProject
|
||||
): string;
|
||||
begin
|
||||
if FParseValues[eopDebuggerFilename].UnparsedValue <> DebuggerFilename then
|
||||
SetParseValue(eopDebuggerFilename,UTF8Trim(DebuggerFilename));
|
||||
if FParseValues[eopDebuggerFilename].UnparsedValue <> DebuggerFilename(TheProject) then
|
||||
SetParseValue(eopDebuggerFilename,UTF8Trim(DebuggerFilename(TheProject)));
|
||||
|
||||
Result:=GetParsedValue(eopDebuggerFilename);
|
||||
end;
|
||||
@ -3487,13 +3530,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.GetCurrentDebuggerClass: TDebuggerClass;
|
||||
function TEnvironmentOptions.CurrentDebuggerClass(TheProject: TLazProject): TDebuggerClass;
|
||||
begin
|
||||
LoadDebuggerProperties;
|
||||
|
||||
Result := nil;
|
||||
if CurrentDebuggerPropertiesConfig <> nil then
|
||||
Result := CurrentDebuggerPropertiesConfig.DebuggerClass;
|
||||
if CurrentDebuggerPropertiesConfigEx(TheProject) <> nil then
|
||||
Result := CurrentDebuggerPropertiesConfigEx(TheProject).DebuggerClass;
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.GetCurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig;
|
||||
@ -3520,6 +3563,17 @@ begin
|
||||
Result := FDebuggerProperties;
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.CurrentDebuggerPropertiesConfigEx(
|
||||
TheProject: TLazProject): TDebuggerPropertiesConfig;
|
||||
begin
|
||||
Result := nil;
|
||||
if (TheProject <> nil) and (TheProject.CurrentDebuggerBackend <> '') then
|
||||
Result := FDebuggerProperties.EntryByUid(TheProject.CurrentDebuggerBackend);
|
||||
|
||||
if Result = nil then
|
||||
Result := CurrentDebuggerPropertiesConfig;
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.FileHasChangedOnDisk: boolean;
|
||||
begin
|
||||
Result:=FFileHasChangedOnDisk
|
||||
@ -3710,12 +3764,12 @@ begin
|
||||
Result := FDebuggerEventLogColors[AIndex];
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.GetDebuggerFilename: string;
|
||||
function TEnvironmentOptions.DebuggerFilename(TheProject: TLazProject): string;
|
||||
begin
|
||||
Result := '';
|
||||
LoadDebuggerProperties;
|
||||
if CurrentDebuggerPropertiesConfig <> nil then
|
||||
Result:=CurrentDebuggerPropertiesConfig.DebuggerFilename;
|
||||
if CurrentDebuggerPropertiesConfigEx(TheProject) <> nil then
|
||||
Result:=CurrentDebuggerPropertiesConfigEx(TheProject).DebuggerFilename;
|
||||
end;
|
||||
|
||||
function TEnvironmentOptions.GetDebuggerSearchPath: string;
|
||||
|
||||
39
ide/frames/project_debug_options.lfm
Normal file
39
ide/frames/project_debug_options.lfm
Normal file
@ -0,0 +1,39 @@
|
||||
object ProjectDebugOptionsFrame: TProjectDebugOptionsFrame
|
||||
Left = 0
|
||||
Height = 240
|
||||
Top = 0
|
||||
Width = 320
|
||||
ClientHeight = 240
|
||||
ClientWidth = 320
|
||||
TabOrder = 0
|
||||
DesignLeft = 617
|
||||
DesignTop = 390
|
||||
object lbProjectDebugger: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = cbProjectDebugger
|
||||
AnchorSideTop.Side = asrCenter
|
||||
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
|
||||
end
|
||||
end
|
||||
113
ide/frames/project_debug_options.pas
Normal file
113
ide/frames/project_debug_options.pas
Normal file
@ -0,0 +1,113 @@
|
||||
unit project_debug_options;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
// LazUtils
|
||||
LazTracer,
|
||||
// LCL
|
||||
Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
|
||||
// IdeIntf
|
||||
IDEOptionsIntf, IDEOptEditorIntf, ProjectIntf,
|
||||
// IDE
|
||||
Project, LazarusIDEStrConsts, EnvironmentOpts;
|
||||
|
||||
type
|
||||
|
||||
{ TProjectDebugOptionsFrame }
|
||||
|
||||
TProjectDebugOptionsFrame = class(TAbstractIDEOptionsEditor)
|
||||
cbProjectDebugger: TComboBox;
|
||||
lbProjectDebugger: TLabel;
|
||||
private
|
||||
fProject: TProject;
|
||||
FDebuggerBackend: String;
|
||||
public
|
||||
function GetTitle: string; override;
|
||||
procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
|
||||
procedure ReadSettings(AOptions: TAbstractIDEOptions); override;
|
||||
procedure WriteSettings(AOptions: TAbstractIDEOptions); override;
|
||||
class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
|
||||
//property aProject: TProject read fProject;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TProjectDebugOptionsFrame }
|
||||
|
||||
function TProjectDebugOptionsFrame.GetTitle: string;
|
||||
begin
|
||||
Result := dlgPODebugger;
|
||||
end;
|
||||
|
||||
procedure TProjectDebugOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
|
||||
begin
|
||||
lbProjectDebugger.Caption := lisDebugOptionsFrmDebuggerBackend;
|
||||
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;
|
||||
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;
|
||||
end;
|
||||
|
||||
procedure TProjectDebugOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
|
||||
var
|
||||
AFlags: TProjectFlags;
|
||||
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;
|
||||
|
||||
with (AOptions as TProjectIDEOptions).Project do
|
||||
begin
|
||||
DebuggerBackend := FDebuggerBackend;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TProjectDebugOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
|
||||
begin
|
||||
Result := TProjectIDEOptions;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterIDEOptionsEditor(GroupProject, TProjectDebugOptionsFrame, ProjectOptionsDebug);
|
||||
|
||||
end.
|
||||
|
||||
@ -6594,6 +6594,10 @@ resourcestring
|
||||
UnitDepOptionsForUnit = 'Options for Unit graph';
|
||||
LvlGraphReduceBackedges = 'Reduce backedges';
|
||||
lisDebugOptionsFrmBackend = 'Debugger backend';
|
||||
dlgPODebugger = 'Debugger';
|
||||
lisDebugOptionsFrmDebuggerBackend = 'DebuggerBackend:';
|
||||
lisDebugOptionsFrmUseIDEDebugger = '-- Use IDE default Debugger --';
|
||||
lisDebugOptionsFrmUnknownDebuggerBacke = 'Unknown Debugger backend "%s"';
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -131,7 +131,7 @@ uses
|
||||
// project option frames
|
||||
project_application_options, project_forms_options, project_lazdoc_options,
|
||||
project_save_options, project_versioninfo_options, project_i18n_options,
|
||||
project_misc_options, project_resources_options,
|
||||
project_misc_options, project_resources_options, project_debug_options,
|
||||
// project compiler option frames
|
||||
compiler_path_options, compiler_config_target, compiler_parsing_options,
|
||||
compiler_codegen_options, compiler_debugging_options, compiler_verbosity_options,
|
||||
|
||||
@ -708,6 +708,7 @@ type
|
||||
FAllEditorsInfoMap: TMap;
|
||||
FAutoCreateForms: boolean;
|
||||
FChangeStampSaved: integer;
|
||||
FDebuggerBackend: String;
|
||||
FEnableI18NForLFM: boolean;
|
||||
FHistoryLists: THistoryLists;
|
||||
FLastCompileComplete: boolean;
|
||||
@ -799,6 +800,7 @@ type
|
||||
CheckIfAllowed: boolean; var Allowed: boolean);
|
||||
procedure SetActiveBuildMode(const AValue: TProjectBuildMode);
|
||||
procedure SetAutoOpenDesignerFormsDisabled(const AValue: boolean);
|
||||
procedure SetDebuggerBackend(AValue: String);
|
||||
procedure SetEnableI18N(const AValue: boolean);
|
||||
procedure SetEnableI18NForLFM(const AValue: boolean);
|
||||
procedure SetLastCompilerParams(AValue: string);
|
||||
@ -861,6 +863,7 @@ type
|
||||
procedure SetSessionModified(const AValue: boolean); override;
|
||||
procedure SetSessionStorage(const AValue: TProjectSessionStorage); override;
|
||||
procedure SetUseManifest(AValue: boolean); override;
|
||||
function GetCurrentDebuggerBackend: String; override;
|
||||
protected
|
||||
// special unit lists
|
||||
procedure AddToList(AnUnitInfo: TUnitInfo; ListType: TUnitInfoList);
|
||||
@ -1114,6 +1117,8 @@ type
|
||||
property OtherDefines: TStrings read FOtherDefines;
|
||||
property UpdateLock: integer read FUpdateLock;
|
||||
property UseAsDefault: Boolean read FUseAsDefault write FUseAsDefault; // for dialog only (used to store options once)
|
||||
|
||||
property DebuggerBackend: String read FDebuggerBackend write SetDebuggerBackend;
|
||||
end;
|
||||
|
||||
|
||||
@ -2953,6 +2958,9 @@ begin
|
||||
LoadOtherDefines(Path);
|
||||
// load session info
|
||||
LoadSessionInfo(Path,false);
|
||||
|
||||
FDebuggerBackend := FXMLConfig.GetValue(Path+'Debugger/Backend/Value', '');
|
||||
|
||||
// call hooks to read their info (e.g. DebugBoss)
|
||||
if Assigned(OnLoadProjectInfo) then
|
||||
OnLoadProjectInfo(Self, FXMLConfig, false);
|
||||
@ -3275,6 +3283,8 @@ begin
|
||||
// save units
|
||||
SaveUnits(Path,FSaveSessionInLPI);
|
||||
|
||||
FXMLConfig.SetDeleteValue(Path+'Debugger/Backend/Value', DebuggerBackend, '');
|
||||
|
||||
if FSaveSessionInLPI then begin
|
||||
// save defines used for custom options
|
||||
SaveOtherDefines(Path);
|
||||
@ -3912,6 +3922,11 @@ begin
|
||||
ProjResources.XPManifest.UseManifest:=AValue;
|
||||
end;
|
||||
|
||||
function TProject.GetCurrentDebuggerBackend: String;
|
||||
begin
|
||||
Result := FDebuggerBackend;
|
||||
end;
|
||||
|
||||
function TProject.UnitCount:integer;
|
||||
begin
|
||||
Result:=FUnitList.Count;
|
||||
@ -5279,6 +5294,13 @@ begin
|
||||
FAutoOpenDesignerFormsDisabled:=AValue;
|
||||
end;
|
||||
|
||||
procedure TProject.SetDebuggerBackend(AValue: String);
|
||||
begin
|
||||
if FDebuggerBackend = AValue then Exit;
|
||||
FDebuggerBackend := AValue;
|
||||
Modified := True;
|
||||
end;
|
||||
|
||||
procedure TProject.SetEnableI18NForLFM(const AValue: boolean);
|
||||
begin
|
||||
if FEnableI18NForLFM=AValue then exit;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user