mirror of https://gitlab.com/basile.b/dexed.git
split runnable compilation and execution + 2 new related actions
- compile (and not run) - run (eventually ask for compile)
This commit is contained in:
parent
6851aa1973
commit
e4c7626345
|
@ -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...'
|
||||
|
|
153
src/ce_main.pas
153
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);
|
||||
|
|
Loading…
Reference in New Issue