mirror of https://gitlab.com/basile.b/dexed.git
1520 lines
44 KiB
Plaintext
1520 lines
44 KiB
Plaintext
unit ce_dmdwrap;
|
|
|
|
{$I ce_defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
classes, sysutils, process, asyncprocess,
|
|
ce_common, ce_processes, ce_interfaces;
|
|
|
|
(*
|
|
|
|
procedure to add a new compiler option:
|
|
- the option must be published with a setter proc, in the setter 'doChanged' must be called.
|
|
- getOpts must be updated to generate the new option.
|
|
- Assign() must be updated to copy the new option. (used when cloning a configuration)
|
|
|
|
*)
|
|
|
|
type
|
|
|
|
(*****************************************************************************
|
|
* Base class designed to encapsulate some compiler options.
|
|
* A descendant must be able to generate the related options
|
|
* as a string representing the partial switches/arguments.
|
|
*)
|
|
TOptsGroup = class(TPersistent)
|
|
private
|
|
fOnChange: TNotifyEvent;
|
|
procedure doChanged;
|
|
protected
|
|
fSymStringExpander: ICESymStringExpander;
|
|
property onChange: TNotifyEvent read fOnChange write fOnChange;
|
|
public
|
|
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); virtual; abstract;
|
|
constructor create; virtual;
|
|
end;
|
|
|
|
(*****************************************************************************
|
|
* Encapsulates the options/args related to the DDoc and JSON generation.
|
|
*)
|
|
TDocOpts = class(TOptsGroup)
|
|
private
|
|
fGenDoc: boolean;
|
|
fDocDir: TCEPathname;
|
|
fGenJson: boolean;
|
|
fJsonFname: TCEFilename;
|
|
procedure setGenDoc(const aValue: boolean);
|
|
procedure setGenJSON(const aValue: boolean);
|
|
procedure setDocDir(const aValue: TCEPathname);
|
|
procedure setJSONFile(const aValue: TCEFilename);
|
|
published
|
|
property generateDocumentation: boolean read fGenDoc write setGenDoc default false;
|
|
property generateJSON: boolean read fGenJson write setGenJSON default false;
|
|
property DocumentationDirectory: TCEPathname read fDocDir write setDocDir;
|
|
property JSONFilename: TCEFilename read fJsonFname write setJSONFile;
|
|
public
|
|
procedure assign(aValue: TPersistent); override;
|
|
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
|
end;
|
|
|
|
|
|
(*****************************************************************************
|
|
* Describes the different deprecation handling.
|
|
*)
|
|
TDepHandling = (silent, warning, error);
|
|
|
|
(*****************************************************************************
|
|
* Encapsulates the options/args related to the compiler output messages.
|
|
*)
|
|
TMsgOpts = class(TOptsGroup)
|
|
private
|
|
fDepHandling : TDepHandling;
|
|
fVerbose: boolean;
|
|
fWarnings: boolean;
|
|
fWarnInfo: boolean;
|
|
fVtls: boolean;
|
|
fQuiet: boolean;
|
|
fVgc: boolean;
|
|
fCol: boolean;
|
|
procedure setDepHandling(const aValue: TDepHandling);
|
|
procedure setVerbose(const aValue: boolean);
|
|
procedure setWarnings(const aValue: boolean);
|
|
procedure setWarnInfo(const aValue: boolean);
|
|
procedure setVtls(const aValue: boolean);
|
|
procedure setQuiet(const aValue: boolean);
|
|
procedure setVgc(const aValue: boolean);
|
|
procedure setCol(const aValue: boolean);
|
|
published
|
|
property deprecationHandling: TDepHandling read fDepHandling write setDepHandling default warning;
|
|
property verbose: boolean read fVerbose write setVerbose default false;
|
|
property warnings: boolean read fWarnings write setWarnings default true;
|
|
property warningsAsInfo: boolean read fWarnInfo write setWarnInfo default false;
|
|
property tlsInformations: boolean read fVtls write setVtls default false;
|
|
property quiet: boolean read fQuiet write setQuiet default false;
|
|
property showHiddenAlloc: boolean read fVgc write setVgc default false;
|
|
property showColumnsNumber: boolean read fCol write setCol default false;
|
|
public
|
|
constructor create; override;
|
|
procedure assign(aValue: TPersistent); override;
|
|
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
|
end;
|
|
|
|
(**
|
|
* Describes the target registry size.
|
|
*)
|
|
TTargetSystem = (auto, os32bit, os64bit);
|
|
|
|
(**
|
|
* Describes the bounds check kinds.
|
|
*)
|
|
TBoundCheckKind = (onAlways, safeOnly, offAlways);
|
|
|
|
(*****************************************************************************
|
|
* Encapsulates the options/args related to the analysis & the code gen.
|
|
*)
|
|
TOutputOpts = class(TOptsGroup)
|
|
private
|
|
fTrgKind: TTargetSystem;
|
|
fBinKind: TProjectBinaryKind;
|
|
fUnittest: boolean;
|
|
fVerIds: TStringList;
|
|
fInline: boolean;
|
|
fBoundsCheck: TBoundCheckKind;
|
|
fOptimz: boolean;
|
|
fGenStack: boolean;
|
|
fAddMain: boolean;
|
|
fRelease: boolean;
|
|
fAllInst: boolean;
|
|
fStackStomp: boolean;
|
|
fAlwayLinkLibs: boolean;
|
|
procedure setAlwaysLinkLibs(const aValue: boolean);
|
|
procedure setAllInst(const aValue: boolean);
|
|
procedure setUnittest(const aValue: boolean);
|
|
procedure setTrgKind(const aValue: TTargetSystem);
|
|
procedure setBinKind(const aValue: TProjectBinaryKind);
|
|
procedure setInline(const aValue: boolean);
|
|
procedure setBoundsCheck(const aValue: TBoundCheckKind);
|
|
procedure setOptims(const aValue: boolean);
|
|
procedure setGenStack(const aValue: boolean);
|
|
procedure setAddMain(const aValue: boolean);
|
|
procedure setRelease(const aValue: boolean);
|
|
procedure setVerIds(const aValue: TStringList);
|
|
procedure setStackStomp(const aValue: boolean);
|
|
published
|
|
property alwaysLinkStaticLibs: boolean read fAlwayLinkLibs write setAlwaysLinkLibs default false;
|
|
property targetKind: TTargetSystem read fTrgKind write setTrgKind default auto;
|
|
property binaryKind: TProjectBinaryKind read fBinKind write setBinKind default executable;
|
|
property inlining: boolean read fInline write setInline default false;
|
|
property boundsCheck: TBoundCheckKind read fBoundsCheck write setBoundsCheck default safeOnly;
|
|
property optimizations: boolean read fOptimz write setOptims default false;
|
|
property addMain: boolean read fAddMain write setAddMain default false;
|
|
property release: boolean read fRelease write setRelease default false;
|
|
property unittest: boolean read fUnittest write setUnittest default false;
|
|
property versionIdentifiers: TStringList read fVerIds write setVerIds;
|
|
property generateAllTmpCode: boolean read fAllInst write setAllInst default false;
|
|
property addStackStompCode: boolean read fStackStomp write setStackStomp default false;
|
|
//TODO-cmaintenace: remove deprecated props after next rlz
|
|
property generateStackFrame: boolean write setGenStack stored false; deprecated;
|
|
public
|
|
constructor create; override;
|
|
destructor destroy; override;
|
|
procedure assign(aValue: TPersistent); override;
|
|
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
|
end;
|
|
|
|
(*****************************************************************************
|
|
* Encapsulates the options/args related to the debugging
|
|
*)
|
|
TDebugOpts = class(TOptsGroup)
|
|
private
|
|
fDebugConditions: boolean;
|
|
fGenInfos: boolean;
|
|
fDbgC: boolean;
|
|
fGenMap: boolean;
|
|
fDbgIdents: TStringList;
|
|
fDbgLevel: Integer;
|
|
fForceDbgBool: boolean;
|
|
fGenFrame: boolean;
|
|
procedure updateForceDbgBool;
|
|
procedure setGenFrame(const aValue: boolean);
|
|
procedure setDebugConditions(const aValue: boolean);
|
|
procedure setGenInfos(const aValue: boolean);
|
|
procedure setDbgC(const aValue: boolean);
|
|
procedure setGenMap(const aValue: boolean);
|
|
procedure setDbgLevel(const aValue: Integer);
|
|
procedure setDbgIdents(aValue: TStringList);
|
|
published
|
|
property debugConditions: boolean read fDebugConditions write setDebugConditions default false;
|
|
property debugIdentifiers: TStringList read fDbgIdents write setDbgIdents;
|
|
property debugLevel: Integer read fDbgLevel write setDbgLevel default 0;
|
|
property generateInfos: boolean read fGenInfos write setGenInfos default false;
|
|
property generateMapFile: boolean read fGenMap write setGenMap default false;
|
|
property generateStackFrame: boolean read fGenFrame write setGenFrame default false;
|
|
//TODO-cmaintenace: remove deprecated props after next rlz
|
|
property debug: boolean write setDebugConditions; deprecated;
|
|
property codeviewDexts: boolean write setGenInfos stored false; deprecated;
|
|
property codeviewCformat: boolean write setDbgC stored false; deprecated;
|
|
public
|
|
constructor create; override;
|
|
destructor destroy; override;
|
|
procedure assign(aValue: TPersistent); override;
|
|
procedure getOpts(aList: TStrings;base: TOptsGroup = nil); override;
|
|
end;
|
|
|
|
(*****************************************************************************
|
|
* Encapsulates the options/args related to the output and include paths
|
|
*)
|
|
TPathsOpts = class(TOptsGroup)
|
|
private
|
|
fExtraSrcs: TStringList;
|
|
fImpMod: TStringList;
|
|
fImpStr: TStringList;
|
|
fExcl: TStringList;
|
|
fFname: TCEFilename;
|
|
fObjDir: TCEPathname;
|
|
fForceExt: boolean;
|
|
procedure setForceExt(aValue: boolean);
|
|
procedure setFname(const aValue: TCEFilename);
|
|
procedure setObjDir(const aValue: TCEPathname);
|
|
procedure setSrcs(aValue: TStringList);
|
|
procedure setIncl(aValue: TStringList);
|
|
procedure setImpt(aValue: TStringList);
|
|
procedure setExcl(aValue: TStringList);
|
|
procedure strLstChange(sender: TObject);
|
|
published
|
|
property outputFilename: TCEFilename read fFname write setFname;
|
|
property objectDirectory: TCEPathname read fObjDir write setObjDir;
|
|
property exclusions: TStringList read fExcl write setExcl;
|
|
property extraSources: TStringList read fExtraSrcs write setSrcs;
|
|
property importModulePaths: TStringList read fImpMod write setIncl;
|
|
property importStringPaths: TStringList read fImpStr write setImpt;
|
|
property forceExtension: boolean read fForceExt write setForceExt default false;
|
|
public
|
|
constructor create; override;
|
|
destructor destroy; override;
|
|
procedure assign(aValue: TPersistent); override;
|
|
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
|
end;
|
|
|
|
(*****************************************************************************
|
|
* Encapsulates the unclassified and custom options/args
|
|
*)
|
|
TOtherOpts = class(TOptsGroup)
|
|
private
|
|
fCov: boolean;
|
|
fCustom: TStringList;
|
|
procedure setCov(const aValue: boolean);
|
|
procedure setCustom(aValue: TStringList);
|
|
published
|
|
property coverage: boolean read fCov write setCov default false;
|
|
property customOptions: TStringList read fCustom write setCustom;
|
|
public
|
|
constructor create; override;
|
|
destructor destroy; override;
|
|
procedure assign(aValue: TPersistent); override;
|
|
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
|
end;
|
|
|
|
(*****************************************************************************
|
|
* Encapsulates the most common TProcess options.
|
|
* Used to simplify pre/post-compilation and run process options.
|
|
*)
|
|
TCustomProcOptions = class(TOptsGroup)
|
|
private
|
|
fExecutable: TCEFilename;
|
|
fWorkDir: TCEPathname;
|
|
fOptions: TProcessOptions;
|
|
fParameters: TStringList;
|
|
fShowWin: TShowWindowOptions;
|
|
fCommands: TStringList;
|
|
procedure setExecutable(const aValue: TCEFilename);
|
|
procedure setWorkDir(const aValue: TCEPathname);
|
|
procedure setOptions(const aValue: TProcessOptions);
|
|
procedure setParameters(aValue: TStringList);
|
|
procedure setShowWin(const aValue: TShowWindowOptions);
|
|
procedure setCommands(aValue: TStringList);
|
|
protected
|
|
property executable: TCEFilename read fExecutable write setExecutable;
|
|
property workingDirectory: TCEPathname read fWorkDir write setWorkDir;
|
|
property options: TProcessOptions read fOptions write setOptions default [];
|
|
property parameters: TStringList read fParameters write setParameters;
|
|
property showWindow: TShowWindowOptions read fShowWin write setShowWin default swoNone;
|
|
property simpleCommands: TStringList read fCommands write setCommands;
|
|
public
|
|
constructor create; override;
|
|
destructor destroy; override;
|
|
procedure assign(source: TPersistent); override;
|
|
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
|
{ TAsyncProcess "Parameters" inherits from UTF8 process,
|
|
and the property reader is not anymore "fParameters" but "fUTF8Parameters"
|
|
without the overload aProcess does not get the Parameters if aProcess is TAsynProcess...}
|
|
procedure setProcess(var aProcess: TProcess);
|
|
procedure setProcess(var aProcess: TAsyncProcess);
|
|
procedure setProcess(var aProcess: TCEProcess);
|
|
end;
|
|
|
|
(*****************************************************************************
|
|
* Encapsulates the options for the pre/post compilation processes
|
|
*)
|
|
TCompileProcOptions = class(TCustomProcOptions)
|
|
published
|
|
property executable;
|
|
property workingDirectory;
|
|
property options default [];
|
|
property parameters;
|
|
property showWindow default swoNone;
|
|
property simpleCommands;
|
|
end;
|
|
|
|
(*****************************************************************************
|
|
* Encapsulates the options for the project run process.
|
|
* 'executable' prop is hidden since it's defined by the project.
|
|
*)
|
|
TProjectRunOptions = class(TCustomProcOptions)
|
|
published
|
|
property workingDirectory;
|
|
property options default [];
|
|
property parameters;
|
|
property showWindow default swoNone;
|
|
end;
|
|
|
|
(*****************************************************************************
|
|
* Encapsulates all the contextual options/args
|
|
*)
|
|
TCompilerConfiguration = class(TCollectionItem)
|
|
private
|
|
fSymStringExpander: ICESymStringExpander;
|
|
fName: string;
|
|
fOnChanged: TNotifyEvent;
|
|
fDocOpts: TDocOpts;
|
|
fDebugOpts: TDebugOpts;
|
|
fMsgOpts: TMsgOpts;
|
|
fOutputOpts: TOutputOpts;
|
|
fPathsOpts: TPathsOpts;
|
|
fOthers: TOtherOpts;
|
|
fPreProcOpt: TCompileProcOptions;
|
|
fPostProcOpt: TCompileProcOptions;
|
|
fRunProjOpt: TProjectRunOptions;
|
|
fIsBaseConfiguration: boolean;
|
|
fIsOverriddenConfiguration: boolean;
|
|
procedure doChanged;
|
|
procedure subOptsChanged(sender: TObject);
|
|
procedure setName(const aValue: string);
|
|
procedure setDocOpts(const aValue: TDocOpts);
|
|
procedure setDebugOpts(const aValue: TDebugOpts);
|
|
procedure setMsgOpts(const aValue: TMsgOpts);
|
|
procedure setOutputOpts(const aValue: TOutputOpts);
|
|
procedure setPathsOpts(const aValue: TPathsOpts);
|
|
procedure setOthers(const aValue: TOtherOpts);
|
|
procedure setPreProcOpt(const aValue: TCompileProcOptions);
|
|
procedure setPostProcOpt(const aValue: TCompileProcOptions);
|
|
procedure setRunProjOpt(const aValue: TProjectRunOptions);
|
|
procedure setisBaseConfiguration(const aValue: boolean);
|
|
procedure setisOverriddenConfiguration(const aValue: boolean);
|
|
protected
|
|
function nameFromID: string;
|
|
published
|
|
property name: string read fName write setName;
|
|
property documentationOptions: TDocOpts read fDocOpts write setDocOpts;
|
|
property debugingOptions: TDebugOpts read fDebugOpts write setDebugOpts;
|
|
property messagesOptions: TMsgOpts read fMsgOpts write setMsgOpts;
|
|
property outputOptions: TOutputOpts read fOutputOpts write setOutputOpts;
|
|
property pathsOptions: TPathsOpts read fPathsOpts write setPathsOpts;
|
|
property otherOptions: TOtherOpts read fOthers write setOthers;
|
|
property preBuildProcess: TCompileProcOptions read fPreProcOpt write setPreProcOpt;
|
|
property postBuildProcess: TCompileProcOptions read fPostProcOpt write setPostProcOpt;
|
|
property runOptions: TProjectRunOptions read fRunProjOpt write setRunProjOpt;
|
|
property isBaseConfiguration: boolean read fIsBaseConfiguration write setisBaseConfiguration default false;
|
|
property isOverriddenConfiguration: boolean read fIsOverriddenConfiguration write setisOverriddenConfiguration default false;
|
|
public
|
|
constructor create(aCollection: TCollection); override;
|
|
destructor destroy; override;
|
|
procedure assign(aValue: TPersistent); override;
|
|
procedure getOpts(aList: TStrings; base: TCompilerConfiguration = nil);
|
|
property onChanged: TNotifyEvent read fOnChanged write fOnChanged;
|
|
end;
|
|
|
|
implementation
|
|
|
|
constructor TOptsGroup.create;
|
|
begin
|
|
fSymStringExpander := getSymStringExpander;
|
|
end;
|
|
|
|
procedure TOptsGroup.doChanged;
|
|
begin
|
|
if assigned(fOnChange) then fOnChange(self);
|
|
end;
|
|
|
|
{$REGION TDocOpts --------------------------------------------------------------}
|
|
procedure TDocOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
|
var
|
|
baseopt: TDocOpts;
|
|
begin
|
|
if base.isNil then
|
|
begin
|
|
if fGenDoc then
|
|
aList.Add('-D');
|
|
if fGenJson then
|
|
aList.Add('-X');
|
|
if fDocDir <> '' then
|
|
aList.Add('-Dd' + fSymStringExpander.expand(fDocDir));
|
|
if fJsonFname <> '' then
|
|
aList.Add('-Xf' + fSymStringExpander.expand(fJsonFname));
|
|
end else
|
|
begin
|
|
baseopt := TDocOpts(base);
|
|
if baseopt.fGenDoc or fGenDoc then
|
|
aList.Add('-D');
|
|
if baseopt.fGenJson or fGenJson then
|
|
aList.Add('-X');
|
|
if (baseopt.fDocDir <> '') and (fDocDir <> '') then
|
|
aList.Add('-Dd' + fSymStringExpander.expand(fDocDir))
|
|
else if (fDocDir <> '') then
|
|
aList.Add('-Dd' + fSymStringExpander.expand(fDocDir))
|
|
else if (baseopt.fDocDir <> '') then
|
|
aList.Add('-Dd' + fSymStringExpander.expand(baseopt.fDocDir));
|
|
if (baseopt.fJsonFname <> '') and (fJsonFname <> '') then
|
|
aList.Add('-Xf' + fSymStringExpander.expand(fJsonFname))
|
|
else if fJsonFname <> '' then
|
|
aList.Add('-Xf' + fSymStringExpander.expand(fJsonFname))
|
|
else if (baseopt.fJsonFname <> '') then
|
|
aList.Add('-Dd' + fSymStringExpander.expand(baseopt.fJsonFname));
|
|
end;
|
|
end;
|
|
|
|
procedure TDocOpts.assign(aValue: TPersistent);
|
|
var
|
|
src: TDocOpts;
|
|
begin
|
|
if (aValue is TDocOpts) then
|
|
begin
|
|
src := TDocOpts(aValue);
|
|
//
|
|
fGenDoc := src.fGenDoc;
|
|
fGenJson := src.fGenJson;
|
|
fDocDir := patchPlateformPath(src.fDocDir);
|
|
fJsonFname:= patchPlateformPath(src.fJsonFname);
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TDocOpts.setGenDoc(const aValue: boolean);
|
|
begin
|
|
if fDocDir <> '' then
|
|
begin
|
|
fGenDoc := true;
|
|
exit;
|
|
end;
|
|
//
|
|
if fGenDoc = aValue then
|
|
exit;
|
|
fGenDoc := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TDocOpts.setGenJSON(const aValue: boolean);
|
|
begin
|
|
if fJsonFname <> '' then
|
|
begin
|
|
fGenJson := true;
|
|
exit;
|
|
end;
|
|
//
|
|
if fGenJson = aValue then
|
|
exit;
|
|
fGenJson := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TDocOpts.setDocDir(const aValue: TCEPathname);
|
|
begin
|
|
if fDocDir = aValue then
|
|
exit;
|
|
fDocDir := patchPlateformPath(aValue);
|
|
if fDocDir <> '' then
|
|
setGenDoc(true);
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TDocOpts.setJSONFile(const aValue: TCEFilename);
|
|
begin
|
|
if fJsonFname = aValue then
|
|
exit;
|
|
fJsonFname := patchPlateformPath(aValue);
|
|
if fJsonFname <> '' then
|
|
setGenJSON(true);
|
|
doChanged;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
{$REGION TMsgOpts --------------------------------------------------------------}
|
|
constructor TMsgOpts.create;
|
|
begin
|
|
inherited;
|
|
fDepHandling := TDepHandling.warning;
|
|
fWarnings := true;
|
|
end;
|
|
|
|
procedure TMsgOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
|
var
|
|
dep, depbase: string;
|
|
baseopt: TMsgOpts;
|
|
const
|
|
DepStr : array[TDepHandling] of string = ('-d', '', '-de');
|
|
begin
|
|
if base.isNil then
|
|
begin
|
|
dep := DepStr[fDepHandling];
|
|
if dep.isNotEmpty then aList.Add(dep);
|
|
if fVerbose then aList.Add('-v');
|
|
if fWarnings then aList.Add('-w');
|
|
if fWarnInfo then aList.Add('-wi');
|
|
if fVtls then aList.Add('-vtls');
|
|
if fQuiet then aList.Add('-quiet');
|
|
if fVgc then aList.Add('-vgc');
|
|
if fCol then aList.Add('-vcolumns');
|
|
end else
|
|
begin
|
|
baseopt := TMsgOpts(base);
|
|
dep := DepStr[fDepHandling];
|
|
depbase := DepStr[baseopt.fDepHandling];
|
|
if dep <> depbase then aList.Add(dep) else aList.Add(depbase);
|
|
if baseopt.fVerbose or fVerbose then aList.Add('-v');
|
|
if baseopt.fWarnings or fWarnings then aList.Add('-w');
|
|
if baseopt.fWarnInfo or fWarnInfo then aList.Add('-wi');
|
|
if baseopt.fVtls or fVtls then aList.Add('-vtls');
|
|
if baseopt.fQuiet or fQuiet then aList.Add('-quiet');
|
|
if baseopt.fVgc or fVgc then aList.Add('-vgc');
|
|
if baseopt.fCol or fCol then aList.Add('-vcolumns');
|
|
end;
|
|
end;
|
|
|
|
procedure TMsgOpts.assign(aValue: TPersistent);
|
|
var
|
|
src: TMsgOpts;
|
|
begin
|
|
if (aValue is TMsgOpts) then
|
|
begin
|
|
src := TMsgOpts(aValue);
|
|
//
|
|
fDepHandling := src.fDepHandling;
|
|
fVerbose := src.fVerbose;
|
|
fWarnings := src.fWarnings;
|
|
fWarnInfo := src.fWarnInfo;
|
|
fVtls := src.fVtls;
|
|
fQuiet := src.fQuiet;
|
|
fVgc := src.fVgc;
|
|
fCol := src.fCol;
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TMsgOpts.setDepHandling(const aValue: TDepHandling);
|
|
begin
|
|
if fDepHandling = aValue then exit;
|
|
fDepHandling := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TMsgOpts.setVerbose(const aValue: boolean);
|
|
begin
|
|
if fVerbose = aValue then exit;
|
|
fVerbose := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TMsgOpts.setWarnings(const aValue: boolean);
|
|
begin
|
|
if fWarnings = aValue then exit;
|
|
fWarnings := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TMsgOpts.setWarnInfo(const aValue: boolean);
|
|
begin
|
|
if fWarnInfo = aValue then exit;
|
|
fWarnInfo := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TMsgOpts.setVtls(const aValue: boolean);
|
|
begin
|
|
if fVtls = aValue then exit;
|
|
fVtls := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TMsgOpts.setQuiet(const aValue: boolean);
|
|
begin
|
|
if fQuiet = aValue then exit;
|
|
fQuiet := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TMsgOpts.setVgc(const aValue: boolean);
|
|
begin
|
|
if fVgc = aValue then exit;
|
|
fVgc := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TMsgOpts.setCol(const aValue: boolean);
|
|
begin
|
|
if fCol = aValue then exit;
|
|
fCol := aValue;
|
|
doChanged;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
{$REGION TOutputOpts -----------------------------------------------------------}
|
|
constructor TOutputOpts.create;
|
|
begin
|
|
inherited;
|
|
fVerIds := TStringList.Create;
|
|
fBoundsCheck := safeOnly;
|
|
end;
|
|
|
|
destructor TOutputOpts.destroy;
|
|
begin
|
|
fVerIds.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TOutputOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
|
var
|
|
str, strbase: string;
|
|
baseopt: TOutputOpts;
|
|
const
|
|
trgKindStr: array[TTargetSystem] of string = ('', '-m32','-m64');
|
|
binKindStr: array[TProjectBinaryKind] of string = ('', '-lib', '-shared', '-c');
|
|
bchKindStr: array[TBoundCheckKind] of string = ('on', 'safeonly', 'off');
|
|
begin
|
|
if base.isNil then
|
|
begin
|
|
str := binKindStr[fBinKind];
|
|
if str.isNotEmpty then aList.Add(str);
|
|
{$IFNDEF WINDOWS}
|
|
if fBinKind = sharedlib then
|
|
aList.Add('-fPIC');
|
|
{$ENDIF}
|
|
str := trgKindStr[fTrgKind];
|
|
if str.isNotEmpty then aList.Add(str);
|
|
if fUnittest then aList.Add('-unittest');
|
|
if fInline then aList.Add('-inline');
|
|
if fOptimz then aList.Add('-O');
|
|
if fStackStomp then aList.Add('-gx');
|
|
if fAllInst then aList.Add('-allinst');
|
|
if fAddMain then aList.Add('-main');
|
|
if fRelease then aList.Add('-release');
|
|
for str in fVerIds do
|
|
if not isStringDisabled(str) then aList.Add('-version=' + str);
|
|
//
|
|
if fRelease then
|
|
begin
|
|
if fBoundsCheck <> safeOnly then
|
|
aList.Add('-boundscheck=' + bchKindStr[fBoundsCheck] );
|
|
end
|
|
else
|
|
if fBoundsCheck <> onAlways then
|
|
aList.Add('-boundscheck=' + bchKindStr[fBoundsCheck] );
|
|
end else
|
|
begin
|
|
baseopt := TOutputOpts(base);
|
|
str := binKindStr[fBinKind];
|
|
strbase := binKindStr[baseopt.fBinKind];
|
|
if (str <> strbase) then
|
|
begin
|
|
aList.Add(str);
|
|
{$IFNDEF WINDOWS}
|
|
if fBinKind = sharedlib then
|
|
aList.Add('-fPIC');
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
begin
|
|
aList.Add(strbase);
|
|
{$IFNDEF WINDOWS}
|
|
if baseopt.fBinKind = sharedlib then
|
|
aList.Add('-fPIC');
|
|
{$ENDIF}
|
|
end;
|
|
str := trgKindStr[fTrgKind];
|
|
strbase := trgKindStr[baseopt.fTrgKind];
|
|
if (str <> strbase) then aList.Add(str) else aList.Add(strbase);
|
|
if baseopt.fUnittest or fUnittest then aList.Add('-unittest');
|
|
if baseopt.fInline or fInline then aList.Add('-inline');
|
|
if baseopt.fOptimz or fOptimz then aList.Add('-O');
|
|
if baseopt.fStackStomp or fStackStomp then aList.Add('-gx');
|
|
if baseopt.fAllInst or fAllInst then aList.Add('-allinst');
|
|
if baseopt.fAddMain or fAddMain then aList.Add('-main');
|
|
if baseopt.fRelease or fRelease then aList.Add('-release');
|
|
if (fVerIds.Count = 0) then for str in baseopt.fVerIds do begin
|
|
if not isStringDisabled(str) then aList.Add('-version=' + str);
|
|
end else for str in fVerIds do
|
|
if not isStringDisabled(str) then aList.Add('-version=' + str);
|
|
// default values are not handled here, TODO
|
|
if fBoundsCheck <> baseopt.fBoundsCheck then
|
|
aList.Add('-boundscheck=' + bchKindStr[fBoundsCheck] )
|
|
else
|
|
aList.Add('-boundscheck=' + bchKindStr[baseopt.fBoundsCheck] );
|
|
end;
|
|
end;
|
|
|
|
procedure TOutputOpts.assign(aValue: TPersistent);
|
|
var
|
|
src: TOutputOpts;
|
|
begin
|
|
if (aValue is TOutputOpts) then
|
|
begin
|
|
src := TOutputOpts(aValue);
|
|
//
|
|
fVerIds.Assign(src.fVerIds);
|
|
fBinKind := src.fBinKind;
|
|
fTrgKind := src.fTrgKind;
|
|
fUnittest := src.fUnittest;
|
|
fInline := src.fInline;
|
|
fBoundsCheck:= src.fBoundsCheck;
|
|
fOptimz := src.fOptimz;
|
|
fGenStack := src.fGenStack;
|
|
fAddMain := src.fAddMain;
|
|
fRelease := src.fRelease;
|
|
fAllinst := src.fAllInst;
|
|
fStackStomp := src.fStackStomp;
|
|
fAlwayLinkLibs := src.fAlwayLinkLibs;
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TOutputOpts.setUnittest(const aValue: boolean);
|
|
begin
|
|
if fUnittest = aValue then exit;
|
|
fUnittest := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setAllInst(const aValue: boolean);
|
|
begin
|
|
if fAllinst = aValue then exit;
|
|
fAllinst := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setAlwaysLinkLibs(const aValue: boolean);
|
|
begin
|
|
if fAlwayLinkLibs = aValue then exit;
|
|
fAlwayLinkLibs := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setVerIds(const aValue: TStringList);
|
|
begin
|
|
fVerIds.Assign(aValue);
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setTrgKind(const aValue: TTargetSystem);
|
|
begin
|
|
if fTrgKind = aValue then exit;
|
|
fTrgKind := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setBinKind(const aValue: TProjectBinaryKind);
|
|
begin
|
|
if fBinKind = aValue then exit;
|
|
fBinKind := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setInline(const aValue: boolean);
|
|
begin
|
|
if fInline = aValue then exit;
|
|
fInline := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setBoundsCheck(const aValue: TBoundCheckKind);
|
|
begin
|
|
if fBoundsCheck = aValue then exit;
|
|
fBoundsCheck := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setOptims(const aValue: boolean);
|
|
begin
|
|
if fOptimz = aValue then exit;
|
|
fOptimz := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setGenStack(const aValue: boolean);
|
|
begin
|
|
if fGenStack = aValue then exit;
|
|
fGenStack := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setAddMain(const aValue: boolean);
|
|
begin
|
|
if fAddMain = aValue then exit;
|
|
fAddMain := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setRelease(const aValue: boolean);
|
|
begin
|
|
if fRelease = aValue then exit;
|
|
fRelease := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOutputOpts.setStackStomp(const aValue: boolean);
|
|
begin
|
|
if fStackStomp = aValue then exit;
|
|
fStackStomp := aValue;
|
|
doChanged;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
{$REGION TDebugOpts ------------------------------------------------------------}
|
|
constructor TDebugOpts.create;
|
|
begin
|
|
inherited;
|
|
fDbgIdents := TStringList.Create;
|
|
end;
|
|
|
|
destructor TDebugOpts.destroy;
|
|
begin
|
|
fDbgIdents.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDebugOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
|
var
|
|
idt: string;
|
|
baseopt: TDebugOpts;
|
|
begin
|
|
if base.isNil then
|
|
begin
|
|
if fDebugConditions then aList.Add('-debug');
|
|
if fDbgLevel <> 0 then
|
|
aList.Add('-debug=' + intToStr(fDbgLevel));
|
|
for idt in fDbgIdents do
|
|
aList.Add('-debug=' + idt);
|
|
if fGenInfos then aList.Add('-g');
|
|
if fDbgC then aList.Add('-gc');
|
|
if fGenMap then aList.Add('-map');
|
|
if fGenFrame and (aList.IndexOf('-gs') = -1) then aList.Add('-gs');
|
|
end else
|
|
begin
|
|
baseopt := TDebugOpts(base);
|
|
if baseopt.fDebugConditions or fDebugConditions then aList.Add('-debug');
|
|
if (baseopt.fDbgLevel <> 0) and (fDbgLevel = 0) then
|
|
aList.Add('-debug=' + intToStr(baseopt.fDbgLevel))
|
|
else if fDbgLevel <> 0 then
|
|
aList.Add('-debug=' + intToStr(fDbgLevel));
|
|
if fDbgIdents.Count = 0 then
|
|
for idt in baseopt.fDbgIdents do aList.Add('-debug=' + idt)
|
|
else for idt in fDbgIdents do aList.Add('-debug=' + idt);
|
|
if baseopt.fGenInfos or fGenInfos then aList.Add('-g');
|
|
if baseopt.fDbgC or fDbgC then aList.Add('-gc');
|
|
if baseopt.fGenMap or fGenMap then aList.Add('-map');
|
|
if (baseopt.fGenFrame or fGenFrame) and (aList.IndexOf('-gs') = -1) then aList.Add('-gs');
|
|
end;
|
|
end;
|
|
|
|
procedure TDebugOpts.assign(aValue: TPersistent);
|
|
var
|
|
src: TDebugOpts;
|
|
begin
|
|
if (aValue is TDebugOpts) then
|
|
begin
|
|
src := TDebugOpts(aValue);
|
|
//
|
|
fDbgIdents.Assign(src.fDbgIdents);
|
|
fDebugConditions := src.fDebugConditions;
|
|
fDbgLevel := src.fDbgLevel;
|
|
fGenInfos := src.fGenInfos;
|
|
fDbgC := src.fDbgC;
|
|
fGenMap := src.fGenMap;
|
|
fGenFrame := src.fGenFrame;
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TDebugOpts.updateForceDbgBool;
|
|
begin
|
|
fForceDbgBool := (fDbgLevel > 0) or (fDbgIdents.Count > 0);
|
|
if fForceDbgBool then setDebugConditions(true);
|
|
end;
|
|
|
|
procedure TDebugOpts.setDebugConditions(const aValue: boolean);
|
|
begin
|
|
if fForceDbgBool then
|
|
begin
|
|
fDebugConditions := true;
|
|
exit;
|
|
end;
|
|
if fDebugConditions = aValue then exit;
|
|
fDebugConditions := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TDebugOpts.setGenFrame(const aValue: boolean);
|
|
begin
|
|
if fGenFrame = aValue then exit;
|
|
fGenFrame:=aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TDebugOpts.setGenInfos(const aValue: boolean);
|
|
begin
|
|
if fGenInfos = aValue then exit;
|
|
fGenInfos := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TDebugOpts.setDbgC(const aValue: boolean);
|
|
begin
|
|
if fDbgC = aValue then exit;
|
|
fDbgC := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TDebugOpts.setGenMap(const aValue: boolean);
|
|
begin
|
|
if fGenMap = aValue then exit;
|
|
fGenMap := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TDebugOpts.setDbgLevel(const aValue: Integer);
|
|
begin
|
|
if fDbgLevel = aValue then exit;
|
|
fDbgLevel := aValue;
|
|
if fDbgLevel < 0 then fDbgLevel := 0;
|
|
updateForceDbgBool;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TDebugOpts.setDbgIdents(aValue: TStringList);
|
|
begin
|
|
fDbgIdents.Assign(aValue);
|
|
updateForceDbgBool;
|
|
doChanged;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
{$REGION TPathsOpts ------------------------------------------------------------}
|
|
constructor TPathsOpts.create;
|
|
begin
|
|
inherited;
|
|
fExtraSrcs := TStringList.Create;
|
|
fImpMod := TStringList.Create;
|
|
fImpStr := TStringList.Create;
|
|
fExcl := TStringList.Create;
|
|
// setSrcs(), setIncl(), etc are not called when reloading from
|
|
// a stream but rather the TSgringList.Assign()
|
|
fExtraSrcs.OnChange := @strLstChange;
|
|
fImpMod.OnChange := @strLstChange;
|
|
fImpStr.OnChange := @strLstChange;
|
|
fExcl.OnChange := @strLstChange;
|
|
end;
|
|
|
|
procedure TPathsOpts.strLstChange(sender: TObject);
|
|
begin
|
|
TStringList(sender).BeginUpdate; // onChange not called anymore
|
|
patchPlateformPaths(TStringList(sender));
|
|
// EndUpdate is not called to avoid an infinite loop
|
|
end;
|
|
|
|
procedure TPathsOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
|
var
|
|
str, sym: string;
|
|
exts: TStringList;
|
|
baseopt: TPathsOpts;
|
|
rightList: TStringList;
|
|
begin
|
|
if base.isNil then
|
|
begin
|
|
exts := TStringList.Create;
|
|
try
|
|
exts.AddStrings(['.d', '.di', '.dd']);
|
|
for str in fExtraSrcs do
|
|
begin
|
|
if isStringDisabled(str) then
|
|
continue;
|
|
sym := fSymStringExpander.expand(str);
|
|
if not listAsteriskPath(sym, aList, exts) then
|
|
aList.Add(sym);
|
|
end;
|
|
finally
|
|
exts.Free;
|
|
end;
|
|
for str in fImpMod do if not isStringDisabled(str) then
|
|
aList.Add('-I'+ fSymStringExpander.expand(str));
|
|
for str in fImpStr do if not isStringDisabled(str) then
|
|
aList.Add('-J'+ fSymStringExpander.expand(str));
|
|
if fFname <> '' then
|
|
aList.Add('-of' + fSymStringExpander.expand(fFname));
|
|
if fObjDir <> '' then
|
|
aList.Add('-od' + fSymStringExpander.expand(fObjDir));
|
|
end else
|
|
begin
|
|
baseopt := TPathsOpts(base);
|
|
if fExtraSrcs.Count = 0 then rightList := baseopt.fExtraSrcs
|
|
else rightList := fExtraSrcs;
|
|
exts := TStringList.Create;
|
|
try
|
|
exts.AddStrings(['.d', '.di', '.dd']);
|
|
for str in rightList do
|
|
begin
|
|
if isStringDisabled(str) then
|
|
continue;
|
|
sym := fSymStringExpander.expand(str);
|
|
if not listAsteriskPath(sym, aList, exts) then
|
|
aList.Add(sym);
|
|
end;
|
|
finally
|
|
exts.Free;
|
|
end;
|
|
//
|
|
if fImpMod.Count = 0 then rightList := baseopt.fImpMod
|
|
else rightList := fImpMod;
|
|
for str in rightList do if not isStringDisabled(str) then
|
|
aList.Add('-I'+ fSymStringExpander.expand(str));
|
|
//
|
|
if fImpStr.Count = 0 then rightList := baseopt.fImpStr
|
|
else rightList := fImpStr;
|
|
for str in rightList do if not isStringDisabled(str) then
|
|
aList.Add('-J'+ fSymStringExpander.expand(str));
|
|
//
|
|
str := '';
|
|
if fFname <> '' then str := fFname else
|
|
if baseopt.fFname <> '' then str := baseopt.fFname;
|
|
if str.isNotEmpty then aList.Add('-of' + fSymStringExpander.expand(str));
|
|
//
|
|
str := '';
|
|
if fObjDir <> '' then str := fObjDir else
|
|
if baseopt.fObjDir <> '' then str := baseopt.fObjDir;
|
|
if str.isNotEmpty then aList.Add('-od' + fSymStringExpander.expand(str));
|
|
end;
|
|
end;
|
|
|
|
procedure TPathsOpts.assign(aValue: TPersistent);
|
|
var
|
|
src: TPathsOpts;
|
|
begin
|
|
if (aValue is TPathsOpts) then
|
|
begin
|
|
src := TPathsOpts(aValue);
|
|
//
|
|
fExtraSrcs.Assign(src.fExtraSrcs);
|
|
fImpMod.Assign(src.fImpMod);
|
|
fImpStr.Assign(src.fImpStr);
|
|
fExcl.Assign(src.fExcl);
|
|
fForceExt:= src.fForceExt;
|
|
fFName := patchPlateformPath(src.fFname);
|
|
fObjDir := patchPlateformPath(src.fObjDir);
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
destructor TPathsOpts.destroy;
|
|
begin
|
|
fExtraSrcs.free;
|
|
fImpMod.free;
|
|
fImpStr.free;
|
|
fExcl.free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TPathsOpts.setForceExt(aValue: boolean);
|
|
begin
|
|
if fForceExt = aValue then exit;
|
|
fForceExt:=aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TPathsOpts.setFname(const aValue: TCEFilename);
|
|
begin
|
|
if fFname = aValue then exit;
|
|
fFname := patchPlateformPath(aValue);
|
|
fFname := patchPlateformExt(fFname);
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TPathsOpts.setObjDir(const aValue: TCEPathname);
|
|
begin
|
|
if fObjDir = aValue then exit;
|
|
fObjDir := patchPlateformPath(aValue);
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TPathsOpts.setSrcs(aValue: TStringList);
|
|
begin
|
|
fExtraSrcs.Assign(aValue);
|
|
patchPlateformPaths(fExtraSrcs);
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TPathsOpts.setIncl(aValue: TStringList);
|
|
begin
|
|
fImpMod.Assign(aValue);
|
|
patchPlateformPaths(fImpMod);
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TPathsOpts.setImpt(aValue: TStringList);
|
|
begin
|
|
fImpStr.Assign(aValue);
|
|
patchPlateformPaths(fImpStr);
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TPathsOpts.setExcl(aValue: TStringList);
|
|
begin
|
|
fExcl.Assign(aValue);
|
|
patchPlateformPaths(fExcl);
|
|
doChanged;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
{$REGION TOtherOpts ------------------------------------------------------------}
|
|
constructor TOtherOpts.create;
|
|
begin
|
|
inherited;
|
|
fCustom := TStringList.Create;
|
|
end;
|
|
|
|
procedure TOtherOpts.assign(aValue: TPersistent);
|
|
var
|
|
src: TOtherOpts;
|
|
begin
|
|
if (aValue is TOtherOpts) then
|
|
begin
|
|
src := TOtherOpts(aValue);
|
|
fCustom.Assign(src.fCustom);
|
|
fCov := src.fCov;
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
destructor TOtherOpts.destroy;
|
|
begin
|
|
fCustom.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TOtherOpts.setCov(const aValue: boolean);
|
|
begin
|
|
if fCov = aValue then exit;
|
|
fCov := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TOtherOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
|
var
|
|
str1, str2: string;
|
|
baseopt: TOtherOpts;
|
|
rightList: TStringList;
|
|
begin
|
|
if base.isNil then
|
|
begin
|
|
for str1 in fCustom do if str1 <> '' then
|
|
begin
|
|
if isStringDisabled(str1) then
|
|
continue;
|
|
if str1[1] <> '-' then
|
|
str2 := '-' + str1
|
|
else
|
|
str2 := str1;
|
|
aList.AddText(fSymStringExpander.expand(str2));
|
|
end;
|
|
if fCov then aList.Add('-cov');
|
|
end else
|
|
begin
|
|
baseopt := TOtherOpts(base);
|
|
if fCustom.Count = 0 then rightList := baseopt.fCustom
|
|
else rightList := fCustom;
|
|
for str1 in rightList do if str1 <> '' then
|
|
begin
|
|
if isStringDisabled(str1) then
|
|
continue;
|
|
if str1[1] <> '-' then
|
|
str2 := '-' + str1
|
|
else
|
|
str2 := str1;
|
|
aList.AddText(fSymStringExpander.expand(str2));
|
|
end;
|
|
if baseopt.fCov or fCov then aList.Add('-cov');
|
|
end;
|
|
end;
|
|
|
|
procedure TOtherOpts.setCustom(aValue: TStringList);
|
|
begin
|
|
fCustom.Assign(aValue);
|
|
doChanged;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
{$REGION TCustomProcOptions ----------------------------------------------------}
|
|
constructor TCustomProcOptions.create;
|
|
begin
|
|
inherited;
|
|
fParameters := TStringList.Create;
|
|
fCommands := TStringList.Create;
|
|
end;
|
|
|
|
destructor TCustomProcOptions.destroy;
|
|
begin
|
|
fParameters.Free;
|
|
fCommands.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomProcOptions.assign(source: TPersistent);
|
|
var
|
|
src: TCustomProcOptions;
|
|
begin
|
|
if source is TCustomProcOptions then
|
|
begin
|
|
src := TCustomProcOptions(source);
|
|
//
|
|
Parameters.Assign(src.Parameters);
|
|
fOptions := src.fOptions;
|
|
fExecutable := src.fExecutable;
|
|
fShowWin := src.fShowWin;
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TCustomProcOptions.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
|
begin
|
|
end;
|
|
|
|
procedure TCustomProcOptions.setProcess(var aProcess: TProcess);
|
|
begin
|
|
//TODO-cNativeProjects: adapt TCustomProcOptions.setProcess to base/override system
|
|
aProcess.Parameters.Clear;
|
|
aProcess.Parameters.AddText(fSymStringExpander.expand(Parameters.Text));
|
|
aProcess.Executable := fExecutable;
|
|
aProcess.ShowWindow := fShowWin;
|
|
aProcess.Options := fOptions;
|
|
aProcess.CurrentDirectory := fWorkDir;
|
|
aProcess.StartupOptions := aProcess.StartupOptions + [suoUseShowWindow];
|
|
end;
|
|
|
|
procedure TCustomProcOptions.setProcess(var aProcess: TAsyncProcess);
|
|
begin
|
|
aProcess.Parameters.Clear;
|
|
aProcess.Parameters.AddText(fSymStringExpander.expand(Parameters.Text));
|
|
aProcess.Executable := fExecutable;
|
|
aProcess.ShowWindow := fShowWin;
|
|
aProcess.Options := fOptions;
|
|
aProcess.CurrentDirectory := fWorkDir;
|
|
aProcess.StartupOptions := aProcess.StartupOptions + [suoUseShowWindow];
|
|
end;
|
|
|
|
procedure TCustomProcOptions.setProcess(var aProcess: TCEProcess);
|
|
begin
|
|
aProcess.Parameters.Clear;
|
|
aProcess.Parameters.AddText(fSymStringExpander.expand(Parameters.Text));
|
|
aProcess.Executable := fExecutable;
|
|
aProcess.ShowWindow := fShowWin;
|
|
aProcess.Options := fOptions;
|
|
aProcess.CurrentDirectory := fWorkDir;
|
|
aProcess.StartupOptions := aProcess.StartupOptions + [suoUseShowWindow];
|
|
end;
|
|
|
|
procedure TCustomProcOptions.setExecutable(const aValue: TCEFilename);
|
|
begin
|
|
if fExecutable = aValue then exit;
|
|
fExecutable := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TCustomProcOptions.setWorkDir(const aValue: TCEPathname);
|
|
begin
|
|
if fWorkDir = aValue then exit;
|
|
fWorkDir := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TCustomProcOptions.setOptions(const aValue: TProcessOptions);
|
|
begin
|
|
if fOptions = aValue then exit;
|
|
fOptions := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TCustomProcOptions.setParameters(aValue: TStringList);
|
|
begin
|
|
fParameters.Assign(aValue);
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TCustomProcOptions.setCommands(aValue: TStringList);
|
|
begin
|
|
fCommands.Assign(aValue);
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TCustomProcOptions.setShowWin(const aValue: TShowWindowOptions);
|
|
begin
|
|
if fShowWin = aValue then exit;
|
|
fShowWin := aValue;
|
|
doChanged;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
{$REGION TCompilerConfiguration ------------------------------------------------}
|
|
constructor TCompilerConfiguration.create(aCollection: TCollection);
|
|
begin
|
|
inherited create(aCollection);
|
|
|
|
fSymStringExpander:= getSymStringExpander;
|
|
|
|
fDocOpts := TDocOpts.create;
|
|
fDebugOpts := TDebugOpts.create;
|
|
fMsgOpts := TMsgOpts.create;
|
|
fOutputOpts := TOutputOpts.create;
|
|
fPathsOpts := TPathsOpts.create;
|
|
fOthers := TOtherOpts.create;
|
|
fPreProcOpt := TCompileProcOptions.create;
|
|
fPostProcOpt:= TCompileProcOptions.create;
|
|
fRunProjOpt := TProjectRunOptions.create;
|
|
|
|
fDocOpts.onChange := @subOptsChanged;
|
|
fDebugOpts.onChange := @subOptsChanged;
|
|
fMsgOpts.onChange := @subOptsChanged;
|
|
fOutputOpts.onChange := @subOptsChanged;
|
|
fPathsOpts.onChange := @subOptsChanged;
|
|
fOthers.onChange := @subOptsChanged;
|
|
fPreProcOpt.onChange := @subOptsChanged;
|
|
fPostProcOpt.onChange := @subOptsChanged;
|
|
fRunProjOpt.onChange := @subOptsChanged;
|
|
|
|
fName := nameFromID;
|
|
end;
|
|
|
|
destructor TCompilerConfiguration.destroy;
|
|
begin
|
|
fOnChanged := nil;
|
|
fDocOpts.free;
|
|
fDebugOpts.free;
|
|
fMsgOpts.free;
|
|
fOutputOpts.free;
|
|
fPathsOpts.free;
|
|
fOthers.free;
|
|
fPreProcOpt.free;
|
|
fPostProcOpt.free;
|
|
fRunProjOpt.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.assign(aValue: TPersistent);
|
|
var
|
|
src: TCompilerConfiguration;
|
|
begin
|
|
if (aValue is TCompilerConfiguration) then
|
|
begin
|
|
src := TCompilerConfiguration(aValue);
|
|
//
|
|
fDocOpts.assign(src.fDocOpts);
|
|
fDebugOpts.assign(src.fDebugOpts);
|
|
fMsgOpts.assign(src.fMsgOpts);
|
|
fOutputOpts.assign(src.fOutputOpts);
|
|
fPathsOpts.assign(src.fPathsOpts);
|
|
fOthers.assign(src.fOthers);
|
|
fPreProcOpt.assign(src.fPreProcOpt);
|
|
fPostProcOpt.assign(src.fPostProcOpt);
|
|
fRunProjOpt.assign(src.fRunProjOpt);
|
|
//
|
|
// isBase / isOverriden not copied by purpose.
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
function TCompilerConfiguration.nameFromID: string;
|
|
begin
|
|
result := format('<configuration %d>', [ID]);
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.getOpts(aList: TStrings; base: TCompilerConfiguration = nil);
|
|
var
|
|
ext, nme: string;
|
|
fe: boolean;
|
|
i: integer;
|
|
begin
|
|
if (base = nil) or (base = self) then
|
|
begin
|
|
fDocOpts.getOpts(aList);
|
|
fDebugOpts.getOpts(aList);
|
|
fMsgOpts.getOpts(aList);
|
|
fOutputOpts.getOpts(aList);
|
|
fPathsOpts.getOpts(aList);
|
|
fOthers.getOpts(aList);
|
|
fe := fPathsOpts.forceExtension;
|
|
nme := fPathsOpts.outputFilename;
|
|
end else
|
|
begin
|
|
fDocOpts.getOpts(aList, base.fDocOpts);
|
|
fDebugOpts.getOpts(aList, base.fDebugOpts);
|
|
fMsgOpts.getOpts(aList, base.fMsgOpts);
|
|
fOutputOpts.getOpts(aList, base.fOutputOpts);
|
|
fPathsOpts.getOpts(aList, base.fPathsOpts);
|
|
fOthers.getOpts(aList, base.fOthers);
|
|
fe := fPathsOpts.forceExtension or base.fPathsOpts.forceExtension;
|
|
nme := fPathsOpts.outputFilename;
|
|
if base.fPathsOpts.outputFilename <> '' then
|
|
nme := base.fPathsOpts.outputFilename;
|
|
end;
|
|
if fe and nme.isNotEmpty then
|
|
begin
|
|
nme := fSymStringExpander.expand(nme);
|
|
ext := nme.extractFileExt;
|
|
nme := '-of' + nme;
|
|
i := aList.IndexOf(nme);
|
|
if i <> -1 then case fOutputOpts.binaryKind of
|
|
{$IFDEF WINDOWS}
|
|
executable: if ext <> exeExt then
|
|
aList[i] := aList[i] + exeExt;
|
|
{$ENDIF}
|
|
obj: if ext <> objExt then
|
|
aList[i] := aList[i] + objExt;
|
|
sharedlib: if ext <> dynExt then
|
|
aList[i] := aList[i] + dynExt;
|
|
staticlib: if ext <> libExt then
|
|
aList[i] := aList[i] + libExt;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setName(const aValue: string);
|
|
begin
|
|
if fName = aValue then
|
|
exit;
|
|
fName := aValue;
|
|
if fName = '' then
|
|
fName := nameFromID;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.subOptsChanged(sender: TObject);
|
|
begin
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.doChanged;
|
|
begin
|
|
if assigned(fOnChanged) then fOnChanged(self);
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setDocOpts(const aValue: TDocOpts);
|
|
begin
|
|
fDocOpts.assign(aValue);
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setDebugOpts(const aValue: TDebugOpts);
|
|
begin
|
|
fDebugOpts.assign(aValue);
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setMsgOpts(const aValue: TMsgOpts);
|
|
begin
|
|
fMsgOpts.assign(aValue);
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setOutputOpts(const aValue: TOutputOpts);
|
|
begin
|
|
fOutputOpts.assign(aValue);
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setPathsOpts(const aValue: TPathsOpts);
|
|
begin
|
|
fPathsOpts.assign(aValue);
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setOthers(const aValue: TOtherOpts);
|
|
begin
|
|
fOthers.Assign(aValue);
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setPreProcOpt(const aValue: TCompileProcOptions);
|
|
begin
|
|
fPreProcOpt.assign(aValue);
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setPostProcOpt(const aValue: TCompileProcOptions);
|
|
begin
|
|
fPostProcOpt.assign(aValue);
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setRunProjOpt(const aValue: TProjectRunOptions);
|
|
begin
|
|
fRunProjOpt.assign(aValue);
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setisBaseConfiguration(const aValue: boolean);
|
|
begin
|
|
fIsBaseConfiguration := aValue;
|
|
doChanged;
|
|
end;
|
|
|
|
procedure TCompilerConfiguration.setisOverriddenConfiguration(const aValue: boolean);
|
|
begin
|
|
fIsBaseConfiguration := false;
|
|
fIsOverriddenConfiguration := aValue;
|
|
doChanged;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
initialization
|
|
RegisterClasses([TOtherOpts, TPathsOpts, TDebugOpts, TOutputOpts, TMsgOpts,
|
|
TDocOpts, TCompileProcOptions, TProjectRunOptions, TCompilerConfiguration]);
|
|
end.
|