IDE: Debugger-Backend options, new layout

2025-04-05 13:38:08 +02:00 · 2025-02-26 14:22:30 +01:00 · 2025-02-26 14:22:30 +01:00 · b9f6ea9b9d
commit b9f6ea9b9d
parent f90db81742
3 changed files with 194 additions and 152 deletions
--- a/debugger/frames/debugger_class_options.lfm
+++ b/debugger/frames/debugger_class_options.lfm
@ -1,75 +1,117 @@
 object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
  Left = 0
-  Height = 427
+  Height = 434
  Top = 0
-  Width = 519
-  ClientHeight = 427
-  ClientWidth = 519
+  Width = 532
+  ClientHeight = 434
+  ClientWidth = 532
  TabOrder = 0
  Visible = False
-  DesignLeft = 812
-  DesignTop = 313
-  object ToolBar1: TToolBar
+  DesignLeft = 613
+  DesignTop = 71
+  object divSelectBackend: TDividerBevel
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = Owner
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
    Left = 0
-    Height = 26
+    Height = 15
    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
-      Style = tbsButtonDrop
-    end
-    object tbAddNew: TToolButton
-      Left = 76
-      Top = 0
-      Caption = 'tbAddNew'
-      OnClick = tbAddNewClick
-    end
-    object tbCopy: TToolButton
-      Left = 141
-      Top = 0
-      Caption = 'tbCopy'
-      OnClick = tbCopyClick
-    end
-    object ToolButton2: TToolButton
-      Left = 201
-      Height = 22
-      Top = 0
-      Caption = 'ToolButton2'
-      Style = tbsDivider
-    end
-    object tbDelete: TToolButton
-      Left = 206
-      Top = 0
-      Caption = 'tbDelete'
-      OnClick = tbDeleteClick
-    end
-    object ToolButton3: TToolButton
-      Left = 71
-      Height = 22
-      Top = 0
-      Caption = 'ToolButton3'
-      Style = tbsDivider
-    end
+    Width = 532
+    Caption = 'divSelectBackend'
+    Anchors = [akTop, akLeft, akRight]
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object cbBackend: TComboBox
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = divSelectBackend
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 6
+    Height = 23
+    Top = 21
+    Width = 520
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Around = 6
+    ItemHeight = 15
+    Style = csDropDownList
+    TabOrder = 4
+    OnChange = cbBackendChange
+  end
+  object btnAdd: TButton
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = cbBackend
+    AnchorSideTop.Side = asrBottom
+    Left = 6
+    Height = 22
+    Top = 50
+    Width = 75
+    BorderSpacing.Around = 6
+    Caption = 'btnAdd'
+    TabOrder = 1
+    OnClick = tbAddNewClick
+  end
+  object btnCopy: TButton
+    AnchorSideLeft.Control = btnAdd
+    AnchorSideLeft.Side = asrBottom
+    AnchorSideTop.Control = btnAdd
+    Left = 93
+    Height = 22
+    Top = 50
+    Width = 75
+    BorderSpacing.Left = 12
+    Caption = 'btnCopy'
+    TabOrder = 2
+    OnClick = tbCopyClick
+  end
+  object btnDelete: TButton
+    AnchorSideTop.Control = btnAdd
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 451
+    Height = 22
+    Top = 50
+    Width = 75
+    Anchors = [akTop, akRight]
+    BorderSpacing.Right = 6
+    Caption = 'btnDelete'
+    TabOrder = 3
+    OnClick = tbDeleteClick
+  end
+  object divEditBackend: TDividerBevel
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = btnAdd
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 0
+    Height = 15
+    Top = 78
+    Width = 532
+    Caption = 'divEditBackend'
+    Anchors = [akTop, akLeft, akRight]
+    Font.Style = [fsBold]
+    ParentFont = False
  end
  object Panel1: TPanel
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = divEditBackend
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    AnchorSideBottom.Control = Owner
+    AnchorSideBottom.Side = asrBottom
    Left = 0
-    Height = 401
-    Top = 26
-    Width = 519
-    Align = alClient
+    Height = 341
+    Top = 93
+    Width = 532
+    Anchors = [akTop, akLeft, akRight, akBottom]
    BevelOuter = bvNone
-    ClientHeight = 401
-    ClientWidth = 519
-    TabOrder = 1
+    ClientHeight = 341
+    ClientWidth = 532
+    TabOrder = 0
    object lblName: TLabel
      AnchorSideLeft.Control = Panel1
      AnchorSideTop.Control = edName
@ -80,7 +122,6 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
      Width = 45
      BorderSpacing.Left = 10
      Caption = 'lblName'
-      Color = clDefault
      ParentColor = False
    end
    object edName: TEdit
@ -93,14 +134,14 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
      Left = 61
      Height = 23
      Top = 27
-      Width = 448
+      Width = 461
      Anchors = [akTop, akLeft, akRight]
      BorderSpacing.Left = 6
      BorderSpacing.Top = 6
      BorderSpacing.Right = 10
+      TabOrder = 0
      OnEditingDone = edNameExit
      OnExit = edNameExit
-      TabOrder = 0
    end
    object gbDebuggerType: TGroupBox
      AnchorSideLeft.Control = Panel1
@ -111,13 +152,13 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
      Left = 0
      Height = 105
      Top = 56
-      Width = 519
+      Width = 532
      Anchors = [akTop, akLeft, akRight]
      AutoSize = True
      BorderSpacing.Top = 6
      Caption = 'Debugger type and path'
      ClientHeight = 85
-      ClientWidth = 515
+      ClientWidth = 528
      TabOrder = 1
      object cmbDebuggerType: TComboBox
        AnchorSideLeft.Control = gbDebuggerType
@ -126,15 +167,15 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
        Left = 6
        Height = 23
        Top = 6
-        Width = 406
+        Width = 419
        Anchors = [akTop, akLeft, akRight]
        BorderSpacing.Around = 6
        Enabled = False
        ItemHeight = 15
-        OnEditingDone = cmbDebuggerTypeEditingDone
-        OnSelect = cmbDebuggerTypeEditingDone
        Style = csDropDownList
        TabOrder = 0
+        OnEditingDone = cmbDebuggerTypeEditingDone
+        OnSelect = cmbDebuggerTypeEditingDone
      end
      object cmbDebuggerPath: TComboBox
        AnchorSideLeft.Control = gbDebuggerType
@ -144,15 +185,15 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
        Left = 6
        Height = 23
        Top = 56
-        Width = 480
+        Width = 493
        Anchors = [akTop, akLeft, akRight]
        BorderSpacing.Left = 6
        BorderSpacing.Top = 6
        BorderSpacing.Bottom = 6
        ItemHeight = 15
+        TabOrder = 1
        OnEditingDone = cmbDebuggerPathEditingDone
        OnEnter = cmbDebuggerPathEditingDone
-        TabOrder = 1
      end
      object cmdOpenDebuggerPath: TButton
        AnchorSideTop.Control = cmbDebuggerPath
@ -160,21 +201,21 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
        AnchorSideRight.Side = asrBottom
        AnchorSideBottom.Control = cmbDebuggerPath
        AnchorSideBottom.Side = asrBottom
-        Left = 486
+        Left = 499
        Height = 23
        Top = 56
        Width = 23
        Anchors = [akTop, akRight, akBottom]
        BorderSpacing.Right = 6
        Caption = '…'
-        OnClick = cmdOpenDebuggerPathClick
        TabOrder = 2
+        OnClick = cmdOpenDebuggerPathClick
      end
      object BtnEditClass: TButton
        AnchorSideTop.Control = gbDebuggerType
        AnchorSideRight.Control = gbDebuggerType
        AnchorSideRight.Side = asrBottom
-        Left = 418
+        Left = 431
        Height = 25
        Top = 6
        Width = 91
@ -182,8 +223,8 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
        AutoSize = True
        BorderSpacing.Around = 6
        Caption = 'BtnEditClass'
-        OnClick = BtnEditClassClick
        TabOrder = 3
+        OnClick = BtnEditClassClick
      end
      object LblWarnClassChange: TLabel
        AnchorSideLeft.Control = gbDebuggerType
@ -194,11 +235,10 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
        Left = 6
        Height = 15
        Top = 35
-        Width = 503
+        Width = 516
        Anchors = [akTop, akLeft, akRight]
        BorderSpacing.Around = 6
        Caption = 'LblWarnClassChange'
-        Color = clDefault
        Font.Color = clRed
        ParentColor = False
        ParentFont = False
@ -215,13 +255,13 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
      Left = 0
      Height = 55
      Top = 167
-      Width = 519
+      Width = 532
      Anchors = [akTop, akLeft, akRight]
      AutoSize = True
      BorderSpacing.Top = 6
      Caption = 'Additional search path'
      ClientHeight = 35
-      ClientWidth = 515
+      ClientWidth = 528
      TabOrder = 2
      Visible = False
      object txtAdditionalPath: TEdit
@ -231,7 +271,7 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
        Left = 6
        Height = 23
        Top = 6
-        Width = 480
+        Width = 493
        Anchors = [akTop, akLeft, akRight]
        BorderSpacing.Left = 6
        BorderSpacing.Top = 6
@ -244,15 +284,15 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
        AnchorSideRight.Side = asrBottom
        AnchorSideBottom.Control = txtAdditionalPath
        AnchorSideBottom.Side = asrBottom
-        Left = 486
+        Left = 499
        Height = 23
        Top = 6
        Width = 23
        Anchors = [akTop, akRight, akBottom]
        BorderSpacing.Right = 6
        Caption = '…'
-        OnClick = cmdOpenAdditionalPathClick
        TabOrder = 1
+        OnClick = cmdOpenAdditionalPathClick
      end
    end
    object gbDebuggerSpecific: TGroupBox
@ -264,9 +304,9 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
      AnchorSideBottom.Control = Panel1
      AnchorSideBottom.Side = asrBottom
      Left = 0
-      Height = 173
+      Height = 113
      Top = 228
-      Width = 519
+      Width = 532
      Anchors = [akTop, akLeft, akRight, akBottom]
      BorderSpacing.Top = 6
      Caption = 'Debugger specific options (depends on type of debugger)'
@ -280,7 +320,7 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
      Left = 6
      Height = 15
      Top = 6
-      Width = 507
+      Width = 520
      Anchors = [akTop, akLeft, akRight]
      BorderSpacing.Around = 6
      Caption = 'lblWarningProject'
@ -289,8 +329,4 @@ object DebuggerClassOptionsFrame: TDebuggerClassOptionsFrame
      Visible = False
    end
  end
-  object tbDropMenu: TPopupMenu
-    Left = 294
-    Top = 5
-  end
 end
--- a/debugger/frames/debugger_class_options.pas
+++ b/debugger/frames/debugger_class_options.pas
@ -36,7 +36,7 @@ uses
  PropEdits, ObjectInspector, IDEOptionsIntf, IDEOptEditorIntf, IDEUtils,
  IdeIntfStrConsts, InputHistory,
  // LazDebuggerGDBMI
-  GDBMIDebugger,
+  GDBMIDebugger, DividerBevel,
  // IdeDebugger
  Debugger, IdeDebuggerOpts, EnvDebuggerOptions, ProjectDebugLink,
  // IdeConfig
@ -50,10 +50,16 @@ type

  TDebuggerClassOptionsFrame = class(TAbstractIDEOptionsEditor)
    BtnEditClass: TButton;
+    btnAdd: TButton;
+    btnCopy: TButton;
+    btnDelete: TButton;
    cmbDebuggerPath: TComboBox;
    cmbDebuggerType: TComboBox;
    cmdOpenAdditionalPath: TButton;
    cmdOpenDebuggerPath: TButton;
+    cbBackend: TComboBox;
+    divSelectBackend: TDividerBevel;
+    divEditBackend: TDividerBevel;
    edName: TEdit;
    gbAdditionalSearchPath: TGroupBox;
    gbDebuggerSpecific: TGroupBox;
@ -62,16 +68,9 @@ type
    LblWarnClassChange: TLabel;
    lblName: TLabel;
    Panel1: TPanel;
-    tbDropMenu: TPopupMenu;
-    ToolBar1: TToolBar;
-    tbSelect: TToolButton;
-    tbAddNew: TToolButton;
-    ToolButton2: TToolButton;
-    tbDelete: TToolButton;
-    tbCopy: TToolButton;
-    ToolButton3: TToolButton;
    txtAdditionalPath: TEdit;
    procedure BtnEditClassClick(Sender: TObject);
+    procedure cbBackendChange(Sender: TObject);
    procedure cmbDebuggerPathEditingDone(Sender: TObject);
    procedure cmbDebuggerTypeEditingDone(Sender: TObject);
    procedure cmdOpenAdditionalPathClick(Sender: TObject);
@ -89,11 +88,11 @@ type
    FPropertyEditorHook: TPropertyEditorHook;
    FCopiedDbgPropertiesConfigList: TDebuggerPropertiesConfigList;
    FSelectedDbgPropertiesConfig: TDebuggerPropertiesConfig;
+    FUpdatingBackendDropDown: Boolean;
    FLastCheckedDebuggerPath: String;
    function SelectedDebuggerClass: TDebuggerClass; // currently shown debugger class
    function SelectedDebuggerProperties: TDebuggerProperties;

-    procedure DoNameSelected(Sender: TObject);
    procedure FillDebuggerClassDropDown;
    procedure UpdateDebuggerClass;
    procedure UpdateDebuggerClassDropDown;
@ -160,6 +159,27 @@ begin
  LblWarnClassChange.Visible := True;
 end;

+procedure TDebuggerClassOptionsFrame.cbBackendChange(Sender: TObject);
+var
+  idx: PtrInt;
+begin
+  if FUpdatingBackendDropDown then
+    exit;
+
+  UpdateDebuggerPathHistory;
+  idx := cbBackend.ItemIndex;
+
+  edNameExit(nil);
+  UpdateDebuggerClass;
+  cmbDebuggerPathEditingDone(nil);
+
+  FSelectedDbgPropertiesConfig := FCopiedDbgPropertiesConfigList.Opt[idx];
+  FillNameDropDown;
+
+  UpdateDebuggerClassDropDown;
+  FetchDebuggerSpecificOptions;
+end;
+
 procedure TDebuggerClassOptionsFrame.cmdOpenAdditionalPathClick(Sender: TObject);
 begin
  PathEditorDialog.Path:=txtAdditionalPath.Text;
@ -401,24 +421,6 @@ begin
    TStringList(FDebuggerFileHistory.Objects[i]).Assign(cmbDebuggerPath.Items);
 end;

-procedure TDebuggerClassOptionsFrame.DoNameSelected(Sender: TObject);
-var
-  idx: PtrInt;
-begin
-  UpdateDebuggerPathHistory;
-  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;
@ -564,39 +566,36 @@ end;

 procedure TDebuggerClassOptionsFrame.FillNameDropDown;
 var
-  m: TMenuItem;
-  i: Integer;
+  i, j: Integer;
+  c: TDebuggerPropertiesConfig;
 begin
-  {$IFDEF linux}
-  // Workaround for issue https://bugs.freepascal.org/view.php?id=36305 https://bugs.freepascal.org/view.php?id=36306
-  tbDropMenu := TPopupMenu.Create(Self);
-  tbSelect.DropdownMenu := tbDropMenu;
-  {$ENDIF}
-  tbDropMenu.Items.Clear;
-  for i := 0 to FCopiedDbgPropertiesConfigList.Count - 1 do 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 := FSelectedDbgPropertiesConfig <> nil;
-  tbCopy.Enabled := FSelectedDbgPropertiesConfig <> nil;
-  tbDelete.Enabled := FSelectedDbgPropertiesConfig <> nil;
+  FUpdatingBackendDropDown := True;
+  try
+    cbBackend.Items.Clear;
+    j := -1;
+    for i := 0 to FCopiedDbgPropertiesConfigList.Count - 1 do begin
+      c := FCopiedDbgPropertiesConfigList.Opt[i];
+      cbBackend.Items.Add(c.DisplayName);
+      if FCopiedDbgPropertiesConfigList.Opt[i] = FSelectedDbgPropertiesConfig then
+        j := i;
+    end;
+    cbBackend.ItemIndex := j;
+    cbBackend.Enabled := FCopiedDbgPropertiesConfigList.Count > 0;

-  if ShowWarningOverridenByProject and Assigned(FSelectedDbgPropertiesConfig) then
-    lblWarningProject.Visible := not (
-      (DbgProjectLink.DebuggerBackend = FSelectedDbgPropertiesConfig.UID) or
-      (DbgProjectLink.DebuggerBackend = 'IDE') or
-      ( (DbgProjectLink.DebuggerBackend = '') and
-        (DbgProjectLink.DebuggerPropertiesConfigList.Count = 0) )
-    );
+    Panel1.Enabled := FSelectedDbgPropertiesConfig <> nil;
+    btnCopy.Enabled := FSelectedDbgPropertiesConfig <> nil;
+    btnDelete.Enabled := FSelectedDbgPropertiesConfig <> nil;
+
+    if ShowWarningOverridenByProject and Assigned(FSelectedDbgPropertiesConfig) then
+      lblWarningProject.Visible := not (
+        (DbgProjectLink.DebuggerBackend = FSelectedDbgPropertiesConfig.UID) or
+        (DbgProjectLink.DebuggerBackend = 'IDE') or
+        ( (DbgProjectLink.DebuggerBackend = '') and
+          (DbgProjectLink.DebuggerPropertiesConfigList.Count = 0) )
+      );
+  finally
+    FUpdatingBackendDropDown := False;
+  end;
 end;

 procedure TDebuggerClassOptionsFrame.HookGetCheckboxForBoolean(var Value: Boolean);
@ -670,11 +669,14 @@ end;

 procedure TDebuggerClassOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
 begin
-  tbAddNew.Caption := lisAdd;
-  tbCopy.Caption := lisCopy;
-  tbDelete.Caption := lisDelete;
+  divSelectBackend.Caption := dlgOptDebugBackendSelectDebuggerBackend;
+  divEditBackend.Caption := dlgOptDebugBackendEditDebuggerBackend;
+  btnAdd.Caption := lisAdd;
+  btnCopy.Caption := lisCopy;
+  btnDelete.Caption := lisDelete;
+
  lblName.Caption := lisDebugOptionsFrmName;
-  lblWarningProject.Caption := 'The project options have been set to use a different debugger backend';
+  lblWarningProject.Caption := dlgOptDebugBackendTheProjectOptionsHaveBeen;
  BtnEditClass.Caption := lisDebugOptionsFrmEditClass;
  LblWarnClassChange.Caption := lisDebugOptionsFrmEditClassWarn;
  gbDebuggerType.Caption := dlgDebugType;
--- a/ide/lazarusidestrconsts.pas
+++ b/ide/lazarusidestrconsts.pas
@ -6318,6 +6318,10 @@ resourcestring
  dlgIAhadentifierComplEntryKeyword = 'Keyword';
  dlgIAhadentifierComplEntryOther = 'Other';
  dlgIAhadentifierComplEntryEnum = 'Enum';
+  dlgOptDebugBackendSelectDebuggerBackend = 'Select debugger backend';
+  dlgOptDebugBackendEditDebuggerBackend = 'Edit debugger backend';
+  dlgOptDebugBackendTheProjectOptionsHaveBeen = 'The project options have been set to use a '
+    +'different debugger backend';

 implementation