diff --git a/src/ce_ceproject.pas b/src/ce_ceproject.pas index b2c69581..9840397e 100644 --- a/src/ce_ceproject.pas +++ b/src/ce_ceproject.pas @@ -109,6 +109,7 @@ type function getCommandLine: string; function modified: boolean; procedure reload; + procedure stopCompilation; // function configurationCount: integer; procedure setActiveConfigurationIndex(index: integer); @@ -776,6 +777,12 @@ begin exit(fCompiled); end; +procedure TCENativeProject.stopCompilation; +begin + if fCompilProc.isNotNil and fCompilProc.Running then + fCompilProc.Terminate(1); +end; + procedure TCENativeProject.compile; var config: TCompilerConfiguration; diff --git a/src/ce_dubproject.pas b/src/ce_dubproject.pas index 39aa0792..820bb6da 100644 --- a/src/ce_dubproject.pas +++ b/src/ce_dubproject.pas @@ -167,6 +167,7 @@ type function getCommandLine: string; function outputFilename: string; procedure reload; + procedure stopCompilation; // function isSource(const fname: string): boolean; function sourcesCount: integer; @@ -937,6 +938,12 @@ end; {$ENDREGION --------------------------------------------------------------------} {$REGION ICECommonProject: actions ---------------------------------------------} +procedure TCEDubProject.stopCompilation; +begin + if fDubProc.isNotNil and fDubProc.Running then + fDubProc.Terminate(1); +end; + procedure TCEDubProject.dubProcOutput(proc: TObject); var lst: TStringList; diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas index 11b8ddb6..bd999912 100644 --- a/src/ce_interfaces.pas +++ b/src/ce_interfaces.pas @@ -55,6 +55,8 @@ type function binaryKind: TProjectBinaryKind; // returns what's gonna be executed in background for this config function getCommandLine: string; + // stops compilation + procedure stopCompilation; // configs ----------------------------------------------------------------- diff --git a/src/ce_main.lfm b/src/ce_main.lfm index b2b78552..4c63805b 100644 --- a/src/ce_main.lfm +++ b/src/ce_main.lfm @@ -1472,7 +1472,6 @@ object CEMainForm: TCEMainForm OnResize = FormResize OnWindowStateChange = FormWindowStateChange ShowHint = True - LCLVersion = '1.8.4.0' Visible = False object mainMenu: TMainMenu top = 1 @@ -1693,6 +1692,9 @@ object CEMainForm: TCEMainForm object MenuItem35: TMenuItem Action = actProjCompAndRunWithArgs end + object MenuItem113: TMenuItem + Action = actProjStopComp + end object MenuItem47: TMenuItem Caption = '-' end @@ -2268,6 +2270,12 @@ object CEMainForm: TCEMainForm OnExecute = actProjTestExecute OnUpdate = updateProjectBasedAction end + object actProjStopComp: TAction + Category = 'Project' + Caption = 'Stop compiling' + OnExecute = actProjStopCompExecute + OnUpdate = updateProjectBasedAction + end end object ApplicationProperties1: TApplicationProperties OnActivate = ApplicationProperties1Activate diff --git a/src/ce_main.pas b/src/ce_main.pas index e10f56de..7039033c 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -117,6 +117,7 @@ type actFileCloseAll: TAction; actFileNewClip: TAction; actEdFormat: TAction; + actProjStopComp: TAction; actProjTest: TAction; actLayoutReset: TAction; actProjDscan: TAction; @@ -174,6 +175,7 @@ type MenuItem110: TMenuItem; MenuItem111: TMenuItem; MenuItem112: TMenuItem; + MenuItem113: TMenuItem; mnuItemHelp: TMenuItem; mnuItemAbout: TMenuItem; mnuItemCheckUpd: TMenuItem; @@ -309,6 +311,7 @@ type procedure actProjSaveGroupAsExecute(Sender: TObject); procedure actProjSaveGroupExecute(Sender: TObject); procedure actProjSelUngroupedExecute(Sender: TObject); + procedure actProjStopCompExecute(Sender: TObject); procedure actProjTestExecute(Sender: TObject); procedure actSetRunnableSwExecute(Sender: TObject); procedure ApplicationProperties1Activate(Sender: TObject); @@ -1503,6 +1506,9 @@ begin i := LoadIcon('MOVE_TO_FOLDER'); actFileAddToProj.ImageIndex:=i; + + i := loadIcon('CROSS'); + actProjStopComp.ImageIndex:=i; end; procedure TCEMainForm.InitWidgets; @@ -3916,6 +3922,13 @@ begin fProject.test; end; +procedure TCEMainForm.actProjStopCompExecute(Sender: TObject); +begin + if fProject = nil then + exit; + fProject.stopCompilation(); +end; + procedure TCEMainForm.actProjDscanExecute(Sender: TObject); var lst: TStringList;