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

Debugger: Allow project to override selected debugger.

Browse Source 
git-svn-id: trunk@61673 -
This commit is contained in:
martin 2019-08-06 15:38:36 +00:00
parent 3356170ca6
commit 5e7fd9a4fa
10 changed files with 263 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -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

3
components/ideintf/ideoptionsintf.pas
View File

@ -215,7 +215,8 @@ const
ProjectOptionsResources = 550;
ProjectOptionsI18N = 600;
ProjectOptionsMisc = 700;
DbgOptionsLanguageExceptions = 800;
ProjectOptionsDebug = 700;
DbgOptionsLanguageExceptions = 900;
GroupPackage = 200100;
PackageOptionsUsage = 100;

2
components/ideintf/projectintf.pas
View File

@ -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;

20
ide/debugmanager.pas
View File

@ -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;

82
ide/environmentopts.pp
View File

@ -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
View 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
View 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.

4
ide/lazarusidestrconsts.pas
View File

@ -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

2
ide/main.pp
View File

@ -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,

22
ide/project.pp
View File

@ -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;