fix #423 - Add compiler switches for project

This commit is contained in:
Basile Burg 2019-02-04 00:25:24 +01:00
parent 6750020d16
commit e7708131db
3 changed files with 64 additions and 8 deletions

View File

@ -135,6 +135,7 @@ type
fMsgs: IMessagesDisplay;
fNextTerminatedCommand: TDubCommand;
fAsProjectItf: ICommonProject;
fMetaEnv: TStringList;
procedure doModified;
procedure updateFields;
procedure updatePackageNameFromJson;
@ -148,8 +149,8 @@ type
procedure dubProcTerminated(proc: TObject);
function getCurrentCustomConfig: TJSONObject;
procedure executeDub(command: TDubCommand; const runArgs: string = '');
procedure restorePersistentConfigId;
procedure storePersistentConfigId;
procedure restorePersistentMetadata;
procedure storePersistentMetadata;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
@ -192,6 +193,7 @@ type
procedure run(const runArgs: string = '');
procedure test;
function targetUpToDate: boolean;
function getPersistentEnvironment: TStrings;
property json: TJSONObject read fJSON;
property packageName: string read fPackageName;
@ -683,6 +685,8 @@ begin
fImportPaths := TStringList.Create;
fImportPaths.Sorted:=true;
fImportPaths.Duplicates:=dupIgnore;
fMetaEnv:= TStringList.create;
fMetaEnv.LineBreak:=';';
json.Add('name', '');
endModification;
@ -695,8 +699,8 @@ end;
destructor TDubProject.destroy;
begin
if not inGroup and fHasLoaded then
storePersistentConfigId();
if fHasLoaded then
storePersistentMetadata();
killProcess(fDubProc);
subjProjClosing(fProjectSubject, self);
fProjectSubject.free;
@ -706,6 +710,7 @@ begin
fConfigs.Free;
fSrcs.Free;
fImportPaths.Free;
fMetaEnv.free;
inherited;
end;
{$ENDREGION --------------------------------------------------------------------}
@ -842,7 +847,7 @@ begin
updateFields;
if not inGroup then
restorePersistentConfigId();
restorePersistentMetadata();
subjProjChanged(fProjectSubject, self);
fModified := false;
@ -947,7 +952,7 @@ end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION ICommonProject: configs ---------------------------------------------}
procedure TDubProject.restorePersistentConfigId;
procedure TDubProject.restorePersistentMetadata;
var
f: string;
t: string;
@ -971,12 +976,14 @@ begin
setActiveConfigurationIndex(i);
break;
end;
fMetaEnv.Clear;
fMetaEnv.AddText(values['project_environment_vars']);
finally
free;
end;
end;
procedure TDubProject.storePersistentConfigId;
procedure TDubProject.storePersistentMetadata;
var
f: string;
n: string;
@ -998,6 +1005,7 @@ begin
try
values['last_dexed_buildType'] := t;
values['last_dexed_config'] := c;
values['project_environment_vars'] := fMetaEnv.text;
try
SaveToFile(f);
except
@ -1087,6 +1095,8 @@ procedure TDubProject.executeDub(command: TDubCommand; const runArgs: string = '
var
prjname: string;
rargs: TStringList;
i: integer;
e: string;
begin
if fDubProc.isNotNil and fDubProc.Active then
begin
@ -1120,6 +1130,19 @@ begin
begin
fDubProc.Options := fDubProc.Options + [poWaitOnExit, poNewConsole];
end;
if fMetaEnv.Count <> 0 then
begin
for i := 0 to fMetaEnv.Count-1 do
begin
e := fMetaEnv.Strings[i];
fDubProc.Environment.Add(e);
end;
for i := 0 to GetEnvironmentVariableCount-1 do
begin
e := GetEnvironmentString(i);
fDubProc.Environment.Add(e);
end;
end;
fDubProc.CurrentDirectory := fFilename.extractFilePath;
fDubProc.XTermProgram:=consoleProgram;
fDubProc.Parameters.Add(dubCmd2Arg[command]);
@ -1171,6 +1194,11 @@ begin
// rebuilding is done automatically when the command is 'run'
result := true;
end;
function TDubProject.getPersistentEnvironment: TStrings;
begin
result := fMetaEnv;
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION JSON to internal fields -----------------------------------------------}

View File

@ -12,7 +12,6 @@ object MainForm: TMainForm
OnResize = FormResize
OnWindowStateChange = FormWindowStateChange
ShowHint = True
LCLVersion = '2.0.0.3'
object mainMenu: TMainMenu
top = 1
object MenuItem1: TMenuItem
@ -223,6 +222,9 @@ object MainForm: TMainForm
object MenuItem108: TMenuItem
Action = actProjDscan
end
object MenuItem117: TMenuItem
Action = actProjSetEnv
end
object MenuItem40: TMenuItem
Caption = '-'
end
@ -846,6 +848,11 @@ object MainForm: TMainForm
Caption = 'Git pull'
OnExecute = actProjGitPullExecute
end
object actProjSetEnv: TAction
Category = 'Project'
Caption = 'Set persistent environment...'
OnExecute = actProjSetEnvExecute
end
end
object ApplicationProperties1: TApplicationProperties
OnActivate = ApplicationProperties1Activate

View File

@ -117,6 +117,7 @@ type
actFileCloseAll: TAction;
actFileNewClip: TAction;
actEdFormat: TAction;
actProjSetEnv: TAction;
actProjGitPull: TAction;
actProjGitBranchesUpd: TAction;
actProjNewDialog: TAction;
@ -182,6 +183,7 @@ type
MenuItem114: TMenuItem;
MenuItem115: TMenuItem;
MenuItem116: TMenuItem;
MenuItem117: TMenuItem;
mnuGitBranch: TMenuItem;
mnuItemDubDialog: TMenuItem;
mnuItemHelp: TMenuItem;
@ -322,6 +324,7 @@ type
procedure actProjSaveGroupAsExecute(Sender: TObject);
procedure actProjSaveGroupExecute(Sender: TObject);
procedure actProjSelUngroupedExecute(Sender: TObject);
procedure actProjSetEnvExecute(Sender: TObject);
procedure actProjStopCompExecute(Sender: TObject);
procedure actProjTestExecute(Sender: TObject);
procedure actSetRunnableSwExecute(Sender: TObject);
@ -4253,6 +4256,24 @@ begin
fFreeProj.activate;
end;
procedure TMainForm.actProjSetEnvExecute(Sender: TObject);
var
p: TDubProject;
e: TStrings;
s: string;
begin
if not assigned(fProject) or (fProject.getFormat <> pfDUB) then
exit;
p := TDubProject(fProject.getProject);
e := p.getPersistentEnvironment;
s := e.strictText;
if InputQuery('Persistent project environment', 'values (key=value;key=value;...)', s) then
begin
e.Clear;
e.AddText(s);
end;
end;
procedure TMainForm.actNewGroupExecute(Sender: TObject);
begin
if fProjectGroup.groupModified then