ufrmIDEPaths.pas

unit ufrmIDEPaths;

interface

uses
  System.Classes, System.Types, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls,
  Vcl.ExtCtrls, Vcl.Dialogs, uIDEPathSettings;

type
  TfrmIDEPaths = class(TForm)
    pnlTop: TPanel;
    lblSetting: TLabel;
    cmbSetting: TComboBox;
    lblLocation: TLabel;
    lbPaths: TListBox;
    pnlButtons: TPanel;
    btnAdd: TButton;
    btnBrowse: TButton;
    btnRemove: TButton;
    btnUp: TButton;
    btnDown: TButton;
    btnCheck: TButton;
    pnlBottom: TPanel;
    lblPath: TLabel;
    edtPath: TEdit;
    lblResolved: TLabel;
    mmoResolved: TMemo;
    lblLegend: TLabel;
    lblValid: TLabel;
    lblMissing: TLabel;
    lblUnresolved: TLabel;
    lblDuplicate: TLabel;
    btnSave: TButton;
    btnClose: TButton;
    dlgFolder: TFileOpenDialog;
    procedure cmbSettingChange(Sender: TObject);
    procedure lbPathsClick(Sender: TObject);
    procedure lbPathsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure btnAddClick(Sender: TObject);
    procedure btnBrowseClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
    procedure btnUpClick(Sender: TObject);
    procedure btnDownClick(Sender: TObject);
    procedure btnCheckClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure edtPathChange(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    FStore: TIDEPathSettings;
    FIndex: Integer;
    FLoading: Boolean;
    FResolved: TArray<string>;
    FStates: TArray<Integer>;
    FHasDuplicates: Boolean;
    function FindDuplicate(const Entry: string; IgnoreIndex: Integer): Integer;
    function CurrentValue: string;
    function DiscardChanges: Boolean;
    procedure RefreshRows;
    procedure UpdateSelection;
    procedure MoveRow(Delta: Integer);
  public
    destructor Destroy; override;
    procedure LoadVersion(const Version: string);
  end;

implementation

{$R *.dfm}

uses
  Winapi.Windows, System.SysUtils, System.StrUtils, System.IOUtils,
  System.UITypes, System.Math, Vcl.Graphics;

destructor TfrmIDEPaths.Destroy;
begin
  FStore.Free;
  inherited;
end;

procedure TfrmIDEPaths.LoadVersion(const Version: string);
begin
  Caption := 'IDE path editor - BDS ' + Version;
  FStore := TIDEPathSettings.Create(Version);
  FIndex := -1;
  for var Item in FStore.Items do
    cmbSetting.Items.Add(Item.Caption);
  if cmbSetting.Items.Count > 0 then
  begin
    cmbSetting.ItemIndex := 0;
    cmbSettingChange(nil);
  end;
end;

function TfrmIDEPaths.CurrentValue: string;
begin
  Result := string.Join(';', lbPaths.Items.ToStringArray);
end;

function TfrmIDEPaths.DiscardChanges: Boolean;
begin
  Result := (FIndex < 0) or (CurrentValue = FStore.Items[FIndex].Original);
  if not Result then
    Result := MessageDlg('Discard the unsaved changes to this setting?', mtConfirmation,
      [mbYes, mbNo], 0) = mrYes;
end;

procedure TfrmIDEPaths.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := DiscardChanges;
end;

procedure TfrmIDEPaths.cmbSettingChange(Sender: TObject);
begin
  if not DiscardChanges then
  begin
    cmbSetting.ItemIndex := FIndex;
    Exit;
  end;
  FIndex := cmbSetting.ItemIndex;
  if FIndex < 0 then Exit;
  lbPaths.Items.BeginUpdate;
  try
    lbPaths.Clear;
    if FStore.Items[FIndex].Original <> '' then
      for var Entry in FStore.Items[FIndex].Original.Split([';']) do
        lbPaths.Items.Add(Entry);
  finally
    lbPaths.Items.EndUpdate;
  end;
  lblLocation.Caption := 'HKCU' + FStore.Items[FIndex].Key + ' / ' + FStore.Items[FIndex].Name;
  if FStore.Items[FIndex].Platform = '' then
    lblLegend.Caption := 'Environment overrides apply after restarting the IDE.'
  else
    lblLegend.Caption := 'Save updates the registry and existing EnvOptions.proj.';
  if lbPaths.Count > 0 then lbPaths.ItemIndex := 0;
  RefreshRows;
end;

procedure TfrmIDEPaths.RefreshRows;
var
  Resolved, Part: string;
  Width, Other: Integer;
  Keys: TStringList;
begin
  SetLength(FResolved, lbPaths.Count);
  SetLength(FStates, lbPaths.Count);
  Width := lbPaths.ClientWidth;
  FHasDuplicates := False;
  Keys := TStringList.Create;
  try
  for var I := 0 to lbPaths.Count - 1 do
  begin
    Resolved := FStore.Resolve(lbPaths.Items[I], FStore.Items[FIndex]);
    FResolved[I] := Resolved;
    FStates[I] := 0;
    if Resolved = '' then FStates[I] := 2;
    for var RawPart in Resolved.Split([';']) do
    begin
      Part := RawPart.Trim.DeQuotedString('"');
      if Part = '' then Continue;
      if ContainsText(Part, '$(') or ContainsText(Part, '%') or
        not TPath.IsPathRooted(Part) or ((Length(Part) > 0) and (Part[1] = '\') and not StartsText('\\', Part)) then
        FStates[I] := 2
      else if not TDirectory.Exists(Part) and (FStates[I] <> 2) then
        FStates[I] := 1;
    end;
    Part := TIDEPathSettings.PathKey(Resolved);
    Other := Keys.IndexOf(Part);
    if (Part <> '') and (Other >= 0) then
    begin
      FHasDuplicates := True;
      FStates[I] := 3;
      FStates[Other] := 3;
    end;
    Keys.Add(Part);
    Width := Max(Width, lbPaths.Canvas.TextWidth(lbPaths.Items[I]) + 32);
  end;
  finally
    Keys.Free;
  end;
  lbPaths.ScrollWidth := Width;
  lbPaths.Invalidate;
  UpdateSelection;
end;

procedure TfrmIDEPaths.UpdateSelection;
var
  I: Integer;
begin
  I := lbPaths.ItemIndex;
  FLoading := True;
  try
    edtPath.Enabled := I >= 0;
    if I >= 0 then
    begin
      edtPath.Text := lbPaths.Items[I];
      mmoResolved.Text := FResolved[I];
    end
    else
    begin
      edtPath.Clear;
      mmoResolved.Clear;
    end;
  finally
    FLoading := False;
  end;
  btnAdd.Enabled := FIndex >= 0;
  btnBrowse.Enabled := I >= 0;
  btnRemove.Enabled := I >= 0;
  btnUp.Enabled := I > 0;
  btnDown.Enabled := (I >= 0) and (I < lbPaths.Count - 1);
  btnSave.Enabled := (FIndex >= 0) and not FHasDuplicates and (CurrentValue <> FStore.Items[FIndex].Original);
end;

procedure TfrmIDEPaths.lbPathsClick(Sender: TObject);
begin
  RefreshRows;
end;

procedure TfrmIDEPaths.edtPathChange(Sender: TObject);
var
  Duplicate: Integer;
begin
  if FLoading or (lbPaths.ItemIndex < 0) then Exit;
  lbPaths.Items[lbPaths.ItemIndex] := edtPath.Text;
  FStates[lbPaths.ItemIndex] := 2;
  mmoResolved.Text := 'Press Check paths to resolve the edited value.';
  Duplicate := FindDuplicate(edtPath.Text, lbPaths.ItemIndex);
  if Duplicate >= 0 then
  begin
    FStates[lbPaths.ItemIndex] := 3;
    mmoResolved.Text := Format('Duplicate of row %d. Change or remove this path before saving.', [Duplicate + 1]);
  end;
  btnSave.Enabled := (Duplicate < 0) and (CurrentValue <> FStore.Items[FIndex].Original);
  lbPaths.Invalidate;
end;

procedure TfrmIDEPaths.lbPathsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
const
  TextColors: array[0..3] of TColor = (clWindowText, $002020C0, $000080B0, $00800080);
  Backgrounds: array[0..3] of TColor = (clWindow, $00EEEEFF, $00E0F4FF, $00FFE0FF);
var
  Kind: Integer;
begin
  if Index >= Length(FStates) then Exit;
  Kind := FStates[Index];
  lbPaths.Canvas.Brush.Color := Backgrounds[Kind];
  lbPaths.Canvas.Font.Assign(lbPaths.Font);
  lbPaths.Canvas.Font.Color := TextColors[Kind];
  if odSelected in State then
    lbPaths.Canvas.Font.Style := [fsBold];
  lbPaths.Canvas.FillRect(Rect);
  lbPaths.Canvas.TextOut(Rect.Left + 6, Rect.Top + 2, lbPaths.Items[Index]);
  if odSelected in State then lbPaths.Canvas.DrawFocusRect(Rect);
end;

function TfrmIDEPaths.FindDuplicate(const Entry: string; IgnoreIndex: Integer): Integer;
begin
  for var I := 0 to lbPaths.Count - 1 do
    if (I <> IgnoreIndex) and FStore.PathsEqual(Entry, lbPaths.Items[I], FStore.Items[FIndex]) then
      Exit(I);
  Result := -1;
end;

procedure TfrmIDEPaths.btnAddClick(Sender: TObject);
begin
  if dlgFolder.Execute then
  begin
    if FindDuplicate(dlgFolder.FileName, -1) >= 0 then
    begin
      ShowMessage('This directory is already in the list.');
      Exit;
    end;
    lbPaths.ItemIndex := lbPaths.Items.Add(dlgFolder.FileName);
    RefreshRows;
  end;
end;

procedure TfrmIDEPaths.btnBrowseClick(Sender: TObject);
begin
  if lbPaths.ItemIndex < 0 then Exit;
  RefreshRows;
  dlgFolder.FileName := '';
  dlgFolder.DefaultFolder := TIDEPathSettings.NearestExistingDirectory(FResolved[lbPaths.ItemIndex]);
  if dlgFolder.Execute then
  begin
    if FindDuplicate(dlgFolder.FileName, lbPaths.ItemIndex) >= 0 then
    begin
      ShowMessage('This directory is already in the list.');
      Exit;
    end;
    lbPaths.Items[lbPaths.ItemIndex] := FStore.PreserveMacros(
      lbPaths.Items[lbPaths.ItemIndex], dlgFolder.FileName, FStore.Items[FIndex]);
    RefreshRows;
  end;
end;

procedure TfrmIDEPaths.btnRemoveClick(Sender: TObject);
var
  I: Integer;
begin
  I := lbPaths.ItemIndex;
  if I < 0 then Exit;
  if FindDuplicate(lbPaths.Items[I], I) < 0 then
    for var Part in FStore.Resolve(lbPaths.Items[I], FStore.Items[FIndex]).Split([';']) do
      if TDirectory.Exists(Part.Trim.DeQuotedString('"')) then
      begin
        if MessageDlg('This entry contains an existing directory:' + sLineBreak +
          lbPaths.Items[I] + sLineBreak + sLineBreak +
          'Remove it from the path list? No files or folders will be deleted.',
          mtConfirmation, [mbYes, mbNo], 0, mbNo) <> mrYes then Exit;
        Break;
      end;
  lbPaths.Items.Delete(I);
  lbPaths.ItemIndex := Min(I, lbPaths.Count - 1);
  RefreshRows;
end;

procedure TfrmIDEPaths.MoveRow(Delta: Integer);
var
  I: Integer;
begin
  I := lbPaths.ItemIndex;
  if (I < 0) or (I + Delta < 0) or (I + Delta >= lbPaths.Count) then Exit;
  lbPaths.Items.Exchange(I, I + Delta);
  lbPaths.ItemIndex := I + Delta;
  RefreshRows;
end;

procedure TfrmIDEPaths.btnUpClick(Sender: TObject);
begin
  MoveRow(-1);
end;

procedure TfrmIDEPaths.btnDownClick(Sender: TObject);
begin
  MoveRow(1);
end;

procedure TfrmIDEPaths.btnCheckClick(Sender: TObject);
begin
  RefreshRows;
end;

procedure TfrmIDEPaths.btnSaveClick(Sender: TObject);
var
  Backup: string;
begin
  if TIDEPathSettings.IDEIsRunning then
  begin
    ShowMessage('Close all RAD Studio instances before saving paths.');
    Exit;
  end;
  for var Entry in lbPaths.Items do
    if (Trim(Entry) = '') or ContainsText(Entry, ';') or ContainsText(Entry, #13) or ContainsText(Entry, #10) then
    begin
      ShowMessage('Use one non-empty path per row. Remove empty rows and separate paths into different rows.');
      Exit;
    end;
  RefreshRows;
  if FHasDuplicates then
  begin
    ShowMessage('Remove or change duplicate paths before saving (purple rows).');
    Exit;
  end;
  Backup := FStore.Save(FStore.Items[FIndex], CurrentValue);
  RefreshRows;
  ShowMessage('Setting saved. Backup: ' + Backup);
end;

end.