Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
lazarus-project / usr / share / lazarus / 2.0.10 / components / fppkg / src / fppkg_initializeoptionsfrm.pas
Size: Mime:
unit fppkg_initializeoptionsfrm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, EditBtn,
  ButtonPanel,
  fpTemplate,
  // fppkg
  pkgglobals, pkgFppkg, pkgoptions, pkgUninstalledSrcsRepo;

type

  { TInitializeOptionsForm }

  TInitializeOptionsForm = class(TForm)
    AdvancedCheckbox: TCheckBox;
    LazarusDirValidationLabel: TLabel;
    LazarusButtonPanel: TButtonPanel;
    FPCButtonPanel: TButtonPanel;
    CompilerEdit: TEdit;
    LazarusDirectoryEdit: TDirectoryEdit;
    InitializeLazarusLabel: TLabel;
    Label2: TLabel;
    LazarusConfigPanel: TPanel;
    PrefixLabel: TLabel;
    PathEdit: TEdit;
    FPCDirectoryEdit: TDirectoryEdit;
    FppkgConfigPanel: TPanel;
    InitializeFppkgLabel: TLabel;
    Label1: TLabel;
    FPCDirValidationLabel: TLabel;
    PathLabel: TLabel;
    PrefixEdit: TEdit;
    CompilerLabel: TLabel;
    procedure AdvancedCheckboxChange(Sender: TObject);
    procedure CloseButtonClick(Sender: TObject);
    procedure FPCDirectoryEditChange(Sender: TObject);
    procedure LazarusDirectoryEditChange(Sender: TObject);
    procedure OKButtonClick(Sender: TObject);
    procedure OnLazarusButtonClick(Sender: TObject);
  private
    function IsVersionStr(AString: string): Boolean;
  public
    class function CheckInitialConfiguration: Boolean;
    class function RecreateFppkgConfiguration: Boolean;
    class function CheckLazarusConfiguration: Boolean;
    class function RecreateLazarusConfiguration: Boolean;
  end;

var
  InitializeOptionsForm: TInitializeOptionsForm;

implementation

{$R *.lfm}

{ TInitializeOptionsForm }

procedure TInitializeOptionsForm.FPCDirectoryEditChange(Sender: TObject);
var
  SR: TSearchRec;
  Dir: string;
  Prefix, s: RawByteString;
begin
  Dir := IncludeTrailingPathDelimiter(FPCDirectoryEdit.Text);
  if not DirectoryExists(Dir) then
    FPCDirValidationLabel.Caption := 'Directory does not exist'
  else
    begin
    if FindFirst(Dir+'ppc*'+ExeExt, faAnyFile-faDirectory, SR) = 0 then
      begin
      FindClose(SR);
      if FileExists(Dir+'units') and FileExists(Dir+'fpmkinst') then
        begin
        FPCDirValidationLabel.Caption := '';

        s := ExtractFileName(ExcludeTrailingPathDelimiter(Dir));
        Prefix := ExtractFilePath(ExcludeTrailingPathDelimiter(Dir));

        if IsVersionStr(s) then
          PathEdit.Text := Prefix + '{CompilerVersion}' + PathDelim
        else
          PathEdit.Text := Dir;

        Prefix := ExtractFilePath(ExcludeTrailingPathDelimiter(Prefix));
        Prefix := ExtractFilePath(ExcludeTrailingPathDelimiter(Prefix));
        PrefixEdit.Text := Prefix;

        s := ConcatPaths([Prefix, 'bin', 'fpc'+ExeExt]);
        if FileExists(s) then
          CompilerEdit.Text := s
        else
          CompilerEdit.Text := ExeSearch('fpc'+ExeExt,GetEnvironmentVariable('PATH'));
        end
      else
        FPCDirValidationLabel.Caption := 'This location does not seems to contain a valid fpc-installation'
      end
    else
      begin
      FPCDirValidationLabel.Caption := 'Compiler not found at given location'
      end;
    end;
  FPCButtonPanel.OKButton.Enabled := FPCDirValidationLabel.Caption = '';
end;

procedure TInitializeOptionsForm.LazarusDirectoryEditChange(Sender: TObject);
var
  Dir: string;
begin
  Dir := IncludeTrailingPathDelimiter(LazarusDirectoryEdit.Text);
  if not DirectoryExists(Dir) then
    LazarusDirValidationLabel.Caption := 'Directory does not exist'
  else if DirectoryExists(Dir+'components') and DirectoryExists(Dir+'lcl') and DirectoryExists(Dir+'packager') then
    begin
    LazarusDirValidationLabel.Caption := '';
    end
  else
    LazarusDirValidationLabel.Caption := 'This location does not seems to contain a valid lazarus-installation';
  LazarusButtonPanel.OKButton.Enabled := LazarusDirValidationLabel.Caption = '';
end;

procedure TInitializeOptionsForm.CloseButtonClick(Sender: TObject);
begin
  ModalResult := mrClose;
end;

procedure TInitializeOptionsForm.AdvancedCheckboxChange(Sender: TObject);
begin
  PathLabel.Enabled := AdvancedCheckbox.Checked;
  PrefixLabel.Enabled := AdvancedCheckbox.Checked;
  PathEdit.Enabled := AdvancedCheckbox.Checked;
  PrefixEdit.Enabled := AdvancedCheckbox.Checked;
end;

procedure TInitializeOptionsForm.OKButtonClick(Sender: TObject);
var
  FPpkg: TpkgFPpkg;
  FileName: string;
  CurrentSection: TFppkgRepositoryOptionSection;
begin
  FPpkg := TpkgFPpkg.Create(Self);
  try
    CurrentSection := FPpkg.Options.AddRepositoryOptionSection(TFppkgRepositoryOptionSection);
    CurrentSection.RepositoryName := 'fpc';
    CurrentSection.Description := 'Packages which are installed along with the Free Pascal Compiler';
    CurrentSection.Path := PathEdit.Text;
    CurrentSection.Prefix := PrefixEdit.Text;

    FPpkg.Options.AddIncludeFilesOptionSection('{LocalRepository}config/conf.d/*.conf');

    CurrentSection := FPpkg.Options.AddRepositoryOptionSection(TFppkgRepositoryOptionSection);
    CurrentSection.RepositoryName := 'user';
    CurrentSection.Description := 'User-installed packages';
    CurrentSection.Path := '{LocalRepository}lib/fpc/{CompilerVersion}/';
    CurrentSection.Prefix := '{LocalRepository}';

    FileName := GetFppkgConfigFile(False, False);
    ForceDirectories(ExtractFilePath(FileName));
    FPpkg.Options.SaveToFile(FileName);

    // Load the just created configuration-file.
    FPpkg.InitializeGlobalOptions(FileName);
    FPpkg.CompilerOptions.Compiler := CompilerEdit.Text;
    // Remove the default configuration-file, so a new one will be generated
    FileName:=FPpkg.Options.GlobalSection.CompilerConfigDir+FPpkg.Options.CommandLineSection.CompilerConfig;
    if FileExists(FileName) then
      RenameFile(FileName, ChangeFileExt(FileName, '.bak'));
    // This will create the compiler-configuration file
    FPpkg.InitializeCompilerOptions;
  finally
    FPpkg.Free;
  end;
end;

procedure TInitializeOptionsForm.OnLazarusButtonClick(Sender: TObject);
var
  Dir: string;
  LazarusConfFilename: RawByteString;
  OptionParser: TTemplateParser;
  LazarusConfFile: TStrings;
  GlobalOpt: TFppkgGlobalOptionSection;

  procedure AddLazarusPackageLocation(ARepoName, ARepoDescription, ALocation: string);
  var
    SourceOptSection: TFppkgUninstalledSourceRepositoryOptionSection;
    OptSection: TFppkgUninstalledRepositoryOptionSection;
  begin
    OptSection := TFppkgUninstalledRepositoryOptionSection.Create(OptionParser);
    SourceOptSection := TFppkgUninstalledSourceRepositoryOptionSection.Create(OptionParser);
    try
      SourceOptSection.RepositoryName := ARepoName + '-src';
      SourceOptSection.Description := ARepoDescription + ' sources';
      SourceOptSection.Path := Dir + ALocation;
      SourceOptSection.InstallRepositoryName := ARepoName;
      SourceOptSection.SaveToStrings(LazarusConfFile);
      LazarusConfFile.Add('');

      OptSection.RepositoryName := ARepoName;
      OptSection.Description := ARepoDescription;
      OptSection.Path := Dir + ALocation;
      OptSection.SourceRepositoryName := ARepoName + '-src';
      OptSection.SaveToStrings(LazarusConfFile);
      LazarusConfFile.Add('');
    finally
      SourceOptSection.Free;
      OptSection.Free;
    end;
  end;

begin
  Dir := IncludeTrailingPathDelimiter(LazarusDirectoryEdit.Text);
  LazarusConfFilename := ConcatPaths([GetUserDir, '.fppkg', 'config', 'conf.d', 'lazarus.conf']);
  LazarusConfFile := TStringList.Create;
  try

    OptionParser := TTemplateParser.Create;
    try
      AddLazarusPackageLocation('laz-comp', 'Lazarus components', 'components');
      AddLazarusPackageLocation('laz-packages', 'Lazarus packager', 'packager');
      AddLazarusPackageLocation('laz-lclbase', 'Lazarus LCL-base', '');
      AddLazarusPackageLocation('laz-lcl', 'Lazarus LCL', 'lcl');

      LazarusConfFile.Add('[Global]');
      LazarusConfFile.Add('FPMakeOptions=--lazarusdir=' + Dir);
    finally
      OptionParser.Free;
    end;

    ForceDirectories(ExtractFileDir(LazarusConfFilename));
    LazarusConfFile.SaveToFile(LazarusConfFilename);
  finally
    LazarusConfFile.Free;
  end;
end;

function TInitializeOptionsForm.IsVersionStr(AString: string): Boolean;
var
  i: Integer;
begin
  Result := length(AString) > 0;
  for i := 1 to length(AString) do
    begin
    // only allow digits or a dot.
    if AString[i] in ['0'..'9'] then
      Continue
    // allow dots, but not as first or last character
    else if (AString[i] = '.') and (i > 1) and (i < length(AString)) then
      begin
      // do not allow two consecutive dots
      if (i > 1) and (AString[i-1]='.') then
        Result := False;
      end
    else
      begin
      Result := False;
      Exit;
      end;
    end;
end;

class function TInitializeOptionsForm.CheckInitialConfiguration: Boolean;
begin
  Result := true;
  if not FileExists(GetFppkgConfigFile(False, False))  and
    not FileExists(GetFppkgConfigFile(True, False)) then
    begin
      Result := RecreateFppkgConfiguration;
    end;
end;

class function TInitializeOptionsForm.RecreateFppkgConfiguration: Boolean;
var
  Frm: TInitializeOptionsForm;
begin
  Frm := TInitializeOptionsForm.Create(nil);
  try
    Frm.FppkgConfigPanel.Visible := True;
    if Frm.ShowModal in [mrClose, mrCancel] then
      Result := False
    else
      Result := True;
  finally
    Frm.Free;
  end;
end;

class function TInitializeOptionsForm.CheckLazarusConfiguration: Boolean;
begin
  Result := true;
  if not FileExists(ConcatPaths([GetUserDir, '.fppkg', 'config', 'conf.d', 'lazarus.conf'])) then
    begin
      Result := RecreateLazarusConfiguration;
    end;
end;

class function TInitializeOptionsForm.RecreateLazarusConfiguration: Boolean;
var
  Frm: TInitializeOptionsForm;
begin
  Frm := TInitializeOptionsForm.Create(nil);
  try
    Frm.LazarusConfigPanel.Visible := True;
    if Frm.ShowModal in [mrClose, mrCancel] then
      Result := False
    else
      Result := True;
  finally
    Frm.Free;
  end;
end;

end.