lazarus/ide/frames/project_debug_options.pas

unit project_debug_options;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes,
  // LazUtils
  LazTracer,
  // LCL
  Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  // LazControls
  DividerBevel,
  // IdeIntf
  IDEOptionsIntf, IDEOptEditorIntf, ProjectIntf,
  // IdeConfig
  EnvironmentOpts,
  // IdeDebugger
  IdeDebuggerOpts,
  // IDE
  Project, DebugManager, ProjectDebugLink,
  LazarusIDEStrConsts, debugger_class_options;

type

  { TProjectDebugOptionsFrame }

  TProjectDebugOptionsFrame = class(TAbstractIDEOptionsEditor)
    cbProjectDebugger: TComboBox;
    chkStoreInSession: TCheckBox;
    DividerBevel1: TDividerBevel;
    lblResolvedDebuggerHint: TLabel;
    lbProjectDebugger: TLabel;
    Panel1: TPanel;
    procedure cbProjectDebuggerChange(Sender: TObject);
  private
    fProject: TProject;
    FDebuggerBackend, FDebuggerBackendUnknown: String;
    FDebuggerBackendIdx: Integer;
    FClassOpts: TDebuggerClassOptionsFrame;
    procedure ClassCountChanged(Sender: TObject);
    procedure UpdateDebuggerBackend;
    procedure FillProjectDebuggerDropDown;
    procedure UpdateResolvedDebuggerHint;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetTitle: string; override;
    procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
    procedure ReadSettings(AOptions: TAbstractIDEOptions); override;
    procedure WriteSettings(AOptions: TAbstractIDEOptions); override;
    class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
    //property aProject: TProject read fProject;
  end;

implementation

const
  DBG_IDX_UNKNOWN = -99; // will use "project debugger"
  DBG_IDX_PROJECT =  -2;
  DBG_IDX_IDE     =  -1;
  DBG_TOKEN_IDE = 'IDE';

{$R *.lfm}

{ TProjectDebugOptionsFrame }

procedure TProjectDebugOptionsFrame.cbProjectDebuggerChange(Sender: TObject);
begin
  UpdateResolvedDebuggerHint;
end;

procedure TProjectDebugOptionsFrame.ClassCountChanged(Sender: TObject);
begin
  UpdateResolvedDebuggerHint
end;

procedure TProjectDebugOptionsFrame.UpdateDebuggerBackend;
var
  i: Integer;
begin
  if cbProjectDebugger.Items.Count = 0 then
    exit;

  FDebuggerBackend := '';
  FDebuggerBackendIdx := DBG_IDX_PROJECT;

  i := cbProjectDebugger.ItemIndex;
  if i >= 0 then begin
    FDebuggerBackendIdx := PtrInt(cbProjectDebugger.Items.Objects[i]);
    if FDebuggerBackendIdx = DBG_IDX_IDE then
      FDebuggerBackend := DBG_TOKEN_IDE
    else
    if FDebuggerBackendIdx = DBG_IDX_UNKNOWN then
      FDebuggerBackend := FDebuggerBackendUnknown
    else
    if FDebuggerBackendIdx >= 0 then
      FDebuggerBackend := DebuggerOptions.DebuggerPropertiesConfigList.Opt[FDebuggerBackendIdx].UID;
  end;
end;

procedure TProjectDebugOptionsFrame.FillProjectDebuggerDropDown;
const
  DBG_IDX_OFFSET  = 2; // 2 Hardcoded items (project, ide) // Offset for DropDown.ItemIndex
var
  i, sel: Integer;
  dbg: TDebuggerPropertiesConfigList;
begin
  cbProjectDebugger.Clear;
  sel := -1;
  cbProjectDebugger.AddItem(lisDebugOptionsFrmUseProjectDebugger, TObject(PtrUInt(DBG_IDX_PROJECT)));
  cbProjectDebugger.AddItem(lisDebugOptionsFrmUseIDEDebugger,     TObject(PtrUInt(DBG_IDX_IDE)));
  if FDebuggerBackend = '' then
    sel := 0
  else
  if FDebuggerBackend = DBG_TOKEN_IDE then
    sel := 1;

  dbg := DebuggerOptions.DebuggerPropertiesConfigList;
  for i := 0 to dbg.Count - 1 do begin
    cbProjectDebugger.AddItem(dbg.Opt[i].DisplayName, TObject(PtrUInt(i)));
    if dbg.Opt[i].UID = FDebuggerBackend then
      sel := i + DBG_IDX_OFFSET;
  end;

  if sel < 0 then begin
    sel := cbProjectDebugger.Items.AddObject(Format(
      lisDebugOptionsFrmUnknownDebuggerBacke, [FDebuggerBackend]), TObject(PtrUInt(DBG_IDX_UNKNOWN)));
    FDebuggerBackendUnknown := FDebuggerBackend;
  end;
  cbProjectDebugger.ItemIndex := sel;
  UpdateResolvedDebuggerHint;
end;

procedure TProjectDebugOptionsFrame.UpdateResolvedDebuggerHint;
begin
  UpdateDebuggerBackend;

  lblResolvedDebuggerHint.Visible := False;
  case FDebuggerBackendIdx of
    DBG_IDX_PROJECT: begin
      if FClassOpts.ModifiedDbgPropertiesConfigList.Count = 0 then begin
        lblResolvedDebuggerHint.Caption := drsUsingIDEDefaultDebuggerSe;
        lblResolvedDebuggerHint.Visible := True;
      end;
    end;
    DBG_IDX_IDE: begin
      if FClassOpts.ModifiedDbgPropertiesConfigList.Count > 0 then begin
        lblResolvedDebuggerHint.Caption := drsUsingIDEDefaultDebuggerSe;
        lblResolvedDebuggerHint.Caption := lblResolvedDebuggerHint.Caption + drsIgnoringProjectDebuggerSettings;
        lblResolvedDebuggerHint.Visible := True;
      end;
    end;
    DBG_IDX_UNKNOWN: begin
      lblResolvedDebuggerHint.Caption := drsUsingIDEDefaultDebuggerSe;
      if FClassOpts.ModifiedDbgPropertiesConfigList.Count > 0 then
        lblResolvedDebuggerHint.Caption := lblResolvedDebuggerHint.Caption + drsIgnoringProjectDebuggerSettings;
      lblResolvedDebuggerHint.Visible := True;
    end;
    otherwise begin
      if FClassOpts.ModifiedDbgPropertiesConfigList.Count > 0 then begin
        lblResolvedDebuggerHint.Caption := drsUsingSelectedIDEDebuggerS;
        lblResolvedDebuggerHint.Caption := lblResolvedDebuggerHint.Caption + drsIgnoringProjectDebuggerSettings;
        lblResolvedDebuggerHint.Visible := True;
    end;
    end;
  end;
end;

constructor TProjectDebugOptionsFrame.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FClassOpts := TDebuggerClassOptionsFrame.Create(Self);
  FClassOpts.Parent := Self;
  FClassOpts.Align := alClient;
  FClassOpts.Visible := True;
  FClassOpts.OnModifiedDbgPropertiesCountChanged := @ClassCountChanged;
end;

destructor TProjectDebugOptionsFrame.Destroy;
begin
  FClassOpts.OnModifiedDbgPropertiesCountChanged := nil;
  inherited Destroy;
end;

function TProjectDebugOptionsFrame.GetTitle: string;
begin
  Result := dlgPODebugger;
end;

procedure TProjectDebugOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
begin
  lbProjectDebugger.Caption := lisDebugOptionsFrmDebuggerBackend;
  chkStoreInSession.Caption := drsStoreProjectDebuggerConfi;
  chkStoreInSession.Hint := drsTheDebuggerBackendSelecti;
  FClassOpts.Setup(ADialog);
end;

procedure TProjectDebugOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
begin
  fProject:=(AOptions as TProjectIDEOptions).Project;
  with fProject.DebuggerLink as TProjectDebugLink do
  begin
    Self.FDebuggerBackend := DebuggerBackend;
    chkStoreInSession.Checked := StoreDebuggerClassConfInSession;
    FClassOpts.ReadSettings(DebuggerPropertiesConfigList);
  end;

  FillProjectDebuggerDropDown;
end;

procedure TProjectDebugOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
begin
  UpdateDebuggerBackend;

  with (AOptions as TProjectIDEOptions).Project.DebuggerLink as TProjectDebugLink do
  begin
    DebuggerBackend := FDebuggerBackend;
    StoreDebuggerClassConfInSession := chkStoreInSession.Checked;
    FClassOpts.WriteSettings(DebuggerPropertiesConfigList);
    MarkDebuggerClassConfAsModified;
  end;

end;

class function TProjectDebugOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
begin
  Result := TProjectIDEOptions;
end;

initialization
  RegisterIDEOptionsEditor(GroupProject, TProjectDebugOptionsFrame, ProjectOptionsDebug);

end.