paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 22:14:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Darius Blaszijk:

Browse Source 
- BaseInstallDir and Prefix are now PathDelimiter limited (implemented in Setter of property), 
   this saves a lot of hassle with rest of code
  - TDefaults -> TCustomDefaults
  - added TFPCDefaults and TBasicDefaults
  - TInstaller -> TCustomInstaller
  - added TFPCInstaller and TBasicInstaller
  - Implemented BaseInstallDir property in TCustomInstaller
  - Added an overloaded Install function
  - Added license header

git-svn-id: trunk@8286 -
This commit is contained in:
michael 2007-08-14 20:04:03 +00:00
parent 2b91a9ef37
commit ad6c0f10d4
1 changed files with 226 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

380
packages/fpmkunit/src/fpmkunit.pp
View File

@ -1,7 +1,24 @@
{
This file is part of the Free Pascal Makefile Package
Implementation of fpmake classes and functions
Copyright (c) 2007 by the freepascal team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit fpmkunit;
{$Mode objfpc} {$Mode objfpc}
{$H+} {$H+}
{$define debug} { $define debug}
unit fpmkunit;
Interface Interface
@ -194,7 +211,7 @@ Type
procedure SetName(const AValue: String);override; procedure SetName(const AValue: String);override;
Procedure GetCleanFiles(List : TStrings; APrefixU, APrefixB : String; AnOS : TOS); virtual; Procedure GetCleanFiles(List : TStrings; APrefixU, APrefixB : String; AnOS : TOS); virtual;
Procedure GetSourceFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual; Procedure GetSourceFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
Procedure GetInstallFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual; Procedure GetInstallFiles(List : TStrings; APrefixU, APrefixB: String; AnOS : TOS); virtual;
Procedure GetArchiveFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual; Procedure GetArchiveFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
Property HasUnitPath : Boolean Index 0 Read GetHasStrings; Property HasUnitPath : Boolean Index 0 Read GetHasStrings;
Property HasObjectPath : Boolean Index 1 Read GetHasStrings; Property HasObjectPath : Boolean Index 1 Read GetHasStrings;
@ -332,7 +349,7 @@ Type
Procedure AddDependency(AName : String); Procedure AddDependency(AName : String);
Procedure AddInstallFile(AFileName : String); Procedure AddInstallFile(AFileName : String);
Procedure GetCleanFiles(List : TStrings; Const APrefixU, APrefixB : String; AOS : TOS); virtual; Procedure GetCleanFiles(List : TStrings; Const APrefixU, APrefixB : String; AOS : TOS); virtual;
procedure GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix : String; AOS : TOS); procedure GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix, APrefixU, APrefixB: String; AOS : TOS);
Procedure GetArchiveFiles(List : TStrings; Const APrefix : String; AOS : TOS); virtual; Procedure GetArchiveFiles(List : TStrings; Const APrefix : String; AOS : TOS); virtual;
Procedure GetSourceFiles(List : TStrings); virtual; Procedure GetSourceFiles(List : TStrings); virtual;
Procedure GetManifest(Manifest : TStrings); Procedure GetManifest(Manifest : TStrings);
@ -395,9 +412,9 @@ Type
Property PackageItems[AIndex : Integer] : TPackage Read GetPackageItem Write SetPackageItem; Property PackageItems[AIndex : Integer] : TPackage Read GetPackageItem Write SetPackageItem;
end; end;
{ TDefaults } { TCustomDefaults }
TDefaults = Class(TPersistent) TCustomDefaults = Class(TPersistent)
Private Private
FArchive: String; FArchive: String;
FCompiler: String; FCompiler: String;
@ -435,7 +452,7 @@ Type
Constructor Create; Constructor Create;
Procedure InitDefaults; Procedure InitDefaults;
Procedure Assign(ASource : TPersistent);override; Procedure Assign(ASource : TPersistent);override;
procedure CompilerDefaults; procedure CompilerDefaults; virtual;
Procedure LocalInit(Const AFileName : String); Procedure LocalInit(Const AFileName : String);
Procedure LoadFromFile(Const AFileName : String); Procedure LoadFromFile(Const AFileName : String);
Procedure SaveToFile(Const AFileName : String); Procedure SaveToFile(Const AFileName : String);
@ -464,6 +481,18 @@ Type
Property Archive : String Read FArchive Write FArchive; // zip $(ARCHIVE) $(FILESORDIRS) Property Archive : String Read FArchive Write FArchive; // zip $(ARCHIVE) $(FILESORDIRS)
end; end;
{ TBasicDefaults }
TBasicDefaults = Class(TCustomDefaults)
end;
{ TFPCDefaults }
TFPCDefaults = Class(TCustomDefaults)
public
procedure CompilerDefaults; override;
end;
{ TBuildEngine } { TBuildEngine }
TBuildEngine = Class(TComponent) TBuildEngine = Class(TComponent)
@ -472,7 +501,7 @@ Type
FCompiler : String; FCompiler : String;
FStartDir : String; FStartDir : String;
FTargetDir : String; FTargetDir : String;
FDefaults : TDefaults; FDefaults : TCustomDefaults;
FForceCompile : Boolean; FForceCompile : Boolean;
FListMode : Boolean; FListMode : Boolean;
// Variables used when compiling a package. // Variables used when compiling a package.
@ -491,7 +520,7 @@ Type
FBeforeCompile: TNotifyEvent; FBeforeCompile: TNotifyEvent;
FBeforeInstall: TNotifyEvent; FBeforeInstall: TNotifyEvent;
FBeforeManifest: TNotifyEvent; FBeforeManifest: TNotifyEvent;
procedure SetDefaults(const AValue: TDefaults); procedure SetDefaults(const AValue: TCustomDefaults);
procedure SetTargetDir(const AValue: String); procedure SetTargetDir(const AValue: String);
Protected Protected
Procedure Error(Msg : String); Procedure Error(Msg : String);
@ -560,7 +589,7 @@ Type
Procedure GetManifest(Packages : TPackages; Manifest : TStrings); Procedure GetManifest(Packages : TPackages; Manifest : TStrings);
Property ListMode : Boolean Read FListMode Write FListMode; Property ListMode : Boolean Read FListMode Write FListMode;
Property ForceCompile : Boolean Read FForceCompile Write FForceCompile; Property ForceCompile : Boolean Read FForceCompile Write FForceCompile;
Property Defaults : TDefaults Read FDefaults Write SetDefaults; Property Defaults : TCustomDefaults Read FDefaults Write SetDefaults;
Property TargetDir : String Read FTargetDir Write SetTargetDir; Property TargetDir : String Read FTargetDir Write SetTargetDir;
// Events // Events
Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile; Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
@ -576,25 +605,28 @@ Type
Property OnLog : TLogEvent Read FOnLog Write FOnlog; Property OnLog : TLogEvent Read FOnLog Write FOnlog;
end; end;
{ TInstaller } { TCustomInstaller }
TInstaller = Class(TComponent) TCustomInstaller = Class(TComponent)
private private
FBaseInstallDir: string;
FBuildEngine: TBuildEngine; FBuildEngine: TBuildEngine;
FDefaultPackage: TPackage; FDefaultPackage: TPackage;
FDefaults: TDefaults; FDefaults: TCustomDefaults;
FPackages: TPackages; FPackages: TPackages;
FRunMode: TRunMode; FRunMode: TRunMode;
FListMode : Boolean; FListMode : Boolean;
FLogLevels : TVerboseLevels; FLogLevels : TVerboseLevels;
function GetBaseInstallDir: string;
Function GetPackageString(Index : Integer) : String; Function GetPackageString(Index : Integer) : String;
Procedure SetPackageString(Index : Integer; AValue : String); Procedure SetPackageString(Index : Integer; AValue : String);
function GetStrings(AIndex : Integer): TStrings; function GetStrings(AIndex : Integer): TStrings;
function GetOSes: TOSes; function GetOSes: TOSes;
function GetTargets: TTargets; function GetTargets: TTargets;
function GetSources: TSources; function GetSources: TSources;
procedure SetBaseInstallDir(AValue: string);
procedure SetDefaultPackage(const AValue: TPackage); procedure SetDefaultPackage(const AValue: TPackage);
procedure SetDefaults(const AValue: TDefaults); procedure SetDefaults(const AValue: TCustomDefaults);
procedure SetStrings(AIndex : Integer; const AValue: TStrings); procedure SetStrings(AIndex : Integer; const AValue: TStrings);
procedure SetOses(const AValue: TOSes); procedure SetOses(const AValue: TOSes);
Protected Protected
@ -615,7 +647,7 @@ Type
Procedure GetSourceFiles; virtual; Procedure GetSourceFiles; virtual;
Property BuildEngine : TBuildEngine Read FBuildEngine; Property BuildEngine : TBuildEngine Read FBuildEngine;
Public Public
Constructor Create(AOWner : TComponent); override; Constructor Create(AOwner : TComponent); virtual; abstract;
Destructor destroy; override; Destructor destroy; override;
Function StartPackage(Const AName : String) : TPackage; Function StartPackage(Const AName : String) : TPackage;
Procedure EndPackage; Procedure EndPackage;
@ -628,9 +660,10 @@ Type
Property InstallFiles : TStrings Index 1 Read GetStrings Write SetStrings; Property InstallFiles : TStrings Index 1 Read GetStrings Write SetStrings;
Property CleanFiles : TStrings Index 2 Read GetStrings Write SetStrings; Property CleanFiles : TStrings Index 2 Read GetStrings Write SetStrings;
Property ArchiveFiles : TStrings Index 3 Read GetStrings Write SetStrings; Property ArchiveFiles : TStrings Index 3 Read GetStrings Write SetStrings;
Property Defaults : TDefaults Read FDefaults Write SetDefaults; Property Defaults : TCustomDefaults Read FDefaults Write SetDefaults;
Property RunMode : TRunMode Read FRunMode; Property RunMode : TRunMode Read FRunMode;
Property ListMode : Boolean Read FListMode; Property ListMode : Boolean Read FListMode;
Property BaseInstallDir : String Read GetBaseInstallDir Write SetBaseInstallDir;
// Default Package redirects. // Default Package redirects.
Property Targets : TTargets Read GetTargets; Property Targets : TTargets Read GetTargets;
Property Sources : TSources Read GetSources; Property Sources : TSources Read GetSources;
@ -647,6 +680,17 @@ Type
Property FileName : String Index 9 Read GetPackageString Write SetPackageString; Property FileName : String Index 9 Read GetPackageString Write SetPackageString;
end; end;
{ TFPCInstaller }
TFPCInstaller = class(TCustomInstaller)
public
Constructor Create(AOwner : TComponent); override;
end;
{ TBasicInstaller }
TBasicInstaller = class(TCustomInstaller)
Constructor Create(AOwner : TComponent); override;
end;
TReplaceFunction = Function (Const AName,Args : String) : String of Object; TReplaceFunction = Function (Const AName,Args : String) : String of Object;
{ TValueItem } { TValueItem }
@ -682,16 +726,14 @@ Type
EDictionaryError = Class(Exception); EDictionaryError = Class(Exception);
EInstallerError = Class(Exception); EInstallerError = Class(Exception);
TInstallerClass = Class of TInstaller; TInstallerClass = Class of TCustomInstaller;
TDictionaryClass = Class of TDictionary; TDictionaryClass = Class of TDictionary;
Type Type
TArchiveEvent = Procedure (Const AFileName : String; List : TStrings) of Object; TArchiveEvent = Procedure (Const AFileName : String; List : TStrings) of Object;
TArchiveProc = Procedure (Const AFileName : String; List : TStrings); TArchiveProc = Procedure (Const AFileName : String; List : TStrings);
Var Var
InstallerClass : TInstallerClass = TInstaller;
DictionaryClass : TDictionaryClass = TDictionary; DictionaryClass : TDictionaryClass = TDictionary;
OnArchiveFiles : TArchiveEvent = Nil; OnArchiveFiles : TArchiveEvent = Nil;
ArchiveFilesProc : TArchiveProc = Nil; ArchiveFilesProc : TArchiveProc = Nil;
@ -699,8 +741,10 @@ Var
Function CurrentOS : String; Function CurrentOS : String;
Function CurrentCPU : String; Function CurrentCPU : String;
Function Installer : TInstaller; Function Installer(InstallerClass: TInstallerClass) : TCustomInstaller; overload;
Function Defaults : TDefaults; // Set by installer. Function Installer : TCustomInstaller; overload;
Function Defaults : TCustomDefaults; // Set by installer.
Function Dictionary : TDictionary; Function Dictionary : TDictionary;
Function OSToString(OS: TOS) : String; Function OSToString(OS: TOS) : String;
@ -952,16 +996,13 @@ begin
end; end;
Function AddStrings(Dest,Src : TStrings) : Integer ; Function AddStrings(Dest,Src : TStrings) : Integer ;
begin begin
Result:=AddStrings(Dest,Src,''); Result:=AddStrings(Dest,Src,'');
end; end;
Procedure AddStrings(Var S : String; L : TStrings; Prefix : String); Procedure AddStrings(Var S : String; L : TStrings; Prefix : String);
Var Var
I : Integer; I : Integer;
begin begin
For I:=0 to L.Count-1 do For I:=0 to L.Count-1 do
begin begin
@ -1015,7 +1056,7 @@ begin
P:=PChar(Result); P:=PChar(Result);
While (P^<>#0) do While (P^<>#0) do
begin begin
If P^ in ['/','\',':'] then // do not use drive letters. If P^ in ['/','\'] then
P^:=PathDelim; P^:=PathDelim;
Inc(P); Inc(P);
end; end;
@ -1250,38 +1291,38 @@ begin
Result:=TNamedItem(Items[i]); Result:=TNamedItem(Items[i]);
end; end;
{ TDefaults } { TCustomDefaults }
procedure TDefaults.SetCPU(const AValue: TCPU); procedure TCustomDefaults.SetCPU(const AValue: TCPU);
begin begin
FCPU:=AValue; FCPU:=AValue;
RecalcTarget; RecalcTarget;
end; end;
function TDefaults.GetBaseInstallDir: String; function TCustomDefaults.GetBaseInstallDir: String;
begin begin
If (FBaseInstallDir<>'') then If (FBaseInstallDir<>'') then
Result:=FBaseInstallDir Result:=FBaseInstallDir
else else
if UnixPaths then if UnixPaths then
Result:=Prefix+PathDelim+'lib'+PathDelim+'fpc' Result:=Prefix +'lib' + PathDelim + 'fpc'
else else
Result:=Prefix; Result:=Prefix;
end; end;
function TDefaults.GetBinInstallDir: String; function TCustomDefaults.GetBinInstallDir: String;
begin begin
If (FBinInstallDir<>'') then If (FBinInstallDir<>'') then
Result:=FBinInstallDir Result:=FBinInstallDir
else else
If UnixPaths then If UnixPaths then
Result:=BaseInstallDir+PathDelim+'bin' Result:=BaseInstallDir+'bin'
else else
Result:=BaseInstallDir+PathDelim+'bin'; Result:=BaseInstallDir+'bin';
end; end;
function TDefaults.GetCompiler: String; function TCustomDefaults.GetCompiler: String;
begin begin
If (FCompiler<>'') then If (FCompiler<>'') then
Result:=FCompiler Result:=FCompiler
@ -1289,61 +1330,61 @@ begin
Result:='fpc'; Result:='fpc';
end; end;
function TDefaults.GetDocInstallDir: String; function TCustomDefaults.GetDocInstallDir: String;
begin begin
If (FBinInstallDir<>'') then If (FBinInstallDir<>'') then
Result:=FBinInstallDir Result:=FBinInstallDir
else else
If UnixPaths then If UnixPaths then
Result:=Prefix+PathDelim+'share'+PathDelim+'docs' Result:=Prefix +'share'+PathDelim+'docs'
else else
Result:=BaseInstallDir+PathDelim+'docs'; Result:=BaseInstallDir+'docs';
end; end;
function TDefaults.GetExamplesInstallDir: String; function TCustomDefaults.GetExamplesInstallDir: String;
begin begin
If (FExamplesInstallDir<>'') then If (FExamplesInstallDir<>'') then
Result:=FExamplesInstallDir Result:=FExamplesInstallDir
else else
If UnixPaths then If UnixPaths then
Result:=Prefix+PathDelim+'share'+PathDelim+'docs'+PathDelim+'examples' Result:=Prefix +'share'+PathDelim+'docs'+PathDelim+'examples'
else else
Result:=BaseInstallDir+PathDelim+'examples'; Result:=BaseInstallDir+'examples';
end; end;
function TDefaults.GetUnitInstallDir: String; function TCustomDefaults.GetUnitInstallDir: String;
begin begin
If (FUnitInstallDir<>'') then If (FUnitInstallDir<>'') then
Result:=FUnitInstallDir Result:=FUnitInstallDir
else else
If UnixPaths then If UnixPaths then
Result:=BaseInstallDir+PathDelim+'units'+PathDelim+Target Result:=BaseInstallDir+'units'+PathDelim+Target
else else
Result:=BaseInstallDir+PathDelim+'units'+PathDelim+Target; Result:=BaseInstallDir+'units'+PathDelim+Target;
end; end;
procedure TDefaults.SetBaseInstallDir(const AValue: String); procedure TCustomDefaults.SetBaseInstallDir(const AValue: String);
begin begin
FBaseInstallDir:=AValue; FBaseInstallDir:=IncludeTrailingPathDelimiter(AValue);
UnitInstallDir:=''; UnitInstallDir:='';
BinInstallDir:=''; BinInstallDir:='';
ExamplesInstallDir:=''; ExamplesInstallDir:='';
end; end;
procedure TDefaults.SetOS(const AValue: TOS); procedure TCustomDefaults.SetOS(const AValue: TOS);
begin begin
FOS:=AValue; FOS:=AValue;
Recalctarget; Recalctarget;
end; end;
procedure TDefaults.SetPrefix(const AValue: String); procedure TCustomDefaults.SetPrefix(const AValue: String);
begin begin
if FPrefix=AValue then exit; if FPrefix=AValue then exit;
FPrefix:=AValue; FPrefix:=IncludeTrailingPathDelimiter(AValue);
BaseInstallDir:=''; BaseInstallDir:='';
end; end;
procedure TDefaults.SetTarget(const AValue: String); procedure TCustomDefaults.SetTarget(const AValue: String);
Var Var
P : Integer; P : Integer;
@ -1363,17 +1404,17 @@ begin
end; end;
end; end;
procedure TDefaults.RecalcTarget; procedure TCustomDefaults.RecalcTarget;
begin begin
Ftarget:=CPUToString(FCPU)+'-'+OStoString(FOS); Ftarget:=CPUToString(FCPU)+'-'+OStoString(FOS);
end; end;
constructor TDefaults.Create; constructor TCustomDefaults.Create;
begin begin
InitDefaults; InitDefaults;
end; end;
procedure TDefaults.InitDefaults; procedure TCustomDefaults.InitDefaults;
begin begin
{$ifdef unix} {$ifdef unix}
UnixPaths:=True; UnixPaths:=True;
@ -1382,15 +1423,15 @@ begin
{$endif} {$endif}
end; end;
procedure TDefaults.Assign(ASource: TPersistent); procedure TCustomDefaults.Assign(ASource: TPersistent);
Var Var
d : TDefaults; d : TCustomDefaults;
begin begin
If ASource is TDefaults then If ASource is TCustomDefaults then
begin begin
D:=ASource as TDefaults; D:=ASource as TCustomDefaults;
FArchive:=D.Farchive; FArchive:=D.Farchive;
FCompiler:=D.Compiler; FCompiler:=D.Compiler;
FCopy:=D.FCopy; FCopy:=D.FCopy;
@ -1412,7 +1453,7 @@ begin
end; end;
end; end;
procedure TDefaults.LocalInit(Const AFileName : String); procedure TCustomDefaults.LocalInit(Const AFileName : String);
Var Var
FN : String; FN : String;
@ -1446,7 +1487,7 @@ begin
end; end;
procedure TDefaults.CompilerDefaults; procedure TCustomDefaults.CompilerDefaults;
begin begin
if Compiler<>'' then if Compiler<>'' then
Compiler:='fpc'; Compiler:='fpc';
@ -1456,32 +1497,9 @@ begin
OS:=StringToOS({$I %FPCTARGETOS%}); OS:=StringToOS({$I %FPCTARGETOS%});
if FCompilerVersion='' then if FCompilerVersion='' then
FCompilerVersion:='2.0.4'; FCompilerVersion:='2.0.4';
if (FBaseInstallDir='') and (FPrefix='') then
begin
// Use the same algorithm as the compiler, see options.pas
{$ifdef Unix}
FBaseInstallDir:=FixPath(GetEnvironmentVariable('FPCDIR'));
if FBaseInstallDir='' then
begin
FBaseInstallDir:='/usr/local/lib/fpc/'+FCompilerVersion;
if not DirectoryExists(FBaseInstallDir) and
DirectoryExists('/usr/lib/fpc/'+FCompilerVersion) then
FBaseInstallDir:='/usr/lib/fpc/'+FCompilerVersion;
end;
{$else unix}
FBaseInstallDir:=FixPath(GetEnvironmentVariable('FPCDIR'));
if FBaseInstallDir='' then
begin
FBaseInstallDir:=ExtractFilePath(FCompiler)+'..';
if not(DirectoryExists(FBaseInstallDir+'/units')) and
not(DirectoryExists(FBaseInstallDir+'/rtl')) then
FBaseInstallDir:=FBaseInstallDir+'..';
end;
{$endif unix}
end;
end; end;
procedure TDefaults.LoadFromFile(Const AFileName: String); procedure TCustomDefaults.LoadFromFile(Const AFileName: String);
Var Var
F : TFileStream; F : TFileStream;
@ -1495,7 +1513,7 @@ begin
end; end;
end; end;
procedure TDefaults.SaveToFile(Const AFileName: String); procedure TCustomDefaults.SaveToFile(Const AFileName: String);
Var Var
F : TFileStream; F : TFileStream;
@ -1509,7 +1527,7 @@ begin
end; end;
end; end;
procedure TDefaults.SaveToStream(S : TStream); procedure TCustomDefaults.SaveToStream(S : TStream);
Var Var
L : TStringList; L : TStringList;
@ -1543,7 +1561,7 @@ begin
end; end;
end; end;
procedure TDefaults.LoadFromStream(S: TStream); procedure TCustomDefaults.LoadFromStream(S: TStream);
Var Var
L : TStrings; L : TStrings;
@ -1597,6 +1615,37 @@ begin
end; end;
end; end;
{ TFPCDefaults }
procedure TFPCDefaults.CompilerDefaults;
begin
inherited CompilerDefaults;
if (FBaseInstallDir='') and (FPrefix='') then
begin
// Use the same algorithm as the compiler, see options.pas
{$ifdef Unix}
FBaseInstallDir:=FixPath(GetEnvironmentVariable('FPCDIR'));
if FBaseInstallDir='' then
begin
FBaseInstallDir:='/usr/local/lib/fpc/'+FCompilerVersion;
if not DirectoryExists(FBaseInstallDir) and
DirectoryExists('/usr/lib/fpc/'+FCompilerVersion) then
FBaseInstallDir:='/usr/lib/fpc/'+FCompilerVersion;
end;
{$else unix}
FBaseInstallDir:=FixPath(GetEnvironmentVariable('FPCDIR'));
if FBaseInstallDir='' then
begin
FBaseInstallDir:=ExtractFilePath(FCompiler)+'..';
if not(DirectoryExists(FBaseInstallDir+'/units')) and
not(DirectoryExists(FBaseInstallDir+'/rtl')) then
FBaseInstallDir:=FBaseInstallDir+'..';
end;
{$endif unix}
end;
end;
{ TPackage } { TPackage }
function TPackage.GetHasStrings(AIndex: integer): Boolean; function TPackage.GetHasStrings(AIndex: integer): Boolean;
@ -1860,19 +1909,17 @@ begin
FSources.SourceItems[I].GetSourceFiles(List); FSources.SourceItems[I].GetSourceFiles(List);
end; end;
procedure TPackage.GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix : String; AOS : TOS); procedure TPackage.GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix, APrefixU, APrefixB: String; AOS : TOS);
Var Var
I : Integer; I : Integer;
T : TTarget; T : TTarget;
begin begin
AddStrings(List,InstallFiles,APrefix); AddStrings(List,InstallFiles,APrefix);
For I:=0 to FTargets.Count-1 do For I:=0 to FTargets.Count-1 do
begin begin
T:=FTargets.TargetItems[I]; T:=FTargets.TargetItems[I];
if (T.TargetType in Types) then if (T.TargetType in Types) then
T.GetInstallFiles(List,APrefix,AOS); T.GetInstallFiles(List, APrefixU, APrefixB, AOS);
end; end;
end; end;
@ -1953,9 +2000,9 @@ begin
end; end;
{ TInstaller } { TCustomInstaller }
function TInstaller.GetStrings(AIndex : Integer): TStrings; function TCustomInstaller.GetStrings(AIndex : Integer): TStrings;
begin begin
CheckDefaultPackage; CheckDefaultPackage;
Case AIndex of Case AIndex of
@ -1966,7 +2013,12 @@ begin
end; end;
end; end;
Function TInstaller.GetPackageString(Index : Integer) : String; function TCustomInstaller.GetBaseInstallDir: string;
begin
Result := Defaults.BaseInstallDir;
end;
Function TCustomInstaller.GetPackageString(Index : Integer) : String;
Var Var
P : TPackage; P : TPackage;
@ -1990,7 +2042,7 @@ begin
end; end;
Procedure TInstaller.SetPackageString(Index : Integer; AValue : String); Procedure TCustomInstaller.SetPackageString(Index : Integer; AValue : String);
Var Var
P : TPackage; P : TPackage;
@ -2013,36 +2065,42 @@ begin
end; end;
function TInstaller.GetOSes: TOSes; function TCustomInstaller.GetOSes: TOSes;
begin begin
CheckDefaultPackage; CheckDefaultPackage;
Result:=DefaultPackage.OS; Result:=DefaultPackage.OS;
end; end;
function TInstaller.GetTargets: TTargets; function TCustomInstaller.GetTargets: TTargets;
begin begin
CheckDefaultPackage; CheckDefaultPackage;
Result:=DefaultPackage.Targets; Result:=DefaultPackage.Targets;
end; end;
function TInstaller.GetSources: TSources; function TCustomInstaller.GetSources: TSources;
begin begin
CheckDefaultPackage; CheckDefaultPackage;
Result:=DefaultPackage.Sources; Result:=DefaultPackage.Sources;
end; end;
procedure TInstaller.SetDefaultPackage(const AValue: TPackage); procedure TCustomInstaller.SetBaseInstallDir(AValue: string);
begin
if AValue <> Defaults.BaseInstallDir then
Defaults.BaseInstallDir := AValue;
end;
procedure TCustomInstaller.SetDefaultPackage(const AValue: TPackage);
begin begin
if FDefaultPackage=AValue then exit; if FDefaultPackage=AValue then exit;
FDefaultPackage:=AValue; FDefaultPackage:=AValue;
end; end;
procedure TInstaller.SetDefaults(const AValue: TDefaults); procedure TCustomInstaller.SetDefaults(const AValue: TCustomDefaults);
begin begin
FDefaults.Assign(AValue); FDefaults.Assign(AValue);
end; end;
procedure TInstaller.SetStrings(AIndex : Integer; const AValue: TStrings); procedure TCustomInstaller.SetStrings(AIndex : Integer; const AValue: TStrings);
Var Var
Res : TStrings; Res : TStrings;
@ -2058,24 +2116,24 @@ begin
Res.Assign(Avalue); Res.Assign(Avalue);
end; end;
procedure TInstaller.SetOses(const AValue: TOSes); procedure TCustomInstaller.SetOses(const AValue: TOSes);
begin begin
CheckDefaultPackage; CheckDefaultPackage;
DefaultPackage.OS:=AValue; DefaultPackage.OS:=AValue;
end; end;
procedure TInstaller.Log(Level: TVerboseLevel; const Msg: String); procedure TCustomInstaller.Log(Level: TVerboseLevel; const Msg: String);
begin begin
If Level in FLogLevels then If Level in FLogLevels then
Writeln(StdErr,Msg); Writeln(StdErr,Msg);
end; end;
procedure TInstaller.CreatePackages; procedure TCustomInstaller.CreatePackages;
begin begin
FPAckages:=TPackages.Create(TPackage); FPAckages:=TPackages.Create(TPackage);
end; end;
procedure TInstaller.CreateBuildEngine; procedure TCustomInstaller.CreateBuildEngine;
begin begin
FBuildEngine:=TBuildEngine.Create(Self); FBuildEngine:=TBuildEngine.Create(Self);
FBuildEngine.Defaults:=Defaults; FBuildEngine.Defaults:=Defaults;
@ -2083,34 +2141,34 @@ begin
FBuildEngine.OnLog:=@Self.Log; FBuildEngine.OnLog:=@Self.Log;
end; end;
procedure TInstaller.CheckDefaultPackage; procedure TCustomInstaller.CheckDefaultPackage;
begin begin
If (FDefaultPackage=Nil) then If (FDefaultPackage=Nil) then
Raise EInstallerError.Create(SErrNoPackage); Raise EInstallerError.Create(SErrNoPackage);
end; end;
procedure TInstaller.Error(Msg: String); procedure TCustomInstaller.Error(Msg: String);
begin begin
Raise EInstallerError.Create(Msg); Raise EInstallerError.Create(Msg);
end; end;
procedure TInstaller.Error(Fmt: String; Args: array of const); procedure TCustomInstaller.Error(Fmt: String; Args: array of const);
begin begin
Raise EInstallerError.CreateFmt(Fmt,Args); Raise EInstallerError.CreateFmt(Fmt,Args);
end; end;
Function TInstaller.StartPackage(const AName: String) : TPackage; Function TCustomInstaller.StartPackage(const AName: String) : TPackage;
begin begin
FDefaultPackage:=FPackages.AddPackage(AName); FDefaultPackage:=FPackages.AddPackage(AName);
Result:=FDefaultPackage; Result:=FDefaultPackage;
end; end;
procedure TInstaller.EndPackage; procedure TCustomInstaller.EndPackage;
begin begin
FDefaultPackage:=Nil; FDefaultPackage:=Nil;
end; end;
procedure TInstaller.AnalyzeOptions; procedure TCustomInstaller.AnalyzeOptions;
Function CheckOption(Index : Integer;Short,Long : String): Boolean; Function CheckOption(Index : Integer;Short,Long : String): Boolean;
@ -2228,9 +2286,7 @@ begin
{$endif} {$endif}
end; end;
procedure TCustomInstaller.Usage(FMT: String; Args: array of const);
procedure TInstaller.Usage(FMT: String; Args: array of const);
Procedure WriteCmd(LC : String; Msg : String); Procedure WriteCmd(LC : String; Msg : String);
@ -2280,28 +2336,28 @@ begin
halt(0); halt(0);
end; end;
procedure TInstaller.Compile(Force: Boolean); procedure TCustomInstaller.Compile(Force: Boolean);
begin begin
FBuildEngine.ForceCompile:=Force; FBuildEngine.ForceCompile:=Force;
FBuildEngine.Compile(FPackages); FBuildEngine.Compile(FPackages);
end; end;
procedure TInstaller.Clean; procedure TCustomInstaller.Clean;
begin begin
BuildEngine.Clean(FPackages); BuildEngine.Clean(FPackages);
end; end;
procedure TInstaller.Install; procedure TCustomInstaller.Install;
begin begin
BuildEngine.Install(FPackages); BuildEngine.Install(FPackages);
end; end;
procedure TInstaller.Archive; procedure TCustomInstaller.Archive;
begin begin
FBuildEngine.Archive(FPackages); FBuildEngine.Archive(FPackages);
end; end;
procedure TInstaller.Manifest; procedure TCustomInstaller.Manifest;
Var Var
L : TStrings; L : TStrings;
@ -2317,7 +2373,7 @@ begin
end; end;
end; end;
procedure TInstaller.GetSourceFiles; procedure TCustomInstaller.GetSourceFiles;
Var Var
L : TStrings; L : TStrings;
@ -2333,22 +2389,13 @@ begin
end; end;
end; end;
destructor TCustomInstaller.destroy;
constructor TInstaller.Create(AOWner: TComponent);
begin
inherited Create(AOWner);
FDefaults:=TDefaults.Create;
AnalyzeOptions;
CreatePackages;
end;
destructor TInstaller.destroy;
begin begin
FreeAndNil(FDefaults); FreeAndNil(FDefaults);
inherited destroy; inherited destroy;
end; end;
procedure TInstaller.CheckPackages; procedure TCustomInstaller.CheckPackages;
begin begin
If (FPackages.Count=0) then If (FPackages.Count=0) then
@ -2356,7 +2403,7 @@ begin
// Check for other obvious errors ? // Check for other obvious errors ?
end; end;
Function TInstaller.Run : Boolean; Function TCustomInstaller.Run : Boolean;
begin begin
Result:=True; Result:=True;
@ -2382,21 +2429,39 @@ begin
end; end;
end; end;
function TInstaller.AddTarget(AName: String): TTarget; function TCustomInstaller.AddTarget(AName: String): TTarget;
begin begin
CheckDefaultPackage; CheckDefaultPackage;
Result:=DefaultPackage.AddTarget(AName); Result:=DefaultPackage.AddTarget(AName);
end; end;
procedure TInstaller.AddDependency(AName: String); procedure TCustomInstaller.AddDependency(AName: String);
begin begin
CheckDefaultPackage; CheckDefaultPackage;
DefaultPackage.AddDependency(AName); DefaultPackage.AddDependency(AName);
end; end;
{ TFPCInstaller }
constructor TFPCInstaller.Create(AOwner: TComponent);
begin
FDefaults:=TFPCDefaults.Create;
AnalyzeOptions;
CreatePackages;
end;
{ TBasicInstaller }
constructor TBasicInstaller.Create(AOwner: TComponent);
begin
FDefaults:=TBasicDefaults.Create;
AnalyzeOptions;
CreatePackages;
end;
{ TBuildEngine } { TBuildEngine }
procedure TBuildEngine.SetDefaults(const AValue: TDefaults); procedure TBuildEngine.SetDefaults(const AValue: TCustomDefaults);
begin begin
FDefaults.Assign(AValue); FDefaults.Assign(AValue);
end; end;
@ -2420,7 +2485,7 @@ end;
constructor TBuildEngine.Create(AOwner: TComponent); constructor TBuildEngine.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FDefaults:=TDefaults.Create; FDefaults:=TCustomDefaults.Create;
// Maybe this should be the current directory ? // Maybe this should be the current directory ?
// Or have it as a command-line option. // Or have it as a command-line option.
// Would allow to put all 'installers' in one dir and call them // Would allow to put all 'installers' in one dir and call them
@ -2914,7 +2979,7 @@ begin
Result:=''; Result:='';
If (APackage.Directory<>'') then If (APackage.Directory<>'') then
Result:=IncludeTrailingPathDelimiter(Result+APackage.Directory); Result:=IncludeTrailingPathDelimiter(Result+APackage.Directory);
Result:=Result + AName + PathDelim + Defaults.Target; Result := IncludeTrailingPathDelimiter(Result + AName + PathDelim + Defaults.Target);
end; end;
end; end;
@ -3058,11 +3123,14 @@ Procedure TBuildEngine.InstallPackageFiles(APAckage : TPackage; tt : TTargetType
Var Var
List : TStringList; List : TStringList;
UnitsDir: string;
BinDir: string;
begin begin
List:=TStringList.Create; List:=TStringList.Create;
Try Try
APackage.GetInstallFiles(List,[tt],Src,Defaults.OS); UnitsDir := GetUnitsOutputDir(APackage);
BinDir := GetBinOutputDir(APackage);
APackage.GetInstallFiles(List,[tt],Src, UnitsDir, BinDir, Defaults.OS);
if (List.Count>0) then if (List.Count>0) then
CmdCopyFiles(List,Dest); CmdCopyFiles(List,Dest);
Finally Finally
@ -3129,17 +3197,19 @@ end;
procedure TBuildEngine.Archive(APackage: TPackage); procedure TBuildEngine.Archive(APackage: TPackage);
Var Var
L : TStrings; L : TStrings;
A : String; A : String;
UnitsDir: string;
BinDir: string;
begin begin
Log(vlInfo,SLogArchivingPackage,[APackage.Name]); Log(vlInfo,SLogArchivingPackage,[APackage.Name]);
DoBeforeArchive(Apackage); DoBeforeArchive(Apackage);
L:=TStringList.Create; L:=TStringList.Create;
Try Try
APackage.GetInstallFiles(L,[ttUnit],TargetDir,Defaults.OS); UnitsDir := GetUnitsOutputDir(APackage);
BinDir := GetUnitsOutputDir(APackage);
APackage.GetInstallFiles(L,[ttUnit], TargetDir, UnitsDir, BinDir, Defaults.OS);
A:=APackage.Name+ZipExt; A:=APackage.Name+ZipExt;
CmdArchiveFiles(L,A); CmdArchiveFiles(L,A);
Finally Finally
@ -3488,13 +3558,13 @@ procedure TTarget.GetCleanFiles(List: TStrings; APrefixU, APrefixB : String; AnO
begin begin
If (OS=[]) or (AnOS in OS) then If (OS=[]) or (AnOS in OS) then
begin begin
List.Add(APrefixU+ObjectFileName); List.Add(APrefixU + ObjectFileName);
If (TargetType in [ttUnit,ttExampleUnit]) then If (TargetType in [ttUnit,ttExampleUnit]) then
List.Add(APrefixU+UnitFileName) List.Add(APrefixU + UnitFileName)
else If (TargetType in [ttProgram,ttExampleProgram]) then else If (TargetType in [ttProgram,ttExampleProgram]) then
List.Add(APrefixB+GetProgramFileName(AnOS)); List.Add(APrefixB + GetProgramFileName(AnOS));
If ResourceStrings then If ResourceStrings then
List.Add(APrefixU+RSTFileName); List.Add(APrefixU + RSTFileName);
// Maybe add later ? AddStrings(List,CleanFiles); // Maybe add later ? AddStrings(List,CleanFiles);
end; end;
end; end;
@ -3514,18 +3584,18 @@ begin
end; end;
end; end;
procedure TTarget.GetInstallFiles(List: TStrings; APrefix : String; AnOS : TOS); procedure TTarget.GetInstallFiles(List: TStrings; APrefixU, APrefixB: String; AnOS : TOS);
begin begin
If (OS=[]) or (AnOS in OS) then If (OS=[]) or (AnOS in OS) then
begin begin
If Not (TargetType in [ttProgram,ttExampleProgram]) then If Not (TargetType in [ttProgram,ttExampleProgram]) then
List.Add(APrefix+ObjectFileName); List.Add(APrefixU + ObjectFileName);
If (TargetType in [ttUnit,ttExampleUnit]) then If (TargetType in [ttUnit,ttExampleUnit]) then
List.Add(APrefix+UnitFileName) List.Add(APrefixU + UnitFileName)
else If (TargetType in [ttProgram,ttExampleProgram]) then else If (TargetType in [ttProgram,ttExampleProgram]) then
List.Add(APrefix+GetProgramFileName(AnOS)); List.Add(APrefixB + GetProgramFileName(AnOS));
If ResourceStrings then If ResourceStrings then
List.Add(APrefix+RSTFileName); List.Add(APrefixU + RSTFileName);
// Maybe add later ? AddStrings(List,InstallFiles); // Maybe add later ? AddStrings(List,InstallFiles);
end; end;
end; end;
@ -3615,18 +3685,22 @@ begin
end; end;
Var Var
DefInstaller : TInstaller = Nil; DefInstaller : TCustomInstaller = Nil;
DefDictionary : TDictionary = Nil; DefDictionary : TDictionary = Nil;
Function Installer : TInstaller; Function Installer(InstallerClass: TInstallerClass): TCustomInstaller;
begin begin
If Not Assigned(DefInstaller) then If Not Assigned(DefInstaller) then
DefInstaller:=InstallerClass.Create(Nil); DefInstaller:=InstallerClass.Create(Nil);
Result:=DefInstaller; Result:=DefInstaller;
end; end;
Function Defaults : TDefaults; Function Installer: TCustomInstaller;
begin
Result := Installer(TFPCInstaller);
end;
Function Defaults : TCustomDefaults;
begin begin
Result:=Installer.Defaults; Result:=Installer.Defaults;
@ -3777,10 +3851,8 @@ begin
end; end;
Function Substitute(Const Source : String; Macros : Array of string) : String; Function Substitute(Const Source : String; Macros : Array of string) : String;
Var Var
I : Integer; I : Integer;
begin begin
I:=0; I:=0;
While I<High(Macros) do While I<High(Macros) do