Lazarus can be restarted, even if not started by startlazarus (only win32 implemented).

git-svn-id: trunk@6166 -

ide/lazarusidestrconsts.pas

@@ -494,6 +494,7 @@ resourcestring
     +'method. Plz fix the error shown in the message window.';
   lisStopDebugging = 'Stop Debugging?';
   lisStopTheDebugging = 'Stop the debugging?';
+  lisCannotFindLazarusStarter = 'Cannot find lazarus starter:%s%s';
 
   // resource files
   lisResourceFileComment =

ide/lazarusmanager.pas

@@ -6,8 +6,11 @@ unit LazarusManager;
 interface
 
 uses
+{$IFDEF win32}
+  Windows,
+{$ENDIF}
   Classes, SysUtils, Process,
-  FileUtil, Forms,
+  LCLProc, FileUtil, Forms,
   LazConf,
   StartLazOpts, Splash;
   
@@ -33,9 +36,13 @@ type
     FStartLazarusOptions: TStartLazarusOptions;
     FLazarusProcess: TLazarusProcess;
     FLazarusPath: string;
+    FLazarusPID: Integer;
+    FCmdLineParams: TStrings;
+    procedure ParseCommandLine;
     function GetLazarusPath(const FileName: string): string;
     procedure RenameLazarusExecutables;
     procedure LazarusProcessStart(Sender: TObject);
+    procedure WaitForLazarus;
   public
     constructor Create; reintroduce;
     destructor Destroy; override;
@@ -51,14 +58,41 @@ begin
   SplashForm := TSplashForm.Create(Self);
   ShowSplash;
   FStartLazarusOptions := TStartLazarusOptions.Create;
+  ParseCommandLine;
 end;
 
 destructor TLazarusManager.Destroy;
 begin
+  FreeAndNil(FCmdLineParams);
   FreeAndNil(FStartLazarusOptions);
   inherited Destroy;
 end;
 
+procedure TLazarusManager.ParseCommandLine;
+const
+  LazarusPidOpt='--lazarus-pid=';
+var
+  i: Integer;
+  Param: string;
+begin
+  FCmdLineParams := TStringList.Create;
+  FLazarusPID := 0;
+  for i := 1 to ParamCount do begin
+    Param := ParamStr(i);
+    if LeftStr(Param,length(LazarusPidOpt))=LazarusPidOpt then begin
+      try
+        FLazarusPID :=
+          StrToInt(RightStr(Param,Length(Param)-Length(LazarusPidOpt)));
+      except
+        DebugLn('Failed to parse %s',[Param]);
+        FLazarusPid := 0;
+      end;
+    end
+    else
+      FCmdLineParams.Add(Param);
+  end;
+end;
+
 function TLazarusManager.GetLazarusPath(const FileName: string) : string;
 begin
   result := AppendPathDelim(FStartLazarusOptions.LazarusDir) + FileName +
@@ -90,10 +124,32 @@ begin
   SplashForm.Hide;
 end;
 
+procedure TLazarusManager.WaitForLazarus;
+  procedure WaitForPid(PID: integer);
+  {$IFDEF win32}
+  var
+    ProcessHandle: THandle;
+  begin
+    ProcessHandle := OpenProcess(SYNCHRONIZE, false, PID);
+    WaitForSingleObject(ProcessHandle, INFINITE);
+  end;
+  {$ELSE}
+  begin
+    DebugLn('WaitForPid not implemented for this OS. We just wait 5 seconds');
+    Sleep(5000);
+  end;
+  {$ENDIF}
+begin
+  if FLazarusPID<>0 then begin
+    WaitForPID(FLazarusPID);
+  end;
+end;
+
 procedure TLazarusManager.Run;
 var
   Restart: boolean;
 begin
+  WaitForLazarus;
   repeat
     SplashForm.Show;
     Application.ProcessMessages;
@@ -125,7 +181,7 @@ begin
   FProcess := TProcess.Create(nil);
   FProcess.Options := [];
   FProcess.ShowWindow := swoShow;
-  FProcess.CommandLine := FLazarusPath + ' --no-splash-screen  --by-starter';
+  FProcess.CommandLine := FLazarusPath + ' --no-splash-screen --started-by-startlazarus';
 end;
 
 destructor TLazarusProcess.Destroy;
@@ -153,6 +209,9 @@ end;
 end.
 {
   $Log$
+  Revision 1.6  2004/10/27 20:49:26  vincents
+  Lazarus can be restarted, even if not started by startlazarus (only win32 implemented).
+
   Revision 1.5  2004/09/27 22:05:40  vincents
   splitted off unit FileUtil, it doesn't depend on other LCL units
 

ide/main.pp

@@ -769,6 +769,7 @@ uses
   
 var
   SkipAutoLoadingLastProject: boolean;
+  StartedByStartLazarus: boolean;
 
 //==============================================================================
 
@@ -788,6 +789,7 @@ const
   SecondaryConfPathOptShort='--scp=';
   NoSplashScreenOptLong='--no-splash-screen';
   NoSplashScreenOptShort='--nsc';
+  StartedByStartLazarusOpt='--started-by-startlazarus';
   SkipLastProjectOpt='--skip-last-project';
   DebugLogOpt='--debug-log=';
 
@@ -815,6 +817,7 @@ var
   AValue: string;
 begin
   SkipAutoLoadingLastProject:=false;
+  StartedByStartLazarus:=false;
   if (ParamCount>0)
   and ((AnsiCompareText(ParamStr(1),'--help')=0)
     or (AnsiCompareText(ParamStr(1),'-help')=0)
@@ -875,6 +878,8 @@ begin
     end;
     if ParamIsOption(i,SkipLastProjectOpt) then
       SkipAutoLoadingLastProject:=true;
+    if ParamIsOption(i,StartedByStartLazarusOpt) then
+      StartedByStartLazarus:=true;
   end;
 end;
 
@@ -2392,10 +2397,38 @@ end;
 
 {$IFDEF UseStartLazarus}
 procedure TMainIDE.mnuRestartClicked(Sender: TObject);
+
+  procedure StartStarter;
+  var
+    StartLazProcess: TProcess;
+    ExeName: string;
+  begin
+    StartLazProcess := TProcess.Create(nil);
+    try
+      StartLazProcess.CurrentDirectory := ExtractFileDir(ParamStr(0));
+      ExeName := AppendPathDelim(StartLazProcess.CurrentDirectory) +
+        'startlazarus' + GetDefaultExecutableExt;
+      if not FileExists(ExeName) then begin
+        ShowMessage(format(lisCannotFindLazarusStarter,
+          [LineEnding, ExeName]));
+        exit;
+      end;
+      StartLazProcess.CommandLine := format('%s --lazarus-pid=%d',
+        [ExeName, ProcessID]);
+      StartLazProcess.Execute;
+    finally
+      StartLazProcess.Free;
+    end;
+  end;
+  
 begin
   mnuQuitClicked(Sender);
-  if Application.Terminated then
-    ExitCode := 99;
+  if Application.Terminated then begin
+    if StartedByStartLazarus then
+      ExitCode := 99
+    else
+      StartStarter;
+  end;
 end;
 {$ENDIF}
 
@@ -10921,6 +10954,9 @@ end.
 
 { =============================================================================
   $Log$
+  Revision 1.785  2004/10/27 20:49:26  vincents
+  Lazarus can be restarted, even if not started by startlazarus (only win32 implemented).
+
   Revision 1.784  2004/10/15 12:04:08  mattias
   calling updating notebook tab after realize, needed for close btns
 

ide/startlazarus.lpr

@@ -1,4 +1,31 @@
 {  $Id$  }
+{
+ /***************************************************************************
+                               startlazarus.lpr
+                             --------------------
+                   This is a wrapper to (re)start lazarus.
+
+ ***************************************************************************/
+
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+}
 program StartLazarus;
 
 {$mode objfpc}{$H+}
@@ -23,6 +50,9 @@ begin
 end.
 {
   $Log$
+  Revision 1.4  2004/10/27 20:49:26  vincents
+  Lazarus can be restarted, even if not started by startlazarus (only win32 implemented).
+
   Revision 1.3  2004/10/01 21:33:36  vincents
   Added icon to startlazarus.