moved project compile to TCEProject

src/ce_main.pas

@@ -1341,15 +1341,15 @@ begin
 end;
 
 procedure TCEMainForm.compileProject(const aProject: TCEProject);
-var
+(*var
   dmdproc: TProcess;
   ppproc: TProcess;
   olddir, prjpath, ppname: string;
-  i, j: NativeInt;
+  i, j: NativeInt;*)
 begin
-
   fMesgWidg.ClearAllMessages;
-
+  fProject.compileProject;
+(*
   with fProject.currentConfiguration do
   begin
     ppname := expandSymbolicString(preBuildProcess.executable);
@@ -1444,6 +1444,7 @@ begin
     dmdproc.Free;
     chDir(olddir);
   end;
+  *)
 end;
 
 procedure TCEMainForm.runProject(const aProject: TCEProject; const runArgs: string = '');

src/ce_project.pas

@@ -45,13 +45,14 @@ type
     procedure setConfIx(aValue: Integer);
     function getConfig(const ix: integer): TCompilerConfiguration;
     function getCurrConf: TCompilerConfiguration;
-    procedure runPrePostProcess(const processInfo: TCompileProcOptions);
+    function runPrePostProcess(const processInfo: TCompileProcOptions): Boolean;
+    function getCanBeRun: boolean;
   protected
     procedure afterSave; override;
     procedure afterLoad; override;
     procedure setFilename(const aValue: string); override;
     procedure readerPropNoFound(Reader: TReader; Instance: TPersistent;
-      var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); override;
+      var PropName: string; IsPath: Boolean; var Handled, Skip: Boolean); override;
   published
     property RootFolder: string read fRootFolder write setRoot;
     property OptionsCollection: TCollection read fOptsColl write setOptsColl;
@@ -71,14 +72,15 @@ type
     function addConfiguration: TCompilerConfiguration;
     procedure getOpts(const aList: TStrings);
     function outputFilename: string;
-    procedure runProject;
+    function runProject: Boolean;
-    procedure compileProject;
+    function compileProject: Boolean;
     //
     property libraryManager: TLibraryManager read fLibMan write fLibMan;
     property configuration[ix: integer]: TCompilerConfiguration read getConfig;
     property currentConfiguration: TCompilerConfiguration read getCurrConf;
     property onChange: TNotifyEvent read fOnChange write fOnChange;
-    property modified: boolean read fModified;
+    property modified: Boolean read fModified;
+    property canBeRun: Boolean read getCanBeRun;
   end;
 
 implementation
@@ -355,7 +357,7 @@ procedure TCEProject.afterLoad;
 var
   i, j: Integer;
   src, ini, newdir: string;
-  hasPatched: boolean;
+  hasPatched: Boolean;
 begin
   patchPlateformPaths(fSrcs);
   doChanged;
@@ -406,7 +408,7 @@ begin
 end;
 
 procedure TCEProject.readerPropNoFound(Reader: TReader; Instance: TPersistent;
-      var PropName: string; IsPath: boolean; var Handled, Skip: Boolean);
+      var PropName: string; IsPath: Boolean; var Handled, Skip: Boolean);
 //var
   //idt: string;
   //curr: TCompilerConfiguration;
@@ -438,76 +440,113 @@ begin
   end;
 end;
 
-procedure TCEProject.runPrePostProcess(const processInfo: TCompileProcOptions);
+function TCEProject.getCanBeRun: boolean;
+begin
+  if currentConfiguration = nil then
+    exit(false)
+  else
+    exit(fileExists(outputFilename) and (currentConfiguration.outputOptions.binaryKind = executable));
+end;
+
+function TCEProject.runPrePostProcess(const processInfo: TCompileProcOptions): Boolean;
 var
   process: TProcess;
   pname: string;
   i, j: integer;
 begin
-  with currentConfiguration do
+  pname := CEMainForm.expandSymbolicString(processInfo.executable);
-  begin
+  if (not exeInSysPath(pname)) and (pname <> '``') then
-    pname := CEMainForm.expandSymbolicString(preBuildProcess.executable);
+    exit(false)
-    if pname <> '``' then
+  else if (pname = '``') then
-      if exeInSysPath(pname) then
+    exit(true);
-      begin
+  //
-        process := TProcess.Create(nil);
+  process := TProcess.Create(nil);
-        try
+  try
-          processInfo.setProcess(process);
+    processInfo.setProcess(process);
-          process.Executable := pname;
+    process.Executable := pname;
-          j := process.Parameters.Count-1;
+    j := process.Parameters.Count-1;
-          for i:= 0 to j do
+    for i:= 0 to j do
-            process.Parameters.AddText(CEMainForm.expandSymbolicString(process.Parameters.Strings[i]));
+      process.Parameters.AddText(CEMainForm.expandSymbolicString(process.Parameters.Strings[i]));
-          for i:= 0 to j do
+    for i:= 0 to j do
-            process.Parameters.Delete(0);
+      process.Parameters.Delete(0);
-          if process.CurrentDirectory = '' then
+    if process.CurrentDirectory = '' then
-            process.CurrentDirectory := extractFilePath(process.Executable);
+      process.CurrentDirectory := extractFilePath(process.Executable);
-          process.Execute;
+    ensureNoPipeIfWait(process);
-          if not (poWaitOnExit in process.Options) then
+    process.Execute;
-            if poUsePipes in process.Options then
+    while process.Running do
-              subjLmProcess(TCELogMessageSubject(fLogMessager), process, @Self, amcProj, amkBub);
+    if not (poWaitOnExit in process.Options) then
-        finally
+      if poUsePipes in process.Options then
-          process.Free;
+        subjLmProcess(TCELogMessageSubject(fLogMessager), process, @Self, amcProj, amkBub);
-        end;
+  finally
-      end
+    result := process.ExitStatus = 0;
-      else subjLmStandard(TCELogMessageSubject(fLogMessager),
+    process.Free;
-        'the pre/post compilation executable does not exist', @Self, amcProj, amkBub);
   end;
 end;
 
-procedure TCEProject.runProject;
+function TCEProject.runProject: Boolean;
 begin
+  result := false;
   killProcess(fRunner);
   fRunner := TAsyncProcess.Create(nil);
+  result := true;
 end;
 
-procedure TCEProject.compileProject;
+function TCEProject.compileProject: Boolean;
 var
+  config: TCompilerConfiguration;
   compilproc: TProcess;
-  olddir: string;
+  olddir, prjpath: string;
+  prjname: string;
 begin
-
+  result := false;
-  runPrePostProcess(currentConfiguration.preBuildProcess);
+  config := currentConfiguration;
-
+    if config = nil then
+    begin
+      subjLmStandard(TCELogMessageSubject(fLogMessager),
+        'unexpected project error: no active configuration', @Self, amcProj, amkErr);
+      exit;
+    end;
+  //
+  if not runPrePostProcess(config.preBuildProcess) then
+    subjLmStandard(TCELogMessageSubject(fLogMessager),
+      'project warning: the pre-compilation process has not been executed', @Self, amcProj, amkWarn);
+  //
+  prjname := shortenPath(filename, 25);
   compilproc := TProcess.Create(nil);
+  olddir := '';
   getDir(0, olddir);
   try
+    subjLmStandard(TCELogMessageSubject(fLogMessager),
+      'compiling ' + prjname, @Self, amcProj, amkInf);
+    prjpath := extractFilePath(fileName);
+    if directoryExists(prjpath) then
+    begin
+      chDir(prjpath);
+      compilproc.CurrentDirectory := prjpath;
+    end;
     compilproc.Executable := DCompiler;
     compilproc.Options := compilproc.Options + [poStderrToOutPut, poUsePipes];
     compilproc.ShowWindow := swoHIDE;
     getOpts(compilproc.Parameters);
     compilproc.Execute;
-    subjLmProcess(TCELogMessageSubject(fLogMessager), compilproc, @Self, amcProj, amkBub);
+    while compilProc.Running do
-    if compilproc.ExitStatus <> 0 then
+      subjLmProcess(TCELogMessageSubject(fLogMessager), compilproc, @Self, amcProj, amkBub);
-    else ;
+    if compilproc.ExitStatus = 0 then begin
+      subjLmStandard(TCELogMessageSubject(fLogMessager),
+        prjname + ' has been successfully compiled', @Self, amcProj, amkInf);
+      result := true;
+    end else
+      subjLmStandard(TCELogMessageSubject(fLogMessager),
+        prjname + ' has not been compiled', @Self, amcProj, amkWarn);
 
-    runPrePostProcess(currentConfiguration.postBuildProcess);
+  if not runPrePostProcess(config.PostBuildProcess) then
+    subjLmStandard(TCELogMessageSubject(fLogMessager),
+      'project warning: the post-compilation process has not been executed', @Self, amcProj, amkWarn);
 
   finally
     compilproc.Free;
     chDir(olddir);
   end;
-
-
 end;
 
 initialization