From e4c7626345e4035ad322b3e1c28c85017ea08743 Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Tue, 5 Apr 2016 11:53:22 +0200 Subject: [PATCH] split runnable compilation and execution + 2 new related actions - compile (and not run) - run (eventually ask for compile) --- src/ce_main.lfm | 82 +++++++++++++++++--------- src/ce_main.pas | 153 +++++++++++++++++++++++++++++++++++------------- 2 files changed, 165 insertions(+), 70 deletions(-) diff --git a/src/ce_main.lfm b/src/ce_main.lfm index 805f6294..6596ffc4 100644 --- a/src/ce_main.lfm +++ b/src/ce_main.lfm @@ -1471,7 +1471,6 @@ object CEMainForm: TCEMainForm LCLVersion = '1.6.0.4' object mainMenu: TMainMenu Images = imgList - top = 1 object MenuItem1: TMenuItem Caption = 'File' object MenuItem5: TMenuItem @@ -1913,6 +1912,9 @@ object CEMainForm: TCEMainForm object MenuItem36: TMenuItem Caption = '-' end + object MenuItem72: TMenuItem + Action = actFileCompile + end object MenuItem37: TMenuItem Action = actFileCompAndRun Bitmap.Data = { @@ -2030,6 +2032,9 @@ object CEMainForm: TCEMainForm 07FFB47A07FFB47A08FFB57C0AFFB67F0FFFB88114FFBA851B23 } end + object MenuItem73: TMenuItem + Action = actFileRun + end object MenuItem63: TMenuItem Action = actFileUnittest Bitmap.Data = { @@ -3277,6 +3282,9 @@ object CEMainForm: TCEMainForm end object MenuItem8: TMenuItem Caption = 'Run' + object MenuItem74: TMenuItem + Action = actFileCompile + end object MenuItem9: TMenuItem Action = actFileCompAndRun Bitmap.Data = { @@ -3394,6 +3402,9 @@ object CEMainForm: TCEMainForm 07FFB47A07FFB47A08FFB57C0AFFB67F0FFFB88114FFBA851B23 } end + object MenuItem75: TMenuItem + Action = actFileRun + end object MenuItem64: TMenuItem Action = actFileUnittest Bitmap.Data = { @@ -3722,6 +3733,7 @@ object CEMainForm: TCEMainForm Images = imgList OnUpdate = ActionsUpdate left = 32 + top = 1 object actEdCopy: TAction Category = 'Edit' Caption = 'Copy' @@ -3822,14 +3834,6 @@ object CEMainForm: TCEMainForm OnExecute = actFileAddToProjExecute OnUpdate = updateDocumentBasedAction end - object actFileCompAndRun: TAction - Category = 'File' - Caption = 'Compile file and run' - ImageIndex = 22 - OnExecute = actFileCompAndRunExecute - OnUpdate = updateDocumentBasedAction - ShortCut = 116 - end object actProjSave: TAction Category = 'Project' Caption = 'Save project' @@ -3961,6 +3965,33 @@ object CEMainForm: TCEMainForm ImageIndex = 30 OnExecute = actLayoutSaveExecute end + object actProjNewDubJson: TAction + Category = 'Project' + Caption = 'DUB json' + ImageIndex = 8 + OnExecute = actProjNewDubJsonExecute + end + object actProjNewNative: TAction + Category = 'Project' + Caption = 'Native format' + ImageIndex = 8 + OnExecute = actProjNewNativeExecute + end + object actFileCompile: TAction + Category = 'File' + Caption = 'Compile file' + ImageIndex = 22 + OnExecute = actFileCompileExecute + OnUpdate = updateDocumentBasedAction + end + object actFileCompAndRun: TAction + Category = 'File' + Caption = 'Compile file and run' + ImageIndex = 22 + OnExecute = actFileCompAndRunExecute + OnUpdate = updateDocumentBasedAction + ShortCut = 116 + end object actFileCompileAndRunOut: TAction Category = 'File' Caption = 'Compile file and run outside' @@ -3977,6 +4008,20 @@ object CEMainForm: TCEMainForm OnUpdate = updateDocumentBasedAction ShortCut = 24695 end + object actFileRun: TAction + Category = 'File' + Caption = 'Run compiled file' + ImageIndex = 22 + OnExecute = actFileRunExecute + OnUpdate = updateDocumentBasedAction + end + object actFileUnittest: TAction + Category = 'File' + Caption = 'Run file unittests' + ImageIndex = 22 + OnExecute = actFileUnittestExecute + OnUpdate = updateDocumentBasedAction + end object actFileSaveAll: TAction Category = 'File' Caption = 'Save all' @@ -4006,31 +4051,12 @@ object CEMainForm: TCEMainForm OnExecute = actFileHtmlExportExecute OnUpdate = updateDocumentBasedAction end - object actFileUnittest: TAction - Category = 'File' - Caption = 'Run file unittests' - ImageIndex = 22 - OnExecute = actFileUnittestExecute - OnUpdate = updateDocumentBasedAction - end object actSetRunnableSw: TAction Category = 'File' Caption = 'Set runnable switches' ImageIndex = 34 OnExecute = actSetRunnableSwExecute end - object actProjNewDubJson: TAction - Category = 'Project' - Caption = 'DUB json' - ImageIndex = 8 - OnExecute = actProjNewDubJsonExecute - end - object actProjNewNative: TAction - Category = 'Project' - Caption = 'Native format' - ImageIndex = 8 - OnExecute = actProjNewNativeExecute - end object actFileSaveCopyAs: TAction Category = 'File' Caption = 'Save file copy as...' diff --git a/src/ce_main.pas b/src/ce_main.pas index 2139be6c..e2f804cc 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -37,6 +37,8 @@ type actFileUnittest: TAction; actFileCompileAndRunOut: TAction; actFileSaveCopyAs: TAction; + actFileCompile: TAction; + actFileRun: TAction; actProjNewDubJson: TAction; actProjNewNative: TAction; actSetRunnableSw: TAction; @@ -132,6 +134,10 @@ type MenuItem69: TMenuItem; MenuItem70: TMenuItem; MenuItem71: TMenuItem; + MenuItem72: TMenuItem; + MenuItem73: TMenuItem; + MenuItem74: TMenuItem; + MenuItem75: TMenuItem; mnuLayout: TMenuItem; mnuItemMruFile: TMenuItem; mnuItemMruProj: TMenuItem; @@ -142,6 +148,8 @@ type MenuItem7: TMenuItem; MenuItem8: TMenuItem; MenuItem9: TMenuItem; + procedure actFileCompileExecute(Sender: TObject); + procedure actFileRunExecute(Sender: TObject); procedure actFileSaveCopyAsExecute(Sender: TObject); procedure actProjNewDubJsonExecute(Sender: TObject); procedure actProjNewNativeExecute(Sender: TObject); @@ -290,7 +298,8 @@ type procedure asyncprocOutput(sender: TObject); procedure asyncprocTerminate(sender: TObject); procedure unittestDone(Sender: TObject); - procedure compileAndRunFile(unittest: boolean = false; redirect: boolean = true; + procedure compileRunnable(unittest: boolean = false); + procedure executeRunnable(unittest: boolean = false; redirect: boolean = true; const runArgs: string = ''); // file sub routines @@ -1924,8 +1933,7 @@ begin form.Free; end; -procedure TCEMainForm.compileAndRunFile(unittest: boolean = false; redirect: boolean = true; - const runArgs: string = ''); +procedure TCEMainForm.compileRunnable(unittest: boolean = false); var i: integer; dmdproc: TCEProcess; @@ -1948,28 +1956,16 @@ begin end else firstlineFlags:= ''; - fRunProc := TCEProcess.Create(nil); - if redirect then - begin - fRunProc.Options := [poStderrToOutPut, poUsePipes]; - fRunProc.ShowWindow := swoHIDE; - fRunProc.OnReadData := @asyncprocOutput; - fRunProc.OnTerminate:= @asyncprocTerminate; - end else - begin - {$IFNDEF WINDOWS} - fRunProc.Options := fRunProc.Options + [poNewConsole]; - {$ENDIF} - end; - lst := TStringList.Create; dmdproc := TCEProcess.Create(nil); try fMsgs.message('compiling ' + shortenPath(fDoc.fileName, 25), fDoc, amcEdit, amkInf); - if fDoc.fileName.fileExists then fDoc.save - else fDoc.saveTempFile; + if fDoc.fileName.fileExists then + fDoc.save + else + fDoc.saveTempFile; fname := stripFileExt(fDoc.fileName); if fRunnableSw.isEmpty then @@ -2001,25 +1997,11 @@ begin dmdproc.Execute; while dmdproc.Running do application.ProcessMessages; - + sysutils.DeleteFile(fname + objExt); if (dmdProc.ExitStatus = 0) then begin fMsgs.message(shortenPath(fDoc.fileName, 25) + ' successfully compiled', fDoc, amcEdit, amkInf); - fRunProc.CurrentDirectory := fRunProc.Executable.extractFileDir; - if runArgs.isNotEmpty then - begin - lst.Clear; - CommandToList(fSymStringExpander.expand(runArgs), lst); - fRunProc.Parameters.AddStrings(lst); - end; - fRunProc.Executable := fname + exeExt; - if unittest and fCovModUt then - fRunProc.OnTerminate:=@unittestDone; - if redirect then - getprocInputHandler.addProcess(fRunProc); - fRunProc.Execute; - sysutils.DeleteFile(fname + objExt); end else begin fMsgs.message(format('error: the process (%s) has returned the signal %d', @@ -2034,6 +2016,49 @@ begin end; end; +procedure TCEMainForm.executeRunnable(unittest: boolean = false; redirect: boolean = true; + const runArgs: string = ''); +var + lst: TStringList; + fname: string; +begin + if fDoc.isNil then exit; + fname := stripFileExt(fDoc.fileName) + exeExt; + if not fname.fileExists then exit; + + fRunProc := TCEProcess.Create(nil); + if redirect then + begin + fRunProc.Options := [poStderrToOutPut, poUsePipes]; + fRunProc.ShowWindow := swoHIDE; + fRunProc.OnReadData := @asyncprocOutput; + fRunProc.OnTerminate:= @asyncprocTerminate; + end + else + begin + {$IFNDEF WINDOWS} + fRunProc.Options := fRunProc.Options + [poNewConsole]; + {$ENDIF} + end; + lst := TStringList.Create; + try + fRunProc.CurrentDirectory := fRunProc.Executable.extractFileDir; + if runArgs.isNotEmpty then + begin + CommandToList(fSymStringExpander.expand(runArgs), lst); + fRunProc.Parameters.AddStrings(lst); + end; + fRunProc.Executable := fname + exeExt; + if unittest and fCovModUt then + fRunProc.OnTerminate:=@unittestDone; + if redirect then + getprocInputHandler.addProcess(fRunProc); + fRunProc.Execute; + finally + lst.Free; + end; +end; + procedure TCEMainForm.unittestDone(Sender: TObject); var fullcov: boolean; @@ -2075,28 +2100,72 @@ end; procedure TCEMainForm.actFileUnittestExecute(Sender: TObject); begin - if fDoc.isNotNil then - compileAndRunFile(true); + if fDoc.isNil then + exit; + compileRunnable(true); + executeRunnable(true); end; procedure TCEMainForm.actFileCompAndRunExecute(Sender: TObject); begin - if fDoc.isNotNil then - compileAndRunFile(false); + if fDoc.isNil then + exit; + compileRunnable(false); + executeRunnable(false, true); end; procedure TCEMainForm.actFileCompileAndRunOutExecute(Sender: TObject); begin - if fDoc.isNotNil then - compileAndRunFile(false, false); + if fDoc.isNil then + exit; + compileRunnable(false); + executeRunnable(false, false); end; procedure TCEMainForm.actFileCompAndRunWithArgsExecute(Sender: TObject); var runargs: string = ''; begin - if fDoc.isNotNil and InputQuery('Execution arguments', '', runargs) then - compileAndRunFile(false, true, runargs); + if fDoc.isNil then + exit; + if not InputQuery('Execution arguments', '', runargs) then + exit; + compileRunnable(false); + executeRunnable(false, true, runargs); +end; + +procedure TCEMainForm.actFileCompileExecute(Sender: TObject); +begin + compileRunnable(false); +end; + +procedure TCEMainForm.actFileRunExecute(Sender: TObject); +var + fname: string; + older: boolean = false; + exist: boolean = false; +const + messg: string = 'Either the runnable does not exist or it is older than its source.' + + LineEnding + ' Do you wish to recompile it ?'; +begin + if fDoc.isNil then + exit; + FreeRunnableProc; + fname := stripFileExt(fDoc.fileName) + exeExt; + if fname.fileExists then + begin + exist := true; + older := FileAge(fname) < FileAge(fDoc.fileName); + end; + if (not exist) or (older) then + begin + if dlgOkCancel(messg) = mrOK then + compileRunnable + else if not exist then + exit; + end; + if fname.fileExists then + executeRunnable(false, true); end; procedure TCEMainForm.actFileOpenContFoldExecute(Sender: TObject);