IDE: optional packaged IDE starts custom IDE

git-svn-id: trunk@64214 -

ide/idecmdline.pas

@@ -250,7 +250,7 @@ var
   s: String;
 begin
   if isStartLazarus then
-    Result := ' --no-splash-screen --started-by-startlazarus'
+    Result := ' '+NoSplashScreenOptLong+' '+StartedByStartLazarusOpt
   else
     Result := '';
   for i := 0 to aCmdLineParams.Count - 1 do begin

ide/ideinstances.pas

@@ -37,14 +37,16 @@ unit IDEInstances;
 interface
 
 uses
-  sysutils, Interfaces, Classes, Controls, Forms, Dialogs, ExtCtrls,
-  LCLProc, LCLIntf, LCLType, LazFileUtils, LazUTF8, laz2_XMLRead, laz2_XMLWrite,
-  Laz2_DOM, LazarusIDEStrConsts, IDECmdLine, crc,
+  Classes, sysutils, crc, Process,
   {$IF (FPC_FULLVERSION >= 30101)}
   AdvancedIPC
   {$ELSE}
   LazAdvancedIPC
   {$ENDIF}
+  Interfaces, Controls, Forms, Dialogs, ExtCtrls, LCLProc,
+  LCLIntf, LCLType, LazFileUtils, LazUTF8, laz2_XMLRead, laz2_XMLWrite,
+  Laz2_DOM, FileUtil, UTF8Process,
+  LazarusIDEStrConsts, IDECmdLine, LazConf,
   ;
 
 type
@@ -99,6 +101,8 @@ type
       var outHandleBringToFront: HWND): TStartNewInstanceResult;
   end;
 
+  { TIDEInstances }
+
   TIDEInstances = class(TComponent)
   private
     FMainServer: TMainServer;//running IDE
@@ -126,6 +130,9 @@ type
     function AllowStartNewInstance(const aFiles: TStrings;
       var outModalErrorMessage, outModalErrorForceUniqueMessage, outNotRespondingErrorMessage: string;
       var outHandleBringToFront: HWND): TStartNewInstanceResult;
+
+    function StartUserBuiltIDE: TStartNewInstanceResult;
+
     procedure InitIDEInstances;
   public
     constructor Create(aOwner: TComponent); override;
@@ -415,6 +422,94 @@ begin
   end;
 end;
 
+function TIDEInstances.StartUserBuiltIDE: TStartNewInstanceResult;
+// check if this is the standard(nonwritable) IDE and there is a custom built IDE.
+// if yes, start the custom IDE.
+{$IFDEF EnableRedirectToUserIDE}
+var
+  CustomDir, StartPath, DefaultDir, DefaultExe, CustomExe: String;
+  Params: TStringList;
+  aProcess: TProcessUTF8;
+  i: Integer;
+{$ENDIF}
+begin
+  Result:=ofrStartNewInstance;
+  {$IFDEF EnableRedirectToUserIDE}
+
+  debugln('Debug: (lazarus) TIDEInstances.StartUserBuiltIDE ');
+
+  if Application.HasOption(StartedByStartLazarusOpt) then
+    exit; // startlazarus has started this exe -> do not redirect
+
+  try
+    StartPath:=ExpandFileNameUTF8(ParamStrUTF8(0));
+    debugln(['Debug: (lazarus) TIDEInstances.StartUserBuiltIDE StartPath=',StartPath]);
+    if FileIsSymlink(StartPath) then
+      StartPath:=GetPhysicalFilename(StartPath,pfeException);
+    DefaultDir:=ExtractFilePath(StartPath);
+    if DirectoryExistsUTF8(DefaultDir) then
+      DefaultDir:=GetPhysicalFilename(DefaultDir,pfeException);
+  except
+    on E: Exception do begin
+      MessageDlg ('Error',E.Message,mtError,[mbCancel],0);
+      exit;
+    end;
+  end;
+  DefaultDir:=AppendPathDelim(DefaultDir);
+  CustomDir:=AppendPathDelim(GetPrimaryConfigPath) + 'bin' + PathDelim;
+  debugln(['Debug: (lazarus) TIDEInstances.StartUserBuiltIDE DefaultDir=',DefaultDir,' CustomDir=',CustomDir]);
+  if CompareFilenames(DefaultDir,CustomDir)=0 then
+    exit; // this is the user built IDE
+
+  DefaultExe:=DefaultDir+'lazarus'+GetExeExt; // started IDE
+  CustomExe:=CustomDir+'lazarus'+GetExeExt; // user built IDE
+
+  if (not FileExistsUTF8(DefaultExe))
+      or (not FileExistsUTF8(CustomExe))
+      or (FileAgeUTF8(CustomExe)<FileAgeUTF8(DefaultExe)) then
+    exit;
+
+  if DirectoryIsWritable(ChompPathDelim(ExtractFilePath(DefaultExe))) then
+    exit;
+  debugln(['Debug: (lazarus) TIDEInstances.StartUserBuiltIDE Starting custom IDE DefaultDir=',DefaultDir,' CustomDir=',CustomDir]);
+
+  // customexe is younger and defaultexe is not writable
+  // => the user started the default binary
+  // -> start the customexe
+  Params:=TStringList.Create;
+  aProcess:=nil;
+  try
+    aProcess := TProcessUTF8.Create(nil);
+    aProcess.InheritHandles := false;
+    aProcess.Options := [];
+    aProcess.ShowWindow := swoShow;
+    {$IFDEF Darwin}
+    aProcess.Executable:='/usr/bin/open';
+    Params.Add('-a');
+    if DirectoryExistsUTF8(CustomExe+'.app') then
+    begin
+      // start the bundle instead
+      CustomExe:=CustomExe+'.app/Contents/MacOS/'+ExtractFileName(CustomExe);
+    end;
+    Params.Add(CustomExe);
+    Params.Add('--args');
+    {$ELSE}
+    aProcess.Executable:=CustomExe;
+    {$ENDIF}
+    // append params
+    for i:=1 to ParamCount do
+      Params.Add(ParamStr(i));
+    aProcess.Parameters:=Params;
+    debugln(['Debug: (lazarus) AAA5 TIDEInstances.StartUserBuiltIDE Starting custom IDE: aProcess.Executable=',aProcess.Executable,' Params=[',Params.Text,']']);
+    aProcess.Execute;
+  finally
+    Params.Free;
+    aProcess.Free;
+  end;
+  Result:=ofrDoNotStart;
+  {$ENDIF}
+end;
+
 function TIDEInstances.CheckParamsForForceNewInstanceOpt: Boolean;
 var
   I: Integer;
@@ -437,7 +532,16 @@ begin
     Exit;
 
   if not FForceNewInstance then
-    xResult := AllowStartNewInstance(FilesToOpen, xModalErrorMessage, xModalErrorForceUniqueMessage, xNotRespondingErrorMessage, xHandleBringToFront)
+  begin
+    // check for already running instance
+    xResult := AllowStartNewInstance(FilesToOpen, xModalErrorMessage, xModalErrorForceUniqueMessage, xNotRespondingErrorMessage, xHandleBringToFront);
+
+    if xResult=ofrStartNewInstance then
+    begin
+      // check if there is an user built binary
+      xResult := StartUserBuiltIDE;
+    end;
+  end
   else
     xResult := ofrStartNewInstance;
 

ide/lazarus.lpi

@@ -1053,6 +1053,7 @@
       <Unit170>
         <Filename Value="lazarusmanager.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="LazarusManager"/>
       </Unit170>
       <Unit171>
         <Filename Value="macropromptdlg.pas"/>

ide/lazarusmanager.pas

@@ -384,7 +384,7 @@ begin
         {$IFDEF Linux}
         EnvOverrides.Values['LIBOVERLAY_SCROLLBAR']:='0';
         {$ENDIF}
-        {$IFDEF LCLCarbon}
+        {$IFDEF darwin}
         // "open" process runs a bundle, but doesn't wait for it to finish execution
         // "startlazarus" logic suggests that the Lazarus process would be waited
         // and if the special 99 (ExitCodeRestartLazarus) code is received,
@@ -393,7 +393,10 @@ begin
         // The arguments would not indicate that lazarus was started by startlazarus
         FLazarusProcess :=
           TLazarusProcess.Create('open',
-               ' -a ' + FLazarusPath + ' --args  --no-splash-screen ' + GetCommandLineParameters(FCmdLineParams, False)+' '+FCmdLineFiles,
+               ' -a ' + FLazarusPath + ' --args'
+               +' '+NoSplashScreenOptLong
+               +' '+GetCommandLineParameters(FCmdLineParams, False)
+               +' '+FCmdLineFiles,
                EnvOverrides);
         {$ELSE}
         FLazarusProcess :=