di-6

- action related to run proj in main, ok, but sub routines missing for TCEDubProject
- pretty format DUB proj on save
- proj binary kind in TCECOmmonProject itf, moved enum so that TCEDubProject can use the same values

src/ce_dmdwrap.pas

@@ -5,7 +5,8 @@ unit ce_dmdwrap;
 interface
 
 uses
-  classes, sysutils, process, asyncprocess, ce_common, ce_inspectors, ce_processes;
+  classes, sysutils, process, asyncprocess, ce_common, ce_inspectors,
+  ce_processes, ce_interfaces;
 
 (*
 
@@ -103,11 +104,6 @@ type
    *)
   TTargetSystem = (auto, os32bit, os64bit);
 
-  (**
-   * Describes the output kind.
-   *)
-  TBinaryKind = (executable, staticlib, sharedlib, obj);
-
   (**
    * Describes the bounds check kinds.
    *)
@@ -119,7 +115,7 @@ type
   TOutputOpts = class(TOptsGroup)
   private
     fTrgKind: TTargetSystem;
-    fBinKind: TBinaryKind;
+    fBinKind: TProjectBinaryKind;
     fUnittest: boolean;
     fVerIds: TStringList;
     fInline: boolean;
@@ -135,7 +131,7 @@ type
     procedure setAllInst(const aValue: boolean);
     procedure setUnittest(const aValue: boolean);
     procedure setTrgKind(const aValue: TTargetSystem);
-    procedure setBinKind(const aValue: TBinaryKind);
+    procedure setBinKind(const aValue: TProjectBinaryKind);
     procedure setInline(const aValue: boolean);
     procedure setBoundsCheck(const aValue: TBoundCheckKind);
     procedure setOptims(const aValue: boolean);
@@ -147,7 +143,7 @@ type
   published
     property alwaysLinkStaticLibs: boolean read fAlwayLinkLibs write setAlwaysLinkLibs default false;
     property targetKind: TTargetSystem read fTrgKind write setTrgKind default auto;
-    property binaryKind: TBinaryKind read fBinKind write setBinKind default executable;
+    property binaryKind: TProjectBinaryKind read fBinKind write setBinKind default executable;
     property inlining: boolean read fInline write setInline default false;
     property boundsCheck: TBoundCheckKind read fBoundsCheck write setBoundsCheck default safeOnly;
     property optimizations: boolean read fOptimz write setOptims default false;
@@ -562,7 +558,7 @@ var
   opt: string;
 const
   trgKindStr: array[TTargetSystem] of string = ('', '-m32','-m64');
-  binKindStr: array[TBinaryKind] of string = ('', '-lib', '-shared', '-c');
+  binKindStr: array[TProjectBinaryKind] of string = ('', '-lib', '-shared', '-c');
   bchKindStr: array[TBoundCheckKind] of string = ('on', 'safeonly', 'off');
 begin
   opt := binKindStr[fBinKind];
@@ -657,7 +653,7 @@ begin
   doChanged;
 end;
 
-procedure TOutputOpts.setBinKind(const aValue: TBinaryKind);
+procedure TOutputOpts.setBinKind(const aValue: TProjectBinaryKind);
 begin
   if fBinKind = aValue then exit;
   fBinKind := aValue;

src/ce_dubproject.pas

@@ -30,6 +30,7 @@ type
     procedure loadFromFile(const aFilename: string);
     procedure saveToFile(const aFilename: string);
     function getIfModified: boolean;
+    function getBinaryKind: TProjectBinaryKind;
     //
     function getIfIsSource(const aFilename: string): boolean;
     function getOutputFilename: string;
@@ -39,6 +40,7 @@ type
     function getConfigurationName(index: integer): string;
     //
     function compile: boolean;
+    function run(const runArgs: string = ''): boolean;
   end;
 
 implementation
@@ -93,6 +95,12 @@ begin
   exit(fFilename);
 end;
 
+function TCEDubProject.getBinaryKind: TProjectBinaryKind;
+begin
+  //TODO-cDUB: implement
+  exit(executable);
+end;
+
 procedure TCEDubProject.loadFromFile(const aFilename: string);
 var
   loader: TMemoryStream;
@@ -116,7 +124,6 @@ begin
   end;
 end;
 
-//TODO -cDUB: conserve pretty formatting
 procedure TCEDubProject.saveToFile(const aFilename: string);
 var
   saver: TMemoryStream;
@@ -125,7 +132,7 @@ begin
   saver := TMemoryStream.Create;
   try
     fFilename := aFilename;
-    str := fJson.AsJSON;
+    str := fJson.FormatJSON;
     saver.Write(str[1], length(str));
     saver.SaveToFile(fFilename);
   finally
@@ -203,5 +210,11 @@ begin
   end;
 end;
 
+function TCEDubProject.run(const runArgs: string = ''): boolean;
+begin
+  //TODO-cDUB: implement
+  result := false;
+end;
+
 end.
 

src/ce_interfaces.pas

@@ -13,6 +13,9 @@ type
   // describes the project kind. Used as a hint to cast ICECommonProject.getProject()
   TCEProjectFormat = (pfNative, pfDub);
 
+  // describes the binary kind produces when compiling a project
+  TProjectBinaryKind = (executable, staticlib, sharedlib, obj);
+
   (**
    * Common project interface.
    *
@@ -28,7 +31,10 @@ type
 
     // sub routines for the actions --------------------------------------------
 
+    // tries to compile and returns true if it does
     function compile: boolean;
+    // tries to un the project and returns true if it did
+    function run(const runArgs: string = ''): boolean;
 
     // project file - allows main form to create/load/save ---------------------
 
@@ -55,6 +61,8 @@ type
     function getIfIsSource(const aFilename: string): boolean;
     // returns the name of the file produced when a project is compiled
     function getOutputFilename: string;
+    // returns the binary kind produced according to the current configuration
+    function getBinaryKind: TProjectBinaryKind;
 
     // configs -----------------------------------------------------------------
 

src/ce_main.pas

@@ -210,6 +210,8 @@ type
     fSymlWidg: TCESymbolListWidget;
     fInfoWidg: TCEInfoWidget;
 
+    //TODO-cDUB: widget to edit and view, select config of, a DUB project
+
     fInitialized: boolean;
     fRunnableSw: string;
     fRunProc: TCEProcess;
@@ -1509,21 +1511,19 @@ end;
 
 procedure TCEMainForm.actProjCompileAndRunExecute(Sender: TObject);
 begin
-  //TODO-cDUB: implement compile proj and run for DUB projects
-  if fNativeProject.compile then
-    fNativeProject.runProject;
+  if fProjectInterface.compile then
+    fProjectInterface.run;
 end;
 
 procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject);
 var
   runargs: string;
 begin
-  // TODO-cDUB: implement compile proj and run with arg for DUB projects
-  if not fNativeProject.compile then
+  if not fProjectInterface.compile then
     exit;
   runargs := '';
   if InputQuery('Execution arguments', '', runargs) then
-    fNativeProject.runProject(runargs);
+    fProjectInterface.run(runargs);
 end;
 
 procedure TCEMainForm.actProjRunExecute(Sender: TObject);
@@ -1534,33 +1534,40 @@ label
   _rbld,
   _run;
 begin
-  // TODO-cDUB: implement proj run for DUB projects
-  if fNativeProject.currentConfiguration.outputOptions.binaryKind <> executable then
+  if fProjectInterface.getBinaryKind <> executable then
   begin
     dlgOkInfo('Non executable projects cant be run');
     exit;
   end;
-  if not fileExists(fNativeProject.getOutputFilename) then
+  if not fileExists(fProjectInterface.getOutputFilename) then
   begin
     if dlgOkCancel('The project output is missing, build ?') <> mrOK then
       exit;
     goto _rbld;
   end;
-  dt := fileAge(fNativeProject.getOutputFilename);
-  for i := 0 to fNativeProject.Sources.Count-1 do
+
+  // TODO-cICECommonInterface, add function to check if rebuild needed.
+  if fProjectInterface.getFormat = pfNative then
   begin
-    if fileAge(fNativeProject.getAbsoluteSourceName(i)) > dt then
-      if dlgOkCancel('The project sources have changed since last build, rebuild ?') = mrOK then
-        goto _rbld
-      else
-        break;
-  end;
+    dt := fileAge(fNativeProject.getOutputFilename);
+    for i := 0 to fNativeProject.Sources.Count-1 do
+    begin
+      if fileAge(fNativeProject.getAbsoluteSourceName(i)) > dt then
+        if dlgOkCancel('The project sources have changed since last build, rebuild ?') = mrOK then
+          goto _rbld
+        else
+          break;
+    end;
+  end
+  // DUB checks this automatically
+  else fProjectInterface.compile;
+
   goto _run;
   _rbld:
-    fNativeProject.compile;
+    fProjectInterface.compile;
   _run:
-    if fileExists(fNativeProject.getOutputFilename) then
-      fNativeProject.runProject;
+    if fileExists(fProjectInterface.getOutputFilename) then
+      fProjectInterface.run;
 end;
 
 procedure TCEMainForm.actProjRunWithArgsExecute(Sender: TObject);
@@ -1568,9 +1575,8 @@ var
   runargs: string;
 begin
   runargs := '';
-  // TODO-cDUB: change to fProjInterface.runProject when sub routine implemented
   if InputQuery('Execution arguments', '', runargs) then
-    fNativeProject.runProject(runargs);
+    fProjectInterface.run(runargs);
 end;
 {$ENDREGION}
 
@@ -1724,12 +1730,11 @@ end;
 
 procedure TCEMainForm.saveProjSource(const aEditor: TCESynMemo);
 begin
-  //TODO-cDUB: implement save project source for a DUB json file edited in CE
-  if fNativeProject = nil then exit;
-  if fNativeProject.fileName <> aEditor.fileName then exit;
+  if fProjectInterface = nil then exit;
+  if fProjectInterface.getFilename <> aEditor.fileName then exit;
   //
-  aEditor.saveToFile(fNativeProject.fileName);
-  openProj(fNativeProject.fileName);
+  aEditor.saveToFile(fProjectInterface.getFilename);
+  openProj(fProjectInterface.getFilename);
 end;
 
 procedure TCEMainForm.closeProj;
@@ -1773,9 +1778,10 @@ end;
 procedure TCEMainForm.openProj(const aFilename: string);
 begin
   closeProj;
-  if ExtractFileExt(aFilename) = '.json' then newDubProj
-  else newNativeProj;
-
+  if LowerCase(ExtractFileExt(aFilename)) = '.json' then
+    newDubProj
+  else
+    newNativeProj;
   //
   fProjectInterface.loadFromFile(aFilename);
   showProjTitle;
@@ -1856,11 +1862,11 @@ end;
 
 procedure TCEMainForm.actProjSourceExecute(Sender: TObject);
 begin
-  //TODO-cDUB: add json highligher to edit json project in CE
-  if fNativeProject = nil then exit;
-  if not fileExists(fNativeProject.fileName) then exit;
+  if fProjectInterface = nil then exit;
+  if not fileExists(fProjectInterface.getFilename) then exit;
   //
-  openFile(fNativeProject.fileName);
+  openFile(fProjectInterface.getFilename);
+  //TODO-cDUB: add json highligher to edit json project in CE
   fDoc.Highlighter := LfmSyn;
 end;
 

src/ce_nativeproject.pas

@@ -80,7 +80,7 @@ type
     procedure addSource(const aFilename: string);
     function addConfiguration: TCompilerConfiguration;
     procedure getOpts(const aList: TStrings);
-    function runProject(const runArgs: string = ''): Boolean;
+    function run(const runArgs: string = ''): Boolean;
     function compile: Boolean;
     //
     function getIfModified: boolean;
@@ -89,6 +89,7 @@ type
     procedure setActiveConfiguration(index: integer);
     function getConfigurationName(index: integer): string;
     function getFilename: string;
+    function getBinaryKind: TProjectBinaryKind;
     //
     property configuration[ix: integer]: TCompilerConfiguration read getConfig;
     property currentConfiguration: TCompilerConfiguration read getCurrConf;
@@ -705,7 +706,7 @@ begin
   end;
 end;
 
-function TCENativeProject.runProject(const runArgs: string = ''): Boolean;
+function TCENativeProject.run(const runArgs: string = ''): Boolean;
 var
   prm: string;
   i: Integer;
@@ -821,6 +822,11 @@ begin
   exit(fFilename);
 end;
 
+function TCENativeProject.getBinaryKind: TProjectBinaryKind;
+begin
+  exit(currentConfiguration.outputOptions.binaryKind);
+end;
+
 function isValidNativeProject(const filename: string): boolean;
 var
   maybe: TCENativeProject;