Added StartLazarus.

git-svn-id: trunk@5865 -

.gitattributes

@@ -620,6 +620,7 @@ ide/lazarus.rc svneol=native#text/plain
 ide/lazarus_about_logo.lrs svneol=native#text/pascal
 ide/lazarus_dci.lrs svneol=native#text/pascal
 ide/lazarusidestrconsts.pas svneol=native#text/pascal
+ide/lazarusmanager.pas svneol=native#text/pascal
 ide/lazconf.pp svneol=native#text/pascal
 ide/macropromptdlg.pas svneol=native#text/pascal
 ide/main.pp svneol=native#text/pascal
@@ -661,6 +662,8 @@ ide/sourceeditprocs.pas svneol=native#text/pascal
 ide/sourcemarks.pas svneol=native#text/pascal
 ide/splash.lrs svneol=native#text/pascal
 ide/splash.pp svneol=native#text/pascal
+ide/startlazarus.lpr svneol=native#text/pascal
+ide/startlazopts.pas svneol=native#text/pascal
 ide/sysvaruseroverridedlg.pas svneol=native#text/pascal
 ide/todolist.pp svneol=native#text/pascal
 ide/transfermacros.pp svneol=native#text/pascal

ide/lazarusmanager.pas

@@ -0,0 +1,139 @@
+unit LazarusManager;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Process,
+  FileCtrl, Forms,
+  LazConf,
+  StartLazOpts, Splash;
+  
+type
+  TLazarusProcess = class
+  private
+    FOnStart: TNotifyEvent;
+    FProcess: TProcess;
+    FLazarusPath: string;
+    FWantsRestart: boolean;
+  public
+    constructor Create(const LazarusPath: string);
+    destructor Destroy; override;
+    procedure Execute;
+    procedure WaitOnExit;
+    property WantsRestart: boolean read FWantsRestart;
+    property OnStart: TNotifyEvent read FOnStart write FOnStart;
+  end;
+  
+type
+  TLazarusManager = class
+  private
+    FStartLazarusOptions: TStartLazarusOptions;
+    FLazarusProcess: TLazarusProcess;
+    FLazarusPath: string;
+    function GetLazarusPath(name: string): string;
+    procedure RenameLazarusExecutables;
+    procedure LazarusProcessStart(Sender: TObject);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Run;
+  end;
+
+implementation
+
+constructor TLazarusManager.Create;
+begin
+  FStartLazarusOptions := TStartLazarusOptions.Create;
+end;
+
+destructor TLazarusManager.Destroy;
+begin
+  FreeAndNil(FStartLazarusOptions);
+  inherited Destroy;
+end;
+
+function TLazarusManager.GetLazarusPath(name: string) : string;
+begin
+  result := AppendPathDelim(FStartLazarusOptions.LazarusDir) + name +
+    GetDefaultExecutableExt;
+end;
+
+procedure TLazarusManager.RenameLazarusExecutables;
+var
+  NewFileName: string;
+  BackupFileName: String;
+begin
+  NewFileName := GetLazarusPath('lazarus.new');
+  FLazarusPath := GetLazarusPath('lazarus');
+  BackupFileName := GetLazarusPath('lazarus.old');
+  if FileExists(NewFileName) then
+  begin
+    if FileExists(FLazarusPath) then
+    begin
+      if FileExists(BackupFileName)
+        then DeleteFile(BackupFileName);
+      RenameFile(FLazarusPath, BackupFileName);
+    end;
+    RenameFile(NewFileName, FLazarusPath);
+  end;
+end;
+
+procedure TLazarusManager.LazarusProcessStart(Sender: TObject);
+begin
+  SplashForm.Hide;
+end;
+
+procedure TLazarusManager.Run;
+var
+  Restart: boolean;
+begin
+  repeat
+    SplashForm.Show;
+    RenameLazarusExecutables();
+    FLazarusProcess := TLazarusProcess.Create(FLazarusPath);
+    FLazarusProcess.OnStart := @LazarusProcessStart;
+    FLazarusProcess.Execute;
+    FLazarusProcess.WaitOnExit;
+    Restart := FLazarusProcess.WantsRestart;
+    FreeAndNil(FLazarusProcess);
+  until not Restart;
+  Application.Terminate;
+end;
+
+{ TLazarusProcess }
+
+constructor TLazarusProcess.Create(const LazarusPath: string);
+begin
+  FLazarusPath := LazarusPath;
+  FProcess := TProcess.Create(nil);
+  FProcess.Options := [];
+  FProcess.ShowWindow := swoHIDE;
+  FProcess.CommandLine := FLazarusPath + ' --no-splash-screen';
+end;
+
+destructor TLazarusProcess.Destroy;
+begin
+  FreeAndNil(FProcess);
+  inherited Destroy;
+end;
+
+procedure TLazarusProcess.Execute;
+begin
+  FProcess.Execute;
+  {$IFNDEF VER1_0}
+  Sleep(2000);
+  {$ENDIF}
+  if Assigned(FOnStart) then
+    FOnStart(Self);
+end;
+
+procedure TLazarusProcess.WaitOnExit;
+begin
+  FProcess.WaitOnExit;
+  FWantsRestart := FProcess.ExitStatus=99
+end;
+
+end.
+

ide/startlazarus.lpr

@@ -0,0 +1,31 @@
+program StartLazarus;
+
+{$mode objfpc}{$H+}
+
+uses
+  Interfaces, SysUtils,
+  Forms,
+  Splash, LazarusManager;
+  
+var
+  ALazarusManager: TLazarusManager;
+  
+procedure ShowSplash;
+begin
+  SplashForm := TSplashForm.Create(Application);
+  with SplashForm do begin
+    Show;
+    Paint;
+    StartTimer;
+  end;
+  Application.ProcessMessages; // process splash paint message
+end;
+
+begin
+  Application.Initialize;
+  ShowSplash;
+  ALazarusManager := TLazarusManager.Create;
+  ALazarusManager.Run;
+  FreeAndNil(ALazarusManager);
+end.
+

ide/startlazopts.pas

@@ -0,0 +1,57 @@
+unit StartLazOpts;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  Laz_XMLCfg;
+  
+type
+  TStartLazarusOptions = class
+  private
+    FFilename: string;
+    FLazarusDir: string;
+    procedure SetFilename(const AValue: string);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Load;
+    procedure Save;
+    property LazarusDir: string read FLazarusDir write FLazarusDir;
+    property Filename: string read FFilename write SetFilename;
+  end;
+
+implementation
+
+{ TStartLazarusOptions }
+
+procedure TStartLazarusOptions.SetFilename(const AValue: string);
+begin
+  if FFilename=AValue then exit;
+  FFilename:=AValue;
+end;
+
+constructor TStartLazarusOptions.Create;
+begin
+  FLazarusDir := ExtractFilePath(ExpandFileName(ParamStr(0)));
+end;
+
+destructor TStartLazarusOptions.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TStartLazarusOptions.Load;
+begin
+
+end;
+
+procedure TStartLazarusOptions.Save;
+begin
+
+end;
+
+end.
+