Permalink
Fetching contributors…
Cannot retrieve contributors at this time
379 lines (321 sloc) 11.4 KB
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: PackageUtils.pas, released on 2004-03-29.
The Initial Developer of the Original Code is Andreas Hausladen
(Andreas dott Hausladen att gmx dott de)
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
All Rights Reserved.
Contributor(s): -
You may retrieve the latest version of this file at the Project JEDI's JVCL
home page, located at http://jvcl.delphi-jedi.org
Known Issues:
-----------------------------------------------------------------------------}
// $Id$
unit PackageUtils;
{$I jvcl.inc}
interface
uses
SysUtils, Classes, Contnrs,
JclBase,
Utils, DelphiData, Intf, GenerateUtils, PackageInformation;
type
TPackageTarget = class;
TProjectGroup = class;
TPackageGroupArray = array[{Personal:}Boolean, {Kind:}TPackageGroupKind] of TProjectGroup;
/// <summary>
/// TFrameworks contains all possible package lists for the target. If
/// Items[x] is nil then there is no .bpg file for this target kind.
/// </summary>
TFrameworks = class(TObject)
private
FItems: TPackageGroupArray;
FTargetConfig: ITargetConfig;
function GetCount: Integer;
function GetItem(Personal: Boolean;
Kind: TPackageGroupKind): TProjectGroup;
public
constructor Create(ATargetConfig: ITargetConfig);
destructor Destroy; override;
property Items[Personal: Boolean; Kind: TPackageGroupKind] : TProjectGroup read GetItem;
property Count: Integer read GetCount;
property TargetConfig: ITargetConfig read FTargetConfig;
end;
/// <summary>
/// TPackageTarget contains a .bpl target and the .xml file in the
/// Info property. This class is used to specify if the package should be
/// compiled and/or installed. But it does not perform these actions itself.
/// </summary>
TPackageTarget = class(TBpgPackageTarget)
private
FLockInstallChange: Integer;
FJvDependencies: TStringList; // Strings[]: "JvXxxx-"[D|R] | "JvQXxxx-"[D|R]
// Objects[]: TRequiredPackage
FJclDependencies: TStringList; // Strings[]: "JvXxxx-"[D|R] | "JvQXxxx-"[D|R]
// Objects[]: TRequiredPackage
FCompile: Boolean;
FInstall: Boolean;
function GetDcpName: string;
procedure SetCompile(Value: Boolean);
procedure SetInstall(const Value: Boolean);
function GetJclDependenciesReqPkg(Index: Integer): TRequiredPackage;
function GetJvDependenciesReqPkg(Index: Integer): TRequiredPackage;
function GetOwner: TProjectGroup;
protected
procedure GetDependencies; override; // is called after alle package targets are created
public
constructor Create(AOwner: TPackageGroup; const ATargetName, ASourceName: string); override;
destructor Destroy; override;
function FindRuntimePackage: TPackageTarget;
property JvDependencies: TStringList read FJvDependencies;
property JvDependenciesReqPkg[Index: Integer]: TRequiredPackage read GetJvDependenciesReqPkg;
property JclDependencies: TStringList read FJclDependencies;
property JclDependenciesReqPkg[Index: Integer]: TRequiredPackage read GetJclDependenciesReqPkg;
property Compile: Boolean read FCompile write SetCompile;
property Install: Boolean read FInstall write SetInstall;
property DcpName: string read GetDcpName;
property Owner: TProjectGroup read GetOwner;
end;
/// <summary>
/// TProjectGroup contains the data from a .bpg (Borland Package Group) file.
/// </summary>
TProjectGroup = class(TPackageGroup)
private
FTargetConfig: ITargetConfig;
FOnCompileChange: TNotifyEvent;
function GetPackages(Index: Integer): TPackageTarget;
function GetTarget: TCompileTarget;
protected
procedure DoInstallChange; virtual;
function GetPackageTargetClass: TBpgPackageTargetClass; override;
public
constructor Create(ATargetConfig: ITargetConfig; const AFilename: string);
function GetBplNameOf(Package: TRequiredPackage): string; override;
function FindPackageByXmlName(const XmlName: string): TPackageTarget;
{ FindPackageByXmlName returns the TPackageTarget object that contains
the specified .xml file. }
property Packages[Index: Integer]: TPackageTarget read GetPackages; default;
property TargetConfig: ITargetConfig read FTargetConfig;
property Target: TCompileTarget read GetTarget;
property OnCompileChange: TNotifyEvent read FOnCompileChange;
end;
implementation
{$IFNDEF COMPILER12_UP}
uses
JvJCLUtils;
{$ENDIF ~COMPILER12_UP}
{ TFrameworks }
constructor TFrameworks.Create(ATargetConfig: ITargetConfig);
var
Kind: TPackageGroupKind;
begin
inherited Create;
FTargetConfig := ATargetConfig;
for Kind := pkFirst to pkLast do
begin
if FileExists(TargetConfig.GetBpgFilename(False, Kind)) then
FItems[False, Kind] := TProjectGroup.Create(TargetConfig, TargetConfig.GetBpgFilename(False, Kind));
if FileExists(TargetConfig.GetBpgFilename(True, Kind)) then
FItems[True, Kind] := TProjectGroup.Create(TargetConfig, TargetConfig.GetBpgFilename(True, Kind));
end;
end;
destructor TFrameworks.Destroy;
var
Kind: TPackageGroupKind;
begin
for Kind := pkFirst to pkLast do
begin
FItems[False, Kind].Free;
FItems[True, Kind].Free;
end;
inherited Destroy;
end;
function TFrameworks.GetCount: Integer;
begin
Result := Length(FItems);
end;
function TFrameworks.GetItem(Personal: Boolean;
Kind: TPackageGroupKind): TProjectGroup;
begin
Result := FItems[Personal, Kind];
end;
{ TProjectGroup }
constructor TProjectGroup.Create(ATargetConfig: ITargetConfig; const AFilename: string);
begin
FTargetConfig := ATargetConfig;
inherited Create(AFilename, ATargetConfig.JVCLPackagesXmlDir, ATargetConfig.TargetSymbol, ATargetConfig.Target.Platform);
end;
procedure TProjectGroup.DoInstallChange;
begin
if Assigned(FOnCompileChange) then
FOnCompileChange(Self);
end;
function TProjectGroup.FindPackageByXmlName(const XmlName: string): TPackageTarget;
begin
Result := TPackageTarget(inherited FindPackageByXmlName(XmlName));
end;
function TProjectGroup.GetBplNameOf(Package: TRequiredPackage): string;
begin
if Utils.StartsWith(Package.Name, 'Jv', True) then
Result := inherited GetBplNameOf(Package)
else
Result := Package.Name;
end;
function TProjectGroup.GetPackages(Index: Integer): TPackageTarget;
begin
Result := TPackageTarget(inherited Packages[Index]);
end;
function TProjectGroup.GetPackageTargetClass: TBpgPackageTargetClass;
begin
Result := TPackageTarget;
end;
function TProjectGroup.GetTarget: TCompileTarget;
begin
Result := TargetConfig.Target;
end;
function SortProc_PackageTarget(Item1, Item2: Pointer): Integer;
var
p1, p2: TPackageTarget;
begin
p1 := Item1;
p2 := Item2;
Result := CompareText(p1.Info.DisplayName, p2.Info.DisplayName);
if Result = 0 then
begin
if ProjectTypeIsDesign(p1.Info.ProjectType) and not ProjectTypeIsDesign(p2.Info.ProjectType) then
Result := 1
else if not ProjectTypeIsDesign(p1.Info.ProjectType) and ProjectTypeIsDesign(p2.Info.ProjectType) then
Result := -1;
end;
end;
{ TPackageTarget }
constructor TPackageTarget.Create(AOwner: TPackageGroup; const ATargetName,
ASourceName: string);
begin
inherited Create(AOwner, ATargetName, ASourceName);
FJvDependencies := TStringList.Create;
FJvDependencies.Sorted := True;
FJclDependencies := TStringList.Create;
FJclDependencies.Sorted := True;
FCompile := True;
end;
destructor TPackageTarget.Destroy;
begin
FJvDependencies.Free;
FJclDependencies.Free;
inherited Destroy;
end;
/// <summary>
/// GetDependencies obtains the JVCL (JvXxx) and JCL ([D|C]JCLxx) dependencies
/// from the PackageInfo data. Only the JvXxx packages that are for this target
/// are added to the JvDependencies list. And only the [D|C]JCLxxx packages are
/// added to the JclDependencies list that are for this target. All items in
/// JvDependencies are physical files and are a valid JVCL target. All items in
/// JclDependencies must not be physical files.
/// </summary>
function TPackageTarget.FindRuntimePackage: TPackageTarget;
begin
Result := TPackageTarget(inherited FindRuntimePackage);
end;
function TPackageTarget.GetDcpName: string;
begin
Result := ChangeFileExt(ExtractFileName(SourceName), '.dcp');
end;
procedure TPackageTarget.GetDependencies;
var
i: Integer;
begin
FJvDependencies.Clear;
FJclDependencies.Clear;
for i := 0 to Info.RequireCount - 1 do
begin
// JVCL dependencies
if Utils.StartsWith(Info.Requires[i].Name, 'Jv', True) then // do not localize
begin
if FileExists(Info.XmlDir + '\' + Info.Requires[i].Name + '.xml') and // do not localize
(Owner.FindPackagebyXmlName(Info.Requires[i].Name) <> nil) and
Info.Requires[i].IsRequiredByTarget(Owner.TargetSymbol) then
begin
FJvDependencies.AddObject(Info.Requires[i].Name, Info.Requires[i]);
end;
end
else
// is it a JCL dependency
if Utils.StartsWith(Info.Requires[i].Name, 'Jcl', True) or // do not localize
Utils.StartsWith(Info.Requires[i].Name, 'JclD', True) or // do not localize
Utils.StartsWith(Info.Requires[i].Name, 'JclC', True) then // do not localize
begin
if Info.Requires[i].IsRequiredByTarget(Owner.TargetSymbol) then
FJclDependencies.AddObject(Info.Requires[i].Name, Info.Requires[i]);
end;
end;
end;
function TPackageTarget.GetJclDependenciesReqPkg(Index: Integer): TRequiredPackage;
begin
Result := TRequiredPackage(JclDependencies.Objects[Index]);
end;
function TPackageTarget.GetJvDependenciesReqPkg(Index: Integer): TRequiredPackage;
begin
Result := TRequiredPackage(JvDependencies.Objects[Index]);
end;
function TPackageTarget.GetOwner: TProjectGroup;
begin
Result := TProjectGroup(inherited Owner);
end;
procedure TPackageTarget.SetCompile(Value: Boolean);
var
i: Integer;
Pkg: TPackageTarget;
begin
if Value <> FCompile then
begin
FCompile := Value;
if not FCompile then
FInstall := False;
Inc(FLockInstallChange);
try
if FCompile then
begin
// activate packages on which this package depend on
for i := 0 to JvDependencies.Count - 1 do
begin
Pkg := Owner.FindPackagebyXmlName(JvDependencies[i]);
if Pkg <> nil then
Pkg.SetCompile(True);
end;
end
else
begin
// deactivate all packages which depend on this package
for i := 0 to Owner.Count - 1 do
begin
Pkg := Owner.Packages[i];
if Pkg <> Self then
begin
if Pkg.JvDependencies.IndexOf(Info.Name) <> -1 then
Pkg.Compile := False;
end;
end;
end;
finally
Dec(FLockInstallChange);
end;
if FLockInstallChange = 0 then
Owner.DoInstallChange;
end;
end;
procedure TPackageTarget.SetInstall(const Value: Boolean);
begin
if ProjectTypeIsDesign(Info.ProjectType) then
FInstall := Value
else
FInstall := False; // runtime packages are not installable.
if Value then
Compile := True;
end;
end.