* Replaced single events in TBuildEnine with TNotifyEventCollection. This

way multiple events can be bound on actions.
 * Added events to TCustomInstaller. The TBuildEngine is not initialized
   during the creation of the packages. So setting TBuildEngine-events
   was cumbersome.

git-svn-id: trunk@29363 -
This commit is contained in:
joost 2014-12-31 15:47:09 +00:00
parent f813703cf3
commit ff7ce315e6

View File

@ -422,6 +422,37 @@ Type
Property ConditionalStrings[Index : Integer] : TConditionalDestString Read GetConditionalString Write SetConditionalString; default; Property ConditionalStrings[Index : Integer] : TConditionalDestString Read GetConditionalString Write SetConditionalString; default;
end; end;
{ TNotifyEventCollection }
TNotifyEventAction = (neaBeforeCompile, neaAfterCompile, neaBeforeInstall, neaAfterInstall,
neaBeforeClean, neaAfterClean, neaBeforeArchive, neaAfterArchive,
neaBeforeManifest, neaAfterManifest, neaBeforePkgList, neaAfterPkgList,
neaBeforeCreateBuildEngine, neaAfterCreateBuildengine);
TNotifyEventActionSet = set of TNotifyEventAction;
TNotifyEventItem = class(TCollectionItem)
private
FOnAction: TNotifyEventAction;
FOnEvent: TNotifyEvent;
FOnProcEvent: TNotifyProcEvent;
public
property OnAction: TNotifyEventAction read FOnAction write FOnAction;
property OnEvent: TNotifyEvent read FOnEvent write FOnEvent;
property OnProcEvent: TNotifyProcEvent read FOnProcEvent write FOnProcEvent;
procedure CallEvent(Sender: TObject);
end;
TNotifyEventCollection = class(TCollection)
private
FSupportedActionSet: TNotifyEventActionSet;
public
constructor create(ASupportedActionSet: TNotifyEventActionSet);
procedure AppendEvent(AnAction: TNotifyEventAction; AnEvent: TNotifyEvent);
procedure AppendProcEvent(AnACtion: TNotifyEventAction; AnProcEvent: TNotifyProcEvent);
procedure CallEvents(AnAction: TNotifyEventAction; Sender: TObject);
end;
{ TDictionary } { TDictionary }
TReplaceFunction = Function (Const AName,Args : String) : String of Object; TReplaceFunction = Function (Const AName,Args : String) : String of Object;
@ -1057,18 +1088,7 @@ Type
FExternalPackages : TPackages; FExternalPackages : TPackages;
// Events // Events
FOnLog: TLogEvent; FOnLog: TLogEvent;
FAfterArchive: TNotifyEvent; FNotifyEventCollection: TNotifyEventCollection;
FAfterClean: TNotifyEvent;
FAfterCompile: TNotifyEvent;
FAfterInstall: TNotifyEvent;
FAfterManifest: TNotifyEvent;
FAfterPkgList: TNotifyEvent;
FBeforeArchive: TNotifyEvent;
FBeforeClean: TNotifyEvent;
FBeforeCompile: TNotifyEvent;
FBeforeInstall: TNotifyEvent;
FBeforeManifest: TNotifyEvent;
FBeforePkgList: TNotifyEvent;
FOnCopyFile: TCopyFileProc; FOnCopyFile: TCopyFileProc;
FOnFinishCopy: TNotifyEvent; FOnFinishCopy: TNotifyEvent;
@ -1187,18 +1207,7 @@ Type
Property ExternalPackages: TPackages Read FExternalPackages; Property ExternalPackages: TPackages Read FExternalPackages;
Property StartDir: String Read FStartDir; Property StartDir: String Read FStartDir;
// Events // Events
Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile; Property NotifyEventCollection: TNotifyEventCollection read FNotifyEventCollection;
Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
Property BeforeInstall : TNotifyEvent Read FBeforeInstall Write FBeforeInstall;
Property AfterInstall : TNotifyEvent Read FAfterInstall Write FAfterInstall;
Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
Property BeforeArchive : TNotifyEvent Read FBeforeArchive Write FBeforeArchive;
Property AfterArchive : TNotifyEvent Read FAfterArchive Write FAfterArchive;
Property BeforeManifest : TNotifyEvent Read FBeforeManifest Write FBeforeManifest;
Property AfterManifest : TNotifyEvent Read FAfterManifest Write FAfterManifest;
Property BeforePkgList : TNotifyEvent Read FBeforePkgList Write FBeforePkgList;
Property AfterPkgList : TNotifyEvent Read FAfterPkgList Write FAfterPkgList;
Property OnLog : TLogEvent Read FOnLog Write FOnlog; Property OnLog : TLogEvent Read FOnLog Write FOnlog;
end; end;
@ -1214,6 +1223,7 @@ Type
FFPMakeOptionsString: string; FFPMakeOptionsString: string;
FPackageVariantSettings: TStrings; FPackageVariantSettings: TStrings;
FPackageVariants: TFPList; FPackageVariants: TFPList;
FNotifyEventCollection: TNotifyEventCollection;
Protected Protected
Procedure Log(Level : TVerboseLevel; Const Msg : String); Procedure Log(Level : TVerboseLevel; Const Msg : String);
Procedure CreatePackages; virtual; Procedure CreatePackages; virtual;
@ -1244,6 +1254,7 @@ Type
Property Packages : TPackages Read GetPackages; Property Packages : TPackages Read GetPackages;
Property RunMode : TRunMode Read FRunMode; Property RunMode : TRunMode Read FRunMode;
Property ListMode : Boolean Read FListMode; Property ListMode : Boolean Read FListMode;
Property NotifyEventCollection : TNotifyEventCollection read FNotifyEventCollection;
end; end;
{ TFPCInstaller } { TFPCInstaller }
@ -1536,6 +1547,7 @@ ResourceString
SErrCouldNotCompile = 'Could not compile target %s from package %s'; SErrCouldNotCompile = 'Could not compile target %s from package %s';
SErrUnsupportedBuildmode = 'Package does not support this buildmode'; SErrUnsupportedBuildmode = 'Package does not support this buildmode';
SErrPackVarNotExist = 'There is no package variant with the name "%s"'; SErrPackVarNotExist = 'There is no package variant with the name "%s"';
SErrEventNotSupported = 'Unsupported event type';
SWarnCircularTargetDependency = 'Warning: Circular dependency detected when compiling target %s with target %s'; SWarnCircularTargetDependency = 'Warning: Circular dependency detected when compiling target %s with target %s';
SWarnCircularPackageDependency = 'Warning: Circular dependency detected when compiling package %s with package %s'; SWarnCircularPackageDependency = 'Warning: Circular dependency detected when compiling package %s with package %s';
@ -4409,6 +4421,10 @@ begin
GlobalDictionary.AddVariable('BuildString',Defaults.BuildString); GlobalDictionary.AddVariable('BuildString',Defaults.BuildString);
GlobalDictionary.AddVariable('Prefix',Defaults.Prefix); GlobalDictionary.AddVariable('Prefix',Defaults.Prefix);
GlobalDictionary.AddVariable('CompilerVersion',Defaults.CompilerVersion); GlobalDictionary.AddVariable('CompilerVersion',Defaults.CompilerVersion);
FNotifyEventCollection := TNotifyEventCollection.create([neaBeforeCompile, neaAfterCompile, neaBeforeClean, neaAfterClean,
neaBeforeInstall, neaAfterInstall, neaBeforeArchive, neaAfterArchive,
neaBeforeManifest, neaAfterManifest, neaBeforePkgList, neaAfterPkgList,
neaBeforeCreateBuildEngine, neaAfterCreateBuildengine]);
CreatePackages; CreatePackages;
end; end;
@ -4427,6 +4443,7 @@ begin
TPackageVariants(FPackageVariants.Items[i]).Free; TPackageVariants(FPackageVariants.Items[i]).Free;
end; end;
FreeAndNil(FPackageVariants); FreeAndNil(FPackageVariants);
FreeAndNil(FNotifyEventCollection);
inherited destroy; inherited destroy;
end; end;
@ -4458,11 +4475,13 @@ end;
procedure TCustomInstaller.CreateBuildEngine; procedure TCustomInstaller.CreateBuildEngine;
begin begin
NotifyEventCollection.CallEvents(neaBeforeCreateBuildEngine, Self);
FBuildEngine:=TBuildEngine.Create(Self); FBuildEngine:=TBuildEngine.Create(Self);
// FBuildEngine.Defaults:=Defaults; // FBuildEngine.Defaults:=Defaults;
FBuildEngine.ListMode:=FListMode; FBuildEngine.ListMode:=FListMode;
FBuildEngine.Verbose := (FLogLevels = AllMessages); FBuildEngine.Verbose := (FLogLevels = AllMessages);
FBuildEngine.OnLog:=@Self.Log; FBuildEngine.OnLog:=@Self.Log;
NotifyEventCollection.CallEvents(neaAfterCreateBuildengine, Self);
end; end;
@ -4784,25 +4803,33 @@ end;
procedure TCustomInstaller.Compile(Force: Boolean); procedure TCustomInstaller.Compile(Force: Boolean);
begin begin
FNotifyEventCollection.CallEvents(neaBeforeCompile, Self);
FBuildEngine.ForceCompile:=Force; FBuildEngine.ForceCompile:=Force;
FBuildEngine.Compile(Packages); FBuildEngine.Compile(Packages);
FNotifyEventCollection.CallEvents(neaAfterCompile, Self);
end; end;
procedure TCustomInstaller.Clean(AllTargets: boolean); procedure TCustomInstaller.Clean(AllTargets: boolean);
begin begin
NotifyEventCollection.CallEvents(neaBeforeClean, Self);
BuildEngine.Clean(Packages, AllTargets); BuildEngine.Clean(Packages, AllTargets);
NotifyEventCollection.CallEvents(neaAfterClean, Self);
end; end;
procedure TCustomInstaller.Install; procedure TCustomInstaller.Install;
begin begin
NotifyEventCollection.CallEvents(neaBeforeInstall, self);
BuildEngine.Install(Packages); BuildEngine.Install(Packages);
NotifyEventCollection.CallEvents(neaAfterInstall, self);
end; end;
procedure TCustomInstaller.ZipInstall; procedure TCustomInstaller.ZipInstall;
begin begin
NotifyEventCollection.CallEvents(neaBeforeInstall, self);
BuildEngine.ZipInstall(Packages); BuildEngine.ZipInstall(Packages);
NotifyEventCollection.CallEvents(neaAfterInstall, self);
end; end;
@ -4810,19 +4837,25 @@ procedure TCustomInstaller.Archive;
begin begin
// Force generation of manifest.xml, this is required for the repository // Force generation of manifest.xml, this is required for the repository
BuildEngine.Manifest(Packages); BuildEngine.Manifest(Packages);
NotifyEventCollection.CallEvents(neaBeforeArchive, self);
BuildEngine.Archive(Packages); BuildEngine.Archive(Packages);
NotifyEventCollection.CallEvents(neaAfterArchive, self);
end; end;
procedure TCustomInstaller.Manifest; procedure TCustomInstaller.Manifest;
begin begin
NotifyEventCollection.CallEvents(neaBeforeManifest, self);
BuildEngine.Manifest(Packages); BuildEngine.Manifest(Packages);
NotifyEventCollection.CallEvents(neaAfterManifest, self);
end; end;
procedure TCustomInstaller.PkgList; procedure TCustomInstaller.PkgList;
begin begin
NotifyEventCollection.CallEvents(neaBeforePkgList, self);
BuildEngine.PkgList(Packages); BuildEngine.PkgList(Packages);
NotifyEventCollection.CallEvents(neaAfterPkgList, self);
end; end;
@ -4904,7 +4937,9 @@ begin
// With --start-dir=/path/to/sources. // With --start-dir=/path/to/sources.
FStartDir:=includeTrailingPathDelimiter(GetCurrentDir); FStartDir:=includeTrailingPathDelimiter(GetCurrentDir);
FExternalPackages:=TPackages.Create(TPackage); FExternalPackages:=TPackages.Create(TPackage);
FNotifyEventCollection := TNotifyEventCollection.create([neaAfterCompile, neaBeforeCompile, neaAfterInstall, neaBeforeInstall,
neaAfterClean, neaBeforeClean, neaAfterArchive, neaBeforeArchive,
neaAfterManifest, neaBeforeManifest, neaAfterPkgList, neaBeforePkgList]);
{$ifndef NO_THREADING} {$ifndef NO_THREADING}
InitCriticalSection(FGeneralCriticalSection); InitCriticalSection(FGeneralCriticalSection);
{$endif NO_THREADING} {$endif NO_THREADING}
@ -4914,6 +4949,7 @@ end;
destructor TBuildEngine.Destroy; destructor TBuildEngine.Destroy;
begin begin
FreeAndNil(FExternalPackages); FreeAndNil(FExternalPackages);
FreeAndNil(FNotifyEventCollection);
{$ifndef NO_THREADING} {$ifndef NO_THREADING}
DoneCriticalsection(FGeneralCriticalSection); DoneCriticalsection(FGeneralCriticalSection);
@ -7264,8 +7300,7 @@ Var
{$endif NO_THREADING} {$endif NO_THREADING}
begin begin
If Assigned(BeforeCompile) then NotifyEventCollection.CallEvents(neaBeforeCompile, Self);
BeforeCompile(Self);
FProgressMax:=Packages.Count; FProgressMax:=Packages.Count;
FProgressCount:=0; FProgressCount:=0;
@ -7324,8 +7359,7 @@ begin
raise Exception.Create(ErrorMessage); raise Exception.Create(ErrorMessage);
{$endif NO_THREADING} {$endif NO_THREADING}
end; end;
If Assigned(AfterCompile) then NotifyEventCollection.CallEvents(neaAfterCompile, Self);
AfterCompile(Self);
end; end;
@ -7334,8 +7368,7 @@ Var
I : Integer; I : Integer;
P : TPackage; P : TPackage;
begin begin
If Assigned(BeforeInstall) then NotifyEventCollection.CallEvents(neaBeforeInstall, Self);
BeforeInstall(Self);
For I:=0 to Packages.Count-1 do For I:=0 to Packages.Count-1 do
begin begin
P:=Packages.PackageItems[i]; P:=Packages.PackageItems[i];
@ -7347,8 +7380,7 @@ begin
else else
log(vlWarning,SWarnSkipPackageTarget,[P.Name, Defaults.Target]); log(vlWarning,SWarnSkipPackageTarget,[P.Name, Defaults.Target]);
end; end;
If Assigned(AfterInstall) then NotifyEventCollection.CallEvents(neaAfterInstall, Self);
AfterInstall(Self);
end; end;
procedure TBuildEngine.ZipInstall(Packages: TPackages); procedure TBuildEngine.ZipInstall(Packages: TPackages);
@ -7358,8 +7390,7 @@ var
P : TPackage; P : TPackage;
begin begin
If Assigned(BeforeInstall) then NotifyEventCollection.CallEvents(neaBeforeInstall, Self);
BeforeInstall(Self);
if Defaults.UnixPaths then if Defaults.UnixPaths then
Defaults.IntSetBaseInstallDir('lib/fpc/' + Defaults.FCompilerVersion+ '/') Defaults.IntSetBaseInstallDir('lib/fpc/' + Defaults.FCompilerVersion+ '/')
@ -7382,8 +7413,7 @@ begin
FinishArchive(P); FinishArchive(P);
end; end;
If Assigned(AfterInstall) then NotifyEventCollection.CallEvents(neaAfterInstall, Self);
AfterInstall(Self);
end; end;
@ -7392,16 +7422,14 @@ Var
I : Integer; I : Integer;
P : TPackage; P : TPackage;
begin begin
If Assigned(BeforeArchive) then NotifyEventCollection.CallEvents(neaBeforeArchive, Self);
BeforeArchive(Self);
Log(vlDebug, SDbgBuildEngineArchiving); Log(vlDebug, SDbgBuildEngineArchiving);
For I:=0 to Packages.Count-1 do For I:=0 to Packages.Count-1 do
begin begin
P:=Packages.PackageItems[i]; P:=Packages.PackageItems[i];
Archive(P); Archive(P);
end; end;
If Assigned(AfterArchive) then NotifyEventCollection.CallEvents(neaAfterArchive, Self);
AfterArchive(Self);
end; end;
@ -7411,8 +7439,7 @@ Var
I : Integer; I : Integer;
P : TPackage; P : TPackage;
begin begin
If Assigned(BeforeManifest) then NotifyEventCollection.CallEvents(neaBeforeManifest, Self);
BeforeManifest(Self);
Log(vlDebug, SDbgBuildEngineGenerateManifests); Log(vlDebug, SDbgBuildEngineGenerateManifests);
L:=TStringList.Create; L:=TStringList.Create;
@ -7432,8 +7459,7 @@ begin
L.Free; L.Free;
end; end;
If Assigned(AfterManifest) then NotifyEventCollection.CallEvents(neaAfterManifest, Self);
AfterManifest(Self);
end; end;
@ -7445,8 +7471,7 @@ Var
PKGL : String; PKGL : String;
begin begin
L:=TStringList.Create; L:=TStringList.Create;
If Assigned(BeforePkgList) then NotifyEventCollection.CallEvents(neaBeforePkgList, Self);
BeforePkgList(Self);
Log(vlDebug, SDbgBuildEngineGeneratePkgList); Log(vlDebug, SDbgBuildEngineGeneratePkgList);
{ Consider only the target OS, because the installer would be run there } { Consider only the target OS, because the installer would be run there }
if Defaults.OS in AllLimit83fsOSes then if Defaults.OS in AllLimit83fsOSes then
@ -7471,8 +7496,7 @@ begin
L.Free; L.Free;
end; end;
If Assigned(AfterPkgList) then NotifyEventCollection.CallEvents(neaAfterPkgList, Self);
AfterPkgList(Self);
end; end;
procedure TBuildEngine.Clean(Packages: TPackages; AllTargets: boolean); procedure TBuildEngine.Clean(Packages: TPackages; AllTargets: boolean);
@ -7480,8 +7504,7 @@ Var
I : Integer; I : Integer;
P : TPackage; P : TPackage;
begin begin
If Assigned(BeforeClean) then NotifyEventCollection.CallEvents(neaBeforeClean, Self);
BeforeClean(Self);
Log(vldebug, SDbgBuildEngineCleaning); Log(vldebug, SDbgBuildEngineCleaning);
For I:=0 to Packages.Count-1 do For I:=0 to Packages.Count-1 do
begin begin
@ -7490,8 +7513,7 @@ begin
Clean(P, AllTargets); Clean(P, AllTargets);
log(vlWarning, SWarnCleanPackagecomplete, [P.Name]); log(vlWarning, SWarnCleanPackagecomplete, [P.Name]);
end; end;
If Assigned(AfterClean) then NotifyEventCollection.CallEvents(neaAfterClean, Self);
AfterClean(Self);
end; end;
{**************************************************************************** {****************************************************************************
@ -8164,6 +8186,62 @@ begin
FFunc:=AFunc; FFunc:=AFunc;
end; end;
{****************************************************************************
TNotifyEventItem
****************************************************************************}
procedure TNotifyEventItem.CallEvent(Sender: TObject);
begin
if assigned(OnEvent) then
OnEvent(Sender);
if assigned(OnProcEvent) then
OnProcEvent(sender);
end;
{****************************************************************************
TNotifyEventCollection
****************************************************************************}
constructor TNotifyEventCollection.create(ASupportedActionSet: TNotifyEventActionSet);
begin
FSupportedActionSet:=ASupportedActionSet;
inherited create(TNotifyEventItem);
end;
procedure TNotifyEventCollection.AppendEvent(AnAction: TNotifyEventAction; AnEvent: TNotifyEvent);
var
item: TNotifyEventItem;
begin
if not (AnAction in FSupportedActionSet) then
raise Exception.Create(SErrEventNotSupported);
item := TNotifyEventItem(add);
item.OnEvent:=AnEvent;
item.OnAction:=AnAction;
end;
procedure TNotifyEventCollection.AppendProcEvent(AnAction: TNotifyEventAction; AnProcEvent: TNotifyProcEvent);
var
item: TNotifyEventItem;
begin
if not (AnAction in FSupportedActionSet) then
raise Exception.Create(SErrEventNotSupported);
item := TNotifyEventItem(add);
item.OnProcEvent:=AnProcEvent;
item.OnAction:=AnAction;
end;
procedure TNotifyEventCollection.CallEvents(AnAction: TNotifyEventAction; Sender: TObject);
var
i: integer;
item: TNotifyEventItem;
begin
for i := 0 to Count-1 do
begin
item := TNotifyEventItem(Items[i]);
if item.OnAction=AnAction then
item.CallEvent(Sender);
end;
end;
{**************************************************************************** {****************************************************************************
TDictionary TDictionary