add action to stop project compilation

This commit is contained in:
Basile Burg 2018-06-27 13:45:44 +02:00
parent 6c65d4b4fd
commit 1baa52f006
5 changed files with 38 additions and 1 deletions

View File

@ -109,6 +109,7 @@ type
function getCommandLine: string; function getCommandLine: string;
function modified: boolean; function modified: boolean;
procedure reload; procedure reload;
procedure stopCompilation;
// //
function configurationCount: integer; function configurationCount: integer;
procedure setActiveConfigurationIndex(index: integer); procedure setActiveConfigurationIndex(index: integer);
@ -776,6 +777,12 @@ begin
exit(fCompiled); exit(fCompiled);
end; end;
procedure TCENativeProject.stopCompilation;
begin
if fCompilProc.isNotNil and fCompilProc.Running then
fCompilProc.Terminate(1);
end;
procedure TCENativeProject.compile; procedure TCENativeProject.compile;
var var
config: TCompilerConfiguration; config: TCompilerConfiguration;

View File

@ -167,6 +167,7 @@ type
function getCommandLine: string; function getCommandLine: string;
function outputFilename: string; function outputFilename: string;
procedure reload; procedure reload;
procedure stopCompilation;
// //
function isSource(const fname: string): boolean; function isSource(const fname: string): boolean;
function sourcesCount: integer; function sourcesCount: integer;
@ -937,6 +938,12 @@ end;
{$ENDREGION --------------------------------------------------------------------} {$ENDREGION --------------------------------------------------------------------}
{$REGION ICECommonProject: actions ---------------------------------------------} {$REGION ICECommonProject: actions ---------------------------------------------}
procedure TCEDubProject.stopCompilation;
begin
if fDubProc.isNotNil and fDubProc.Running then
fDubProc.Terminate(1);
end;
procedure TCEDubProject.dubProcOutput(proc: TObject); procedure TCEDubProject.dubProcOutput(proc: TObject);
var var
lst: TStringList; lst: TStringList;

View File

@ -55,6 +55,8 @@ type
function binaryKind: TProjectBinaryKind; function binaryKind: TProjectBinaryKind;
// returns what's gonna be executed in background for this config // returns what's gonna be executed in background for this config
function getCommandLine: string; function getCommandLine: string;
// stops compilation
procedure stopCompilation;
// configs ----------------------------------------------------------------- // configs -----------------------------------------------------------------

View File

@ -1472,7 +1472,6 @@ object CEMainForm: TCEMainForm
OnResize = FormResize OnResize = FormResize
OnWindowStateChange = FormWindowStateChange OnWindowStateChange = FormWindowStateChange
ShowHint = True ShowHint = True
LCLVersion = '1.8.4.0'
Visible = False Visible = False
object mainMenu: TMainMenu object mainMenu: TMainMenu
top = 1 top = 1
@ -1693,6 +1692,9 @@ object CEMainForm: TCEMainForm
object MenuItem35: TMenuItem object MenuItem35: TMenuItem
Action = actProjCompAndRunWithArgs Action = actProjCompAndRunWithArgs
end end
object MenuItem113: TMenuItem
Action = actProjStopComp
end
object MenuItem47: TMenuItem object MenuItem47: TMenuItem
Caption = '-' Caption = '-'
end end
@ -2268,6 +2270,12 @@ object CEMainForm: TCEMainForm
OnExecute = actProjTestExecute OnExecute = actProjTestExecute
OnUpdate = updateProjectBasedAction OnUpdate = updateProjectBasedAction
end end
object actProjStopComp: TAction
Category = 'Project'
Caption = 'Stop compiling'
OnExecute = actProjStopCompExecute
OnUpdate = updateProjectBasedAction
end
end end
object ApplicationProperties1: TApplicationProperties object ApplicationProperties1: TApplicationProperties
OnActivate = ApplicationProperties1Activate OnActivate = ApplicationProperties1Activate

View File

@ -117,6 +117,7 @@ type
actFileCloseAll: TAction; actFileCloseAll: TAction;
actFileNewClip: TAction; actFileNewClip: TAction;
actEdFormat: TAction; actEdFormat: TAction;
actProjStopComp: TAction;
actProjTest: TAction; actProjTest: TAction;
actLayoutReset: TAction; actLayoutReset: TAction;
actProjDscan: TAction; actProjDscan: TAction;
@ -174,6 +175,7 @@ type
MenuItem110: TMenuItem; MenuItem110: TMenuItem;
MenuItem111: TMenuItem; MenuItem111: TMenuItem;
MenuItem112: TMenuItem; MenuItem112: TMenuItem;
MenuItem113: TMenuItem;
mnuItemHelp: TMenuItem; mnuItemHelp: TMenuItem;
mnuItemAbout: TMenuItem; mnuItemAbout: TMenuItem;
mnuItemCheckUpd: TMenuItem; mnuItemCheckUpd: TMenuItem;
@ -309,6 +311,7 @@ type
procedure actProjSaveGroupAsExecute(Sender: TObject); procedure actProjSaveGroupAsExecute(Sender: TObject);
procedure actProjSaveGroupExecute(Sender: TObject); procedure actProjSaveGroupExecute(Sender: TObject);
procedure actProjSelUngroupedExecute(Sender: TObject); procedure actProjSelUngroupedExecute(Sender: TObject);
procedure actProjStopCompExecute(Sender: TObject);
procedure actProjTestExecute(Sender: TObject); procedure actProjTestExecute(Sender: TObject);
procedure actSetRunnableSwExecute(Sender: TObject); procedure actSetRunnableSwExecute(Sender: TObject);
procedure ApplicationProperties1Activate(Sender: TObject); procedure ApplicationProperties1Activate(Sender: TObject);
@ -1503,6 +1506,9 @@ begin
i := LoadIcon('MOVE_TO_FOLDER'); i := LoadIcon('MOVE_TO_FOLDER');
actFileAddToProj.ImageIndex:=i; actFileAddToProj.ImageIndex:=i;
i := loadIcon('CROSS');
actProjStopComp.ImageIndex:=i;
end; end;
procedure TCEMainForm.InitWidgets; procedure TCEMainForm.InitWidgets;
@ -3916,6 +3922,13 @@ begin
fProject.test; fProject.test;
end; end;
procedure TCEMainForm.actProjStopCompExecute(Sender: TObject);
begin
if fProject = nil then
exit;
fProject.stopCompilation();
end;
procedure TCEMainForm.actProjDscanExecute(Sender: TObject); procedure TCEMainForm.actProjDscanExecute(Sender: TObject);
var var
lst: TStringList; lst: TStringList;