Merge branch 'feature/19-auto-detect-new-compilers' into develop

Closes #19

Author: delphidabbler

Src/CodeSnip.dpr

@@ -370,7 +370,10 @@ uses
   UXMLDocConsts in 'UXMLDocConsts.pas',
   UXMLDocHelper in 'UXMLDocHelper.pas',
   UXMLDocumentEx in 'UXMLDocumentEx.pas',
-  FmDeleteUserDBDlg in 'FmDeleteUserDBDlg.pas' {DeleteUserDBDlg};
+  FmDeleteUserDBDlg in 'FmDeleteUserDBDlg.pas' {DeleteUserDBDlg},
+  Compilers.UAutoDetect in 'Compilers.UAutoDetect.pas',
+  Compilers.USettings in 'Compilers.USettings.pas',
+  FmRegisterCompilersDlg in 'FmRegisterCompilersDlg.pas' {RegisterCompilersDlg};
 
 // Include resources
 {$Resource ExternalObj.tlb}       // Type library file

Src/CodeSnip.dproj

@@ -575,6 +575,11 @@
 			<DCCReference Include="FmDeleteUserDBDlg.pas">
 				<Form>DeleteUserDBDlg</Form>
 			</DCCReference>
+			<DCCReference Include="Compilers.UAutoDetect.pas"/>
+			<DCCReference Include="Compilers.USettings.pas"/>
+			<DCCReference Include="FmRegisterCompilersDlg.pas">
+				<Form>RegisterCompilersDlg</Form>
+			</DCCReference>
 			<None Include="CodeSnip.todo"/>
 			<BuildConfiguration Include="Base">
 				<Key>Base</Key>

Src/Compilers.UAutoDetect.pas

@@ -0,0 +1,115 @@
+{
+ * This Source Code Form is subject to the terms of the Mozilla Public License,
+ * v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ * obtain one at https://mozilla.org/MPL/2.0/
+ *
+ * Copyright (C) 2022, Peter Johnson (gravatar.com/delphidabbler).
+ *
+ * Implements a static class that can detect and register Delphi compilers
+ * present on the user's system that are not yet registered with CodeSnip.
+}
+
+
+unit Compilers.UAutoDetect;
+
+interface
+
+uses
+  Compilers.UGlobals,
+  Compilers.UCompilers,
+  UBaseObjects;
+
+type
+  TCompilerAutoDetect = class(TNoConstructObject)
+  public
+    type
+      TCallback = reference to procedure (Compiler: ICompiler);
+  strict private
+    class procedure DoCallback(const Callback: TCallback;
+      Compiler: ICompiler);
+  public
+    class procedure RegisterCompilers(Compilers: ICompilers;
+      const Callback: TCallback = nil); overload;
+    class procedure RegisterSpecificCompilers(AllCompilers: ICompilers;
+      const RegList: TCompilerList; const Callback: TCallback = nil);
+    class procedure ListRegisterableCompilers(Compilers: ICompilers;
+      const Registerable: TCompilerList);
+  end;
+
+implementation
+
+uses
+  SysUtils;
+
+{ TCompilerAutoDetect }
+
+class procedure TCompilerAutoDetect.DoCallback(
+  const Callback: TCallback; Compiler: ICompiler);
+begin
+  if Assigned(Callback) then
+    Callback(Compiler);
+end;
+
+class procedure TCompilerAutoDetect.ListRegisterableCompilers(
+  Compilers: ICompilers; const Registerable: TCompilerList);
+var
+  Compiler: ICompiler;
+begin
+  Registerable.Clear;
+  for Compiler in Compilers do
+  begin
+    if not Supports(Compiler, ICompilerAutoDetect) then
+      Continue; // compiler can't be auto-detected/registered
+    if not (Compiler as ICompilerAutoDetect).IsInstalled then
+      Continue; // compiler is not installed on the user's system
+    if Compiler.IsAvailable then
+      Continue; // compiler installed & already registered for use by CodeSnip
+    if not (Compiler as ICompilerAutoDetect).GetCanAutoInstall then
+      Continue; // user has excluded this compiler from being auto-registered
+    // We get here then we have an installed, un-registered, auto-detectable
+    // compiler with permission to register
+    Registerable.Add(Compiler);
+  end;
+end;
+
+class procedure TCompilerAutoDetect.RegisterSpecificCompilers(
+  AllCompilers: ICompilers; const RegList: TCompilerList;
+  const Callback: TCallback);
+var
+  Compiler: ICompiler;
+begin
+  for Compiler in AllCompilers do
+  begin
+    if RegList.IndexOf(Compiler) >= 0 then
+    begin
+      Assert(Supports(Compiler, ICompilerAutoDetect), ClassName +
+        '.RegisterCompilers: Compiler does not support ICompilerAutoDetect');
+      if (Compiler as ICompilerAutoDetect).DetectExeFile then
+        DoCallback(Callback, Compiler);
+    end;
+  end;
+end;
+
+class procedure TCompilerAutoDetect.RegisterCompilers(Compilers: ICompilers;
+  const Callback: TCallback);
+var
+  Registerable: TCompilerList;
+  Compiler: ICompiler;
+begin
+  Registerable := TCompilerList.Create;
+  try
+    ListRegisterableCompilers(Compilers, Registerable);
+    for Compiler in Registerable do
+    begin
+      Assert(Supports(Compiler, ICompilerAutoDetect), ClassName +
+        '.RegisterCompilers: Compiler does not support ICompilerAutoDetect');
+      if (Compiler as ICompilerAutoDetect).DetectExeFile then
+        DoCallback(Callback, Compiler);
+    end;
+  finally
+    Registerable.Free;
+  end;
+end;
+
+end.
+

Src/Compilers.UBorland.pas

@@ -35,11 +35,22 @@   TBorlandCompiler = class(TCompilerBase)
     var
       fId: TCompilerID;
         {Identifies compiler}
+      // Flags whether user permits compiler to be auto installed.
+      fCanAutoInstall: Boolean;
     function InstallPathFromReg(const RootKey: HKEY): string;
       {Gets compiler install root path from given registry root key, if present.
         @param RootKey [in] Given registry root key.
         @return Required root path or '' if not compiler not installed.
       }
+    ///  <summary>Gets the path to the compiler exe file if the compiler is
+    ///  registered as installed on the user's computer.</summary>
+    ///  <param name="ExePath">string [out] Set to path to compiler executable
+    ///  file. Empty string if compiler not installed.</param>
+    ///  <returns>Boolean. True if compiler is registered as installed or False
+    ///  otherwise.</returns>
+    ///  <remarks>Does not check if compiler exe is actually present, just if
+    ///  it is registered.</remarks>
+    function GetExePathIfInstalled(out ExePath: string): Boolean;
   strict protected
     function SearchDirParams: string; override;
       {One of more parameters that define any search directories to be passed
@@ -61,10 +72,35 @@   TBorlandCompiler = class(TCompilerBase)
         @param Obj Compiler object to copy.
       }
     { ICompilerAutoDetect }
+    ///  <summary>Detects and records path to command line compiler exe file,
+    ///  if compiler is registered as installed.</summary>
+    ///  <returns>Boolean. True if compiler is registered as installed, False
+    ///  otherwise.</returns>
+    ///  <remarks>
+    ///  <para>Does not check if the compiler exe file actually exists.</para>
+    ///  <para>Does not set compiler exe file if compiler is not installed.
+    ///  </para>
+    ///  <para>Method of ICompilerAutoDetect.</para>
+    ///  </remarks>
     function DetectExeFile: Boolean;
-      {Detects and records path to command line compiler if present.
-        @return True if compiler path found, false otherwise.
-      }
+    ///  <summary>Checks if the compiler is installed on the user's system.
+    ///  </summary>
+    ///  <returns>Boolean. True if compiler is physically installed, False
+    ///  otherwise.</returns>
+    ///  <remarks>
+    ///  <para>Checks if compiler exe is actually present.</para>
+    ///  <para>Method of ICompilerAutoDetect.</para>
+    ///  </remarks>
+    function IsInstalled: Boolean;
+    ///  <summary>Checks if the compiler is permitted to be automatically
+    ///  installed.</summary>
+    ///  <remarks>Method of ICompilerAutoDetect.</remarks>
+    function GetCanAutoInstall: Boolean;
+    ///  <summary>Determines whether the compiler can be automatically
+    ///  installed.</summary>
+    ///  <remarks>Method of ICompilerAutoDetect.</remarks>
+    procedure SetCanAutoInstall(const Value: Boolean);
+
     { ICompiler }
     function GetDefaultSwitches: string; override;
       {Returns default command line switches for compiler.
@@ -88,7 +124,7 @@ implementation
 
 uses
   // Delphi
-  SysUtils, Registry,
+  SysUtils, Registry, IOUtils,
   // Project
   UIStringList, UStrUtils, USystemInfo;
 
@@ -109,6 +145,7 @@ constructor TBorlandCompiler.CreateCopy(const Obj: TBorlandCompiler);
 begin
   inherited CreateCopy(Obj);
   fId := Obj.GetID;
+  fCanAutoInstall := Obj.GetCanAutoInstall;
 end;
 
 procedure TBorlandCompiler.DeleteObjFiles(const Path, Project: string);
@@ -128,17 +165,16 @@ function TBorlandCompiler.DetectExeFile: Boolean;
     @return True if compiler path found, false otherwise.
   }
 var
-  InstDir: string;    // installation root directory
+  ExePath: string;
 begin
-  // try HKLM
-  InstDir := InstallPathFromReg(HKEY_LOCAL_MACHINE);
-  if InstDir = '' then
-    // in case install was for user only, try HKCU
-    InstDir := InstallPathFromReg(HKEY_CURRENT_USER);
-  if InstDir = '' then
-    Exit(False);
-  SetExecFile(IncludeTrailingPathDelimiter(InstDir) + 'Bin\DCC32.exe');
-  Result := True;
+  Result := GetExePathIfInstalled(ExePath);
+  if Result then
+    SetExecFile(ExePath);
+end;
+
+function TBorlandCompiler.GetCanAutoInstall: Boolean;
+begin
+  Result := fCanAutoInstall;
 end;
 
 function TBorlandCompiler.GetDefaultSwitches: string;
@@ -161,6 +197,22 @@ function TBorlandCompiler.GetDefaultSwitches: string;
          +  '-$P+';   // Open string params ON
 end;
 
+function TBorlandCompiler.GetExePathIfInstalled(out ExePath: string): Boolean;
+var
+  InstDir: string;
+begin
+  ExePath := '';
+  // try HKLM
+  InstDir := InstallPathFromReg(HKEY_LOCAL_MACHINE);
+  if InstDir = '' then
+    // in case install was for user only, try HKCU
+    InstDir := InstallPathFromReg(HKEY_CURRENT_USER);
+  if InstDir = '' then
+    Exit(False);
+  ExePath := TPath.Combine(InstDir, 'Bin\DCC32.exe');
+  Result := True;
+end;
+
 function TBorlandCompiler.GetID: TCompilerID;
   {Provides the unique id of the compiler.
     @return Compiler id.
@@ -192,6 +244,15 @@ function TBorlandCompiler.InstallPathFromReg(const RootKey: HKEY): string;
   end;
 end;
 
+function TBorlandCompiler.IsInstalled: Boolean;
+var
+  ExePath: string;
+begin
+  if not GetExePathIfInstalled(ExePath) then
+    Exit(False);
+  Result := TFile.Exists(ExePath, False);
+end;
+
 function TBorlandCompiler.SearchDirParams: string;
   {One of more parameters that define any search directories to be passed to
   compiler on command line.
@@ -209,5 +270,10 @@ function TBorlandCompiler.SearchDirParams: string;
     + ' ' + StrQuoteSpaced('-R' + Dirs.GetText(';', False));
 end;
 
+procedure TBorlandCompiler.SetCanAutoInstall(const Value: Boolean);
+begin
+  fCanAutoInstall := Value;
+end;
+
 end.
 

Src/Compilers.UCompilers.pas

@@ -20,6 +20,8 @@ interface
 
 
 uses
+  // Delphi
+  Generics.Collections,
   // Project
   Compilers.UGlobals, UBaseObjects;
 
@@ -64,13 +66,18 @@   TCompilersFactory = class(TNoConstructObject)
       }
   end;
 
+  TCompilerList = class(TList<ICompiler>)
+  public
+    constructor Create;
+  end;
+
 
 implementation
 
 
 uses
   // Delphi
-  Generics.Collections, SysUtils,
+  Generics.Defaults, SysUtils,
   // Project
   Compilers.UBDS, Compilers.UDelphi, Compilers.UFreePascal,
   Compilers.USearchDirs, IntfCommon, UConsts, UExceptions, UIStringList,
@@ -328,6 +335,12 @@ procedure TPersistCompilers.Load(const Compilers: ICompilers);
     // Load search directories
     SearchDirNames := Storage.GetStrings('SearchDirCount', 'SearchDir%d');
     Compiler.SetSearchDirs(TSearchDirs.Create(SearchDirNames.ToArray));
+
+    // Check if compiler can be auto-detected
+    if Supports(Compiler, ICompilerAutoDetect) then
+      (Compiler as ICompilerAutoDetect).SetCanAutoInstall(
+        Storage.GetBoolean('CanAutoInstall', True)
+      );
   end;
 end;
 
@@ -363,10 +376,28 @@ procedure TPersistCompilers.Save(const Compilers: ICompilers);
       Storage.SetString('Namespaces', Compiler.GetRTLNamespaces);
     SearchDirNames := TIStringList.Create(Compiler.GetSearchDirs.ToStrings);
     Storage.SetStrings('SearchDirCount', 'SearchDir%d', SearchDirNames);
+    if Supports(Compiler, ICompilerAutoDetect) then
+      Storage.SetBoolean(
+        'CanAutoInstall', (Compiler as ICompilerAutoDetect).GetCanAutoInstall
+      );
     // save the data
     Storage.Save;
   end;
 end;
 
+{ TCompilerList }
+
+constructor TCompilerList.Create;
+begin
+  inherited Create(
+    TDelegatedComparer<ICompiler>.Create(
+      function (const Left, Right: ICompiler): Integer
+      begin
+        Result := Ord(Left.GetID) - Ord(Right.GetID);
+      end
+    )
+  )
+end;
+
 end.
 

Src/Compilers.UGlobals.pas

@@ -299,7 +299,7 @@ interface
     property Count: Integer read GetCount;
 
     ///  <summary>Number of compilers installed on this computer and made
-    ///  available CodeSnip.</summary>
+    ///  available to CodeSnip.</summary>
     property AvailableCount: Integer read GetAvailableCount;
 
     ///  <summary>Checks if any compilers in the list are displayable.</summary>
@@ -327,6 +327,15 @@ interface
     ///  <summary>Detects and records the full path of the compiler's
     ///  executable.</summary>
     function DetectExeFile: Boolean;
+    ///  <summary>Checks if the compiler is installed on the user's system.
+    ///  </summary>
+    function IsInstalled: Boolean;
+    ///  <summary>Checks if the compiler is permitted to be automatically
+    ///  installed.</summary>
+    function GetCanAutoInstall: Boolean;
+    ///  <summary>Determines whether the compiler can be automatically
+    ///  installed.</summary>
+    procedure SetCanAutoInstall(const Value: Boolean);
   end;