From e7708131db2aaac7a3b0db922ada512170999c97 Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Mon, 4 Feb 2019 00:25:24 +0100 Subject: [PATCH] fix #423 - Add compiler switches for project --- src/u_dubproject.pas | 42 +++++++++++++++++++++++++++++++++++------- src/u_main.lfm | 9 ++++++++- src/u_main.pas | 21 +++++++++++++++++++++ 3 files changed, 64 insertions(+), 8 deletions(-) diff --git a/src/u_dubproject.pas b/src/u_dubproject.pas index ec65e5a1..38c84a4d 100644 --- a/src/u_dubproject.pas +++ b/src/u_dubproject.pas @@ -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 -----------------------------------------------} diff --git a/src/u_main.lfm b/src/u_main.lfm index 97428776..5a9369ab 100644 --- a/src/u_main.lfm +++ b/src/u_main.lfm @@ -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 diff --git a/src/u_main.pas b/src/u_main.pas index 6c646f98..f64f9e1b 100644 --- a/src/u_main.pas +++ b/src/u_main.pas @@ -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