diff --git a/.gitattributes b/.gitattributes index 609b4b0253..3cc23d1020 100644 --- a/.gitattributes +++ b/.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 diff --git a/ide/lazarusmanager.pas b/ide/lazarusmanager.pas new file mode 100644 index 0000000000..6868ac75bb --- /dev/null +++ b/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. + diff --git a/ide/startlazarus.lpr b/ide/startlazarus.lpr new file mode 100644 index 0000000000..f955baabcd --- /dev/null +++ b/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. + diff --git a/ide/startlazopts.pas b/ide/startlazopts.pas new file mode 100644 index 0000000000..3ffbc6c5fa --- /dev/null +++ b/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. +