diff --git a/.gitattributes b/.gitattributes index dd669fac28..4ccdcac9aa 100644 --- a/.gitattributes +++ b/.gitattributes @@ -5961,6 +5961,8 @@ debugger/exceptiondlg.lfm svneol=native#text/plain debugger/exceptiondlg.pas svneol=native#text/pascal debugger/feedbackdlg.lfm svneol=native#text/plain debugger/feedbackdlg.pp svneol=native#text/pascal +debugger/frames/debugger_class_options.lfm svneol=native#text/plain +debugger/frames/debugger_class_options.pas svneol=native#text/pascal debugger/frames/debugger_eventlog_options.lfm svneol=native#text/plain debugger/frames/debugger_eventlog_options.pas svneol=native#text/pascal debugger/frames/debugger_general_options.lfm svneol=native#text/plain diff --git a/components/debuggerintf/dbgintfdebuggerbase.pp b/components/debuggerintf/dbgintfdebuggerbase.pp index 7e46c514ef..5ca7f2aec2 100644 --- a/components/debuggerintf/dbgintfdebuggerbase.pp +++ b/components/debuggerintf/dbgintfdebuggerbase.pp @@ -1895,7 +1895,7 @@ type // debugger properties class function CreateProperties: TDebuggerProperties; virtual; // Creates debuggerproperties class function GetProperties: TDebuggerProperties; // Get the current properties - class procedure SetProperties(const AProperties: TDebuggerProperties); // Set the current properties + //class procedure SetProperties(const AProperties: TDebuggerProperties); // Set the current properties (* TODO: This method is a workaround for http://bugs.freepascal.org/view.php?id=21834 @@ -1988,6 +1988,8 @@ type end; TDebuggerClass = class of TDebuggerIntf; + { TBaseDebugManagerIntf } + TBaseDebugManagerIntf = class(TComponent) public type TStringFunction = function(const aValue: string): string; @@ -1997,10 +1999,11 @@ type function ValueFormatterKey(const aSymbolKind: TDBGSymbolKind; const aTypeName: string): string; protected - function GetDebuggerClass(const AIndex: Integer): TDebuggerClass; + class function GetDebuggerClass(const AIndex: Integer): TDebuggerClass;static; + class function GetDebuggerClassByName(const AIndex: String): TDebuggerClass; static; function FindDebuggerClass(const Astring: String): TDebuggerClass; public - function DebuggerCount: Integer; + class function DebuggerCount: Integer; procedure RegisterValueFormatter(const aSymbolKind: TDBGSymbolKind; const aTypeName: string; const aFunc: TStringFunction); @@ -2008,6 +2011,8 @@ type const aTypeName, aValue: string): string; function FormatValue(const aDBGType: TDBGType; const aValue: string): string; + class property Debuggers[const AIndex: Integer]: TDebuggerClass read GetDebuggerClass; + class property DebuggersByClassName[const AIndex: String]: TDebuggerClass read GetDebuggerClassByName; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -2062,7 +2067,8 @@ var procedure RegisterDebugger(const ADebuggerClass: TDebuggerClass); begin - MDebuggerClasses.AddObject(ADebuggerClass.ClassName, TObject(Pointer(ADebuggerClass))); + if MDebuggerClasses.IndexOfObject(TObject(Pointer(ADebuggerClass))) < 0 then + MDebuggerClasses.AddObject(ADebuggerClass.ClassName, TObject(Pointer(ADebuggerClass))); end; function MinDbgPtr(a, b: TDBGPtr): TDBGPtr; @@ -6229,17 +6235,17 @@ begin SetState(dsIdle); end; -class procedure TDebuggerIntf.SetProperties(const AProperties: TDebuggerProperties); -var - Props: TDebuggerProperties; -begin - if AProperties = nil then Exit; - Props := GetProperties; - if Props = AProperties then Exit; - - if Props = nil then Exit; // they weren't created ? - Props.Assign(AProperties); -end; +//class procedure TDebuggerIntf.SetProperties(const AProperties: TDebuggerProperties); +//var +// Props: TDebuggerProperties; +//begin +// if AProperties = nil then Exit; +// Props := GetProperties; +// if Props = AProperties then Exit; +// +// if Props = nil then Exit; // they weren't created ? +// Props.Assign(AProperties); +//end; class function TDebuggerIntf.RequiresLocalExecutable: Boolean; begin @@ -6370,7 +6376,7 @@ begin FValueFormatterList.Duplicates := dupError; end; -function TBaseDebugManagerIntf.DebuggerCount: Integer; +class function TBaseDebugManagerIntf.DebuggerCount: Integer; begin Result := MDebuggerClasses.Count; end; @@ -6414,11 +6420,25 @@ begin Result := FormatValue(aDBGType.Kind, aDBGType.TypeName, aValue); end; -function TBaseDebugManagerIntf.GetDebuggerClass(const AIndex: Integer): TDebuggerClass; +class function TBaseDebugManagerIntf.GetDebuggerClass(const AIndex: Integer): TDebuggerClass; begin Result := TDebuggerClass(MDebuggerClasses.Objects[AIndex]); end; +class function TBaseDebugManagerIntf.GetDebuggerClassByName(const AIndex: String + ): TDebuggerClass; +var + i: Integer; +begin + i := MDebuggerClasses.Count - 1; + while i >= 0 do begin + if LowerCase(TDebuggerClass(MDebuggerClasses.Objects[i]).ClassName) = LowerCase(AIndex) then + exit(TDebuggerClass(MDebuggerClasses.Objects[i])); + dec(i); + end; + Result := nil; +end; + procedure TBaseDebugManagerIntf.RegisterValueFormatter( const aSymbolKind: TDBGSymbolKind; const aTypeName: string; const aFunc: TStringFunction); diff --git a/components/ideintf/ideoptionsintf.pas b/components/ideintf/ideoptionsintf.pas index 9f717ff723..66a132b22a 100644 --- a/components/ideintf/ideoptionsintf.pas +++ b/components/ideintf/ideoptionsintf.pas @@ -198,6 +198,7 @@ const GroupDebugger = 400; DbgOptionsGeneral = 100; + DbgOptionsClass = 150; DbgOptionsEventLog = 200; DbgOptionsLanguageExceptions = 300; DbgOptionsSignals = 400; diff --git a/components/lazdebuggergdbmi/gdbmidebugger.pp b/components/lazdebuggergdbmi/gdbmidebugger.pp index 6f6be4dfc4..eb0b080710 100644 --- a/components/lazdebuggergdbmi/gdbmidebugger.pp +++ b/components/lazdebuggergdbmi/gdbmidebugger.pp @@ -7687,34 +7687,36 @@ end; procedure TGDBMIDebuggerPropertiesBase.Assign(Source: TPersistent); begin inherited Assign(Source); - FGDBOptions := TGDBMIDebuggerPropertiesBase(Source).FGDBOptions; - {$IFDEF UNIX} - FConsoleTty := TGDBMIDebuggerPropertiesBase(Source).FConsoleTty; - {$ENDIF} - FMaxDisplayLengthForString := TGDBMIDebuggerPropertiesBase(Source).FMaxDisplayLengthForString; - FMaxDisplayLengthForStaticArray := TGDBMIDebuggerPropertiesBase(Source).FMaxDisplayLengthForStaticArray; - FMaxLocalsLengthForStaticArray := TGDBMIDebuggerPropertiesBase(Source).FMaxLocalsLengthForStaticArray; - FTimeoutForEval := TGDBMIDebuggerPropertiesBase(Source).FTimeoutForEval; - FWarnOnTimeOut := TGDBMIDebuggerPropertiesBase(Source).FWarnOnTimeOut; - FWarnOnInternalError := TGDBMIDebuggerPropertiesBase(Source).FWarnOnInternalError; - FEncodeCurrentDirPath := TGDBMIDebuggerPropertiesBase(Source).FEncodeCurrentDirPath; - FEncodeExeFileName := TGDBMIDebuggerPropertiesBase(Source).FEncodeExeFileName; - FInternalStartBreak := TGDBMIDebuggerPropertiesBase(Source).FInternalStartBreak; - FUseAsyncCommandMode := TGDBMIDebuggerPropertiesBase(Source).FUseAsyncCommandMode; - FDisableLoadSymbolsForLibraries := TGDBMIDebuggerPropertiesBase(Source).FDisableLoadSymbolsForLibraries; - FUseNoneMiRunCommands := TGDBMIDebuggerPropertiesBase(Source).FUseNoneMiRunCommands; - FDisableForcedBreakpoint := TGDBMIDebuggerPropertiesBase(Source).FDisableForcedBreakpoint; - FWarnOnSetBreakpointError := TGDBMIDebuggerPropertiesBase(Source).FWarnOnSetBreakpointError; - FCaseSensitivity := TGDBMIDebuggerPropertiesBase(Source).FCaseSensitivity; - FGdbValueMemLimit := TGDBMIDebuggerPropertiesBase(Source).FGdbValueMemLimit; - FGdbLocalsValueMemLimit := TGDBMIDebuggerPropertiesBase(Source).FGdbLocalsValueMemLimit; - FAssemblerStyle := TGDBMIDebuggerPropertiesBase(Source).FAssemblerStyle; - FDisableStartupShell := TGDBMIDebuggerPropertiesBase(Source).FDisableStartupShell; - FFixStackFrameForFpcAssert := TGDBMIDebuggerPropertiesBase(Source).FFixStackFrameForFpcAssert; - FFixIncorrectStepOver := TGDBMIDebuggerPropertiesBase(Source).FFixIncorrectStepOver; - {$IFdef MSWindows} - FAggressiveWaitTime := TGDBMIDebuggerPropertiesBase(Source).FAggressiveWaitTime; - {$EndIf} + if Source is TGDBMIDebuggerPropertiesBase then begin + FGDBOptions := TGDBMIDebuggerPropertiesBase(Source).FGDBOptions; + {$IFDEF UNIX} + FConsoleTty := TGDBMIDebuggerPropertiesBase(Source).FConsoleTty; + {$ENDIF} + FMaxDisplayLengthForString := TGDBMIDebuggerPropertiesBase(Source).FMaxDisplayLengthForString; + FMaxDisplayLengthForStaticArray := TGDBMIDebuggerPropertiesBase(Source).FMaxDisplayLengthForStaticArray; + FMaxLocalsLengthForStaticArray := TGDBMIDebuggerPropertiesBase(Source).FMaxLocalsLengthForStaticArray; + FTimeoutForEval := TGDBMIDebuggerPropertiesBase(Source).FTimeoutForEval; + FWarnOnTimeOut := TGDBMIDebuggerPropertiesBase(Source).FWarnOnTimeOut; + FWarnOnInternalError := TGDBMIDebuggerPropertiesBase(Source).FWarnOnInternalError; + FEncodeCurrentDirPath := TGDBMIDebuggerPropertiesBase(Source).FEncodeCurrentDirPath; + FEncodeExeFileName := TGDBMIDebuggerPropertiesBase(Source).FEncodeExeFileName; + FInternalStartBreak := TGDBMIDebuggerPropertiesBase(Source).FInternalStartBreak; + FUseAsyncCommandMode := TGDBMIDebuggerPropertiesBase(Source).FUseAsyncCommandMode; + FDisableLoadSymbolsForLibraries := TGDBMIDebuggerPropertiesBase(Source).FDisableLoadSymbolsForLibraries; + FUseNoneMiRunCommands := TGDBMIDebuggerPropertiesBase(Source).FUseNoneMiRunCommands; + FDisableForcedBreakpoint := TGDBMIDebuggerPropertiesBase(Source).FDisableForcedBreakpoint; + FWarnOnSetBreakpointError := TGDBMIDebuggerPropertiesBase(Source).FWarnOnSetBreakpointError; + FCaseSensitivity := TGDBMIDebuggerPropertiesBase(Source).FCaseSensitivity; + FGdbValueMemLimit := TGDBMIDebuggerPropertiesBase(Source).FGdbValueMemLimit; + FGdbLocalsValueMemLimit := TGDBMIDebuggerPropertiesBase(Source).FGdbLocalsValueMemLimit; + FAssemblerStyle := TGDBMIDebuggerPropertiesBase(Source).FAssemblerStyle; + FDisableStartupShell := TGDBMIDebuggerPropertiesBase(Source).FDisableStartupShell; + FFixStackFrameForFpcAssert := TGDBMIDebuggerPropertiesBase(Source).FFixStackFrameForFpcAssert; + FFixIncorrectStepOver := TGDBMIDebuggerPropertiesBase(Source).FFixIncorrectStepOver; + {$IFdef MSWindows} + FAggressiveWaitTime := TGDBMIDebuggerPropertiesBase(Source).FAggressiveWaitTime; + {$EndIf} + end; end; diff --git a/components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas b/components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas index 84d1d67b88..657bb3e3f3 100644 --- a/components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas +++ b/components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas @@ -558,9 +558,11 @@ end; procedure TLldbDebuggerProperties.Assign(Source: TPersistent); begin inherited Assign(Source); - FLaunchNewTerminal := TLldbDebuggerProperties(Source).FLaunchNewTerminal; - FSkipGDBDetection := TLldbDebuggerProperties(Source).FSkipGDBDetection; - FIgnoreLaunchWarnings := TLldbDebuggerProperties(Source).FIgnoreLaunchWarnings; + if Source is TLldbDebuggerProperties then begin + FLaunchNewTerminal := TLldbDebuggerProperties(Source).FLaunchNewTerminal; + FSkipGDBDetection := TLldbDebuggerProperties(Source).FSkipGDBDetection; + FIgnoreLaunchWarnings := TLldbDebuggerProperties(Source).FIgnoreLaunchWarnings; + end; end; { TLldbDebuggerCommandRun } diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 12caceaea6..0bfdc0c768 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -98,7 +98,6 @@ type TDebuggerConfigStore = class(TDebuggerConfigStoreBase) private - FDebuggerClass: String; FDlgCallStackConfig: TDebuggerCallStackDlgConfig; FTDebuggerWatchesDlgConfig: TDebuggerWatchesDlgConfig; public @@ -107,7 +106,6 @@ type public constructor Create; destructor Destroy; override; - property DebuggerClass: String read FDebuggerClass write FDebuggerClass; property DlgWatchesConfig: TDebuggerWatchesDlgConfig read FTDebuggerWatchesDlgConfig; property DlgCallStackConfig: TDebuggerCallStackDlgConfig read FDlgCallStackConfig write FDlgCallStackConfig; published @@ -1966,17 +1964,8 @@ procedure TDebuggerConfigStore.Load; const OLD_GDB_DBG_NAME = 'GNU debugger (gdb)'; OLD_SSH_DBG_NAME = 'GNU debugger through SSH (gdb)'; -var - s: String; begin inherited; - FDebuggerClass := ConfigStore.GetValue('Class', ''); - if FDebuggerClass='' then begin - // try old format - s := ConfigStore.GetValue('Type', ''); - if s = OLD_GDB_DBG_NAME then FDebuggerClass:='TGDBMIDEBUGGER'; - if s = OLD_SSH_DBG_NAME then FDebuggerClass:='TSSHGDBMIDEBUGGER'; - end; ConfigStore.AppendBasePath('WatchesDlg/'); try FTDebuggerWatchesDlgConfig.ConfigStore := ConfigStore; @@ -1996,7 +1985,6 @@ end; procedure TDebuggerConfigStore.Save; begin inherited; - ConfigStore.SetDeleteValue('Class', FDebuggerClass, ''); ConfigStore.DeletePath('Type'); ConfigStore.AppendBasePath('WatchesDlg/'); try diff --git a/debugger/frames/debugger_class_options.lfm b/debugger/frames/debugger_class_options.lfm new file mode 100644 index 0000000000..a8f8b6d821 --- /dev/null +++ b/debugger/frames/debugger_class_options.lfm @@ -0,0 +1,244 @@ +object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame + Left = 0 + Height = 427 + Top = 0 + Width = 519 + ClientHeight = 427 + ClientWidth = 519 + TabOrder = 0 + Visible = False + DesignLeft = 812 + DesignTop = 313 + object ToolBar1: TToolBar + Left = 0 + Height = 26 + Top = 0 + Width = 519 + ButtonHeight = 22 + ButtonWidth = 60 + DropDownWidth = 12 + EdgeBorders = [ebBottom] + ShowCaptions = True + TabOrder = 0 + object tbSelect: TToolButton + Left = 1 + Top = 0 + Caption = 'tbSelect' + DropdownMenu = tbDropMenu + OnClick = tbSelectClick + Style = tbsDropDown + end + object tbAddNew: TToolButton + Left = 78 + Top = 0 + Caption = 'tbAddNew' + OnClick = tbAddNewClick + end + object tbCopy: TToolButton + Left = 143 + Top = 0 + Caption = 'tbCopy' + OnClick = tbCopyClick + end + object ToolButton2: TToolButton + Left = 203 + Height = 22 + Top = 0 + Caption = 'ToolButton2' + Style = tbsDivider + end + object tbDelete: TToolButton + Left = 208 + Top = 0 + Caption = 'tbDelete' + OnClick = tbDeleteClick + end + object ToolButton3: TToolButton + Left = 73 + Height = 22 + Top = 0 + Caption = 'ToolButton3' + Style = tbsDivider + end + end + object Panel1: TPanel + Left = 0 + Height = 401 + Top = 26 + Width = 519 + Align = alClient + BevelOuter = bvNone + ClientHeight = 401 + ClientWidth = 519 + TabOrder = 1 + object lblName: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = edName + AnchorSideTop.Side = asrCenter + Left = 10 + Height = 15 + Top = 10 + Width = 45 + BorderSpacing.Left = 10 + Caption = 'lblName' + ParentColor = False + end + object edName: TEdit + AnchorSideLeft.Control = lblName + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 61 + Height = 23 + Top = 6 + Width = 448 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 6 + BorderSpacing.Top = 6 + BorderSpacing.Right = 10 + OnEditingDone = edNameExit + OnExit = edNameExit + TabOrder = 0 + end + object gbDebuggerType: TGroupBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = edName + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 84 + Top = 35 + Width = 519 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 6 + Caption = 'Debugger type and path' + ClientHeight = 64 + ClientWidth = 515 + TabOrder = 1 + object cmbDebuggerType: TComboBox + AnchorSideLeft.Control = gbDebuggerType + AnchorSideTop.Control = gbDebuggerType + AnchorSideRight.Control = gbDebuggerType + AnchorSideRight.Side = asrBottom + Left = 6 + Height = 23 + Top = 6 + Width = 503 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 6 + ItemHeight = 15 + OnEditingDone = cmbDebuggerTypeEditingDone + OnSelect = cmbDebuggerTypeEditingDone + Style = csDropDownList + TabOrder = 0 + end + object cmbDebuggerPath: TComboBox + AnchorSideLeft.Control = gbDebuggerType + AnchorSideTop.Control = cmbDebuggerType + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = cmdOpenDebuggerPath + Left = 6 + Height = 23 + Top = 35 + Width = 480 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 6 + BorderSpacing.Top = 6 + BorderSpacing.Bottom = 6 + ItemHeight = 15 + OnEditingDone = cmbDebuggerPathEditingDone + OnEnter = cmbDebuggerPathEditingDone + TabOrder = 1 + end + object cmdOpenDebuggerPath: TButton + AnchorSideTop.Control = cmbDebuggerPath + AnchorSideRight.Control = gbDebuggerType + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = cmbDebuggerPath + AnchorSideBottom.Side = asrBottom + Left = 486 + Height = 23 + Top = 35 + Width = 23 + Anchors = [akTop, akRight, akBottom] + BorderSpacing.Right = 6 + Caption = '…' + OnClick = cmdOpenDebuggerPathClick + TabOrder = 2 + end + end + object gbAdditionalSearchPath: TGroupBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = gbDebuggerType + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 55 + Top = 125 + Width = 519 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 6 + Caption = 'Additional search path' + ClientHeight = 35 + ClientWidth = 515 + TabOrder = 2 + Visible = False + object txtAdditionalPath: TEdit + AnchorSideLeft.Control = gbAdditionalSearchPath + AnchorSideTop.Control = gbAdditionalSearchPath + AnchorSideRight.Control = cmdOpenAdditionalPath + Left = 6 + Height = 23 + Top = 6 + Width = 480 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 6 + BorderSpacing.Top = 6 + BorderSpacing.Bottom = 6 + TabOrder = 0 + end + object cmdOpenAdditionalPath: TButton + AnchorSideTop.Control = txtAdditionalPath + AnchorSideRight.Control = gbAdditionalSearchPath + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = txtAdditionalPath + AnchorSideBottom.Side = asrBottom + Left = 486 + Height = 23 + Top = 6 + Width = 23 + Anchors = [akTop, akRight, akBottom] + BorderSpacing.Right = 6 + Caption = '…' + OnClick = cmdOpenAdditionalPathClick + TabOrder = 1 + end + end + object gbDebuggerSpecific: TGroupBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = gbAdditionalSearchPath + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 215 + Top = 186 + Width = 519 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 6 + Caption = 'Debugger specific options (depends on type of debugger)' + TabOrder = 3 + end + end + object tbDropMenu: TPopupMenu + left = 294 + top = 5 + end +end diff --git a/debugger/frames/debugger_class_options.pas b/debugger/frames/debugger_class_options.pas new file mode 100644 index 0000000000..99301ef871 --- /dev/null +++ b/debugger/frames/debugger_class_options.pas @@ -0,0 +1,636 @@ +{ + *************************************************************************** + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * + * * + *************************************************************************** +} +unit debugger_class_options; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, TypInfo, + // LCL + Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs, ComCtrls, Menus, + // LazUtils + FileUtil, LazFileUtils, LazStringUtils, LazFileCache, LazLoggerBase, + // DebuggerIntf + DbgIntfDebuggerBase, + // IdeIntf + PropEdits, ObjectInspector, IDEOptionsIntf, IDEOptEditorIntf, IDEUtils, + GDBMIDebugger, + // IDE + TransferMacros, LazarusIDEStrConsts, PathEditorDlg, IDEProcs, DialogProcs, + InputHistory, EnvironmentOpts, BaseDebugManager, Debugger; + +type + + { TDebuggerClassOptionsFrame } + + TDebuggerClassOptionsFrame = class(TAbstractIDEOptionsEditor) + cmbDebuggerPath: TComboBox; + cmbDebuggerType: TComboBox; + cmdOpenAdditionalPath: TButton; + cmdOpenDebuggerPath: TButton; + edName: TEdit; + gbAdditionalSearchPath: TGroupBox; + gbDebuggerSpecific: TGroupBox; + gbDebuggerType: TGroupBox; + lblName: TLabel; + Panel1: TPanel; + tbDropMenu: TPopupMenu; + ToolBar1: TToolBar; + tbSelect: TToolButton; + tbAddNew: TToolButton; + ToolButton2: TToolButton; + tbDelete: TToolButton; + tbCopy: TToolButton; + ToolButton3: TToolButton; + txtAdditionalPath: TEdit; + procedure cmbDebuggerPathEditingDone(Sender: TObject); + procedure cmbDebuggerTypeEditingDone(Sender: TObject); + procedure cmdOpenAdditionalPathClick(Sender: TObject); + procedure cmdOpenDebuggerPathClick(Sender: TObject); + procedure edNameExit(Sender: TObject); + procedure tbAddNewClick(Sender: TObject); + procedure tbCopyClick(Sender: TObject); + procedure tbDeleteClick(Sender: TObject); + procedure tbSelectClick(Sender: TObject); + private + FInOdNameExit: Boolean; + PropertyGrid: TOIPropertyGrid; + FPropertyEditorHook: TPropertyEditorHook; + FCopiedDbgPropertiesConfigList: TDebuggerPropertiesConfigList; + FSelectedDbgPropertiesConfig: TDebuggerPropertiesConfig; + FLastCheckedDebuggerPath: String; + function SelectedDebuggerClass: TDebuggerClass; // currently shown debugger class + function SelectedDebuggerProperties: TDebuggerProperties; + + procedure DoNameSelected(Sender: TObject); + procedure FillDebuggerClassDropDown; + procedure UpdateDebuggerClass; + procedure UpdateDebuggerClassDropDown; + procedure FetchDebuggerSpecificOptions; + function GetDebuggerClassFromDropDown: TDebuggerClass; + function GetUniqueName(AName: String): String; + procedure ClearDbgProperties; + procedure FillNameDropDown; + procedure HookGetCheckboxForBoolean(var Value: Boolean); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function Check: Boolean; override; + function GetTitle: String; override; + procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override; + procedure ReadSettings({%H-}AOptions: TAbstractIDEOptions); override; + procedure WriteSettings({%H-}AOptions: TAbstractIDEOptions); override; + class function SupportedOptionsClass: TAbstractIDEOptionsClass; override; + end; + +implementation + +{$R *.lfm} + +{ TDebuggerClassOptionsFrame } + +procedure TDebuggerClassOptionsFrame.cmbDebuggerPathEditingDone(Sender: TObject + ); +var + ParsedFName: String; +begin + if FSelectedDbgPropertiesConfig = nil then + exit; + + if assigned(SelectedDebuggerClass) and SelectedDebuggerClass.NeedsExePath and + (FSelectedDbgPropertiesConfig.DebuggerFilename <> cmbDebuggerPath.Text) and + (FLastCheckedDebuggerPath <> cmbDebuggerPath.Text) + then begin + FLastCheckedDebuggerPath := cmbDebuggerPath.Text; + ParsedFName := EnvironmentOptions.GetParsedValue(eopDebuggerFilename, FLastCheckedDebuggerPath); + if ParsedFName = '' then + ParsedFName := FLastCheckedDebuggerPath; +DebugLn(['############### ',ParsedFName]); + if not CheckExecutable(FSelectedDbgPropertiesConfig.DebuggerFilename, ParsedFName, + lisEnvOptDlgInvalidDebuggerFilename, + lisEnvOptDlgInvalidDebuggerFilenameMsg) + then + exit; + end; +DebugLn(['<<<<<<<<<< ###### ',FSelectedDbgPropertiesConfig.DebuggerFilename ,' << ', cmbDebuggerPath.Text]); + + FSelectedDbgPropertiesConfig.DebuggerFilename := cmbDebuggerPath.Text; +end; + +procedure TDebuggerClassOptionsFrame.cmdOpenAdditionalPathClick( + Sender: TObject); +begin + PathEditorDialog.Path:=txtAdditionalPath.Text; + PathEditorDialog.Templates:=GetForcedPathDelims( + '$(LazarusDir)/include/$(TargetOS)' + +';$(FPCSrcDir)/rtl/inc/' + +';$(FPCSrcDir)/rtl/$(SrcOS)' + +';$(FPCSrcDir)/rtl/$(TargetOS)' + ); + if PathEditorDialog.ShowModal=mrOk then + txtAdditionalPath.Text:=PathEditorDialog.Path; +end; + +procedure TDebuggerClassOptionsFrame.cmdOpenDebuggerPathClick(Sender: TObject); +var + OpenDialog: TOpenDialog; + AFilename, ParsedFName: string; +begin + if FSelectedDbgPropertiesConfig = nil then + exit; + + OpenDialog:=TOpenDialog.Create(nil); + try + InputHistories.ApplyFileDialogSettings(OpenDialog); + OpenDialog.Options:=OpenDialog.Options+[ofPathMustExist]; + OpenDialog.Title:=lisChooseDebuggerExecutable; + + if OpenDialog.Execute then begin + AFilename:=CleanAndExpandFilename(OpenDialog.Filename); + ParsedFName := EnvironmentOptions.GetParsedValue(eopDebuggerFilename, AFilename); + if ParsedFName = '' then + ParsedFName := AFilename; + if CheckExecutable(FSelectedDbgPropertiesConfig.DebuggerFilename, ParsedFName, + lisEnvOptDlgInvalidDebuggerFilename, + lisEnvOptDlgInvalidDebuggerFilenameMsg) + then begin + SetComboBoxText(cmbDebuggerPath,AFilename,cstFilename); + FSelectedDbgPropertiesConfig.DebuggerFilename := AFilename; + end; + end; + InputHistories.StoreFileDialogSettings(OpenDialog); + finally + OpenDialog.Free; + end; +end; + +procedure TDebuggerClassOptionsFrame.edNameExit(Sender: TObject); +var + n: String; + i: Integer; +begin + if FSelectedDbgPropertiesConfig = nil then + exit; + try + FInOdNameExit := True; + n := GetUniqueName(edName.Text); + if n <> edName.Text then + edName.Text := n; + if FSelectedDbgPropertiesConfig.ConfigName <> n then begin + FSelectedDbgPropertiesConfig.ConfigName := n; + i := FCopiedDbgPropertiesConfigList.IndexOfObject(FSelectedDbgPropertiesConfig); + FCopiedDbgPropertiesConfigList[i] := n; + FillNameDropDown; + end; + finally + FInOdNameExit := False; + end; +end; + +procedure TDebuggerClassOptionsFrame.tbAddNewClick(Sender: TObject); +begin + edNameExit(nil); + UpdateDebuggerClass; + cmbDebuggerPathEditingDone(nil); + + FSelectedDbgPropertiesConfig := TDebuggerPropertiesConfig.CreateForDebuggerClass(TGDBMIDebugger); + FSelectedDbgPropertiesConfig.ConfigName := GetUniqueName(lisNew); + FCopiedDbgPropertiesConfigList.AddObject(FSelectedDbgPropertiesConfig.ConfigName, FSelectedDbgPropertiesConfig); + + FillNameDropDown; + UpdateDebuggerClassDropDown; + FetchDebuggerSpecificOptions; +end; + +procedure TDebuggerClassOptionsFrame.tbCopyClick(Sender: TObject); +var + pc: TDebuggerPropertiesConfig; + s: String; +begin + if FSelectedDbgPropertiesConfig = nil then + exit; + + edNameExit(nil); + UpdateDebuggerClass; + cmbDebuggerPathEditingDone(nil); + + pc := FSelectedDbgPropertiesConfig; + s := pc.ConfigName; + if s = '' then + s := lisNew; + FSelectedDbgPropertiesConfig := TDebuggerPropertiesConfig.CreateCopy(pc); + FSelectedDbgPropertiesConfig.ConfigName := GetUniqueName(s); + FCopiedDbgPropertiesConfigList.AddObject(FSelectedDbgPropertiesConfig.ConfigName, FSelectedDbgPropertiesConfig); + + FillNameDropDown; + UpdateDebuggerClassDropDown; + FetchDebuggerSpecificOptions; +end; + +procedure TDebuggerClassOptionsFrame.tbDeleteClick(Sender: TObject); +var + i: Integer; +begin + if FSelectedDbgPropertiesConfig = nil then + exit; + + i := FCopiedDbgPropertiesConfigList.IndexOfObject(FSelectedDbgPropertiesConfig); + FSelectedDbgPropertiesConfig.MarkAsDeleted; + FCopiedDbgPropertiesConfigList[i] := ''; // remove from named part of list + + FillNameDropDown; + UpdateDebuggerClassDropDown; + FetchDebuggerSpecificOptions; +end; + +procedure TDebuggerClassOptionsFrame.tbSelectClick(Sender: TObject); +begin + tbSelect.CheckMenuDropdown; +end; + +function TDebuggerClassOptionsFrame.SelectedDebuggerClass: TDebuggerClass; +begin + if FSelectedDbgPropertiesConfig = nil then + Result := nil + else + Result := FSelectedDbgPropertiesConfig.DebuggerClass; +end; + +function TDebuggerClassOptionsFrame.SelectedDebuggerProperties: TDebuggerProperties; +begin + if FSelectedDbgPropertiesConfig = nil then + Result := nil + else + Result := FSelectedDbgPropertiesConfig.DebuggerProperties; +end; + +procedure TDebuggerClassOptionsFrame.FillDebuggerClassDropDown; +var + List: TStringList; + i: Integer; + d: TDebuggerClass; +begin + List := TStringList.Create; + for i := 0 to TBaseDebugManagerIntf.DebuggerCount - 1 do begin + d := TBaseDebugManagerIntf.Debuggers[i]; + List.AddObject(d.Caption, TObject(d)); + end; + List.Sorted := True; + cmbDebuggerType.Items.Assign(List); + FreeAndNil(List); + + UpdateDebuggerClassDropDown; +end; + +procedure TDebuggerClassOptionsFrame.cmbDebuggerTypeEditingDone( + Sender: TObject); +begin + UpdateDebuggerClass; + FetchDebuggerSpecificOptions; +end; + +procedure TDebuggerClassOptionsFrame.UpdateDebuggerClass; +var + c: TDebuggerClass; +begin + if FSelectedDbgPropertiesConfig = nil then + exit; + c := GetDebuggerClassFromDropDown; + if SelectedDebuggerClass = c then + exit; + + FSelectedDbgPropertiesConfig.ChangeDebuggerClass(c, True); + // TOOD: Ask user? + FSelectedDbgPropertiesConfig.ConfigName := GetUniqueName(FSelectedDbgPropertiesConfig.ConfigName); + try + FInOdNameExit := True; + edName.Text := FSelectedDbgPropertiesConfig.ConfigName; + finally + FInOdNameExit := False; + end; + FillNameDropDown; +end; + +procedure TDebuggerClassOptionsFrame.UpdateDebuggerClassDropDown; +begin + if SelectedDebuggerClass = nil + then SetComboBoxText(cmbDebuggerType, '(none)',cstCaseInsensitive) + else SetComboBoxText(cmbDebuggerType, SelectedDebuggerClass.Caption,cstCaseInsensitive); +end; + +procedure TDebuggerClassOptionsFrame.DoNameSelected(Sender: TObject); +var + idx: PtrInt; +begin + idx := TMenuItem(Sender).Tag; + + edNameExit(nil); + UpdateDebuggerClass; + cmbDebuggerPathEditingDone(nil); + + FSelectedDbgPropertiesConfig := FCopiedDbgPropertiesConfigList.Opt[idx]; + FillNameDropDown; + + UpdateDebuggerClassDropDown; + FetchDebuggerSpecificOptions; +end; + +procedure TDebuggerClassOptionsFrame.FetchDebuggerSpecificOptions; +var + S, S2, S3: String; + Prop: TDebuggerProperties; +begin + PropertyGrid.Selection.Clear; + + if FSelectedDbgPropertiesConfig = nil then begin + cmbDebuggerPath.Items.Clear; + cmbDebuggerPath.Text := ''; + edName.Text := ''; + exit; + end; + + + with cmbDebuggerPath.Items do begin + BeginUpdate; + Assign(EnvironmentOptions.DebuggerFileHistory); + if (Count = 0) + and (SelectedDebuggerClass <> nil) + then begin + S := SelectedDebuggerClass.ExePaths; + while S <> '' do + begin + S2 := GetPart([], [';'], S); + S3 := S2; + if GlobalMacroList.SubstituteStr(S2) + then Add(S2) + else Add(S3); + if S <> '' then System.Delete(S, 1, 1); + end; + end; + EndUpdate; + end; + +debugln(['>>>### ',FSelectedDbgPropertiesConfig.DebuggerFilename,cstFilename]); + SetComboBoxText(cmbDebuggerPath,FSelectedDbgPropertiesConfig.DebuggerFilename,cstFilename,20); + edName.Text := FSelectedDbgPropertiesConfig.ConfigName; + +// txtAdditionalPath.Text:=EnvironmentOptions.GetParsedDebuggerSearchPath; + + // get ptoperties + Prop := SelectedDebuggerProperties; + if Prop<>nil then + PropertyGrid.Selection.Add(Prop); + PropertyGrid.BuildPropertyList; +end; + +function TDebuggerClassOptionsFrame.GetDebuggerClassFromDropDown: TDebuggerClass; +var + idx: PtrInt; +begin + Result := nil; + + idx := cmbDebuggerType.ItemIndex; + if idx = -1 then Exit; + Result := TDebuggerClass(cmbDebuggerType.Items.Objects[idx]); +end; + +function TDebuggerClassOptionsFrame.GetUniqueName(AName: String): String; + function TrimNumber(s: string): string; + var + i: Integer; + begin + Result := s; + i := Length(s); + if (i=0) or (s[i] <> ')') then + exit; + dec(i); + while (i > 0) and (s[i] in ['0'..'9']) do + dec(i); + if (i=0) or (s[i] <> '(') then + exit; + dec(i); + if (i<=1) or (s[i] <> ' ') then + exit; + Result := copy(s, 1, i-1); + end; +var + i, j: Integer; +begin + Result := Trim(AName); + if Result = '' then begin + i := FCopiedDbgPropertiesConfigList.Count - 1; + while i >= 0 do + if (FCopiedDbgPropertiesConfigList[i] <> '') or + (FCopiedDbgPropertiesConfigList.Opt[i].DebuggerClass <> SelectedDebuggerClass) or + (FCopiedDbgPropertiesConfigList.Opt[i].IsDeleted) or + (FCopiedDbgPropertiesConfigList.Opt[i] = FSelectedDbgPropertiesConfig) + then + dec(i) + else + break; + if i < 0 then + exit; + end + else begin + i := FCopiedDbgPropertiesConfigList.IndexOf(Result); + if (i < 0) or (FCopiedDbgPropertiesConfigList.Opt[i] = FSelectedDbgPropertiesConfig) then + exit; + end; + + Result := TrimNumber(Result); + i := 1; + repeat + inc(i); + j := FCopiedDbgPropertiesConfigList.IndexOf(Result+' ('+IntToStr(i)+')'); + if (j >= 0) and (FCopiedDbgPropertiesConfigList.Opt[i]= FSelectedDbgPropertiesConfig) + then + j := -1; + until j < 0; + + Result := Result+' ('+IntToStr(i)+')'; +end; + +procedure TDebuggerClassOptionsFrame.ClearDbgProperties; +begin + PropertyGrid.Selection.Clear; + FCopiedDbgPropertiesConfigList.ClearAll; +end; + +procedure TDebuggerClassOptionsFrame.FillNameDropDown; +var + m: TMenuItem; + i: Integer; +begin + tbDropMenu.Items.Clear; + for i := 0 to FCopiedDbgPropertiesConfigList.Count - 1 do + if (not FCopiedDbgPropertiesConfigList.Opt[i].IsDeleted) and + (FCopiedDbgPropertiesConfigList.Opt[i].IsLoaded) + then begin + m := TMenuItem.Create(tbDropMenu); + m.Caption := FCopiedDbgPropertiesConfigList.Opt[i].DisplayName; + m.Tag := i; + m.OnClick := @DoNameSelected; + m.Checked := FCopiedDbgPropertiesConfigList.Opt[i] = FSelectedDbgPropertiesConfig; + tbDropMenu.Items.Add(m); + end; + if FSelectedDbgPropertiesConfig <> nil then + tbSelect.Caption := FSelectedDbgPropertiesConfig.DisplayName + else + tbSelect.Caption := '---'; + tbSelect.Enabled := FCopiedDbgPropertiesConfigList.Count > 0; + Panel1.Enabled := FCopiedDbgPropertiesConfigList.Count > 0; + tbCopy.Enabled := FSelectedDbgPropertiesConfig <> nil; + tbDelete.Enabled := FSelectedDbgPropertiesConfig <> nil; +end; + +procedure TDebuggerClassOptionsFrame.HookGetCheckboxForBoolean(var Value: Boolean); +begin + Value := EnvironmentOptions.ObjectInspectorOptions.CheckboxForBoolean; +end; + +constructor TDebuggerClassOptionsFrame.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + // create the PropertyEditorHook (the interface to the properties) + FPropertyEditorHook:=TPropertyEditorHook.Create(Self); + FPropertyEditorHook.AddHandlerGetCheckboxForBoolean(@HookGetCheckboxForBoolean); + + FCopiedDbgPropertiesConfigList := TDebuggerPropertiesConfigList.Create; + FCopiedDbgPropertiesConfigList.CaseSensitive := False; + // create the PropertyGrid + PropertyGrid:=TOIPropertyGrid.CreateWithParams(Self,FPropertyEditorHook + ,[tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat, tkSet{, tkMethod} + , tkSString, tkLString, tkAString, tkWString, tkVariant + {, tkArray, tkRecord, tkInterface}, tkClass, tkObject, tkWChar, tkBool + , tkInt64, tkQWord], + 0); + with PropertyGrid do + begin + Name:='PropertyGrid'; + Parent := gbDebuggerSpecific; + BorderSpacing.Around := 6; + Visible := True; + Align := alClient; + PreferredSplitterX := 200; + SplitterX := 200; + Layout := oilHorizontal; + end; +end; + +destructor TDebuggerClassOptionsFrame.Destroy; +begin + ClearDbgProperties; + PropertyGrid.Selection.Clear; + FreeAndNil(FPropertyEditorHook); + FreeAndNil(FCopiedDbgPropertiesConfigList); + inherited Destroy; +end; + +function TDebuggerClassOptionsFrame.Check: Boolean; +begin + if FSelectedDbgPropertiesConfig = nil then + exit(True); + + edNameExit(nil); + UpdateDebuggerClass; // TODO: might edit the name + FLastCheckedDebuggerPath := 'X'+cmbDebuggerPath.Text; // ensure a new check is done + cmbDebuggerPathEditingDone(nil); +debugln(['############### >',FSelectedDbgPropertiesConfig.DebuggerFilename, '< ## >', cmbDebuggerPath.Text, '< #']); + + Result := (FSelectedDbgPropertiesConfig.DebuggerFilename = cmbDebuggerPath.Text); +end; + +function TDebuggerClassOptionsFrame.GetTitle: String; +begin + Result := lisDebugOptionsFrmBackend; +end; + +procedure TDebuggerClassOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog); +begin + tbAddNew.Caption := lisAdd; + tbCopy.Caption := lisCopy; + tbDelete.Caption := lisDelete; + lblName.Caption := lisDebugOptionsFrmName; + gbDebuggerType.Caption := dlgDebugType; + gbAdditionalSearchPath.Caption := lisDebugOptionsFrmAdditionalSearchPath; + gbDebuggerSpecific.Caption := lisDebugOptionsFrmDebuggerSpecific; +end; + +procedure TDebuggerClassOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions); +var + i: Integer; +begin + ClearDbgProperties; + with EnvironmentOptions do + begin + ObjectInspectorOptions.AssignTo(PropertyGrid); + + FCopiedDbgPropertiesConfigList.ClearAll; + for i := 0 to DebuggerPropertiesConfigList.Count - 1 do + FCopiedDbgPropertiesConfigList.AddObject(DebuggerPropertiesConfigList[i], + TDebuggerPropertiesConfig.CreateCopy(DebuggerPropertiesConfigList.Opt[i], True, True) ); + // Find our copy of the current entry + if CurrentDebuggerPropertiesConfig = nil then + FSelectedDbgPropertiesConfig := nil + else + FSelectedDbgPropertiesConfig := FCopiedDbgPropertiesConfigList.EntryByName( + CurrentDebuggerPropertiesConfig.ConfigName, CurrentDebuggerPropertiesConfig.ConfigClass); + + FillNameDropDown; + FillDebuggerClassDropDown; + FetchDebuggerSpecificOptions; + end; +end; + +procedure TDebuggerClassOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions); +var + i: Integer; + EnvConf: TDebuggerPropertiesConfigList; +begin + with EnvironmentOptions do + begin + DebuggerFileHistory.Assign(cmbDebuggerPath.Items); +// DebuggerSearchPath := TrimSearchPath(txtAdditionalPath.Text,''); + + EnvConf := DebuggerPropertiesConfigList; + EnvConf.ClearAll; + for i := 0 to FCopiedDbgPropertiesConfigList.Count - 1 do + EnvConf.AddObject(FCopiedDbgPropertiesConfigList[i], + TDebuggerPropertiesConfig.CreateCopy(FCopiedDbgPropertiesConfigList.Opt[i], True, True) ); + if FSelectedDbgPropertiesConfig = nil then + CurrentDebuggerPropertiesConfig := nil + else + CurrentDebuggerPropertiesConfig := DebuggerPropertiesConfigList.EntryByName( + FSelectedDbgPropertiesConfig.ConfigName, FSelectedDbgPropertiesConfig.ConfigClass); + end; +end; + +class function TDebuggerClassOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass; +begin + Result := TDebuggerOptions; +end; + +initialization + RegisterIDEOptionsEditor(GroupDebugger, TDebuggerClassOptionsFrame, DbgOptionsGeneral); +end. + diff --git a/debugger/frames/debugger_general_options.lfm b/debugger/frames/debugger_general_options.lfm index d2224dcdce..425443536a 100644 --- a/debugger/frames/debugger_general_options.lfm +++ b/debugger/frames/debugger_general_options.lfm @@ -9,80 +9,14 @@ object DebuggerGeneralOptionsFrame: TDebuggerGeneralOptionsFrame Visible = False DesignLeft = 812 DesignTop = 313 - object gbDebuggerType: TGroupBox + object gbAdditionalSearchPath: TGroupBox AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 - Height = 84 - Top = 0 - Width = 519 - Anchors = [akTop, akLeft, akRight] - AutoSize = True - Caption = 'Debugger type and path' - ClientHeight = 64 - ClientWidth = 515 - TabOrder = 0 - object cmbDebuggerType: TComboBox - AnchorSideLeft.Control = gbDebuggerType - AnchorSideTop.Control = gbDebuggerType - AnchorSideRight.Control = gbDebuggerType - AnchorSideRight.Side = asrBottom - Left = 6 - Height = 23 - Top = 6 - Width = 503 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 6 - ItemHeight = 15 - OnEditingDone = cmbDebuggerTypeEditingDone - OnSelect = cmbDebuggerTypeEditingDone - Style = csDropDownList - TabOrder = 0 - end - object cmbDebuggerPath: TComboBox - AnchorSideLeft.Control = gbDebuggerType - AnchorSideTop.Control = cmbDebuggerType - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = cmdOpenDebuggerPath - Left = 6 - Height = 23 - Top = 35 - Width = 480 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 6 - BorderSpacing.Top = 6 - BorderSpacing.Bottom = 6 - ItemHeight = 15 - TabOrder = 1 - end - object cmdOpenDebuggerPath: TButton - AnchorSideTop.Control = cmbDebuggerPath - AnchorSideRight.Control = gbDebuggerType - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = cmbDebuggerPath - AnchorSideBottom.Side = asrBottom - Left = 486 - Height = 23 - Top = 35 - Width = 23 - Anchors = [akTop, akRight, akBottom] - BorderSpacing.Right = 6 - Caption = '…' - OnClick = cmdOpenDebuggerPathClick - TabOrder = 2 - end - end - object gbAdditionalSearchPath: TGroupBox - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = gbDebuggerType - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - Left = 0 Height = 55 - Top = 90 + Top = 6 Width = 519 Anchors = [akTop, akLeft, akRight] AutoSize = True @@ -90,7 +24,7 @@ object DebuggerGeneralOptionsFrame: TDebuggerGeneralOptionsFrame Caption = 'Additional search path' ClientHeight = 35 ClientWidth = 515 - TabOrder = 1 + TabOrder = 0 object txtAdditionalPath: TEdit AnchorSideLeft.Control = gbAdditionalSearchPath AnchorSideTop.Control = gbAdditionalSearchPath @@ -130,7 +64,7 @@ object DebuggerGeneralOptionsFrame: TDebuggerGeneralOptionsFrame AnchorSideRight.Side = asrBottom Left = 0 Height = 19 - Top = 151 + Top = 67 Width = 519 Anchors = [akTop, akLeft, akRight] AutoFill = True @@ -145,23 +79,6 @@ object DebuggerGeneralOptionsFrame: TDebuggerGeneralOptionsFrame ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - TabOrder = 2 - end - object gbDebuggerSpecific: TGroupBox - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = gcbDebuggerGeneralOptions - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 0 - Height = 251 - Top = 176 - Width = 519 - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Top = 6 - Caption = 'Debugger specific options (depends on type of debugger)' - TabOrder = 3 + TabOrder = 1 end end diff --git a/debugger/frames/debugger_general_options.pas b/debugger/frames/debugger_general_options.pas index 4fe421a3c3..f3f45f8897 100644 --- a/debugger/frames/debugger_general_options.pas +++ b/debugger/frames/debugger_general_options.pas @@ -25,53 +25,31 @@ unit debugger_general_options; interface uses - Classes, SysUtils, TypInfo, + SysUtils, // LCL - Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs, + Controls, StdCtrls, ExtCtrls, Dialogs, Menus, // LazUtils - FileUtil, LazFileUtils, LazStringUtils, LazFileCache, - // DebuggerIntf - DbgIntfDebuggerBase, + FileUtil, LazFileUtils, // IdeIntf - PropEdits, ObjectInspector, IDEOptionsIntf, IDEOptEditorIntf, IDEUtils, + IDEOptionsIntf, IDEOptEditorIntf, // IDE - TransferMacros, LazarusIDEStrConsts, PathEditorDlg, IDEProcs, DialogProcs, - InputHistory, EnvironmentOpts, BaseDebugManager, Debugger; + LazarusIDEStrConsts, PathEditorDlg, IDEProcs, + EnvironmentOpts, BaseDebugManager; type { TDebuggerGeneralOptionsFrame } TDebuggerGeneralOptionsFrame = class(TAbstractIDEOptionsEditor) - cmbDebuggerPath: TComboBox; - cmbDebuggerType: TComboBox; cmdOpenAdditionalPath: TButton; - cmdOpenDebuggerPath: TButton; gbAdditionalSearchPath: TGroupBox; - gbDebuggerSpecific: TGroupBox; - gbDebuggerType: TGroupBox; gcbDebuggerGeneralOptions: TCheckGroup; txtAdditionalPath: TEdit; - procedure cmbDebuggerTypeEditingDone(Sender: TObject); procedure cmdOpenAdditionalPathClick(Sender: TObject); - procedure cmdOpenDebuggerPathClick(Sender: TObject); private - PropertyGrid: TOIPropertyGrid; - FCurDebuggerClass: TDebuggerClass; // currently shown debugger class - FPropertyEditorHook: TPropertyEditorHook; - FOldDebuggerFilename: string; fOldDebuggerSearchPath: string; - FCurrentDebPropertiesList: TStringList; // temporarilly modified - procedure FetchDebuggerClass; procedure FetchDebuggerGeneralOptions; - procedure FetchDebuggerSpecificOptions; - function GetDebuggerClass: TDebuggerClass; - procedure SetDebuggerClass(const AClass: TDebuggerClass); - procedure ClearDbgProperties; - procedure HookGetCheckboxForBoolean(var Value: Boolean); public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; function Check: Boolean; override; function GetTitle: String; override; procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override; @@ -87,12 +65,6 @@ implementation { TDebuggerGeneralOptionsFrame } -procedure TDebuggerGeneralOptionsFrame.cmbDebuggerTypeEditingDone( - Sender: TObject); -begin - SetDebuggerClass(GetDebuggerClass); -end; - procedure TDebuggerGeneralOptionsFrame.cmdOpenAdditionalPathClick( Sender: TObject); begin @@ -107,218 +79,17 @@ begin txtAdditionalPath.Text:=PathEditorDialog.Path; end; -procedure TDebuggerGeneralOptionsFrame.cmdOpenDebuggerPathClick(Sender: TObject); -var - OpenDialog: TOpenDialog; - AFilename: string; -begin - OpenDialog:=TOpenDialog.Create(nil); - try - InputHistories.ApplyFileDialogSettings(OpenDialog); - OpenDialog.Options:=OpenDialog.Options+[ofPathMustExist]; - OpenDialog.Title:=lisChooseDebuggerExecutable; - - if OpenDialog.Execute then begin - AFilename:=CleanAndExpandFilename(OpenDialog.Filename); - SetComboBoxText(cmbDebuggerPath,AFilename,cstFilename); - CheckExecutable(FOldDebuggerFilename,AFilename, - lisEnvOptDlgInvalidDebuggerFilename, - lisEnvOptDlgInvalidDebuggerFilenameMsg); - end; - InputHistories.StoreFileDialogSettings(OpenDialog); - finally - OpenDialog.Free; - end; -end; - -procedure TDebuggerGeneralOptionsFrame.FetchDebuggerClass; -var - n: PtrInt; - DbgClass, CurClass: TDebuggerClass; - List: TStringList; -begin - List := TStringList.Create; - List.Sorted := True; - - CurClass := nil; - for n := 0 to DebugBoss.DebuggerCount - 1 do - begin - DbgClass := DebugBoss.Debuggers[n]; - List.AddObject(DbgClass.Caption, TObject(n)); - if (FCurDebuggerClass = nil) - and (CompareText(DbgClass.ClassName, EnvironmentOptions.DebuggerConfig.DebuggerClass) = 0) - then CurClass := DbgClass; - end; - - cmbDebuggerType.Items.Assign(List); - FreeAndNil(List); - - SetDebuggerClass(CurClass); - if FCurDebuggerClass = nil - then SetComboBoxText(cmbDebuggerType, '(none)',cstCaseInsensitive) - else SetComboBoxText(cmbDebuggerType, FCurDebuggerClass.Caption,cstCaseInsensitive); - - txtAdditionalPath.Text:=EnvironmentOptions.GetParsedDebuggerSearchPath; -end; - procedure TDebuggerGeneralOptionsFrame.FetchDebuggerGeneralOptions; begin // IMPORTANT if more items are added the indexes must be updated here! gcbDebuggerGeneralOptions.Checked[0] := EnvironmentOptions.DebuggerShowStopMessage; gcbDebuggerGeneralOptions.Checked[1] := EnvironmentOptions.DebuggerResetAfterRun; gcbDebuggerGeneralOptions.Checked[2] := EnvironmentOptions.DebuggerAutoCloseAsm; -end; - -procedure TDebuggerGeneralOptionsFrame.FetchDebuggerSpecificOptions; -var - S, S2, S3: String; - i: Integer; - Filename: string; - NewFilename: string; - Prop: TDebuggerProperties; -begin - with cmbDebuggerPath.Items do begin - BeginUpdate; - Assign(EnvironmentOptions.DebuggerFileHistory); - if (Count = 0) - and (FCurDebuggerClass <> nil) - then begin - S := FCurDebuggerClass.ExePaths; - while S <> '' do - begin - S2 := GetPart([], [';'], S); - S3 := S2; - if GlobalMacroList.SubstituteStr(S2) - then Add(S2) - else Add(S3); - if S <> '' then System.Delete(S, 1, 1); - end; - end; - EndUpdate; - end; - - Filename:=cmbDebuggerPath.Text; - if Filename='' then begin - for i:=0 to cmbDebuggerPath.Items.Count-1 do begin - NewFilename:=cmbDebuggerPath.Items[i]; - if FileExistsCached(NewFilename) then begin - Filename:=NewFilename; - break; - end; - NewFilename:=FindDefaultExecutablePath(ExtractFileName(Filename)); - if NewFilename<>'' then begin - Filename:=NewFilename; - break; - end; - end; - end; - SetComboBoxText(cmbDebuggerPath,Filename,cstFilename,20); - - // get ptoperties - PropertyGrid.Selection.Clear; - if FCurDebuggerClass<>nil then begin - i := FCurrentDebPropertiesList.IndexOf(FCurDebuggerClass.ClassName); - if i < 0 then begin - Prop := TDebuggerPropertiesClass(FCurDebuggerClass.GetProperties.ClassType).Create; - EnvironmentOptions.LoadDebuggerProperties(FCurDebuggerClass.ClassName, Prop); - FCurrentDebPropertiesList.AddObject(FCurDebuggerClass.ClassName, Prop); - end - else - Prop := TDebuggerProperties(FCurrentDebPropertiesList.Objects[i]); - PropertyGrid.Selection.Add(Prop); - end; - PropertyGrid.BuildPropertyList; -end; - -function TDebuggerGeneralOptionsFrame.GetDebuggerClass: TDebuggerClass; -var - idx: PtrInt; -begin - Result := nil; - - idx := cmbDebuggerType.ItemIndex; - if idx = -1 then Exit; - idx := PtrInt(cmbDebuggerType.Items.Objects[idx]); - - if idx = -1 then Exit; - Result := DebugBoss.Debuggers[idx]; -end; - -procedure TDebuggerGeneralOptionsFrame.SetDebuggerClass( - const AClass: TDebuggerClass); -begin - if FCurDebuggerClass = AClass then Exit; - FCurDebuggerClass := AClass; - FetchDebuggerSpecificOptions; -end; - -procedure TDebuggerGeneralOptionsFrame.ClearDbgProperties; -var - i: Integer; -begin - PropertyGrid.Selection.Clear; - for i := 0 to FCurrentDebPropertiesList.Count - 1 do - FCurrentDebPropertiesList.Objects[i].Free; - FCurrentDebPropertiesList.Clear; -end; - -procedure TDebuggerGeneralOptionsFrame.HookGetCheckboxForBoolean(var Value: Boolean); -begin - Value := EnvironmentOptions.ObjectInspectorOptions.CheckboxForBoolean; -end; - -constructor TDebuggerGeneralOptionsFrame.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - // create the PropertyEditorHook (the interface to the properties) - FPropertyEditorHook:=TPropertyEditorHook.Create(Self); - FPropertyEditorHook.AddHandlerGetCheckboxForBoolean(@HookGetCheckboxForBoolean); - - FCurrentDebPropertiesList := TStringList.Create; - // create the PropertyGrid - PropertyGrid:=TOIPropertyGrid.CreateWithParams(Self,FPropertyEditorHook - ,[tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat, tkSet{, tkMethod} - , tkSString, tkLString, tkAString, tkWString, tkVariant - {, tkArray, tkRecord, tkInterface}, tkClass, tkObject, tkWChar, tkBool - , tkInt64, tkQWord], - 0); - with PropertyGrid do - begin - Name:='PropertyGrid'; - Parent := gbDebuggerSpecific; - BorderSpacing.Around := 6; - Visible := True; - Align := alClient; - PreferredSplitterX := 200; - SplitterX := 200; - Layout := oilHorizontal; - end; -end; - -destructor TDebuggerGeneralOptionsFrame.Destroy; -begin - ClearDbgProperties; - PropertyGrid.Selection.Clear; - FreeAndNil(FPropertyEditorHook); - FreeAndNil(FCurrentDebPropertiesList); - inherited Destroy; + txtAdditionalPath.Text:=EnvironmentOptions.GetParsedDebuggerSearchPath; end; function TDebuggerGeneralOptionsFrame.Check: Boolean; begin - Result := false; - - if assigned(FCurDebuggerClass) and FCurDebuggerClass.NeedsExePath - and (EnvironmentOptions.DebuggerFilename <> cmbDebuggerPath.Text) - then begin - EnvironmentOptions.DebuggerFilename := cmbDebuggerPath.Text; - if not CheckExecutable(FOldDebuggerFilename, - EnvironmentOptions.GetParsedDebuggerFilename, - lisEnvOptDlgInvalidDebuggerFilename, - lisEnvOptDlgInvalidDebuggerFilenameMsg) - then exit; - end; - Result := true; end; @@ -329,52 +100,32 @@ end; procedure TDebuggerGeneralOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog); begin - gbDebuggerType.Caption := dlgDebugType; gbAdditionalSearchPath.Caption := lisDebugOptionsFrmAdditionalSearchPath; gcbDebuggerGeneralOptions.Caption := lisDebugOptionsFrmDebuggerGeneralOptions; gcbDebuggerGeneralOptions.Items.Add(lisDebugOptionsFrmShowMessageOnStop); gcbDebuggerGeneralOptions.Items.Add(lisDebugOptionsFrmResetDebuggerOnEachRun); gcbDebuggerGeneralOptions.Items.Add(lisDebugOptionsFrmAutoCloseAsm); - gbDebuggerSpecific.Caption := lisDebugOptionsFrmDebuggerSpecific; end; procedure TDebuggerGeneralOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions); begin - ClearDbgProperties; with EnvironmentOptions do begin - ObjectInspectorOptions.AssignTo(PropertyGrid); - - FOldDebuggerFilename := DebuggerFilename; fOldDebuggerSearchPath := DebuggerSearchPath; - cmbDebuggerPath.Text := FOldDebuggerFilename; - FetchDebuggerClass; FetchDebuggerGeneralOptions; end; end; procedure TDebuggerGeneralOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions); -var - i: Integer; begin with EnvironmentOptions do begin - DebuggerFilename := cmbDebuggerPath.Text; - DebuggerFileHistory.Assign(cmbDebuggerPath.Items); DebuggerSearchPath := TrimSearchPath(txtAdditionalPath.Text,''); // IMPORTANT if more items are added the indexes must be updated here! DebuggerShowStopMessage := gcbDebuggerGeneralOptions.Checked[0]; DebuggerResetAfterRun := gcbDebuggerGeneralOptions.Checked[1]; DebuggerAutoCloseAsm := gcbDebuggerGeneralOptions.Checked[2]; - - for i := 0 to FCurrentDebPropertiesList.Count - 1 do - SaveDebuggerProperties(FCurrentDebPropertiesList[i], - TDebuggerProperties(FCurrentDebPropertiesList.Objects[i])); - - if FCurDebuggerClass = nil - then DebuggerConfig.DebuggerClass := '' - else DebuggerConfig.DebuggerClass := FCurDebuggerClass.ClassName; end; end; @@ -382,7 +133,6 @@ procedure TDebuggerGeneralOptionsFrame.RestoreSettings( AOptions: TAbstractIDEOptions); begin with EnvironmentOptions do begin - DebuggerFilename := FOldDebuggerFilename; DebuggerSearchPath := fOldDebuggerSearchPath; end; end; diff --git a/ide/basedebugmanager.pas b/ide/basedebugmanager.pas index 3c568714b4..afee0a5036 100644 --- a/ide/basedebugmanager.pas +++ b/ide/basedebugmanager.pas @@ -221,7 +221,6 @@ type DoDisableAutoSizing: boolean = false); virtual; abstract; public property Commands: TDBGCommands read GetCommands; // All current available commands of the debugger - property Debuggers[const AIndex: Integer]: TDebuggerClass read GetDebuggerClass; property Destroying: boolean read FDestroying; property State: TDBGState read GetState; // The current state of the debugger diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index b9758ac79a..0d5eeb119d 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -2484,7 +2484,10 @@ begin Exit; end; - EnvironmentOptions.LoadDebuggerProperties(NewDebuggerClass.ClassName, FDebugger.GetProperties); + if (EnvironmentOptions.CurrentDebuggerPropertiesConfig <> nil) and + (EnvironmentOptions.CurrentDebuggerPropertiesConfig.DebuggerProperties <> nil) + then + FDebugger.GetProperties.Assign(EnvironmentOptions.CurrentDebuggerPropertiesConfig.DebuggerProperties); ClearDebugOutputLog; if EnvironmentOptions.DebuggerEventLogClearOnRun then @@ -2595,7 +2598,7 @@ function TDebugManager.DoSetBreakkPointWarnIfNoDebugger: boolean; var DbgClass: TDebuggerClass; begin - DbgClass:=FindDebuggerClass(EnvironmentOptions.DebuggerConfig.DebuggerClass); + DbgClass:=EnvironmentOptions.CurrentDebuggerClass; if (DbgClass=nil) or (DbgClass.NeedsExePath and (not FileIsExecutableCached(EnvironmentOptions.GetParsedDebuggerFilename))) @@ -3118,7 +3121,7 @@ end; function TDebugManager.GetDebuggerClass: TDebuggerClass; begin - Result := FindDebuggerClass(EnvironmentOptions.DebuggerConfig.DebuggerClass); + Result := EnvironmentOptions.CurrentDebuggerClass; if Result = nil then Result := TProcessDebugger; end; diff --git a/ide/environmentopts.pp b/ide/environmentopts.pp index dd46bcbed2..0a087ae9b3 100644 --- a/ide/environmentopts.pp +++ b/ide/environmentopts.pp @@ -49,7 +49,7 @@ uses ProjectIntf, ObjectInspector, IDEWindowIntf, IDEOptionsIntf, IDEOptEditorIntf, ComponentReg, IDEExternToolIntf, MacroDefIntf, SrcEditorIntf, // DebuggerIntf - DbgIntfDebuggerBase, + DbgIntfDebuggerBase, GDBMIDebugger, // IDE IDEProcs, DialogProcs, LazarusIDEStrConsts, IDETranslations, LazConf, IDEOptionDefs, TransferMacros, ModeMatrixOpts, Debugger, @@ -291,6 +291,53 @@ type type TEnvironmentOptions = class; + { TDebuggerPropertiesConfig } + + TDebuggerPropertiesConfig = class(TPersistent) + private + FActive: Boolean; + FConfigClass: String; + FConfigName: String; + FDebuggerClass: TDebuggerClass; + FDebuggerFilename: string; + FIsFromOldXml: Boolean; + FXmlIndex: Integer; + FDebuggerProperties: TDebuggerProperties; + public + destructor Destroy; override; + constructor CreateFromXmlConf(AXMLCfg: TRttiXMLConfig; APath: String; AIndex: Integer); + constructor CreateFromOldXmlConf(AXMLCfg: TRttiXMLConfig; APath: String; + ADebuggerClass: TDebuggerClass; AForceLoad: Boolean = False); + constructor CreateFromOldXmlConf(AXMLCfg: TRttiXMLConfig; APath: String; + ADebuggerClassName: String; AForceLoad: Boolean = False); + constructor CreateForDebuggerClass(ADebuggerClass: TDebuggerClass); + constructor CreateCopy(ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean = True; ACopyXmlOrigin: Boolean = False); + + procedure CopyFrom(ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean = True); + procedure AssignTo(Dest: TPersistent); override; + function DisplayName: String; + function NeedsExePath: Boolean; + procedure ChangeDebuggerClass(ADebuggerClass: TDebuggerClass; ACopyPropValues: Boolean = True); + procedure MarkAsDeleted; + function IsLoaded: Boolean; + function IsDeleted: Boolean; + function DebugText: String; + + procedure DeleteFromXml(AXMLCfg: TRttiXMLConfig; APath: String); // uses FXmlIndex from last load/save. No prior sibling must have benn removed or inserted + procedure DeleteFromOldXml(AXMLCfg: TRttiXMLConfig; APath: String); + procedure SaveToXml(AXMLCfg: TRttiXMLConfig; APath: String; AIndex: Integer); + procedure SaveToOldXml(AXMLCfg: TRttiXMLConfig; APath: String); + + property DebuggerClass: TDebuggerClass read FDebuggerClass; + property DebuggerProperties: TDebuggerProperties read FDebuggerProperties; + property IsFromOldXml: Boolean read FIsFromOldXml; + published + property ConfigName: String read FConfigName write FConfigName; + property ConfigClass: String read FConfigClass write FConfigClass; + property DebuggerFilename: string read FDebuggerFilename write FDebuggerFilename; + property Active: Boolean read FActive write FActive; + end; + TLastOpenPackagesList = class(TStringList) public function Remove(const aString: string): Boolean; @@ -468,10 +515,25 @@ type property Path: String read FPath; end; + { TDebuggerPropertiesConfigList } + + TDebuggerPropertiesConfigList = class(TStringList) + private + function GetOpt(Index: Integer): TDebuggerPropertiesConfig; + public + procedure ClearAll; + function EntryByName(AConfName, AConfClass: String): TDebuggerPropertiesConfig; + property Opt[Index: Integer]: TDebuggerPropertiesConfig read GetOpt; + end; + { TEnvironmentOptions - class for storing environment options } TEnvironmentOptions = class(TIDEEnvironmentOptions) + private const + XML_PATH_DEBUGGER_CONF = 'EnvironmentOptions/Debugger/Configs/Config[%d]/'; + XML_PATH_DEBUGGER_CONF_OLD = 'EnvironmentOptions/Debugger/Class%s/%s/'; private + FCurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig; fRegisteredSubConfig: TObjectList; FDebuggerAutoCloseAsm: boolean; // config file @@ -582,7 +644,8 @@ type FDebuggerResetAfterRun: boolean; FDebuggerConfig: TDebuggerConfigStore; FDebuggerFileHistory: TStringList; // per debugger class - FDebuggerProperties: TStringList; // per debugger class + FDebuggerProperties: TDebuggerPropertiesConfigList; // named entries + FKnownDebuggerClassCount: Integer; FDebuggerShowStopMessage: Boolean; FDebuggerEventLogClearOnRun: Boolean; FDebuggerEventLogCheckLineLimit: Boolean; @@ -652,6 +715,8 @@ type function GetActiveDesktop: TDesktopOpt; function GetCompilerFilename: string; function GetCompilerMessagesFilename: string; + function GetCurrentDebuggerClass: TDebuggerClass; + function GetCurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig; function GetDebugDesktop: TDesktopOpt; function GetDebuggerEventLogColors(AIndex: TDBGEventType): TDebuggerEventLogColor; function GetDebuggerFilename: string; @@ -669,12 +734,13 @@ type procedure SaveNonDesktop(Path: String); procedure SetCompilerFilename(const AValue: string); procedure SetCompilerMessagesFilename(AValue: string); + procedure SetCurrentDebuggerPropertiesOpt(AValue: TDebuggerPropertiesConfig + ); procedure SetDebuggerEventLogColors(AIndex: TDBGEventType; const AValue: TDebuggerEventLogColor); procedure SetDebuggerSearchPath(const AValue: string); procedure SetFPDocPaths(const AValue: string); procedure SetMakeFilename(const AValue: string); - procedure SetDebuggerFilename(AValue: string); procedure SetFPCSourceDirectory(const AValue: string); procedure SetLazarusDirectory(const AValue: string); procedure SetFppkgConfigFile(AValue: string); @@ -687,6 +753,7 @@ type procedure InitXMLCfg(CleanConfig: boolean); procedure FileUpdated; procedure SetTestBuildDirectory(const AValue: string); + procedure LoadDebuggerProperties; public class function GetGroupCaption:string; override; class function GetInstance: TAbstractIDEOptions; override; @@ -716,7 +783,7 @@ type function GetParsedDebuggerFilename: string; function GetParsedDebuggerSearchPath: string; function GetParsedFppkgConfig: string; override; - function GetParsedValue(o: TEnvOptParseType): string; + function GetParsedValue(o: TEnvOptParseType; AUnparsedValue: String = ''): string; // macros procedure InitMacros(AMacroList: TTransferMacroList); @@ -823,7 +890,7 @@ type property FPCSourceDirHistory: TStringList read FFPCSourceDirHistory; property MakeFilename: string read GetMakeFilename write SetMakeFilename; property MakeFileHistory: TStringList read FMakeFileHistory; - property DebuggerFilename: string read GetDebuggerFilename write SetDebuggerFilename; + property DebuggerFilename: string read GetDebuggerFilename; property DebuggerFileHistory: TStringList read FDebuggerFileHistory; property DebuggerSearchPath: string read GetDebuggerSearchPath write SetDebuggerSearchPath; property DebuggerShowStopMessage: boolean read FDebuggerShowStopMessage write FDebuggerShowStopMessage; @@ -856,8 +923,9 @@ type // Debugger procedure SaveDebuggerPropertiesList; - procedure SaveDebuggerProperties(DebuggerClass: String; Properties: TDebuggerProperties); - procedure LoadDebuggerProperties(DebuggerClass: String; Properties: TDebuggerProperties); + function DebuggerPropertiesConfigList: TDebuggerPropertiesConfigList; + property CurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig read GetCurrentDebuggerPropertiesConfig write SetCurrentDebuggerPropertiesOpt; + property CurrentDebuggerClass: TDebuggerClass read GetCurrentDebuggerClass; property DebuggerConfig: TDebuggerConfigStore read FDebuggerConfig; // Debugger event log @@ -1114,6 +1182,288 @@ begin WriteStr(Result, u); end; +{ TDebuggerPropertiesConfigList } + +function TDebuggerPropertiesConfigList.GetOpt(Index: Integer + ): TDebuggerPropertiesConfig; +begin + Result := TDebuggerPropertiesConfig(Objects[Index]); +end; + +procedure TDebuggerPropertiesConfigList.ClearAll; +var + i: Integer; +begin + for i := 0 to Count - 1 do + Objects[i].Free; + Clear; +end; + +function TDebuggerPropertiesConfigList.EntryByName(AConfName, AConfClass: String + ): TDebuggerPropertiesConfig; +var + i: Integer; +begin + Result := nil; + i := Count - 1; + while (i >= 0) and ( + Opt[i].IsDeleted or (not Opt[i].IsLoaded) or + (Opt[i].ConfigName <> AConfName) or + (Opt[i].ConfigClass <> AConfClass) + ) + do + dec(i); + if i >= 0 then + Result := Opt[i]; +end; + +{ TDebuggerPropertiesConfig } + +destructor TDebuggerPropertiesConfig.Destroy; +begin + inherited Destroy; + FreeAndNil(FDebuggerProperties); +end; + +constructor TDebuggerPropertiesConfig.CreateFromXmlConf( + AXMLCfg: TRttiXMLConfig; APath: String; AIndex: Integer); +begin + Create; + FIsFromOldXml := False; + + APath := Format(APath, [AIndex]); + AXMLCfg.ReadObject(APath, Self); + FXmlIndex := AIndex; + + FDebuggerClass := TBaseDebugManagerIntf.DebuggersByClassName[ConfigClass]; + if FDebuggerClass <> nil then begin + FDebuggerProperties := FDebuggerClass.CreateProperties; + AXMLCfg.ReadObject(APath + 'Properties/', FDebuggerProperties); + end; +end; + +constructor TDebuggerPropertiesConfig.CreateFromOldXmlConf( + AXMLCfg: TRttiXMLConfig; APath: String; ADebuggerClass: TDebuggerClass; + AForceLoad: Boolean); +var + p: String; +begin + Create; + FIsFromOldXml := True; + + p := Format(APath, [ADebuggerClass.ClassName, 'Config']); + if AXMLCfg.HasPath(p, False) then + AForceLoad := True; + // Read first, so any (invalid) Class/Name will be cleared after reading + AXMLCfg.ReadObject(p, Self); // read FDebuggerFilename; + + FConfigClass := ADebuggerClass.ClassName; + FConfigName := ''; + FXmlIndex := -1; + + APath := Format(APath, [FConfigClass, 'Properties']); + if AForceLoad or AXMLCfg.HasPath(APath, False) then begin + FDebuggerClass := ADebuggerClass; + FDebuggerProperties := ADebuggerClass.CreateProperties; + AXMLCfg.ReadObject(APath, FDebuggerProperties); + end; +end; + +constructor TDebuggerPropertiesConfig.CreateFromOldXmlConf( + AXMLCfg: TRttiXMLConfig; APath: String; ADebuggerClassName: String; + AForceLoad: Boolean); +var + p: String; +begin + Create; + FIsFromOldXml := True; + + p := Format(APath, [ADebuggerClassName, 'Config']); + if AXMLCfg.HasPath(p, False) then + AForceLoad := True; + // Read first, so any (invalid) Class/Name will be cleared after reading + AXMLCfg.ReadObject(p, Self); // read FDebuggerFilename; + + FConfigClass := ADebuggerClassName; + FConfigName := ''; + FXmlIndex := -1; + + FDebuggerClass := TBaseDebugManagerIntf.DebuggersByClassName[ConfigClass]; + APath := Format(APath, [FConfigClass, 'Properties']); + if (FDebuggerClass <> nil) and (AForceLoad or AXMLCfg.HasPath(APath, False)) then begin + FDebuggerProperties := FDebuggerClass.CreateProperties; + AXMLCfg.ReadObject(APath, FDebuggerProperties); + end; +end; + +constructor TDebuggerPropertiesConfig.CreateForDebuggerClass( + ADebuggerClass: TDebuggerClass); +begin + Create; + FIsFromOldXml := False; + FXmlIndex := -1; + + FDebuggerClass := ADebuggerClass; + FConfigClass := ADebuggerClass.ClassName; + FConfigName := ''; + FDebuggerProperties := ADebuggerClass.CreateProperties; +end; + +constructor TDebuggerPropertiesConfig.CreateCopy( + ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean; + ACopyXmlOrigin: Boolean); +begin + Create; + CopyFrom(ASource, ACopyPropValues); + if ACopyXmlOrigin then begin + FIsFromOldXml := ASource.FIsFromOldXml; + FXmlIndex := ASource.FXmlIndex; + end + else begin + FIsFromOldXml := False; + FXmlIndex := -1; + end; +end; + +procedure TDebuggerPropertiesConfig.CopyFrom( + ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean); +begin + FConfigClass := ASource.FConfigClass; + FConfigName := ASource.FConfigName; + FDebuggerClass := ASource.FDebuggerClass; + FDebuggerFilename := ASource.FDebuggerFilename; + + FreeAndNil(FDebuggerProperties); + if ASource.DebuggerClass <> nil then + FDebuggerProperties := ASource.DebuggerClass.CreateProperties; + if ACopyPropValues and (ASource.FDebuggerProperties <> nil) then + FDebuggerProperties.Assign(ASource.FDebuggerProperties); +end; + +procedure TDebuggerPropertiesConfig.AssignTo(Dest: TPersistent); +begin + TDebuggerPropertiesConfig(Dest).CopyFrom(Self); +end; + +function TDebuggerPropertiesConfig.DisplayName: String; +begin + if FDebuggerClass <> nil then + Result := FDebuggerClass.Caption + else + Result := FConfigClass; + if FConfigName <> '' then + Result := FConfigName + ' [' + Result + ']' + else + Result := '[' + Result + ']'; +end; + +function TDebuggerPropertiesConfig.NeedsExePath: Boolean; +begin + Result := (FDebuggerClass <> nil) and FDebuggerClass.NeedsExePath; +end; + +procedure TDebuggerPropertiesConfig.ChangeDebuggerClass( + ADebuggerClass: TDebuggerClass; ACopyPropValues: Boolean); +var + p: TDebuggerProperties; +begin + FDebuggerClass := ADebuggerClass; + FConfigClass := ADebuggerClass.ClassName; + p := FDebuggerProperties; + FDebuggerProperties := ADebuggerClass.CreateProperties; + if ACopyPropValues and (p <> nil) then + FDebuggerProperties.Assign(p); + p.Free; +end; + +procedure TDebuggerPropertiesConfig.MarkAsDeleted; +begin + FreeAndNil(FDebuggerProperties); +end; + +function TDebuggerPropertiesConfig.IsLoaded: Boolean; +begin + Result := (FDebuggerClass <> nil) and (FDebuggerProperties <> nil); +end; + +function TDebuggerPropertiesConfig.IsDeleted: Boolean; +begin + Result := (FDebuggerClass <> nil) and (FDebuggerProperties = nil); +end; + +function TDebuggerPropertiesConfig.DebugText: String; +begin + if Self = nil then + exit('NIL'); + Result := Format('C-Name: %s, C-Class: %s, Class %s, Prop %s, Xml: %d %s, Path: %s', + [FConfigName, FConfigClass, DbgSName(FDebuggerClass), dbgs(FDebuggerProperties), + FXmlIndex, dbgs(FIsFromOldXml), FDebuggerFilename]); +end; + +procedure TDebuggerPropertiesConfig.DeleteFromXml(AXMLCfg: TRttiXMLConfig; + APath: String); +begin + if FXmlIndex < 0 then + exit; + APath := Format(APath, [FXmlIndex]); + FXmlIndex := -1; + + AXMLCfg.DeletePath(APath); +end; + +procedure TDebuggerPropertiesConfig.DeleteFromOldXml(AXMLCfg: TRttiXMLConfig; + APath: String); +begin + AXMLCfg.DeletePath(Format(APath, [FConfigClass, 'Config'])); + AXMLCfg.DeletePath(Format(APath, [FConfigClass, 'Properties'])); + FXmlIndex := -1; + FIsFromOldXml := False; +end; + +procedure TDebuggerPropertiesConfig.SaveToXml(AXMLCfg: TRttiXMLConfig; + APath: String; AIndex: Integer); +var + PropDef: TDebuggerProperties; + OptDef: TDebuggerPropertiesConfig; +begin + APath := Format(APath, [AIndex]); + FIsFromOldXml := False; + FXmlIndex := AIndex; + + OptDef := TDebuggerPropertiesConfig.Create; + AXMLCfg.WriteObject(APath, Self, OptDef); + OptDef.Free; + + if FDebuggerProperties <> nil then begin + PropDef := FDebuggerClass.CreateProperties; + AXMLCfg.WriteObject(APath + 'Properties/', FDebuggerProperties, PropDef); + PropDef.Free; + end; +end; + +procedure TDebuggerPropertiesConfig.SaveToOldXml(AXMLCfg: TRttiXMLConfig; + APath: String); +var + PropDef: TDebuggerProperties; + OptDef: TDebuggerPropertiesConfig; +begin + FIsFromOldXml := True; + FXmlIndex := -1; + + OptDef := TDebuggerPropertiesConfig.Create; + OptDef.ConfigName := ConfigName; // Do not write Name + // ConfigClass will differ and be written. This ensures that even an unmodified config is written (to preserve its existence) + AXMLCfg.WriteObject(Format(APath, [FConfigClass, 'Config']), Self, OptDef); + OptDef.Free; + + if FDebuggerProperties <> nil then begin + APath := Format(APath, [FConfigClass, 'Properties']); + PropDef := FDebuggerClass.CreateProperties; + AXMLCfg.WriteObject(APath, FDebuggerProperties, PropDef); + PropDef.Free; + end; +end; + { TIDESubOptions } procedure TIDESubOptions.ReadFromXml(AnXmlConf: TRttiXMLConfig); @@ -1750,9 +2100,8 @@ begin FFPCSourceDirHistory:=TStringList.Create; MakeFilename:=DefaultMakefilename; FMakeFileHistory:=TStringList.Create; - DebuggerFilename:=''; FDebuggerFileHistory:=TStringList.Create; - FDebuggerProperties := TStringList.Create; + FDebuggerProperties := TDebuggerPropertiesConfigList.Create; FDebuggerEventLogColors:=DebuggerDefaultColors; FppkgConfigFile:=''; FFppkgConfigFileHistory:=TStringList.Create; @@ -1818,8 +2167,6 @@ begin end; destructor TEnvironmentOptions.Destroy; -var - i: Integer; begin FreeAndNil(fRegisteredSubConfig); FreeAndNil(FDesktops); @@ -1836,11 +2183,10 @@ begin FreeAndNil(FCompilerFileHistory); FreeAndNil(FFPCSourceDirHistory); FreeAndNil(FMakeFileHistory); - FreeAndNil(FDebuggerFileHistory); - for i := 0 to FDebuggerProperties.Count - 1 do - FDebuggerProperties.Objects[i].Free; - FreeAndNil(FManyBuildModesSelection); + FDebuggerProperties.ClearAll; FreeAndNil(FDebuggerProperties); + FreeAndNil(FDebuggerFileHistory); + FreeAndNil(FManyBuildModesSelection); FreeAndNil(FTestBuildDirHistory); FreeAndNil(FCompilerMessagesFileHistory); FreeAndNil(FDebuggerConfig); @@ -2040,8 +2386,8 @@ begin LoadBackupInfo(FBackupInfoOtherFiles,Path+'BackupOtherFiles/',DefaultBackupTypeOther); // Debugger + // DO not call LoadDebuggerProperties; => not all debuggers are registered when this is first called FDebuggerConfig.Load; - DebuggerFilename:=FXMLCfg.GetValue(Path+'DebuggerFilename/Value',''); LoadRecentList(FXMLCfg,FDebuggerFileHistory,Path+'DebuggerFilename/History/',rltFile); DebuggerSearchPath:=FXMLCfg.GetValue(Path+'DebuggerSearchPath/Value',''); // Debugger General Options @@ -2432,7 +2778,6 @@ begin // debugger FDebuggerConfig.Save; SaveDebuggerPropertiesList; - FXMLCfg.SetDeleteValue(Path+'DebuggerFilename/Value',DebuggerFilename,''); FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/ShowStopMessage/Value', FDebuggerShowStopMessage, True); FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/DebuggerResetAfterRun/Value', @@ -2813,6 +3158,9 @@ end; function TEnvironmentOptions.GetParsedDebuggerFilename: string; begin + if FParseValues[eopDebuggerFilename].UnparsedValue <> DebuggerFilename then + SetParseValue(eopDebuggerFilename,UTF8Trim(DebuggerFilename)); + Result:=GetParsedValue(eopDebuggerFilename); end; @@ -2826,12 +3174,26 @@ begin Result:=GetParsedValue(eopFppkgConfigFile); end; -function TEnvironmentOptions.GetParsedValue(o: TEnvOptParseType): string; +function TEnvironmentOptions.GetParsedValue(o: TEnvOptParseType; + AUnparsedValue: String): string; +type + PParseString = ^TParseString; var SpacePos: SizeInt; CurParams: String; + TempValue: TParseString; + VP: PParseString; begin - with FParseValues[o] do begin + if AUnparsedValue <> '' then begin + TempValue.UnparsedValue := AUnparsedValue; + TempValue.ParseStamp := CTInvalidChangeStamp; + TempValue.Parsing := False; + VP := @TempValue; + end + else + VP := @FParseValues[o]; + + with VP^ do begin if (ParseStamp<>CompilerParseStamp) or (CompilerParseStamp=CTInvalidChangeStamp) then begin if Parsing then begin @@ -3001,50 +3363,155 @@ end; procedure TEnvironmentOptions.SaveDebuggerPropertiesList; var - DProp, DDef: TDebuggerProperties; - i: Integer; + i, ConfCount: Integer; + Entry: TDebuggerPropertiesConfig; begin + for i := FDebuggerProperties.Count - 1 downto 0 do begin + // Delete last entry first + Entry := FDebuggerProperties.Opt[i]; + if not Entry.IsLoaded then + Continue; + + if (not Entry.IsFromOldXml) then + Entry.DeleteFromXml(FXMLCfg, XML_PATH_DEBUGGER_CONF) + else + if (Entry.DebuggerProperties = nil) or // Entry without DebuggerProperty are a marker for entries to be deleted + (Entry.ConfigName <> '') // Moved to named list + then + Entry.DeleteFromOldXml(FXMLCfg, XML_PATH_DEBUGGER_CONF_OLD); + + if Entry.IsDeleted then begin + Entry.Free; + FDebuggerProperties.Delete(i); + end; + end; + + ConfCount := FXMLCfg.GetListItemCount('EnvironmentOptions/Debugger/Configs/', 'Config', False) + 1; for i := 0 to FDebuggerProperties.Count - 1 do begin - DProp := TDebuggerProperties(FDebuggerProperties.Objects[i]); - DDef := TDebuggerPropertiesClass(DProp.ClassType).Create; - FXMLCfg.WriteObject( - 'EnvironmentOptions/Debugger/Class' + FDebuggerProperties[i] + '/Properties/', - DProp, DDef); - DDef.Free; + Entry := FDebuggerProperties.Opt[i]; + if not Entry.IsLoaded then + Continue; + + Entry.Active := Entry = FCurrentDebuggerPropertiesConfig; + if(Entry.ConfigName <> '') then begin + Entry.SaveToXml(FXMLCfg, XML_PATH_DEBUGGER_CONF, ConfCount); + inc(ConfCount); + end + else begin + Entry.SaveToOldXml(FXMLCfg, XML_PATH_DEBUGGER_CONF_OLD); + // For compatibility + if Entry.Active then + FXMLCfg.SetDeleteValue('EnvironmentOptions/DebuggerFilename/Value', Entry.DebuggerFilename,''); + end; + end; + + // compatibility + if (FCurrentDebuggerPropertiesConfig <> nil) and (FCurrentDebuggerPropertiesConfig.ConfigName = '') then + FXMLCfg.SetValue('EnvironmentOptions/Debugger/Class', CurrentDebuggerPropertiesConfig.ConfigClass) + else + FXMLCfg.DeleteValue('EnvironmentOptions/Debugger/Class') +end; + +procedure TEnvironmentOptions.LoadDebuggerProperties; +var + ConfCount, i: Integer; + DbgClassType: TDebuggerClass; + Entry, UnloadedCurrent: TDebuggerPropertiesConfig; + ActiveClassName, CurFilename: String; + ActiveClassSeen: Boolean; +begin + if (FDebuggerProperties.Count > 0) and + (TBaseDebugManagerIntf.DebuggerCount = FKnownDebuggerClassCount) + then + exit; + FKnownDebuggerClassCount := TBaseDebugManagerIntf.DebuggerCount; + + + FDebuggerProperties.ClearAll; + FCurrentDebuggerPropertiesConfig := nil; + UnloadedCurrent := nil; + + // Load new style entries + ConfCount := FXMLCfg.GetListItemCount('EnvironmentOptions/Debugger/Configs/', 'Config', False); + for i := 1 to ConfCount do begin + Entry := TDebuggerPropertiesConfig.CreateFromXmlConf(FXMLCfg, XML_PATH_DEBUGGER_CONF, i); + FDebuggerProperties.AddObject(Entry.ConfigName, Entry); + if Entry.Active and Entry.IsLoaded and (FCurrentDebuggerPropertiesConfig = nil) then + FCurrentDebuggerPropertiesConfig := Entry; + if Entry.Active and (UnloadedCurrent = nil) then + UnloadedCurrent := Entry; + end; + + if FCurrentDebuggerPropertiesConfig = nil then + FCurrentDebuggerPropertiesConfig := UnloadedCurrent; + + // Read old style, per class + ActiveClassName := ''; + ActiveClassSeen := False; + if FCurrentDebuggerPropertiesConfig = nil then + ActiveClassName := FXMLCfg.GetValue('EnvironmentOptions/Debugger/Class', ''); + // There is only one filename for all classes + CurFilename:=FXMLCfg.GetValue('EnvironmentOptions/DebuggerFilename/Value',''); + + for i := 0 to TBaseDebugManagerIntf.DebuggerCount -1 do begin + DbgClassType := TBaseDebugManagerIntf.Debuggers[i]; + ActiveClassSeen := ActiveClassSeen or (LowerCase(DbgClassType.ClassName) = LowerCase(ActiveClassName)); + Entry := TDebuggerPropertiesConfig.CreateFromOldXmlConf(FXMLCfg, XML_PATH_DEBUGGER_CONF_OLD, + DbgClassType, LowerCase(DbgClassType.ClassName) = LowerCase(ActiveClassName)); + if not Entry.IsLoaded then begin + Entry.Free; + Continue; + end; + if (Entry.DebuggerFilename = '') and (Entry.NeedsExePath or (not Entry.IsLoaded)) then + Entry.DebuggerFilename := CurFilename; + FDebuggerProperties.AddObject(Entry.ConfigName, Entry); + if (Entry.ConfigClass = ActiveClassName) and (FCurrentDebuggerPropertiesConfig = nil) then + FCurrentDebuggerPropertiesConfig := Entry; + end; + + // current active debugger was not found / may not an unknown class + // InitialSetupDlg depends on having a debugger loaded, with the ONLY exception: ActiveClassName = '' + if (not ActiveClassSeen) and (ActiveClassName <> '') then begin + Entry := TDebuggerPropertiesConfig.CreateFromOldXmlConf(FXMLCfg, XML_PATH_DEBUGGER_CONF_OLD, ActiveClassName, True); + if (Entry.DebuggerFilename = '') and (Entry.NeedsExePath or (not Entry.IsLoaded)) then + Entry.DebuggerFilename := CurFilename; + FDebuggerProperties.AddObject(Entry.ConfigName, Entry); + // FCurrentDebuggerPropertiesConfig may NOT be loaded !!! + FCurrentDebuggerPropertiesConfig := Entry; end; end; -procedure TEnvironmentOptions.SaveDebuggerProperties(DebuggerClass: String; - Properties: TDebuggerProperties); -var - i: Integer; - Prop: TDebuggerProperties; +function TEnvironmentOptions.GetCurrentDebuggerClass: TDebuggerClass; begin - i := FDebuggerProperties.IndexOf(DebuggerClass); - if i < 0 then begin - Prop := TDebuggerPropertiesClass(Properties.ClassType).Create; - Prop.Assign(Properties); - FDebuggerProperties.AddObject(DebuggerClass, Prop); - end - else - TDebuggerProperties(FDebuggerProperties.Objects[i]).Assign(Properties); + LoadDebuggerProperties; + + Result := nil; + if CurrentDebuggerPropertiesConfig <> nil then + Result := CurrentDebuggerPropertiesConfig.DebuggerClass; end; -procedure TEnvironmentOptions.LoadDebuggerProperties(DebuggerClass: String; - Properties: TDebuggerProperties); -var - i: Integer; - DDef: TDebuggerProperties; +function TEnvironmentOptions.GetCurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig; begin - i := FDebuggerProperties.IndexOf(DebuggerClass); - if i < 0 then begin - DDef := TDebuggerPropertiesClass(Properties.ClassType).Create; - FXMLCfg.ReadObject('EnvironmentOptions/Debugger/Class' + DebuggerClass + '/Properties/', - Properties, DDef); - DDef.Free; - end - else - Properties.Assign(TDebuggerProperties(FDebuggerProperties.Objects[i])); + LoadDebuggerProperties; + Result := FCurrentDebuggerPropertiesConfig; +end; + +procedure TEnvironmentOptions.SetCurrentDebuggerPropertiesOpt( + AValue: TDebuggerPropertiesConfig); +begin + LoadDebuggerProperties; + + if FCurrentDebuggerPropertiesConfig = AValue then Exit; + if (FDebuggerProperties.IndexOfObject(AValue) < 0) then + FDebuggerProperties.AddObject(AValue.ConfigName, AValue); + FCurrentDebuggerPropertiesConfig := AValue; +end; + +function TEnvironmentOptions.DebuggerPropertiesConfigList: TDebuggerPropertiesConfigList; +begin + LoadDebuggerProperties; + + Result := FDebuggerProperties; end; function TEnvironmentOptions.FileHasChangedOnDisk: boolean; @@ -3239,7 +3706,10 @@ end; function TEnvironmentOptions.GetDebuggerFilename: string; begin - Result:=FParseValues[eopDebuggerFilename].UnparsedValue; + Result := ''; + LoadDebuggerProperties; + if CurrentDebuggerPropertiesConfig <> nil then + Result:=CurrentDebuggerPropertiesConfig.DebuggerFilename; end; function TEnvironmentOptions.GetDebuggerSearchPath: string; @@ -3336,11 +3806,6 @@ begin SetParseValue(eopMakeFilename,TrimFilename(AValue)); end; -procedure TEnvironmentOptions.SetDebuggerFilename(AValue: string); -begin - SetParseValue(eopDebuggerFilename,UTF8Trim(AValue)); -end; - procedure TEnvironmentOptions.SetFppkgConfigFile(AValue: string); begin SetParseValue(eopFppkgConfigFile,UTF8Trim(AValue)); diff --git a/ide/initialsetupdlgs.pas b/ide/initialsetupdlgs.pas index 5eeea4bd91..dd9baac645 100644 --- a/ide/initialsetupdlgs.pas +++ b/ide/initialsetupdlgs.pas @@ -156,6 +156,7 @@ type procedure FppkgBrowseButtonClick(Sender: TObject); procedure FppkgWriteConfigButtonClick(Sender: TObject); private + FSkipDebugger: Boolean; FFlags: TSDFlags; FLastParsedLazDir: string; fLastParsedCompiler: string; @@ -214,7 +215,7 @@ function ShowInitialSetupDialog: TModalResult; // Debugger // Checks a given file to see if it is a valid debugger (only gdb supported for now) -function CheckDebuggerQuality(AFilename: string; out Note: string): TSDFilenameQuality; +function CheckDebuggerQuality(AFilename: string; out Note: string; ASkip: Boolean = False): TSDFilenameQuality; // Search debugger candidates and add them to list, including quality level function SearchDebuggerCandidates(StopIfFits: boolean): TSDFileInfoList; @@ -237,8 +238,17 @@ type LazarusDir: string; end; -function CheckDebuggerQuality(AFilename: string; out Note: string): TSDFilenameQuality; +function CheckDebuggerQuality(AFilename: string; out Note: string; + ASkip: Boolean): TSDFilenameQuality; begin + Note := ''; + Result:=sddqCompatible; + if ASkip and // assume compatible + ( (EnvironmentOptions.CurrentDebuggerPropertiesConfig = nil) or + (EnvironmentOptions.DebuggerFilename = AFilename) // unless the user edited the filename + ) + then + exit; Result:=sddqInvalid; AFilename:=TrimFilename(AFilename); if not FileExistsCached(AFilename) then @@ -275,8 +285,7 @@ function SearchDebuggerCandidates(StopIfFits: boolean): TSDFileInfoList; ForcePathDelims(AFilename); // check if already checked if Assigned(List) and List.CaptionExists(AFilename) then exit; - EnvironmentOptions.DebuggerFilename:=AFilename; - RealFilename:=EnvironmentOptions.GetParsedDebuggerFilename; + RealFilename:=EnvironmentOptions.GetParsedValue(eopDebuggerFilename, AFilename); debugln(['SearchDebuggerCandidates Value=',AFilename,' File=',RealFilename]); if RealFilename='' then exit; // check if exists @@ -292,36 +301,52 @@ function SearchDebuggerCandidates(StopIfFits: boolean): TSDFileInfoList; const DebuggerFileName='gdb'; //For Windows, .exe will be appended var - OldDebuggerFilename: String; - s, AFilename: String; + s, AFilename, XmlClassName, CurDbgClassName: String; Files: TStringList; i: Integer; begin Result:=nil; - OldDebuggerFilename:=EnvironmentOptions.DebuggerFilename; - try - // check current setting - if CheckFile(EnvironmentOptions.DebuggerFilename,Result) then exit; + // check current setting + if CheckFile(EnvironmentOptions.DebuggerFilename,Result) then exit; - // check the primary options + if EnvironmentOptions.CurrentDebuggerPropertiesConfig <> nil then + CurDbgClassName := UpperCase(EnvironmentOptions.CurrentDebuggerPropertiesConfig.ConfigClass) + else + CurDbgClassName := UpperCase(DefaultDebuggerClass.ClassName); + + // check the primary options + XmlClassName :=GetValueFromPrimaryConfig(EnvOptsConfFileName, + 'EnvironmentOptions/Debugger/Class'); + if UpperCase(XmlClassName) = CurDbgClassName then begin AFilename:=GetValueFromPrimaryConfig(EnvOptsConfFileName, 'EnvironmentOptions/DebuggerFilename/Value'); if CheckFile(AFilename,Result) then exit; + end; - // check the secondary options + // check the secondary options + XmlClassName :=GetValueFromSecondaryConfig(EnvOptsConfFileName, + 'EnvironmentOptions/Debugger/Class'); + if UpperCase(XmlClassName) = CurDbgClassName then begin AFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName, 'EnvironmentOptions/DebuggerFilename/Value'); if CheckFile(AFilename,Result) then exit; + end; - // Check locations proposed by debugger class + // Check locations proposed by debugger class + if EnvironmentOptions.CurrentDebuggerClass <> nil then + s := EnvironmentOptions.CurrentDebuggerClass.ExePaths + else s := DefaultDebuggerClass.ExePaths; - while s <> '' do begin - AFilename := GetPart([], [';'], s); - if CheckFile(AFilename, Result) then exit; - if s <> '' then delete(s, 1, 1); - end; + while s <> '' do begin + AFilename := GetPart([], [';'], s); + if CheckFile(AFilename, Result) then exit; + if s <> '' then delete(s, 1, 1); + end; + // Search for gdb + // only if TGDBMIDebugger + if CurDbgClassName = UpperCase(DefaultDebuggerClass.ClassName) then begin // Windows-only locations: if (GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)='win') then begin @@ -339,13 +364,11 @@ begin // check PATH AFilename:=DebuggerFileName+GetExecutableExt; if CheckFile(AFilename,Result) then exit; - - // There are no common directories apart from the PATH - // where gdb would be installed. Otherwise we could do something similar as - // in SearchMakeExeCandidates. - finally - EnvironmentOptions.DebuggerFilename:=OldDebuggerFilename; end; + + // There are no common directories apart from the PATH + // where gdb would be installed. Otherwise we could do something similar as + // in SearchMakeExeCandidates. end; function ShowInitialSetupDialog: TModalResult; @@ -720,11 +743,15 @@ begin s:=MakeExeComboBox.Text; if s<>'' then EnvironmentOptions.MakeFilename:=s; - s:=DebuggerComboBox.Text; - if s<>'' then begin - EnvironmentOptions.DebuggerFilename:=s; - if s <> FInitialDebuggerFileName then - EnvironmentOptions.DebuggerConfig.DebuggerClass := 'TGDBMIDebugger'; + if not (FSkipDebugger and (EnvironmentOptions.CurrentDebuggerPropertiesConfig = nil)) + then begin + s:=DebuggerComboBox.Text; + if s<>'' then begin + if EnvironmentOptions.CurrentDebuggerPropertiesConfig = nil then + EnvironmentOptions.CurrentDebuggerPropertiesConfig := + TDebuggerPropertiesConfig.CreateForDebuggerClass(TGDBMIDebugger); + EnvironmentOptions.CurrentDebuggerPropertiesConfig.DebuggerFilename:=s; + end; end; ModalResult:=mrOk; @@ -1125,25 +1152,25 @@ var CurCaption: String; Note: string; Quality: TSDFilenameQuality; - s: String; + s, ParsedFName: String; ImageIndex: Integer; begin if csDestroying in ComponentState then exit; CurCaption:=DebuggerComboBox.Text; - EnvironmentOptions.DebuggerFilename:=CurCaption; - if fLastParsedDebugger=EnvironmentOptions.GetParsedDebuggerFilename then exit; - fLastParsedDebugger:=EnvironmentOptions.GetParsedDebuggerFilename; + ParsedFName := EnvironmentOptions.GetParsedValue(eopDebuggerFilename, CurCaption); + if fLastParsedDebugger=ParsedFName then exit; + fLastParsedDebugger:=ParsedFName; //debugln(['TInitialSetupDialog.UpdateDebuggerNote ',fLastParsedDebugger]); - Quality:=CheckDebuggerQuality(fLastParsedDebugger,Note); + Quality:=CheckDebuggerQuality(fLastParsedDebugger,Note, FSkipDebugger); case Quality of sddqInvalid: s:=lisError; sddqCompatible: s:=''; else s:=lisWarning; end; - if EnvironmentOptions.DebuggerFilename<>EnvironmentOptions.GetParsedDebuggerFilename + if CurCaption<>ParsedFName then - s:=lisFile2+EnvironmentOptions.GetParsedDebuggerFilename+LineEnding+ + s:=lisFile2+ParsedFName+LineEnding+ LineEnding+s; DebuggerMemo.Text:=s+Note; @@ -1342,15 +1369,25 @@ begin fLastParsedMakeExe:='. .'; UpdateMakeExeNote; + RegisterDebugger(TGDBMIDebugger); // make sure we can read the config + FSkipDebugger := (EnvironmentOptions.CurrentDebuggerPropertiesConfig <> nil) and ( // Has a debugger + (EnvironmentOptions.CurrentDebuggerClass = nil) or // Unknown existing debugger class + (not EnvironmentOptions.CurrentDebuggerPropertiesConfig.NeedsExePath) // Does not need an exe + ); // Debugger FInitialDebuggerFileName := EnvironmentOptions.DebuggerFilename; UpdateDebuggerCandidates; - if IsFirstStart or (not FileExistsCached(EnvironmentOptions.GetParsedDebuggerFilename)) + if (not FSkipDebugger) and + ( IsFirstStart or (not FileExistsCached(EnvironmentOptions.GetParsedDebuggerFilename)) ) then begin // first start => choose first best candidate Candidate:=GetFirstCandidate(FCandidates[sddtDebuggerFilename]); - if Candidate<>nil then - EnvironmentOptions.DebuggerFilename:=Candidate.Caption; + if Candidate<>nil then begin + if EnvironmentOptions.CurrentDebuggerPropertiesConfig = nil then + EnvironmentOptions.CurrentDebuggerPropertiesConfig := + TDebuggerPropertiesConfig.CreateForDebuggerClass(TGDBMIDebugger); + EnvironmentOptions.CurrentDebuggerPropertiesConfig.DebuggerFilename:=Candidate.Caption; + end; end; DebuggerComboBox.Text:=EnvironmentOptions.DebuggerFilename; fLastParsedDebugger:='. .'; diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 760d01101e..da58d0528c 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -5365,6 +5365,7 @@ resourcestring lisAnchorEditorNoControlSelected = 'Anchor Editor - no control selected'; lisAnchorsOfSelectedControls = 'Anchors of selected controls'; lisAnchorsOf = 'Anchors of %s'; + lisDebugOptionsFrmName = 'Name:'; lisDebugOptionsFrmAdditionalSearchPath = 'Additional search path'; lisDebugOptionsFrmDebuggerGeneralOptions = 'Debugger general options'; lisDebugOptionsFrmShowMessageOnStop = 'Show message on stop'; @@ -6591,6 +6592,7 @@ resourcestring UnitDepOptionsForPackage = 'Options for Package graph'; UnitDepOptionsForUnit = 'Options for Unit graph'; LvlGraphReduceBackedges = 'Reduce backedges'; + lisDebugOptionsFrmBackend = 'Backend'; implementation diff --git a/ide/main.pp b/ide/main.pp index e3a1ae9094..197bd9b38a 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -99,7 +99,7 @@ uses // LRT stuff Translations, // debugger - LazDebuggerGdbmi, + LazDebuggerGdbmi, GDBMIDebugger, RunParamsOpts, BaseDebugManager, DebugManager, debugger, DebuggerDlg, DebugAttachDialog, DbgIntfBaseTypes, DbgIntfDebuggerBase, // packager @@ -124,7 +124,7 @@ uses codetools_classcompletion_options, codetools_wordpolicy_options, codetools_linesplitting_options, codetools_space_options, codetools_identifiercompletion_options, - debugger_general_options, debugger_eventlog_options, + debugger_general_options, debugger_class_options, debugger_eventlog_options, debugger_language_exceptions_options, debugger_signals_options, codeexplorer_update_options, codeexplorer_categories_options, codeobserver_options, help_general_options, env_file_filters, @@ -1428,13 +1428,20 @@ begin end; // check debugger - if (not ShowSetupDialog) - and ((EnvironmentOptions.DebuggerConfig.DebuggerClass='') - or (EnvironmentOptions.DebuggerConfig.DebuggerClass='TGDBMIDebugger')) - and (CheckDebuggerQuality(EnvironmentOptions.GetParsedDebuggerFilename, Note)<>sddqCompatible) - then begin - debugln(['Warning: (lazarus) missing GDB exe',EnvironmentOptions.GetParsedLazarusDirectory]); - ShowSetupDialog:=true; + if (not ShowSetupDialog) then begin + // PackageBoss is not yet loaded... + RegisterDebugger(TGDBMIDebugger); // make sure we can read the config + // Todo: add LldbFpDebugger for Mac + // If the default debugger is of a class that is not yet Registered, then the dialog is not shown + if (EnvironmentOptions.CurrentDebuggerPropertiesConfig = nil) // no debugger at all / not even with unknown class + or ( (EnvironmentOptions.CurrentDebuggerClass <> nil) // Debugger with known class + and (EnvironmentOptions.CurrentDebuggerPropertiesConfig.NeedsExePath) // Which does need an exe + and (CheckDebuggerQuality(EnvironmentOptions.GetParsedDebuggerFilename, Note)<>sddqCompatible) + ) + then begin + debugln(['Warning: (lazarus) missing GDB exe',EnvironmentOptions.GetParsedLazarusDirectory]); + ShowSetupDialog:=true; + end; end; // check 'make' utility @@ -7428,7 +7435,7 @@ begin Result := mrAbort; Exit; end; - debugln('Hint: (lazarus) [TMainIDE.DoRunProject] Debugger=',EnvironmentOptions.DebuggerConfig.DebuggerClass); + debugln('Hint: (lazarus) [TMainIDE.DoRunProject] Debugger=',DbgSName(EnvironmentOptions.CurrentDebuggerClass)); try Result:=mrCancel;