dexed/src/ce_dmdwrap.pas

unit ce_dmdwrap;

{$I ce_defines.inc}

interface

uses
  classes, sysutils, process, asyncprocess, ce_common, ce_inspectors;

(*

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
    property onChange: TNotifyEvent read fOnChange write fOnChange;
  public
    procedure getOpts(const aList: TStrings); virtual; abstract;
  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(const aList: TStrings); 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;
    fWarnEx: 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 setWarnEx(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 depreciationHandling: 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 additionalWarnings: boolean read fWarnEx write setWarnEx 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;
    procedure assign(aValue: TPersistent); override;
    procedure getOpts(const aList: TStrings); override;
  end;

  (**
   * Describes the target registry size.
   *)
  TTargetSystem = (auto, os32bit, os64bit);

  (**
   * Describes the output kind.
   *)
  TBinaryKind = (executable, staticlib, sharedlib, obj);

  (**
   * 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: TBinaryKind;
    fUnittest: boolean;
    fVerIds: TStringList;
    fInline: boolean;
    fBoundsCheck: TBoundCheckKind;
    fOptimz: boolean;
    fGenStack: boolean;
    fAddMain: boolean;
    fRelease: boolean;
    fAllInst: boolean;
    fStackStomp: boolean;
    procedure setAllInst(const aValue: boolean);
    procedure setUnittest(const aValue: boolean);
    procedure setTrgKind(const aValue: TTargetSystem);
    procedure setBinKind(const aValue: TBinaryKind);
    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 targetKind: TTargetSystem read fTrgKind write setTrgKind default auto;
    property binaryKind: TBinaryKind 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 generateStackFrame: boolean read fGenStack write setGenStack 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;
  public
    constructor create;
    destructor destroy; override;
    procedure assign(aValue: TPersistent); override;
    procedure getOpts(const aList: TStrings); override;
  end;

  (*****************************************************************************
   * Encapsulates the options/args related to the debugging
   *)
  TDebugOpts = class(TOptsGroup)
  private
    fDebug: boolean;
    fDbgD: boolean;
    fDbgC: boolean;
    fGenMap: boolean;
    fDbgIdents: TStringList;
    fDbgLevel: Integer;
    fForceDbgBool: boolean;
    procedure updateForceDbgBool;
    procedure setDebug(const aValue: boolean);
    procedure setDbgD(const aValue: boolean);
    procedure setDbgC(const aValue: boolean);
    procedure setGenMap(const aValue: boolean);
    procedure setDbgLevel(const aValue: Integer);
    procedure setDbgIdents(const aValue: TStringList);
  published
    property debug: boolean read fDebug write setDebug default false;
    property debugIdentifiers: TStringList read fDbgIdents write setDbgIdents;
    property debugLevel: Integer read fDbgLevel write setDbgLevel default 0;
    property codeviewDexts: boolean read fDbgD write setDbgD default false;
    property codeviewCformat: boolean read fDbgC write setDbgC default false;
    property generateMapFile: boolean read fGenMap write setGenMap default false;
  public
    constructor create;
    destructor destroy; override;
    procedure assign(aValue: TPersistent); override;
    procedure getOpts(const aList: TStrings); 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;
    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;
  public
    constructor create;
    destructor destroy; override;
    procedure assign(aValue: TPersistent); override;
    procedure getOpts(const aList: TStrings); override;
  end;

  (*****************************************************************************
   * Encapsulates the unclassified and custom options/args
   *)
  TOtherOpts = class(TOptsGroup)
  private
    fCustom: TStringList;
    procedure setCustom(const aValue: TStringList);
  published
    property customOptions: TStringList read fCustom write setCustom;
  public
    constructor create;
    destructor destroy; override;
    procedure assign(aValue: TPersistent); override;
    procedure getOpts(const aList: TStrings); 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;
    procedure setExecutable(const aValue: TCEFilename);
    procedure setWorkDir(const aValue: TCEPathname);
    procedure setOptions(const aValue: TProcessOptions);
    procedure setParameters(aValue: TStringList);
    procedure setShowWin(const aValue: TShowWindowOptions);
  protected
    property executable: TCEFilename read fExecutable write setExecutable;
    property workingDirectory: TCEPathname read fWorkDir write setWorkDir;
    property options: TProcessOptions read fOptions write setOptions;
    property parameters: TStringList read fParameters write setParameters;
    property showWindow: TShowWindowOptions read fShowWin write setShowWin;
  public
    constructor create;
    destructor destroy; override;
    procedure assign(source: TPersistent); override;
    procedure getOpts(const aList: TStrings); 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: TCheckedAsyncProcess);
  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;
  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
    fName: string;
    fOnChanged: TNotifyEvent;
    fDocOpts: TDocOpts;
    fDebugOpts: TDebugOpts;
    fMsgOpts: TMsgOpts;
    fOutputOpts: TOutputOpts;
    fPathsOpts: TPathsOpts;
    fOthers: TOtherOpts;
    fPreProcOpt: TCompileProcOptions;
    fPostProcOpt: TCompileProcOptions;
    fRunProjOpt: TProjectRunOptions;
    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);
  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;
  public
    constructor create(aCollection: TCollection); override;
    destructor destroy; override;
    procedure assign(aValue: TPersistent); override;
    procedure getOpts(const aList: TStrings);
    property onChanged: TNotifyEvent read fOnChanged write fOnChanged;
  end;

implementation

uses
  ce_symstring;

procedure TOptsGroup.doChanged;
begin
  if assigned(fOnChange) then fOnChange(self);
end;

{$REGION TDocOpts --------------------------------------------------------------}
procedure TDocOpts.getOpts(const aList: TStrings);
begin
  if fGenDoc then
    aList.Add('-D');
  if fGenJson then
    aList.Add('-X');
  if fDocDir <> '' then
    aList.Add('-Dd' + symbolExpander.get(fDocDir));
  if fJsonFname <> '' then
    aList.Add('-Xf' + symbolExpander.get(fJsonFname));
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
  fDepHandling := TDepHandling.warning;
  fWarnings := true;
end;

procedure TMsgOpts.getOpts(const aList: TStrings);
var
  opt : string;
const
  DepStr : array[TDepHandling] of string = ('-d', '', '-de');
begin
  opt := DepStr[fDepHandling];
  if opt <> '' then aList.Add(opt);
  if fVerbose then aList.Add('-v');
  if fWarnings then aList.Add('-w');
  if fWarnEx 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;

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;
    fWarnEx   := src.fWarnEx;
    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.setWarnEx(const aValue: boolean);
begin
  if fWarnEx = aValue then exit;
  fWarnEx := 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
  fVerIds := TStringList.Create;
  fBoundsCheck := safeOnly;
end;

destructor TOutputOpts.destroy;
begin
  fVerIds.Free;
  inherited;
end;

procedure TOutputOpts.getOpts(const aList: TStrings);
var
  opt: string;
const
  trgKindStr: array[TTargetSystem] of string = ('', '-m32','-m64');
  binKindStr: array[TBinaryKind] of string = ('', '-lib', '-shared', '-c');
  bchKindStr: array[TBoundCheckKind] of string = ('on', 'safeonly', 'off');
begin
  opt := binKindStr[fBinKind];
  if opt <> '' then aList.Add(opt);
  opt := trgKindStr[fTrgKind];
  if opt <> '' then aList.Add(opt);
  if fUnittest then aList.Add('-unittest');
  if fInline then aList.Add('-inline');
  if fOptimz then aList.Add('-O');
  if fGenStack then aList.Add('-gs');
  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 opt in fVerIds do begin
    if length(opt) > 0 then
      if opt[1] = ';' then
        continue;
    if length(opt) > 1 then
      if opt[1..2] = '//' then
        continue;
    aList.Add('-version=' + opt );
  end;
  //
  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;

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;
  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.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: TBinaryKind);
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
  fDbgIdents := TStringList.Create;
end;

destructor TDebugOpts.destroy;
begin
  fDbgIdents.Free;
  inherited;
end;

procedure TDebugOpts.getOpts(const aList: TStrings);
var
  idt: string;
begin
  if fDebug then aList.Add('-debug');
  if fDbgLevel <> 0 then
    aList.Add('-debug=' + intToStr(fDbgLevel));
  for idt in fDbgIdents do
    aList.Add('-debug=' + idt);
  if fDbgD then aList.Add('-g');
  if fDbgC then aList.Add('-gc');
  if fGenMap then aList.Add('-map');
end;

procedure TDebugOpts.assign(aValue: TPersistent);
var
  src: TDebugOpts;
begin
  if (aValue is TDebugOpts) then
  begin
    src := TDebugOpts(aValue);
    //
    fDbgIdents.Assign(src.fDbgIdents);
    fDebug    := src.fDebug;
    fDbgLevel := src.fDbgLevel;
    fDbgD     := src.fDbgD;
    fDbgC     := src.fDbgC;
    fGenMap   := src.fGenMap;
  end
  else inherited;
end;

procedure TDebugOpts.updateForceDbgBool;
begin
  fForceDbgBool := (fDbgLevel > 0) or (fDbgIdents.Count > 0);
  if fForceDbgBool then setDebug(true);
end;

procedure TDebugOpts.setDebug(const aValue: boolean);
begin
  if fForceDbgBool then
  begin
    fDebug := true;
    exit;
  end;
  if fDebug = aValue then exit;
  fDebug := aValue;
  doChanged;
end;

procedure TDebugOpts.setDbgD(const aValue: boolean);
begin
  if fDbgD = aValue then exit;
  fDbgD := 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(const aValue: TStringList);
begin
  fDbgIdents.Assign(aValue);
  updateForceDbgBool;
  doChanged;
end;
{$ENDREGION}

{$REGION TPathsOpts ------------------------------------------------------------}
constructor TPathsOpts.create;
begin
  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(const aList: TStrings);
var
  str: string;
begin
  for str in fExtraSrcs do
  begin
    str := symbolExpander.get(str);
    if not listAsteriskPath(str, aList, dExtList) then
      aList.Add(str);
  end;
  for str in fImpMod do
    aList.Add('-I'+ symbolExpander.get(str));
  for str in fImpStr do
    aList.Add('-J'+ symbolExpander.get(str));
  if fFname <> '' then
    aList.Add('-of' + symbolExpander.get(fFname));
  if fObjDir <> '' then
    aList.Add('-od' + symbolExpander.get(fObjDir));
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);
    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.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
  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);
  end
  else inherited;
end;

destructor TOtherOpts.destroy;
begin
  fCustom.Free;
  inherited;
end;

procedure TOtherOpts.getOpts(const aList: TStrings);
var
  str1, str2: string;
begin
  for str1 in fCustom do if str1 <> '' then
  begin
    if length(str1) > 0 then
      if str1[1] = ';' then
        continue;
    if length(str1) > 1 then
      if str1[1..2] = '//' then
        continue;
    if str1[1] <> '-' then
      str2 := '-' + str1
    else
      str2 := str1;
    aList.AddText(symbolExpander.get(str2));
  end;
end;

procedure TOtherOpts.setCustom(const aValue: TStringList);
begin
  fCustom.Assign(aValue);
  doChanged;
end;
{$ENDREGION}

{$REGION TCustomProcOptions ----------------------------------------------------}
constructor TCustomProcOptions.create;
begin
  fParameters := TStringList.Create;
end;

destructor TCustomProcOptions.destroy;
begin
  fParameters.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(const aList: TStrings);
begin
end;

procedure TCustomProcOptions.setProcess(var aProcess: TProcess);
begin
  aProcess.Parameters.Clear;
  aProcess.Parameters.AddText(symbolExpander.get(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(symbolExpander.get(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: TCheckedAsyncProcess);
begin
  aProcess.Parameters.Clear;
  aProcess.Parameters.AddText(symbolExpander.get(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.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);

  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);
  end
  else inherited;
end;

function TCompilerConfiguration.nameFromID: string;
begin
  result := format('<configuration %d>', [ID]);
end;

procedure TCompilerConfiguration.getOpts(const aList: TStrings);
begin
  fDocOpts.getOpts(aList);
  fDebugOpts.getOpts(aList);
  fMsgOpts.getOpts(aList);
  fOutputOpts.getOpts(aList);
  fPathsOpts.getOpts(aList);
  fOthers.getOpts(aList);
end;

procedure TCompilerConfiguration.setName(const aValue: string);
begin
  if fName = aValue then
    exit;
  fName := aValue;
  if fName = '' then
    fName := nameFromID;
  Changed(true);
  doChanged;
end;

procedure TCompilerConfiguration.subOptsChanged(sender: TObject);
begin
  Changed(true);
  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;
{$ENDREGION}

initialization
  RegisterClasses([TOtherOpts, TPathsOpts, TDebugOpts, TOutputOpts, TMsgOpts,
    TDocOpts, TCompileProcOptions, TProjectRunOptions, TCompilerConfiguration]);
end.