source: trunk/UInstance.pas

unit UInstance;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, USource, Contnrs, Process, Forms, Controls,
  FileUtil, Dialogs;

type
  { TInstance }

  TInstance = class
  private
    function GetCompiled: Boolean;
    function GetDownloaded: Boolean;
  public
    Id: Integer;
    Name: string;
    IDESource: TSource;
    IDERevision: string;
    IDEDate: TDateTime;
    FPCSource: TSource;
    FPCRevision: string;
    FPCDate: TDateTime;
    procedure Build;
    procedure Start;
    procedure UpdateLazarusConfig;
    procedure UpdateFPCConfig;
    function GetPath: string;
    function GetBinPath: string;
    property Downloaded: Boolean read GetDownloaded;
    property Compiled: Boolean read GetCompiled;
  end;

  { TInstanceList }

  TInstanceList = class(TObjectList)
    function GetNewId: Integer;
  end;

implementation

uses
  UOperationProgress, UMainForm;

{ TInstanceList }

function TInstanceList.GetNewId: Integer;
var
  I: Integer;
begin
  Result := 1;
  for I := 0 to Count - 1 do
    if TInstance(Items[I]).Id >= Result then
      Result := TInstance(Items[I]).Id + 1;
end;

{ TInstance }

function TInstance.GetCompiled: Boolean;
begin
  Result := FileExists(GetBinPath + DirectorySeparator + FPCSource.GetExecutableFile);
  if Assigned(IDESource) then Result := Result and
    FileExists(GetPath + DirectorySeparator + IDESource.ProjectShortName +
    DirectorySeparator + IDESource.GetExecutableFile);
end;

function TInstance.GetDownloaded: Boolean;
begin
  Result := DirectoryExists(GetPath + DirectorySeparator + FPCSource.ProjectShortName);
  if Assigned(IDESource) then Result := Result and
    DirectoryExists(GetPath + DirectorySeparator + IDESource.ProjectShortName);
end;

procedure TInstance.Build;
begin
  {$IFDEF Windows}
  OperationProgressForm.Environment := 'PATH=' + MainForm.GetBinUtilsDir;
  {$ENDIF}
  OperationProgressForm.Path := GetPath + DirectorySeparator + FPCSource.ProjectShortName;
  OperationProgressForm.CommandLine := 'make clean all PP=' +
    MainForm.GetCompilerPath + '';
  OperationProgressForm.ShowModal;

  {$IFDEF Windows}
  OperationProgressForm.Environment := 'PATH=' + MainForm.GetBinUtilsDir;
  {$ENDIF}
  OperationProgressForm.Path := GetPath + DirectorySeparator + FPCSource.ProjectShortName;
  OperationProgressForm.CommandLine := 'make install PREFIX=' +
    GetPath + DirectorySeparator + FPCSource.ProjectShortName + '' +
    ' PP=' + MainForm.GetCompilerPath + '';
  OperationProgressForm.ShowModal;

  if Assigned(IDESource) then begin
    {$IFDEF Windows}
    OperationProgressForm.Environment := 'PATH=' + MainForm.GetBinUtilsDir;
    {$ENDIF}
    OperationProgressForm.Path := GetPath + DirectorySeparator + IDESource.ProjectShortName;
    OperationProgressForm.CommandLine :=
      'make OPT="-Xg"';
    OperationProgressForm.ShowModal;
  end;
end;

procedure TInstance.Start;
var
  Process: TProcess;
  I: Integer;
begin
  if Assigned(IDESource) then
  try
    UpdateFPCConfig;
    UpdateLazarusConfig;

    Process := TProcess.Create(nil);

    {$IFDEF Linux}
    for I := 0 to GetEnvironmentVariableCount - 1 do
      Process.Environment.Add(GetEnvironmentString(I));

    Process.Environment.Values['PATH'] := GetPath + DirectorySeparator + FPCSource.ProjectShortName +
      '/lib/fpc/' + FPCSource.VersionNumber + ':' + Process.Environment.Values['PATH'];
    Process.Environment.Values['PPC_CONFIG_PATH'] := GetBinPath;
    //ShowMessage(Process.Environment.Text);
    {$ENDIF}
    {$IFDEF Windows}
    OperationProgressForm.Environment := 'PATH=' + MainForm.GetBinUtilsDir;
    {$ENDIF}
    Process.CurrentDirectory := GetPath + DirectorySeparator + IDESource.ProjectShortName;
    Process.CommandLine := GetPath + DirectorySeparator + IDESource.ProjectShortName +
      DirectorySeparator + IDESource.GetExecutableFile + ' --primary-config-path=' +
      GetPath + DirectorySeparator + IDESource.ProjectShortName +
      DirectorySeparator + 'config';
    Process.Execute;
  finally
    Process.Free;
  end;
end;

procedure TInstance.UpdateLazarusConfig;
var
  Config: TStringList;
  ConfigFileName: string;
  ConfigPath: string;
begin
  ConfigPath := GetPath + DirectorySeparator + IDESource.ProjectShortName +
    DirectorySeparator + 'config';
  ForceDirectories(ConfigPath);
  ConfigFileName := ConfigPath + DirectorySeparator + 'environmentoptions.xml';
  if not FileExists(ConfigFileName) then
  try
    Config := TStringList.Create;
    Config.LoadFromFile(MainForm.GetBaseDir + DirectorySeparator +
      MainForm.TemplateDir + DirectorySeparator + 'environmentoptions.xml');
    Config.Text := StringReplace(Config.Text, '%FPCDir%', GetPath + DirectorySeparator + FPCSource.ProjectShortName, [rfReplaceAll]);
    Config.Text := StringReplace(Config.Text, '%BaseDir%', MainForm.GetBaseDir, [rfReplaceAll]);
    Config.Text := StringReplace(Config.Text, '%LazarusDir%', GetPath + DirectorySeparator + IDESource.ProjectShortName, [rfReplaceAll]);
    {$IFDEF Windows}
    Config.Text := StringReplace(Config.Text, '%Make%', MainForm.GetBinUtilsDir + DirectorySeparator + 'make.exe', [rfReplaceAll]);
    Config.Text := StringReplace(Config.Text, '%FPCCompiler%', GetBinPath + DirectorySeparator + FPCSource.ExecutableFile + '.exe', [rfReplaceAll]);
    Config.Text := StringReplace(Config.Text, '%Temp%', GetEnvironmentVariable('TEMP'), [rfReplaceAll]);
    Config.Text := StringReplace(Config.Text, '%GDB%', MainForm.GetBinUtilsDir + DirectorySeparator + 'mingw\gdb.exe', [rfReplaceAll]);
    {$ENDIF}
    {$IFDEF Linux}
    Config.Text := StringReplace(Config.Text, '%Make%', MainForm.GetBinUtilsDir + DirectorySeparator + 'make', [rfReplaceAll]);
    Config.Text := StringReplace(Config.Text, '%FPCCompiler%', GetBinPath + DirectorySeparator + FPCSource.ExecutableFile, [rfReplaceAll]);
    Config.Text := StringReplace(Config.Text, '%Temp%', '/tmp', [rfReplaceAll]);
    Config.Text := StringReplace(Config.Text, '%GDB%', '/usr/bin/gdb', [rfReplaceAll]);
    {$ENDIF}
    Config.SaveToFile(ConfigFileName);
  finally
    Config.Free;
  end;
end;

procedure TInstance.UpdateFPCConfig;
var
  Config: TStringList;
begin
  try
    Config := TStringList.Create;
    Config.LoadFromFile(MainForm.GetBaseDir + DirectorySeparator +
      MainForm.TemplateDir + DirectorySeparator + 'fpc.cfg');
    {$IFDEF Windows}
    Config.Text := StringReplace(Config.Text, '$(FPCDir)', GetPath +
      DirectorySeparator + FPCSource.ProjectShortName, [rfReplaceAll]);
    {$ENDIF}
    {$IFDEF Linux}
    Config.Text := StringReplace(Config.Text, '$(FPCDir)', GetPath +
      DirectorySeparator + FPCSource.ProjectShortName +
      '/lib/fpc/' + FPCSource.VersionNumber, [rfReplaceAll]);
    {$ENDIF}
    Config.SaveToFile(GetBinPath + DirectorySeparator + 'fpc.cfg');
  finally
    Config.Free;
  end;
end;

function TInstance.GetPath: string;
begin
  Result := ExtractFileDir(Application.ExeName) + DirectorySeparator +
    MainForm.InstanceDir + DirectorySeparator + IntToStr(Id);
end;

function TInstance.GetBinPath: string;
begin
  Result := GetPath + DirectorySeparator + FPCSource.ProjectShortName +
    DirectorySeparator + 'bin';
  {$IFDEF Windows}
  Result := Result + DirectorySeparator +  MainForm.Platform;
  {$ENDIF}
end;

end.