david
78ab77cd4c
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@19 7f62d464-2af8-f54e-996c-e91b33f51cbe
1331 lines
45 KiB
ObjectPascal
1331 lines
45 KiB
ObjectPascal
unit PackageGenerator;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Contnrs, Classes,
|
|
JclSimpleXml,
|
|
PackageInformation, GenerateDefines, GenerateTargets, GenerateAlias, GenerateReplacements, DefinesConditionParser;
|
|
|
|
type
|
|
TProjectProperties = class(TStringList)
|
|
public
|
|
constructor Create(Node: TJclSimpleXmlElem);
|
|
end;
|
|
|
|
TGenerateCallback = procedure (const msg : string);
|
|
|
|
TPackageGenerator = class(TObject)
|
|
private
|
|
FCallBack: TGenerateCallback;
|
|
FStartupDir : string;
|
|
FPackagesLocation : string;
|
|
FIncDefFileName : string;
|
|
FIncFileName : string;
|
|
FPrefix : string;
|
|
FNoLibSuffixPrefix : string;
|
|
FClxPrefix : string;
|
|
FDotNetPrefix : string;
|
|
FFormat : string;
|
|
FNoLibSuffixFormat : string;
|
|
FClxFormat : string;
|
|
FDotNetFormat : string;
|
|
FTargetList: TTargetList;
|
|
FAliasList: TAliasList;
|
|
FClxReplacementList: TClxReplacementList;
|
|
FIsBinaryCache: TStringList;
|
|
FProjectProperties: TProjectProperties;
|
|
FDefinesConditionParser: TDefinesConditionParser;
|
|
procedure SendMsg(const Msg : string);
|
|
function GetPersoTarget(const Target : string) : string;
|
|
function GetNonPersoTarget(const PersoTarget : string) : string;
|
|
function TargetToDir(const target : string) : string;
|
|
function ExpandPackageName(Name: string; const target : string) : string;
|
|
function HasModelPrefix(Name : string; const target:string): Boolean;
|
|
function BuildPackageName(xml: TRequiredPackage; const target : string) : string;
|
|
function IsNotInPerso(Item: TPackageXmlInfoItem; const target : string) : Boolean;
|
|
function IsOnlyInPerso(Item: TPackageXmlInfoItem; const target : string) : Boolean;
|
|
procedure EnsureProperSeparator(var Name : string; const target : string);
|
|
procedure ApplyFormName(ContainedFile: TContainedFile; index: Integer; Lines : TStrings;
|
|
const target : string);
|
|
function GetDescription(xml: TPackageXmlInfo; const target: string): string;
|
|
function ApplyTemplateAndSave(const path, target, package, extension: string;
|
|
template : TStrings; xml : TPackageXmlInfo;
|
|
const templateName, xmlName : string): string;
|
|
function LoadDefines(const Target: string; Filename: string): Boolean;
|
|
function IsBinaryFile(const Filename: string): Boolean;
|
|
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function LoadConfig(const XmlFileName : string; const ModelName : string; var ErrMsg : string) : Boolean;
|
|
function Generate(packages : TStrings;
|
|
targets : TStrings;
|
|
callback : TGenerateCallback;
|
|
const XmlFileName : string;
|
|
const ModelName : string;
|
|
var ErrMsg : string;
|
|
path : string = '';
|
|
prefix : string = '';
|
|
format : string = '';
|
|
incFileName : string = ''
|
|
) : Boolean;
|
|
procedure ExpandTargets(targets : TStrings);
|
|
procedure ExpandTargetsNoPerso(targets : TStrings);
|
|
property StartupDir: string read FStartupDir write FStartupDir;
|
|
property PackagesLocation: string read FPackagesLocation write FPackagesLocation;
|
|
property TargetList: TTargetList read FTargetList write FTargetList;
|
|
// property IncDefFileName : string read FIncDefFileName write FIncDefFileName ;
|
|
// property IncFileName : string read FIncFileName write FIncFileName ;
|
|
// property Prefix : string read FPrefix write FPrefix ;
|
|
// property NoLibSuffixPrefix : string read FNoLibSuffixPrefix write FNoLibSuffixPrefix;
|
|
// property ClxPrefix : string read FClxPrefix write FClxPrefix ;
|
|
// property DotNetPrefix : string read FDotNetPrefix write FDotNetPrefix ;
|
|
// property NoLibSuffixFormat : string read FNoLibSuffixFormat write FNoLibSuffixFormat;
|
|
// property ClxFormat : string read FClxFormat write FClxFormat ;
|
|
// property DotNetFormat : string read FDotNetFormat write FDotNetFormat ;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Windows, SysUtils, FileUtils,
|
|
JclStrings, JclFileUtils, JclDateTime, JclSysUtils,
|
|
GenerateUtils;
|
|
|
|
{ TPackageGenerator }
|
|
|
|
constructor TPackageGenerator.Create;
|
|
begin
|
|
inherited Create;
|
|
FStartupDir := GetCurrentDir;
|
|
PackageInformation.ExpandPackageTargetsObj := ExpandTargets;
|
|
FIsBinaryCache := TStringList.Create;
|
|
FIsBinaryCache.Sorted := True;
|
|
FIsBinaryCache.Duplicates := dupIgnore;
|
|
end;
|
|
|
|
destructor TPackageGenerator.Destroy;
|
|
begin
|
|
PackageInformation.ExpandPackageTargetsObj := nil;
|
|
FTargetList.Free;
|
|
FAliasList.Free;
|
|
FClxReplacementList.Free;
|
|
FIsBinaryCache.Free;
|
|
FProjectProperties.Free;
|
|
FDefinesConditionParser.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TPackageGenerator.SendMsg(const Msg : string);
|
|
begin
|
|
if Assigned(FCallBack) then
|
|
FCallBack(Msg);
|
|
end;
|
|
|
|
function TPackageGenerator.LoadConfig(const XmlFileName : string; const ModelName : string;
|
|
var ErrMsg : string) : Boolean;
|
|
var
|
|
xml : TJclSimpleXml;
|
|
Node : TJclSimpleXmlElem;
|
|
i : integer;
|
|
all : string;
|
|
target : TTarget;
|
|
begin
|
|
Result := True;
|
|
FreeAndNil(FTargetList);
|
|
FreeAndNil(FAliasList);
|
|
FreeAndNil(FClxReplacementList);
|
|
FreeAndNil(FProjectProperties);
|
|
|
|
// Ensure the xml file exists
|
|
if not FileExists(XmlFileName) then
|
|
begin
|
|
ErrMsg := Format('%s does not exist.', [XmlFileName]);
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
try
|
|
// read the xml config file
|
|
xml := TJclSimpleXml.Create;
|
|
try
|
|
xml.LoadFromFile(XmlFileName);
|
|
|
|
// The xml file must contain the models node
|
|
if not Assigned(xml.Root.Items.itemNamed['models']) then
|
|
begin
|
|
Result := False;
|
|
ErrMsg := 'The root node of the xml file must contain '+
|
|
'a node called ''models''.';
|
|
Exit;
|
|
end;
|
|
|
|
Node := xml.root.Items.itemNamed['models'].items[0];
|
|
if not VerifyModelNode(Node, ErrMsg) then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
for i := 0 to xml.root.Items.itemNamed['models'].items.count - 1 do
|
|
if xml.root.Items.itemNamed['models'].items[i].Properties.ItemNamed['Name'].value = ModelName then
|
|
Node := xml.root.Items.itemNamed['models'].items[i];
|
|
|
|
if not VerifyModelNode(Node, ErrMsg) then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
FTargetList := TTargetList.Create(Node.Items.ItemNamed['targets']);
|
|
FAliasList := TAliasList.Create(Node.Items.ItemNamed['aliases']);
|
|
FClxReplacementList := TClxReplacementList.Create(Node.Items.ItemNamed['ClxReplacements']);
|
|
FProjectProperties := TProjectProperties.Create(Node.Items.ItemNamed['ProjectProperties']);
|
|
|
|
if Assigned(Node.Properties.ItemNamed['incdeffile']) then
|
|
FIncDefFileName := Node.Properties.ItemNamed['incdeffile'].Value;
|
|
FIncFileName := Node.Properties.ItemNamed['IncFile'].Value;
|
|
FPackagesLocation := Node.Properties.ItemNamed['packages'].Value;
|
|
FFormat := Node.Properties.ItemNamed['format'].Value;
|
|
FPrefix := Node.Properties.ItemNamed['prefix'].Value;
|
|
|
|
FNoLibSuffixPrefix := FPrefix;
|
|
FClxPrefix := FPrefix;
|
|
FDotNetPrefix := FPrefix;
|
|
FNoLibSuffixFormat := FFormat;
|
|
FClxFormat := FFormat;
|
|
FDotNetFormat := FFormat;
|
|
|
|
if Assigned(Node.Properties.ItemNamed['NoLibSuffixprefix']) then
|
|
FNoLibSuffixPrefix := Node.Properties.ItemNamed['NoLibSuffixprefix'].Value;
|
|
if Assigned(Node.Properties.ItemNamed['clxprefix']) then
|
|
FClxPrefix := Node.Properties.ItemNamed['clxprefix'].Value;
|
|
if Assigned(Node.Properties.ItemNamed['dotnetprefix']) then
|
|
FDotNetPrefix := Node.Properties.ItemNamed['dotnetprefix'].Value;
|
|
if Assigned(Node.Properties.ItemNamed['NoLibSuffixformat']) then
|
|
FNoLibSuffixFormat := Node.Properties.ItemNamed['NoLibSuffixformat'].Value;
|
|
if Assigned(Node.Properties.ItemNamed['clxformat']) then
|
|
FClxFormat := Node.Properties.ItemNamed['clxformat'].Value;
|
|
if Assigned(Node.Properties.ItemNamed['dotnetformat']) then
|
|
FDotNetFormat := Node.Properties.ItemNamed['dotnetformat'].Value;
|
|
|
|
// create the 'all' alias
|
|
all := '';
|
|
for i := 0 to FTargetList.Count-1 do
|
|
begin
|
|
Target := FTargetList.Items[i];
|
|
all := all + Target.Name + ',';
|
|
if Target.PName <> '' then
|
|
all := all + Target.PName + ',';
|
|
end;
|
|
SetLength(all, Length(all) - 1);
|
|
|
|
Node := TJclSimpleXmlElemClassic.Create(nil);
|
|
try
|
|
Node.Properties.Add('name', 'all');
|
|
Node.Properties.Add('value', all);
|
|
FAliasList.Add(TAlias.Create(Node));
|
|
finally
|
|
Node.Free;
|
|
end;
|
|
finally
|
|
xml.Free;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
Result := False;
|
|
ErrMsg := E.Message;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TPackageGenerator.GetPersoTarget(const Target : string) : string;
|
|
begin
|
|
if FTargetList[Target] <> nil then
|
|
Result := FTargetList[Target].PName
|
|
else
|
|
Result := Target;
|
|
end;
|
|
|
|
function TPackageGenerator.GetNonPersoTarget(const PersoTarget : string) : string;
|
|
var
|
|
i : integer;
|
|
Target : TTarget;
|
|
begin
|
|
Result := PersoTarget;
|
|
for i := 0 to FTargetList.Count - 1 do
|
|
begin
|
|
Target := FTargetList.Items[i];
|
|
if SameText(Target.PName, PersoTarget) then
|
|
begin
|
|
Result := Target.Name;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TPackageGenerator.TargetToDir(const target : string) : string;
|
|
begin
|
|
if Assigned(FTargetList[target]) then
|
|
Result := FTargetList[target].Dir
|
|
else if Assigned(FTargetList[GetNonPersoTarget(target)]) then
|
|
Result := FTargetList[GetNonPersoTarget(target)].PDir
|
|
else
|
|
raise Exception.CreateFmt('Target "%s" not found.', [target]);
|
|
end;
|
|
|
|
function TPackageGenerator.ExpandPackageName(Name: string; const target : string) : string;
|
|
var
|
|
Env : string;
|
|
Ver : string;
|
|
Typ : string;
|
|
Prefix: string;
|
|
ATarget: TTarget;
|
|
begin
|
|
ATarget := FTargetList[GetNonPersoTarget(target)];
|
|
Env := ATarget.Env;
|
|
Ver := ATarget.Ver;
|
|
Typ := Copy(Name, Length(Name), 1);
|
|
|
|
if ((AnsiLowerCase(Env) = 'd') or (AnsiLowerCase(Env) = 'c')) and (StrToInt(Ver) < 6) then
|
|
begin
|
|
Result := FNoLibSuffixFormat;
|
|
Prefix := FNoLibSuffixPrefix;
|
|
end
|
|
else if (FTargetList[GetNonPersoTarget(target)].IsCLX) then
|
|
begin
|
|
Result := FClxFormat;
|
|
Prefix := FClxPrefix;
|
|
end
|
|
else if (FTargetList[GetNonPersoTarget(target)].IsDotNet) then
|
|
begin
|
|
Result := FDotNetFormat;
|
|
Prefix := FDotNetPrefix;
|
|
end
|
|
else
|
|
begin
|
|
Result := FFormat;
|
|
Prefix := FPrefix;
|
|
end;
|
|
|
|
// If we find Prefix in the Name, then use it first, else, fall back
|
|
// to GPrefix.
|
|
if (Pos(Prefix, Name) > 0) then
|
|
Name := Copy(Name, Length(Prefix)+1, Pos('-', Name)-Length(Prefix)-1)
|
|
else
|
|
Name := Copy(Name, Length(FPrefix)+1, Pos('-', Name)-Length(FPrefix)-1);
|
|
|
|
// Always use Prefix as the replacement string for %p
|
|
MacroReplace(Result, '%',
|
|
['p', Prefix,
|
|
'n', Name,
|
|
'e', Env,
|
|
'v', Ver,
|
|
't', Typ]);
|
|
end;
|
|
|
|
function TPackageGenerator.HasModelPrefix(Name : string; const target:string): Boolean;
|
|
var
|
|
Env: string;
|
|
Ver: string;
|
|
ATarget: TTarget;
|
|
begin
|
|
ATarget := FTargetList[GetNonPersoTarget(target)];
|
|
Env := ATarget.Env;
|
|
Ver := ATarget.Ver;
|
|
Result := False;
|
|
|
|
// We first try a CLX prefix
|
|
// If this failed, then we try a NoLibSuffix prefix
|
|
// If this failed too, then we go back to the standard prefix.
|
|
// This methods is employed mostly for CLX targets as this allows
|
|
// to have a single xml source file for both CLX and non CLX
|
|
// targets. For instance, in the JVCL, we would have a source file
|
|
// called JvSystem-R.xml which requires JvCore-R. Using this method
|
|
// when generating a CLX package which has a JvQ prefix, we still can
|
|
// recognize JvCore-R has being one of the package names that needs
|
|
// to be modified and thus will end up being JvQCoreD7R in the case
|
|
// of the Delphi 7 CLX target while still being JvCoreD7R for a
|
|
// regular Delphi 7 target (non CLX)
|
|
|
|
if (FTargetList[GetNonPersoTarget(target)].IsCLX) then
|
|
Result := StartsWith(FClxPrefix, Name);
|
|
|
|
if (FTargetList[GetNonPersoTarget(target)].IsDotNet) then
|
|
Result := StartsWith(FDotNetPrefix, Name);
|
|
|
|
if not Result and ((AnsiLowerCase(Env) = 'd') or (AnsiLowerCase(Env) = 'c')) and (StrToInt(Ver) < 6) then
|
|
Result := StartsWith(FNoLibSuffixPrefix, Name);
|
|
|
|
if not Result then
|
|
Result := StartsWith(FPrefix, Name);
|
|
end;
|
|
|
|
function TPackageGenerator.BuildPackageName(xml: TRequiredPackage; const target : string) : string;
|
|
var
|
|
Name : string;
|
|
begin
|
|
Name := xml.Name;
|
|
{TODO : CrossPlatform packages}
|
|
if HasModelPrefix(Name, target) then
|
|
begin
|
|
Result := ExpandPackageName(Name, target);
|
|
end
|
|
else
|
|
begin
|
|
Result := Name;
|
|
end;
|
|
end;
|
|
|
|
function TPackageGenerator.IsNotInPerso(Item: TPackageXmlInfoItem; const target : string) : Boolean;
|
|
var
|
|
persoTarget : string;
|
|
begin
|
|
persoTarget := GetPersoTarget(target);
|
|
if persoTarget = '' then
|
|
Result := False
|
|
else
|
|
begin
|
|
Result := not Item.IsIncluded(persoTarget) and
|
|
Item.IsIncluded(target);
|
|
end;
|
|
end;
|
|
|
|
function TPackageGenerator.IsOnlyInPerso(Item: TPackageXmlInfoItem; const target : string) : Boolean;
|
|
var
|
|
persoTarget : string;
|
|
begin
|
|
persoTarget := GetPersoTarget(target);
|
|
if persoTarget = '' then
|
|
Result := False
|
|
else
|
|
begin
|
|
Result := Item.IsIncluded(persoTarget) and
|
|
not Item.IsIncluded(target);
|
|
end;
|
|
end;
|
|
|
|
procedure TPackageGenerator.EnsureProperSeparator(var Name : string; const target : string);
|
|
var
|
|
TmpName: string;
|
|
begin
|
|
// ensure that the path separator stored in the xml file is
|
|
// replaced by the one for the system we are targeting
|
|
|
|
TmpName := Name;
|
|
|
|
// first ensure we only have backslashes
|
|
StrReplace(TmpName, '/', '\', [rfReplaceAll]);
|
|
|
|
// and replace all them by the path separator for the target
|
|
StrReplace(TmpName, '\', FTargetList[GetNonPersoTarget(target)].PathSep, [rfReplaceAll]);
|
|
|
|
Name := TmpName;
|
|
end;
|
|
|
|
procedure TPackageGenerator.ApplyFormName(ContainedFile: TContainedFile; index: Integer; Lines : TStrings;
|
|
const target : string);
|
|
var
|
|
formName : string;
|
|
formType : string;
|
|
formNameAndType : string;
|
|
incFileName : string;
|
|
openPos : Integer;
|
|
closePos : Integer;
|
|
unitname : string;
|
|
punitname : string;
|
|
formpathname : string;
|
|
S: string;
|
|
ps: Integer;
|
|
begin
|
|
formNameAndType := ContainedFile.FormName;
|
|
incFileName := ContainedFile.Name;
|
|
|
|
// Do the CLX filename replacements if the target is marked as
|
|
// being a CLX target
|
|
if FTargetList[GetNonPersoTarget(target)].IsCLX then
|
|
incFileName := FClxReplacementList.DoReplacement(incFileName);
|
|
|
|
unitname := GetUnitName(incFileName);
|
|
punitname := AnsiLowerCase(unitname);
|
|
punitname[1] := CharUpper(punitname[1]);
|
|
formpathname := StrEnsureSuffix(DirDelimiter, ExtractFilePath(incFileName))+GetUnitName(incFileName);
|
|
|
|
EnsureProperSeparator(formpathname, target);
|
|
EnsureProperSeparator(incfilename, target);
|
|
|
|
ps := Pos(':', formNameAndType);
|
|
if ps = 0 then
|
|
begin
|
|
formName := formNameAndType;
|
|
formType := '';
|
|
end
|
|
else
|
|
begin
|
|
formName := Copy(formNameAndType, 1, ps-1);
|
|
formType := Copy(formNameAndType, ps+2, MaxInt);
|
|
end;
|
|
|
|
if (formType = '') or (formName = '') then
|
|
begin
|
|
S := Lines.Text;
|
|
openPos := Pos('/*', S);
|
|
if openPos > 0 then
|
|
begin
|
|
closePos := Pos('*/', S);
|
|
Delete(S, openPos, closepos + 2 - openPos);
|
|
Lines.Text := S;
|
|
end;
|
|
end;
|
|
|
|
if formName = '' then
|
|
begin
|
|
S := Lines.Text;
|
|
openPos := Pos('{', S);
|
|
if openPos > 0 then
|
|
begin
|
|
closePos := Pos('}', S);
|
|
Delete(S, openPos, closePos + 1 - openPos);
|
|
Lines.Text := S;
|
|
end;
|
|
formName := '';
|
|
formType := '';
|
|
formNameAndType := '';
|
|
formpathname := '';
|
|
end;
|
|
|
|
MacroReplaceLines(Lines, '%',
|
|
['FILENAME%', incFileName,
|
|
'UNITNAME%', unitname,
|
|
'Unitname%', punitname,
|
|
'INDEX%', IntToStr(Index),
|
|
'FORMNAME%', formName,
|
|
'FORMTYPE%', formType,
|
|
'FORMNAMEANDTYPE%', formNameAndType,
|
|
'FORMPATHNAME%', formpathname]);
|
|
end;
|
|
|
|
procedure TPackageGenerator.ExpandTargets(targets : TStrings);
|
|
var
|
|
expandedTargets : TStringList;
|
|
i : Integer;
|
|
Alias : TAlias;
|
|
currentTarget : string;
|
|
begin
|
|
expandedTargets := TStringList.Create;
|
|
try
|
|
// ensure uniqueness in expanded list
|
|
expandedTargets.Sorted := True;
|
|
// CaseSensitive doesn't exist in D5 and the default is False anyway
|
|
// expandedTargets.CaseSensitive := False;
|
|
expandedTargets.Duplicates := dupIgnore;
|
|
|
|
for i := 0 to targets.Count - 1 do
|
|
begin
|
|
currentTarget := targets[i];
|
|
Alias := FAliasList[currentTarget];
|
|
if Assigned(Alias) then
|
|
begin
|
|
expandedTargets.AddStrings(Alias.ValueAsTStrings);
|
|
end
|
|
else
|
|
begin
|
|
expandedTargets.Add(Trim(currentTarget));
|
|
if not Assigned(FTargetList.ItemsByName[currentTarget]) and (GetNonPersoTarget(currentTarget) = currentTarget) then
|
|
SendMsg(Format('Unknown target: %s', [currentTarget]));
|
|
end;
|
|
end;
|
|
|
|
// assign the values back into the caller
|
|
targets.Clear;
|
|
targets.Assign(expandedTargets);
|
|
finally
|
|
expandedTargets.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TPackageGenerator.ExpandTargetsNoPerso(targets : TStrings);
|
|
var
|
|
i : integer;
|
|
begin
|
|
ExpandTargets(targets);
|
|
// now remove "perso" targets
|
|
for i := targets.Count - 1 downto 0 do
|
|
if not Assigned(FTargetList.ItemsByName[targets[i]]) then
|
|
targets.Delete(i);
|
|
end;
|
|
|
|
function TPackageGenerator.GetDescription(xml: TPackageXmlInfo; const target: string): string;
|
|
begin
|
|
if FTargetList[GetNonPersoTarget(target)].IsCLX then
|
|
Result := xml.ClxDescription
|
|
else
|
|
Result := xml.Description;
|
|
end;
|
|
|
|
{$WARNINGS OFF} // hide wrong warning: "Function return value could be undefined."
|
|
function TPackageGenerator.ApplyTemplateAndSave(const path, target, package, extension: string;
|
|
template : TStrings; xml : TPackageXmlInfo;
|
|
const templateName, xmlName : string): string;
|
|
type
|
|
TProjectConditional = record
|
|
StartLine: string;
|
|
EndLine: string;
|
|
ProjectType: TProjectType;
|
|
end;
|
|
const
|
|
ProjectConditionals: array [0..4] of TProjectConditional =
|
|
( ( StartLine:'<%%% BEGIN PROGRAMONLY %%%>'; EndLine:'<%%% END PROGRAMONLY %%%>'; ProjectType:ptProgram),
|
|
( StartLine:'<%%% BEGIN PACKAGEONLY %%%>'; EndLine:'<%%% END PACKAGEONLY %%%>'; ProjectType:ptPackage),
|
|
( StartLine:'<%%% BEGIN LIBRARYONLY %%%>'; EndLine:'<%%% END LIBRARYONLY %%%>'; ProjectType:ptLibrary),
|
|
( StartLine:'<%%% BEGIN DESIGNONLY %%%>'; EndLine:'<%%% END DESIGNONLY %%%>'; ProjectType:ptPackageDesign),
|
|
( StartLine:'<%%% BEGIN RUNONLY %%%>'; EndLine:'<%%% END RUNONLY %%%>'; ProjectType:ptPackageRun) );
|
|
var
|
|
OutFileName : string;
|
|
oneLetterType : string;
|
|
reqPackName : string;
|
|
incFileName : string;
|
|
outFile : TStringList;
|
|
curLine, curLineTrim : string;
|
|
tmpLines, repeatLines : TStrings;
|
|
I : Integer;
|
|
j : Integer;
|
|
ImageBaseInt: string;
|
|
tmpStr : string;
|
|
bcbId : string;
|
|
bcblibsList : TStrings;
|
|
TimeStampLine : Integer;
|
|
Count, RequireCount, ContainCount, FormCount, LibCount, DefineCount: Integer;
|
|
containsSomething : Boolean; // true if package will contain something
|
|
repeatSectionUsed : Boolean; // true if at least one repeat section was used
|
|
AddedLines: Integer;
|
|
IgnoreNextSemicolon: Boolean;
|
|
UnitFileName, UnitFilePath, UnitFileExtension, NoLinkPackageList: string;
|
|
PathPAS, PathCPP, PathRC, PathASM, PathLIB: string;
|
|
VersionMajorNumber, VersionMinorNumber, ReleaseNumber, BuildNumber: string;
|
|
CompilerDefines: TStrings;
|
|
ItemIndex: Integer;
|
|
begin
|
|
Result := '';
|
|
|
|
outFile := TStringList.Create;
|
|
containsSomething := False;
|
|
repeatSectionUsed := False;
|
|
|
|
repeatLines := TStringList.Create;
|
|
tmpLines := TStringList.Create;
|
|
CompilerDefines := TStringList.Create;
|
|
try
|
|
// generate list of pathes
|
|
PathPAS := '.;';
|
|
PathCPP := '.;';
|
|
PathRC := '.;';
|
|
PathASM := '.;';
|
|
PATHLIB := '';
|
|
ContainCount := 0;
|
|
FormCount := 0;
|
|
for I := 0 to xml.ContainCount-1 do
|
|
if xml.Contains[I].IsIncluded(Target) then
|
|
begin
|
|
Inc(ContainCount);
|
|
if xml.Contains[I].FormName <> '' then
|
|
Inc(FormCount);
|
|
|
|
containsSomething := True;
|
|
UnitFileName := xml.Contains[I].Name;
|
|
UnitFilePath := ExtractFilePath(UnitFileName);
|
|
if (UnitFilePath <> '') and (UnitFilePath[Length(UnitFilePath)] = DirDelimiter) then
|
|
UnitFilePath := Copy(UnitFilePath, 1, Length(UnitFilePath)-1);
|
|
UnitFilePath := UnitFilePath + ';';
|
|
UnitFileExtension := ExtractFileExt(UnitFileName);
|
|
if Pos(';'+UnitFilePath,PathLIB) = 0 then
|
|
PathLIB := Format('%s%s',[PathLIB,UnitFilePath]);
|
|
if CompareText(UnitFileExtension,'.pas') = 0 then
|
|
begin
|
|
if Pos(';'+UnitFilePath,PathPAS) = 0 then
|
|
PathPAS := Format('%s%s',[PathPAS,UnitFilePath]);
|
|
end
|
|
else if CompareText(UnitFileExtension,'.asm') = 0 then
|
|
begin
|
|
if Pos(';'+UnitFilePath,PathASM) = 0 then
|
|
PathASM := Format('%s%s',[PathASM,UnitFilePath]);
|
|
end
|
|
else if CompareText(UnitFileExtension,'.cpp') = 0 then
|
|
begin
|
|
if Pos(';'+UnitFilePath,PathCPP) = 0 then
|
|
PathCPP := Format('%s%s',[PathCPP,UnitFilePath]);
|
|
end
|
|
else if CompareText(UnitFileExtension,'.rc') = 0 then
|
|
if Pos(';'+UnitFilePath,PathRC) = 0 then
|
|
PathRC := Format('%s%s',[PathRC,UnitFilePath]);
|
|
end;
|
|
// read the xml file
|
|
OutFileName := xml.Name;
|
|
OneLetterType := ProjectTypeToChar(xml.ProjectType);
|
|
OutFileName := OutFileName + '-' + OneLetterType[1];
|
|
if ProjectTypeIsDesign(xml.ProjectType) then
|
|
OneLetterType := 'd'
|
|
else
|
|
OneLetterType := 'r';
|
|
|
|
NoLinkPackageList := '';
|
|
RequireCount := 0;
|
|
for i := 0 to xml.RequireCount - 1 do
|
|
if xml.Requires[i].IsIncluded(Target) then
|
|
begin
|
|
Inc(RequireCount);
|
|
reqPackName := BuildPackageName(xml.Requires[i], target);
|
|
if NoLinkPackageList = '' then
|
|
NoLinkPackageList := reqPackName
|
|
else
|
|
NoLinkPackageList := Format('%s;%s', [NoLinkPackageList, reqPackName]);
|
|
end;
|
|
|
|
OutFileName := path + TargetToDir(target) + DirDelimiter +
|
|
ExpandPackageName(OutFileName, target)+
|
|
Extension;
|
|
|
|
ImageBaseInt := IntToStr(StrToInt('$' + xml.ImageBase));
|
|
|
|
// project-wide properties if not redefined in xml
|
|
VersionMajorNumber := xml.VersionMajorNumber;
|
|
if VersionMajorNumber = '' then
|
|
VersionMajorNumber := FProjectProperties.Values['VersionMajorNumber'];
|
|
VersionMinorNumber := xml.VersionMinorNumber;
|
|
if VersionMinorNumber = '' then
|
|
VersionMinorNumber := FProjectProperties.Values['VersionMinorNumber'];
|
|
ReleaseNumber := xml.ReleaseNumber;
|
|
if ReleaseNumber = '' then
|
|
ReleaseNumber := FProjectProperties.Values['ReleaseNumber'];
|
|
BuildNumber := xml.BuildNumber;
|
|
if BuildNumber = '' then
|
|
BuildNumber := FProjectProperties.Values['BuildNumber'];
|
|
|
|
CompilerDefines.Assign(FTargetList[GetNonPersoTarget(Target)].Defines);
|
|
CompilerDefines.AddStrings(xml.CompilerDefines);
|
|
DefineCount := CompilerDefines.Count;
|
|
|
|
// read libs as a string of space separated value
|
|
bcbId := FTargetList[GetNonPersoTarget(target)].Env+FTargetList[GetNonPersoTarget(target)].Ver;
|
|
bcblibsList := nil;
|
|
if CompareText(bcbId, 'c6') = 0 then
|
|
bcblibsList := xml.C6Libs
|
|
else
|
|
if bcblibsList <> nil then
|
|
LibCount := bcblibsList.Count
|
|
else
|
|
LibCount := 0;
|
|
|
|
// The time stamp hasn't been found yet
|
|
TimeStampLine := -1;
|
|
|
|
// read the lines of the templates and do some replacements
|
|
i := 0;
|
|
Count := template.Count;
|
|
IgnoreNextSemicolon := False;
|
|
while i < Count do
|
|
begin
|
|
curLine := template[i];
|
|
if IsTrimmedStartsWith('<%%% ', curLine) then
|
|
begin
|
|
curLineTrim := Trim(curLine);
|
|
if curLine = '<%%% START REQUIRES %%%>' then
|
|
begin
|
|
Inc(i);
|
|
repeatSectionUsed := True;
|
|
repeatLines.Clear;
|
|
while (i < Count) and
|
|
not IsTrimmedString(template[i], '<%%% END REQUIRES %%%>') do
|
|
begin
|
|
repeatLines.Add(template[i]);
|
|
Inc(i);
|
|
end;
|
|
|
|
AddedLines := 0;
|
|
ItemIndex := 0;
|
|
for j := 0 to xml.RequireCount - 1 do
|
|
begin
|
|
// if this required package is to be included for this target
|
|
if xml.Requires[j].IsIncluded(target) then
|
|
begin
|
|
Inc(ItemIndex);
|
|
tmpLines.Assign(repeatLines);
|
|
reqPackName := BuildPackageName(xml.Requires[j], target);
|
|
StrReplaceLines(tmpLines, '%NAME%', reqPackName);
|
|
StrReplaceLines(tmpLines, '%INDEX%', IntToStr(ItemIndex));
|
|
// We do not say that the package contains something because
|
|
// a package is only interesting if it contains files for
|
|
// the given target
|
|
// containsSomething := True;
|
|
FDefinesConditionParser.EnsureCondition(tmpLines, xml.Requires[j].Condition);
|
|
outFile.AddStrings(tmpLines);
|
|
Inc(AddedLines);
|
|
end;
|
|
end;
|
|
|
|
if (outFile.Count > 0) and (AddedLines = 0) then
|
|
begin
|
|
// delete "requires" clause.
|
|
j := outFile.Count - 1;
|
|
while (j > 0) and (Trim(outFile[j]) = '') do
|
|
Dec(j);
|
|
if CompareText(Trim(outFile[j]), 'requires') = 0 then
|
|
begin
|
|
outFile.Delete(j);
|
|
IgnoreNextSemicolon := True;
|
|
end;
|
|
end
|
|
else
|
|
// if the last character in the output file is
|
|
// a comma, then remove it. This possible comma will
|
|
// be followed by a carriage return so we look
|
|
// at the third character starting from the end
|
|
AdjustEndingSemicolon(outFile);
|
|
end
|
|
else if curLineTrim = '<%%% START FILES %%%>' then
|
|
begin
|
|
Inc(i);
|
|
repeatSectionUsed := True;
|
|
repeatLines.Clear;
|
|
while (i < Count) and
|
|
not IsTrimmedString(template[i], '<%%% END FILES %%%>') do
|
|
begin
|
|
repeatLines.Add(template[i]);
|
|
Inc(i);
|
|
end;
|
|
|
|
AddedLines := 0;
|
|
ItemIndex := 0;
|
|
for j := 0 to xml.ContainCount - 1 do
|
|
begin
|
|
// if this included file is to be included for this target
|
|
if xml.Contains[j].IsIncluded(target) then
|
|
begin
|
|
Inc(ItemIndex);
|
|
tmpLines.Assign(repeatLines);
|
|
incFileName := xml.Contains[j].Name;
|
|
ApplyFormName(xml.Contains[j], ItemIndex, tmpLines, target);
|
|
FDefinesConditionParser.EnsureCondition(tmpLines, xml.Contains[j].Condition);
|
|
outFile.AddStrings(tmpLines);
|
|
Inc(AddedLines);
|
|
|
|
// if this included file is not in the associated 'perso'
|
|
// target or only in the 'perso' target then return the
|
|
// 'perso' target name.
|
|
if IsNotInPerso(xml.Contains[j], target) or
|
|
IsOnlyInPerso(xml.Contains[j], target) then
|
|
Result := GetPersoTarget(target);
|
|
end;
|
|
end;
|
|
|
|
if (outFile.Count > 0) and (AddedLines = 0) then
|
|
begin
|
|
// delete "contains" clause.
|
|
j := outFile.Count - 1;
|
|
while (j > 0) and (Trim(outFile[j]) = '') do
|
|
Dec(j);
|
|
if CompareText(Trim(outFile[j]), 'contains') = 0 then
|
|
begin
|
|
outFile.Delete(j);
|
|
IgnoreNextSemicolon := True;
|
|
end;
|
|
end
|
|
else
|
|
// if the last character in the output file is
|
|
// a comma, then remove it. This possible comma will
|
|
// be followed by a carriage return so we look
|
|
// at the third character starting from the end
|
|
AdjustEndingSemicolon(outFile);
|
|
end
|
|
else if curLine = '<%%% START FORMS %%%>' then
|
|
begin
|
|
Inc(i);
|
|
repeatSectionUsed := True;
|
|
repeatLines.Clear;
|
|
while (i < Count) and
|
|
not IsTrimmedString(template[i], '<%%% END FORMS %%%>') do
|
|
begin
|
|
repeatLines.Add(template[i]);
|
|
Inc(i);
|
|
end;
|
|
|
|
ItemIndex := 0;
|
|
for j := 0 to xml.ContainCount - 1 do
|
|
begin
|
|
// if this included file is to be included for this target
|
|
// and there is a form associated to the file
|
|
if xml.Contains[j].IsIncluded(target) then
|
|
begin
|
|
containsSomething := True;
|
|
if (xml.Contains[j].FormName <> '') then
|
|
begin
|
|
Inc(ItemIndex);
|
|
tmpLines.Assign(repeatLines);
|
|
ApplyFormName(xml.Contains[j], ItemIndex, tmpLines, target);
|
|
FDefinesConditionParser.EnsureCondition(tmpLines, xml.Contains[j].Condition);
|
|
outFile.AddStrings(tmpLines);
|
|
end;
|
|
|
|
// if this included file is not in the associated 'perso'
|
|
// target or only in the 'perso' target then return the
|
|
// 'perso' target name.
|
|
if IsNotInPerso(xml.Contains[j], target) or
|
|
IsOnlyInPerso(xml.Contains[j], target) then
|
|
Result := GetPersoTarget(target);
|
|
end;
|
|
|
|
end;
|
|
end
|
|
else if curLine = '<%%% START LIBS %%%>' then
|
|
begin
|
|
Inc(i);
|
|
repeatLines.Clear;
|
|
while (i < Count) and
|
|
not IsTrimmedString(template[i], '<%%% END LIBS %%%>') do
|
|
begin
|
|
repeatLines.Add(template[i]);
|
|
Inc(i);
|
|
end;
|
|
|
|
if bcblibsList <> nil then
|
|
begin
|
|
ItemIndex := 0;
|
|
for j := 0 to bcbLibsList.Count - 1 do
|
|
begin
|
|
Inc(ItemIndex);
|
|
tmpLines.Assign(repeatLines);
|
|
MacroReplaceLines(tmpLines, '%',
|
|
['FILENAME%', bcblibsList[j],
|
|
'INDEX%', IntToStr(ItemIndex),
|
|
'UNITNAME%', GetUnitName(bcblibsList[j])]);
|
|
outFile.AddStrings(tmpLines);
|
|
end;
|
|
end;
|
|
end
|
|
else if curLine = '<%%% START COMPILER DEFINES %%%>' then
|
|
begin
|
|
Inc(i);
|
|
repeatLines.Clear;
|
|
while (i < Count) and
|
|
not IsTrimmedString(template[i], '<%%% END COMPILER DEFINES %%%>') do
|
|
begin
|
|
repeatLines.Add(template[i]);
|
|
Inc(i);
|
|
end;
|
|
ItemIndex := 0;
|
|
for j := 0 to CompilerDefines.Count - 1 do
|
|
begin
|
|
Inc(ItemIndex);
|
|
tmpLines.Assign(repeatLines);
|
|
MacroReplaceLines(tmpLines, '%',
|
|
['COMPILERDEFINE%', CompilerDefines[j],
|
|
'INDEX%', IntToStr(ItemIndex)]);
|
|
outFile.AddStrings(tmpLines);
|
|
end;
|
|
end
|
|
else if curLine = '<%%% DO NOT GENERATE %%%>' then
|
|
Exit
|
|
else for j := Low(ProjectConditionals) to High(ProjectConditionals) do
|
|
begin
|
|
if curLine = ProjectConditionals[j].StartLine then
|
|
begin
|
|
if xml.ProjectType <> ProjectConditionals[j].ProjectType then
|
|
while (i < Count) and not IsTrimmedString(template[i], ProjectConditionals[j].EndLine) do
|
|
Inc(i);
|
|
Break;
|
|
end;
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
if Pos('%', curLine) > 0 then
|
|
begin
|
|
tmpStr := curLine;
|
|
StringsToStr(xml.C6Libs, ' ', False);
|
|
if MacroReplace(curLine, '%',
|
|
['NAME%', PathExtractFileNameNoExt(OutFileName),
|
|
'XMLNAME%', ExtractFileName(xmlName),
|
|
'DESCRIPTION%', GetDescription(xml, target),
|
|
'C6PFLAGS%', FDefinesConditionParser.EnsurePFlagsCondition(xml.C6PFlags),
|
|
'C6LIBS%', StringsToStr(xml.C6Libs, ' ', False),
|
|
'GUID%', xml.GUID,
|
|
'IMAGE_BASE%', xml.ImageBase,
|
|
'IMAGE_BASE_INT%', ImageBaseInt,
|
|
'VERSION_MAJOR_NUMBER%', VersionMajorNumber,
|
|
'VERSION_MINOR_NUMBER%', VersionMinorNumber,
|
|
'RELEASE_NUMBER%', ReleaseNumber,
|
|
'BUILD_NUMBER%', BuildNumber,
|
|
'TYPE%', Iff(ProjectTypeIsDesign(xml.ProjectType), 'DESIGN', 'RUN'),
|
|
'DATETIME%', FormatDateTime('dd-mm-yyyy hh:nn:ss', NowUTC) + ' UTC',
|
|
'type%', OneLetterType,
|
|
'PATHPAS%', PathPAS,
|
|
'PATHCPP%', PathCPP,
|
|
'PATHASM%', PathASM,
|
|
'PATHRC%', PathRC,
|
|
'PATHLIB%', PathLIB,
|
|
'PROJECT%', ProjectTypeToProjectName(xml.ProjectType),
|
|
'BINEXTENSION%', ProjectTypeToBinaryExtension(xml.ProjectType),
|
|
'ISDLL%', Iff(ProjectTypeIsDLL(xml.ProjectType), 'True', 'False'),
|
|
'ISPACKAGE%', Iff(ProjectTypeIsPackage(xml.ProjectType), 'True', 'False'),
|
|
'SOURCEEXTENSION%', ProjectTypeToSourceExtension(xml.ProjectType),
|
|
'NOLINKPACKAGELIST%', NoLinkPackageList,
|
|
'DEFINES%', StringsToStr(CompilerDefines, ';', False),
|
|
'COMPILERDEFINES%', Iff(CompilerDefines.Count > 0, '-D' + StringsToStr(CompilerDefines, ';', False), ''),
|
|
'REQUIRECOUNT%', IntToStr(RequireCount),
|
|
'CONTAINCOUNT%', IntToStr(ContainCount),
|
|
'FORMCOUNT%', IntToStr(FormCount),
|
|
'LIBCOUNT%', IntToStr(LibCount),
|
|
'DEFINECOUNT%', IntToStr(DefineCount)]) then
|
|
begin
|
|
if Pos('%DATETIME%', tmpStr) > 0 then
|
|
TimeStampLine := I;
|
|
end;
|
|
end;
|
|
if IgnoreNextSemicolon then
|
|
begin
|
|
if (Trim(curLine) <> '') and (Trim(curLine) = ';') then
|
|
IgnoreNextSemicolon := False
|
|
else
|
|
outFile.Add(curLine);
|
|
end
|
|
else
|
|
outFile.Add(curLine);
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
|
|
// test if there are required packages and/or contained files
|
|
// that make the package require a different version for a
|
|
// perso target. This is determined like that:
|
|
// if a file is not in the associated 'perso'
|
|
// target or only in the 'perso' target then return the
|
|
// 'perso' target name.
|
|
for j := 0 to xml.RequireCount - 1 do
|
|
begin
|
|
if IsNotInPerso(xml.Requires[j], target) or
|
|
IsOnlyInPerso(xml.Requires[j], target) then
|
|
Result := GetPersoTarget(target);
|
|
end;
|
|
for j := 0 to xml.ContainCount - 1 do
|
|
begin
|
|
if IsNotInPerso(xml.Contains[j], target) or
|
|
IsOnlyInPerso(xml.Contains[j], target) then
|
|
Result := GetPersoTarget(target);
|
|
end;
|
|
|
|
// if no repeat section was used, we must check manually
|
|
// that at least one file is to be used by the given target.
|
|
// This will then force the generation of the output file
|
|
// (Useful for cfg templates for instance).
|
|
// We do not check for the use of "required" packages because
|
|
// a package is only interesting if it contains files for
|
|
// the given target
|
|
if not repeatSectionUsed then
|
|
begin
|
|
for j := 0 to xml.ContainCount - 1 do
|
|
if xml.Contains[j].IsIncluded(target) then
|
|
begin
|
|
containsSomething := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
// Save the file, if it contains something, and it
|
|
// has changed when compared with the existing one
|
|
if containsSomething and
|
|
(HasFileChanged(OutFileName, templateName, outFile, TimeStampLine)) then
|
|
begin
|
|
tmpStr := ExtractFilePath(templateName);
|
|
if tmpStr[length(tmpStr)] = DirDelimiter then
|
|
SetLength(tmpStr, length(tmpStr)-1);
|
|
if ExtractFileName(tmpStr) = FTargetList[GetNonPersoTarget(target)].PDir then
|
|
SendMsg(SysUtils.Format(#9#9'Writing %s for %s (%s template used)', [ExtractFileName(OutFileName), target, target]))
|
|
else
|
|
SendMsg(SysUtils.Format(#9#9'Writing %s for %s', [ExtractFileName(OutFileName), target]));
|
|
|
|
// if outfile contains line, save it.
|
|
// else, it's because the template file was a binary file, so simply
|
|
// copy it to the destination name
|
|
SetFileAttributes(PChar(OutFileName), 0); // do not fail on read only files
|
|
if outFile.count > 0 then
|
|
outFile.SaveToFile(OutFileName)
|
|
else
|
|
begin
|
|
CopyFile(PChar(templateName), PChar(OutFileName), False);
|
|
FileSetDate(OutFileName, DateTimeToFileDate(Now)); // adjust file time
|
|
end;
|
|
end
|
|
else
|
|
if FileExists(OutFileName) and not containsSomething then
|
|
SendMsg(SysUtils.Format(#9#9'File %s should be removed', [ExtractFileName(OutFileName)]));
|
|
finally
|
|
tmpLines.Free;
|
|
repeatLines.Free;
|
|
CompilerDefines.Free;
|
|
outFile.Free;
|
|
end;
|
|
end;
|
|
{$WARNINGS ON}
|
|
|
|
function TPackageGenerator.IsBinaryFile(const Filename: string): Boolean;
|
|
const
|
|
BufferSize = 50;
|
|
BinaryPercent = 10;
|
|
var
|
|
F : TFileStream;
|
|
Buffer : array[0..BufferSize] of AnsiChar;
|
|
I, Index : Integer;
|
|
BinaryCount : Integer;
|
|
begin
|
|
Result := False;
|
|
// If the cache contains information on that file, get the result
|
|
// from it and skip the real test
|
|
if FIsBinaryCache.Find(FileName, Index) then
|
|
begin
|
|
Result := Boolean(FIsBinaryCache.Objects[Index]);
|
|
Exit;
|
|
end;
|
|
|
|
// Read the first characters of the file and if enough of them
|
|
// are not text characters, then consider the file to be binary
|
|
if FileExists(FileName) then
|
|
begin
|
|
F := TFileStream.Create(FileName, fmOpenRead);
|
|
try
|
|
F.Read(Buffer, (BufferSize+1) * SizeOf(AnsiChar));
|
|
BinaryCount := 0;
|
|
for I := 0 to BufferSize do
|
|
if not (Buffer[I] in [#9, #13, #10, #32..#127]) then
|
|
Inc(BinaryCount);
|
|
|
|
Result := BinaryCount > BufferSize * BinaryPercent div 100;
|
|
finally
|
|
F.Free;
|
|
end;
|
|
end;
|
|
|
|
// save the result in the cache
|
|
FIsBinaryCache.AddObject(FileName, TObject(Result));
|
|
end;
|
|
|
|
// loads the .inc file into Defines and returns True if the Filename contains
|
|
// a "%t"
|
|
function TPackageGenerator.LoadDefines(const Target: string; Filename: string): Boolean;
|
|
var
|
|
incfile : TStringList;
|
|
ps: Integer;
|
|
begin
|
|
Result := False;
|
|
FreeAndNil(FDefinesConditionParser);
|
|
|
|
// read the include file for this target or the default file if jvclxx.inc does not exist
|
|
ps := Pos('%t', Filename);
|
|
if ps > 0 then
|
|
begin
|
|
Delete(Filename, ps, 2);
|
|
Insert(LowerCase(Target), Filename, ps);
|
|
if not FileExists(Filename) then
|
|
Filename := FIncDefFileName;
|
|
Result := True;
|
|
end;
|
|
incfile := TStringList.Create;
|
|
try
|
|
if FileExists(Filename) then
|
|
incfile.LoadFromFile(Filename);
|
|
FDefinesConditionParser := TDefinesConditionParser.Create(incfile, FTargetList[GetNonPersoTarget(Target)].Defines);
|
|
finally
|
|
incfile.free;
|
|
end;
|
|
end;
|
|
|
|
function TPackageGenerator.Generate(packages : TStrings;
|
|
targets : TStrings;
|
|
callback : TGenerateCallback;
|
|
const XmlFileName : string;
|
|
const ModelName : string;
|
|
var ErrMsg : string;
|
|
path : string = '';
|
|
prefix : string = '';
|
|
format : string = '';
|
|
incfileName : string = ''
|
|
) : Boolean;
|
|
var
|
|
rec : TSearchRec;
|
|
i : Integer;
|
|
j : Integer;
|
|
templateName, templateExtension, templateNamePers : string;
|
|
xml : TPackageXmlInfo;
|
|
xmlName : string;
|
|
template, templatePers : TStringList;
|
|
persoTarget : string;
|
|
target : string;
|
|
GenericIncFile: Boolean;
|
|
|
|
begin
|
|
Result := True;
|
|
|
|
if packages.Count = 0 then
|
|
begin
|
|
ErrMsg := '[Error] No package to generate, no xml file found';
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
if not LoadConfig(XmlFileName, ModelName, ErrMsg) then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
// Empty the binary file cache
|
|
FIsBinaryCache.Clear;
|
|
|
|
if incFileName = '' then
|
|
incFileName := FIncFileName;
|
|
GenericIncFile := LoadDefines('', incFileName);
|
|
|
|
FCallBack := CallBack;
|
|
|
|
if path = '' then
|
|
begin
|
|
if PathIsAbsolute(FPackagesLocation) then
|
|
path := FPackagesLocation
|
|
else
|
|
path := PathNoInsideRelative(StrEnsureSuffix(DirDelimiter, FStartupDir) + FPackagesLocation);
|
|
end;
|
|
|
|
path := StrEnsureSuffix(DirDelimiter, path);
|
|
|
|
if prefix <> '' then
|
|
FPrefix := Prefix;
|
|
if format <> '' then
|
|
FFormat := Format;
|
|
|
|
// for all targets
|
|
for i := 0 to targets.Count - 1 do
|
|
begin
|
|
target := targets[i];
|
|
if GenericIncFile then
|
|
LoadDefines(target, incFileName);
|
|
|
|
SendMsg(SysUtils.Format('Generating packages for %s', [target]));
|
|
// find all template files for that target
|
|
if FindFirst(path + TargetToDir(target) + DirDelimiter + 'template.*',
|
|
faAnyFile, rec) = 0 then
|
|
begin
|
|
repeat
|
|
template := TStringList.Create;
|
|
templatePers := TStringList.Create;
|
|
try
|
|
SendMsg(SysUtils.Format(#9'Loaded %s', [rec.Name]));
|
|
|
|
templateName := path + TargetToDir(target) + DirDelimiter + rec.Name;
|
|
if IsBinaryFile(templateName) then
|
|
template.Clear
|
|
else
|
|
template.LoadFromFile(templateName);
|
|
|
|
// Try to find a template file named the same as the
|
|
// current one in the perso directory so it can
|
|
// be used instead
|
|
templateNamePers := templateName;
|
|
templatePers.Assign(template);
|
|
persoTarget := GetPersoTarget(target);
|
|
if (persoTarget <> '') and
|
|
DirectoryExists(path+TargetToDir(persoTarget)) then
|
|
begin
|
|
templateNamePers := path + TargetToDir(persoTarget) + DirDelimiter + rec.Name;
|
|
if FileExists(templateNamePers) then
|
|
begin
|
|
if IsBinaryFile(templateNamePers) then
|
|
templatePers.Clear
|
|
else
|
|
templatePers.LoadFromFile(templateNamePers);
|
|
end
|
|
else
|
|
begin
|
|
templateNamePers := templateName;
|
|
end
|
|
end;
|
|
|
|
// apply the template for all packages
|
|
for j := 0 to packages.Count - 1 do
|
|
begin
|
|
// load (buffered) xml file
|
|
xmlName := path + 'xml' + DirDelimiter + packages[j] + '.xml';
|
|
xml := GetPackageXmlInfo(xmlName);
|
|
|
|
TemplateExtension := ExtractFileExt(templateName);
|
|
|
|
persoTarget := ApplyTemplateAndSave(
|
|
path,
|
|
target,
|
|
packages[j],
|
|
ExtractFileExt(rec.Name),
|
|
template,
|
|
xml,
|
|
templateName,
|
|
xmlName);
|
|
|
|
// if the generation requested a perso target to be done
|
|
// then generate it now, using the perso template
|
|
if persoTarget <> '' then
|
|
begin
|
|
ApplyTemplateAndSave(
|
|
path,
|
|
persoTarget,
|
|
packages[j],
|
|
ExtractFileExt(rec.Name),
|
|
templatePers,
|
|
xml,
|
|
templateNamePers,
|
|
xmlName);
|
|
end;
|
|
end;
|
|
finally
|
|
template.Free;
|
|
templatePers.Free;
|
|
end;
|
|
until FindNext(rec) <> 0;
|
|
end
|
|
else
|
|
SendMsg(SysUtils.Format(#9'No template found for %s' , [target]));
|
|
FindClose(rec);
|
|
end;
|
|
{ if makeDof then
|
|
begin
|
|
SendMsg('Calling MakeDofs.bat');
|
|
ShellExecute(0,
|
|
'',
|
|
PChar(StrEnsureSuffix(DirDelimiter, ExtractFilePath(ParamStr(0))) + 'MakeDofs.bat'),
|
|
'',
|
|
PChar(ExtractFilePath(ParamStr(0))),
|
|
SW_SHOW);
|
|
end;}
|
|
end;
|
|
|
|
{ TProjectProperties }
|
|
|
|
constructor TProjectProperties.Create(Node: TJclSimpleXmlElem);
|
|
var
|
|
i: Integer;
|
|
NameProp, ValueProp: TJclSimpleXMLProp;
|
|
begin
|
|
inherited Create;
|
|
|
|
if Assigned(Node) then
|
|
for i := 0 to Node.Items.Count - 1 do
|
|
begin
|
|
NameProp := Node.Items.Item[i].Properties.ItemNamed['name'];
|
|
ValueProp := Node.Items.Item[i].Properties.ItemNamed['value'];
|
|
if Assigned(NameProp) and Assigned(ValueProp) then
|
|
Values[NameProp.Value] := ValueProp.Value;
|
|
end;
|
|
end;
|
|
|
|
end.
|