Repository URL to install this package:
Version:
2.0.10 ▾
|
lazarus-project
/
usr
/
share
/
lazarus
/
2.0.10
/
components
/
fppkg
/
src
/
fppkg_initializeoptionsfrm.pas
|
---|
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.