IDE: add option to skip checks (config, dir, fpc, fppkg, single-instance) at startup

components/ideintf/ideutils.pas

@@ -27,6 +27,8 @@ type
     cstFilename
     );
 
+TGetSkipCheckByKey = function(AKey: String): Boolean;
+
 function IndexInStringList(List: TStrings; Cmp: TCmpStrType; s: string): integer;
 procedure SetComboBoxText(AComboBox: TComboBox; const AText: String;
                           Cmp: TCmpStrType; MaxCount: integer = 1000);
@@ -44,8 +46,15 @@ function GetValidDirectory(const aFileDirStr: string;
 function GetValidDirectoryAndFilename(const aFileDirStr: string;
                                       out aoFileName : string): string;
 
+function GetSkipCheckByKey(AKey: String): Boolean;
+procedure SetSkipCheckByKeyProc(AProc: TGetSkipCheckByKey);
+
+
 implementation
 
+var
+  FGetSkipCheckByKeyProc: TGetSkipCheckByKey;
+
 function IndexInStringList(List: TStrings; Cmp: TCmpStrType; s: string): integer;
 var
   i: Integer;
@@ -168,5 +177,17 @@ begin
     aoFileName := lSWPD;
 end;
 
+function GetSkipCheckByKey(AKey: String): Boolean;
+begin
+  Result := FGetSkipCheckByKeyProc <> nil;
+  if Result then
+    Result := FGetSkipCheckByKeyProc(AKey);
+end;
+
+procedure SetSkipCheckByKeyProc(AProc: TGetSkipCheckByKey);
+begin
+  FGetSkipCheckByKeyProc := AProc;
+end;
+
 end.
 

ide/idecmdline.pas

@@ -40,10 +40,26 @@ interface
 uses 
   Classes, SysUtils,
   // LazUtils
-  FileUtil, LazFileUtils, LazStringUtils, LazUTF8, LazLogger,
+  FileUtil, LazFileUtils, LazStringUtils, LazUTF8, LazLogger, IDEUtils,
   // IDE
   LazConf;
 
+// Checks at startup that can be skipped
+// Packages may add there own...
+type
+  TSkipAbleChecks = (
+    skcLazDir,         // Correct Lazarus-dir / CheckLazarusDirectoryQuality
+    skcFpcExe,         // fpc.exe / CheckFPCExeQuality
+    skcFpcSrc,         // fpc source dir / CheckFPCSrcDirQuality
+    skcMake,           // make.exe / CheckMakeExeQuality
+    skcDebugger,       // CheckDebuggerQuality
+    skcFppkg,          // CheckFppkgConfiguration
+    skcSetup,          // **All** of the above
+    skcMissingPackageFile, // lisPkgSysPackageFileNotFound = 'Package file not found';
+    skcLastCalled,     // Config was last used by this/other installation
+    skcUniqueInstance, // Other running IDE // Attempt to get lock file
+    skcAll             // **ALL**
+  );
 const
   // IDE cmd line options
   ShowSetupDialogOptLong='--setup';
@@ -60,6 +76,20 @@ const
   DebugLogOptEnable='--debug-enable=';
   LanguageOpt='--language=';
   LazarusDirOpt ='--lazarusdir=';
+  SkipChecksOptLong='--skip-checks=';
+  SkipChecksKeys: array[TSkipAbleChecks] of string = (
+    'LazarusDir',
+    'FpcExe',
+    'FpcSrc',
+    'Make',
+    'Debbugger',
+    'Fppkg',
+    'Setup',
+    'MissingPackageFile',
+    'InstallDir',
+    'SingleInstance',
+    'All'
+  );
 const
   // startlazarus options
   StartLazarusPidOpt   = '--lazarus-pid=';
@@ -90,6 +120,10 @@ function ParamsAndCfgCount: Integer;
 function ParamsAndCfgStr(Idx: Integer): String;
 procedure ResetParamsAndCfg;
 
+function GetSkipCheck(AKey: TSkipAbleChecks): Boolean;
+function GetSkipCheckByKey(AKey: String): Boolean;
+
+
 implementation
 
 var
@@ -201,6 +235,34 @@ begin
   FreeAndNil(ParamsAndCfgFileContent);
 end;
 
+function GetSkipCheck(AKey: TSkipAbleChecks): Boolean;
+begin
+  Result := GetSkipCheckByKey(SkipChecksKeys[AKey]);
+end;
+
+function GetSkipCheckByKey(AKey: String): Boolean;
+var
+  i: integer;
+  AValue: string;
+begin
+  // return language specified in command line (empty string if no language specified)
+  Result := False;
+  AKey := ','+UpperCase(AKey)+',';
+  AValue := '';
+  i := 1;
+  while i <= ParamsAndCfgCount do
+  begin
+    if ParamIsOptionPlusValue(i, SkipChecksOptLong, AValue) = true then
+    begin
+      AValue := ','+UpperCase(AValue)+',';
+      Result := Pos(AKey, AValue) > 0;
+      if Result then
+        exit;
+    end;
+    inc(i);
+  end;
+end;
+
 procedure ParseCommandLine(aCmdLineParams: TStrings; out IDEPid: Integer; out
   ShowSplashScreen: boolean);
 var
@@ -419,6 +481,7 @@ end;
 
 initialization
   InitLogger;
+  SetSkipCheckByKeyProc(@GetSkipCheckByKey);
 finalization
   FreeAndNil(CfgFileContent);
   FreeAndNil(ParamsAndCfgFileContent);

ide/ideinstances.pas

@@ -107,6 +107,7 @@ type
     FMainServer: TMainServer;//running IDE
     FStartIDE: Boolean;// = True;
     FForceNewInstance: Boolean;
+    FSkipAllChecks: Boolean;
     FFilesToOpen: TStrings;
 
     class procedure AddFilesToParams(const aFiles: TStrings;
@@ -208,7 +209,7 @@ end;
 
 function TIDEInstances.StartIDE: Boolean;
 begin
-  Result := FStartIDE;
+  Result := FStartIDE or FSkipAllChecks;
 end;
 
 function TIDEInstances.ProjectIsOpenInAnotherInstance(aProjectFileName: string
@@ -219,6 +220,9 @@ var
   xServerIDs: TStringList;
   xProjFileName: string;
 begin
+  if FSkipAllChecks then
+    exit(False);
+
   aProjectFileName := ExtractFilePath(aProjectFileName)+ExtractFileNameOnly(aProjectFileName);
 
   xStartClient := nil;
@@ -258,6 +262,8 @@ procedure TIDEInstances.StartListening(
   const aStartNewInstanceEvent: TStartNewInstanceEvent;
   const aGetCurrentProjectEvent: TGetCurrentProjectEvent);
 begin
+  if FSkipAllChecks then
+    exit;
   Assert(Assigned(FMainServer));
 
   FMainServer.StartListening(aStartNewInstanceEvent, aGetCurrentProjectEvent);
@@ -266,6 +272,8 @@ end;
 procedure TIDEInstances.StartServer;
 begin
   Assert(FMainServer = nil);
+  if FSkipAllChecks then
+    exit;
 
   FMainServer := TMainServer.Create(Self);
   FMainServer.StartUnique(LazServerPrefix);
@@ -273,6 +281,8 @@ end;
 
 procedure TIDEInstances.StopListening;
 begin
+  if FMainServer = nil then
+    exit;
   FMainServer.StopListening;
 end;
 
@@ -548,6 +558,8 @@ var
 begin
   if not FStartIDE then//InitIDEInstances->CollectOtherOpeningFiles decided not to start the IDE
     Exit;
+  if FSkipAllChecks then
+    exit;
 
   // set primary config path
   PCP:=ExtractPrimaryConfigPath(GetParamsAndCfgFile);
@@ -732,12 +744,15 @@ var
   I: Integer;
 begin
   FForceNewInstance := CheckParamsForForceNewInstanceOpt;
+  FSkipAllChecks := GetSkipCheck(skcUniqueInstance) or GetSkipCheck(skcAll);
 
   //get cmd line filenames
   FFilesToOpen := ExtractCmdLineFilenames;
   for I := 0 to FilesToOpen.Count-1 do
     FilesToOpen[I] := CleanAndExpandFilename(FilesToOpen[I]);
 
+  if FSkipAllChecks then
+    exit;
   if FilesToOpen.Count > 0 then//if there are file in the cmd, check for multiple starting instances
   begin
     CollectFiles(xFilesWereSentToCollectingServer);

ide/lazarusidestrconsts.pas

@@ -191,6 +191,7 @@ resourcestring
   lisFileWhereDebugOutputIsWritten =
     'file where debug output is written to. If it is '+
     'not specified, debug output is written to the console.';
+  lisSkipStartupChecks = 'Skip selected checks at startup.';
   lisGroupsForDebugOutput = 'Enable or Disable groups of debug output.' +
     ' Valid Options are:';
   lisLazarusDirOverride = 'directory to be used as a basedirectory';

ide/main.pp

@@ -1116,6 +1116,9 @@ begin
     AddHelp([BreakString(space+lissecondaryConfigDirectoryWhereLazarusSearchesFor,
                         75, 22), LazConf.GetSecondaryConfigPath]);
     AddHelp(['']);
+    AddHelp([SkipChecksOptLong,''.Join(',', SkipChecksKeys)]);
+    AddHelp([BreakString(space+lisSkipStartupChecks, 75, 22)]);
+    AddHelp(['']);
     AddHelp([DebugLogOpt,' <file>']);
     AddHelp([BreakString(space+lisFileWhereDebugOutputIsWritten, 75, 22)]);
     AddHelp(['']);
@@ -1265,7 +1268,8 @@ begin
     end;
   end
   else
-  if (CompareFilenames(LastCalled,CurPrgName)<>0) and
+  if (not (GetSkipCheck(skcLastCalled) or GetSkipCheck(skcAll)) ) and
+     (CompareFilenames(LastCalled,CurPrgName)<>0) and
      (CompareFilenames(LastCalled,AltPrgName)<>0) and
      (CompareFilenames(CurPrgName,AltPrgName)<>0) // we can NOT check, if we only have the path inside the PCP
   then begin
@@ -1393,12 +1397,18 @@ var
   Note: string;
   OI: TSimpleWindowLayout;
   ConfigFile: string;
+  SkipAllTests: Boolean;
 begin
   {$IFDEF DebugSearchFPCSrcThread}
   ShowSetupDialog:=true;
   {$ENDIF}
+
+  SkipAllTests := GetSkipCheck(skcSetup) or GetSkipCheck(skcAll);
+
   // check lazarus directory
   if (not ShowSetupDialog)
+  and (not SkipAllTests)
+  and (not GetSkipCheck(skcLazDir))
   and (CheckLazarusDirectoryQuality(EnvironmentOptions.GetParsedLazarusDirectory,Note)<>sddqCompatible)
   then begin
     debugln(['Warning: (lazarus) incompatible Lazarus directory: ',EnvironmentOptions.GetParsedLazarusDirectory]);
@@ -1407,6 +1417,8 @@ begin
 
   // check compiler
   if (not ShowSetupDialog)
+  and (not SkipAllTests)
+  and (not GetSkipCheck(skcFpcExe))
   and (CheckFPCExeQuality(EnvironmentOptions.GetParsedCompilerFilename,Note,
                        CodeToolBoss.CompilerDefinesCache.TestFilename)=sddqInvalid)
   then begin
@@ -1415,8 +1427,10 @@ begin
   end;
 
   // check FPC source directory
-  if (not ShowSetupDialog) then
-  begin
+  if (not ShowSetupDialog)
+  and (not SkipAllTests)
+  and (not GetSkipCheck(skcFpcSrc))
+  then begin
     CfgCache:=CodeToolBoss.CompilerDefinesCache.ConfigCaches.Find(
       EnvironmentOptions.GetParsedCompilerFilename,'','','',true);
     if CheckFPCSrcDirQuality(EnvironmentOptions.GetParsedFPCSourceDirectory,Note,
@@ -1429,6 +1443,8 @@ begin
 
   // check 'make' utility
   if (not ShowSetupDialog)
+  and (not SkipAllTests)
+  and (not GetSkipCheck(skcMake))
   and not (CheckMakeExeQuality(EnvironmentOptions.GetParsedMakeFilename,Note) in [sddqCompatible, sddqMakeNotWithFpc])
   then begin
     debugln(['Warning: (lazarus) incompatible make utility: ',EnvironmentOptions.GetParsedMakeFilename]);
@@ -1436,9 +1452,12 @@ begin
   end;
 
   // check debugger
-  if (not ShowSetupDialog) then begin
-    // PackageBoss is not yet loaded...
-    RegisterDebugger(TGDBMIDebugger); // make sure we can read the config
+  // PackageBoss is not yet loaded...
+  RegisterDebugger(TGDBMIDebugger); // make sure we can read the config
+  if (not ShowSetupDialog)
+  and (not SkipAllTests)
+  and (not GetSkipCheck(skcDebugger))
+  then begin
     // Todo: add LldbFpDebugger for Mac
     // If the default debugger is of a class that is not yet Registered, then the dialog is not shown
     Note:='';
@@ -1457,6 +1476,8 @@ begin
   ConfigFile:=EnvironmentOptions.GetParsedFppkgConfig;
   // check fppkg configuration
   if (not ShowSetupDialog)
+  and (not SkipAllTests)
+  and (not GetSkipCheck(skcFppkg))
   and (CheckFppkgConfiguration(ConfigFile, Note)<>sddqCompatible)
   then begin
     debugln('Warning: (lazarus) fppkg not properly configured.');

packager/pkgmanager.pas

@@ -1536,7 +1536,7 @@ var
 begin
   StaticPackages:=LazarusPackageIntf.RegisteredPackages;
   if StaticPackages=nil then exit;
-  Quiet:=false;
+  Quiet:=GetSkipCheck(skcMissingPackageFile) or GetSkipCheck(skcAll);
   PackageGraph.AbortRegistration:=false;
   // register components in Lazarus packages
   for i:=0 to StaticPackages.Count-1 do begin