add read only support for dub SDL projects, close #96

dastworx/src/common.d

@@ -13,14 +13,19 @@ enum ErrorType: ubyte
     error
 }
 
+/// Stores a dparse AST error
 @NoInit @NoGc struct AstError
 {
+    ///
     ErrorType type;
+    ///
     @NoGc string message;
+    ///
     size_t line, column;
 
     @disable this();
 
+    ///
     this(ErrorType type, string message, size_t line, size_t column) @nogc @safe
     {
         this.type = type;
@@ -43,6 +48,7 @@ alias AstErrors = AstError*[];
     destruct(err);
 }
 
+/// Write function call when compiled with version "devel"
 enum logCall =
 q{
     import std.experimental.logger: log;
@@ -162,13 +168,12 @@ private static immutable predefinedVersions = [
 	"X86_64"
 ];
 
-private void fillBadVersions()
+private void fillBadVrsions()
 {
     // note: compiler switch -m32/64 can lead to wrong results
-    string addVersionidentifier(string ver)()
-    {
-        return `version(` ~ ver ~ `){} else _badVersions["` ~ ver ~ "\"] = true;\n";
-    }
+
+    alias addVerId = (ver) => `version(` ~ ver ~ `){}
+        else _badVersions["` ~ ver ~ "\"] = true;\n";
 
     string addVerionIdentifiers()
     {
@@ -177,7 +182,7 @@ private void fillBadVersions()
         string result;
         foreach(i; aliasSeqOf!(iota(0, predefinedVersions.length)))
         {
-            result ~= addVersionidentifier!(predefinedVersions[i]);
+            result ~= addVerId(predefinedVersions[i]);
         }
         return result;
     }
@@ -358,8 +363,7 @@ T parseAndVisit(T : ASTVisitor)(const(char)[] source)
  * By default libdparse outputs errors and warnings to the standard streams.
  * This function prevents that.
  */
-void ignoreErrors(string fname, size_t line, size_t col, string message,
-    bool err)
+void ignoreErrors(string, size_t, size_t, string, bool)
 {
     // dont pollute output
 }

src/ce_dubproject.pas

@@ -54,6 +54,7 @@ type
 
   TCEDubProject = class(TComponent, ICECommonProject)
   private
+    fIsSdl: boolean;
     fInGroup: boolean;
     fDubProc: TCEProcess;
     fPreCompilePath: string;
@@ -130,6 +131,7 @@ type
     //
     property json: TJSONObject read fJSON;
     property packageName: string read fPackageName;
+    property isSDL: boolean read fIsSdl;
   end;
 
   // these 9 built types always exist
@@ -138,6 +140,9 @@ type
   // returns true if filename is a valid dub project. Only json format is supported.
   function isValidDubProject(const filename: string): boolean;
 
+  // converts a sdl description to json, returns the json
+  function sdl2json(const filename: string): TJSONObject;
+
   function getDubCompiler: TCECompiler;
   procedure setDubCompiler(value: TCECompiler);
 
@@ -145,6 +150,9 @@ var
   DubCompiler: TCECompiler = dmd;
   DubCompilerFilename: string = 'dmd';
 
+const
+  DubSdlWarning = 'this feature is not available for a DUB project with the SDL format';
+
 implementation
 
 var
@@ -330,66 +338,83 @@ procedure TCEDubProject.loadFromFile(const fname: string);
 var
   loader: TMemoryStream;
   parser : TJSONParser;
+  ext: string;
   bom: dword = 0;
 begin
-  loader := TMemoryStream.Create;
-  try
-    fBasePath := fname.extractFilePath;
-    fFilename := fname;
-    loader.LoadFromFile(fFilename);
-    fSaveAsUtf8 := false;
-    // skip BOM, this crashes the parser
-    loader.Read(bom, 4);
-    if (bom and $BFBBEF) = $BFBBEF then
-    begin
-      loader.Position:= 3;
-      fSaveAsUtf8 := true;
-    end
-    else if (bom = $FFFE0000) or (bom = $FEFF) then
-    begin
-      // UCS-4 LE/BE not handled by DUB
-      loader.clear;
-      loader.WriteByte(byte('{'));
-      loader.WriteByte(byte('}'));
-      loader.Position:= 0;
-      fFilename := '';
-    end
-    else if ((bom and $FEFF) = $FEFF) or ((bom and $FFFE) = $FFFE) then
-    begin
-      // UCS-2 LE/BE not handled by DUB
-      loader.clear;
-      loader.WriteByte(byte('{'));
-      loader.WriteByte(byte('}'));
-      loader.Position:= 0;
-      fFilename := '';
-    end
-    else
-      loader.Position:= 0;
-    //
-    FreeAndNil(fJSON);
-    parser := TJSONParser.Create(loader, [joIgnoreTrailingComma, joUTF8]);
-    //TODO-cfcl-json: remove etc/fcl-json the day they'll merge and rlz the version with 'Options'
-    //TODO-cfcl-json: track possible changes and fixes at http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/packages/fcl-json/
-    //latest in etc = rev 34196.
+  ext := fname.extractFileExt.upperCase;
+  fBasePath := fname.extractFilePath;
+  fFilename := fname;
+  fSaveAsUtf8 := false;
+  fIsSdl := false;
+  if ext = '.JSON' then
+  begin
+    loader := TMemoryStream.Create;
     try
-      try
-        fJSON := parser.Parse as TJSONObject;
-      except
-        if assigned(fJSON) then
-          FreeAndNil(fJSON);
+      loader.LoadFromFile(fFilename);
+      // skip BOMs, they crash the parser
+      loader.Read(bom, 4);
+      if (bom and $BFBBEF) = $BFBBEF then
+      begin
+        loader.Position:= 3;
+        fSaveAsUtf8 := true;
+      end
+      else if (bom = $FFFE0000) or (bom = $FEFF) then
+      begin
+        // UCS-4 LE/BE not handled by DUB
+        loader.clear;
+        loader.WriteByte(byte('{'));
+        loader.WriteByte(byte('}'));
+        loader.Position:= 0;
         fFilename := '';
+      end
+      else if ((bom and $FEFF) = $FEFF) or ((bom and $FFFE) = $FFFE) then
+      begin
+        // UCS-2 LE/BE not handled by DUB
+        loader.clear;
+        loader.WriteByte(byte('{'));
+        loader.WriteByte(byte('}'));
+        loader.Position:= 0;
+        fFilename := '';
+      end
+      else
+        loader.Position:= 0;
+      //
+      FreeAndNil(fJSON);
+      parser := TJSONParser.Create(loader, [joIgnoreTrailingComma, joUTF8]);
+      //TODO-cfcl-json: remove etc/fcl-json the day they'll merge and rlz the version with 'Options'
+      //TODO-cfcl-json: track possible changes and fixes at http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/packages/fcl-json/
+      //latest in etc = rev 34196.
+      try
+        try
+          fJSON := parser.Parse as TJSONObject;
+        except
+          if assigned(fJSON) then
+            FreeAndNil(fJSON);
+          fFilename := '';
+        end;
+      finally
+        parser.Free;
       end;
     finally
-      parser.Free;
+      loader.Free;
     end;
-  finally
-    loader.Free;
-    if not assigned(fJSON) then
-      fJson := TJSONObject.Create(['name','invalid json']);
-    updateFields;
-    subjProjChanged(fProjectSubject, self);
-    fModified := false;
+  end
+  else if ext = '.SDL' then
+  begin
+    FreeAndNil(fJSON);
+    fJSON := sdl2json(fFilename);
+    if fJSON.isNil then
+      fFilename := ''
+    else
+      fIsSdl := true;
   end;
+
+  if not assigned(fJSON) then
+    fJson := TJSONObject.Create(['name','invalid json']);
+
+  updateFields;
+  subjProjChanged(fProjectSubject, self);
+  fModified := false;
 end;
 
 procedure TCEDubProject.saveToFile(const fname: string);
@@ -1073,11 +1098,58 @@ end;
 {$ENDREGION --------------------------------------------------------------------}
 
 {$REGION Miscellaneous DUB free functions --------------------------------------}
+function sdl2json(const filename: string): TJSONObject;
+var
+  dub: TProcess;
+  str: TStringList;
+  jsn: TJSONData;
+  prs: TJSONParser;
+  old: string;
+begin
+  result := nil;
+  dub := TProcess.Create(nil);
+  str := TStringList.Create;
+  old := GetCurrentDirUTF8;
+  try
+    SetCurrentDirUTF8(filename.extractFilePath);
+    dub.Executable := 'dub' + exeExt;
+    dub.Options := [poUsePipes{$IFDEF WINDOWS}, poNewConsole{$ENDIF}];
+    dub.ShowWindow := swoHIDE;
+    dub.CurrentDirectory:= filename.extractFilePath;
+    dub.Parameters.Add('describe');
+    dub.Execute;
+    processOutputToStrings(dub, str);
+    while dub.Running do;
+    prs := TJSONParser.Create(str.Text, [joIgnoreTrailingComma, joUTF8]);
+    try
+      jsn := prs.Parse;
+      try
+        if jsn.isNotNil and (jsn.JSONType = jtObject)
+        and TJSONObject(jsn).Find('packages').isNotNil
+        and (TJSONObject(jsn).Find('packages').JSONType = jtArray)
+        and (TJSONArray(TJSONObject(jsn).Find('packages')).Count > 0)
+        and (TJSONArray(TJSONObject(jsn).Find('packages')).Items[0].JSONType = jtObject) then
+          result := TJSONObject(TJSONArray(TJSONObject(jsn).Find('packages')).Items[0].Clone);
+      finally
+        jsn.free;
+      end;
+    finally
+      prs.Free
+    end;
+  finally
+    SetCurrentDirUTF8(old);
+    dub.free;
+    str.Free;
+  end;
+end;
+
 function isValidDubProject(const filename: string): boolean;
 var
   maybe: TCEDubProject;
+  ext: string;
 begin
-  if (filename.extractFileExt.upperCase <> '.JSON') then
+  ext := filename.extractFileExt.upperCase;
+  if (ext <> '.JSON') and (ext <> '.SDL') then
     exit(false);
   result := true;
   // avoid the project to notify the observers, current project is not replaced

src/ce_dubprojeditor.lfm

@@ -21,10 +21,10 @@ inherited CEDubProjectEditorWidget: TCEDubProjectEditorWidget
         Height = 380
         Top = 4
         Width = 403
-        ActivePage = TabSheet2
+        ActivePage = TabSheet1
         Align = alClient
         BorderSpacing.Around = 4
-        TabIndex = 1
+        TabIndex = 0
         TabOrder = 0
         object TabSheet1: TTabSheet
           Caption = 'Inspector'

src/ce_dubprojeditor.pas

@@ -287,7 +287,7 @@ begin
   if project.getProject <> fProj then
     exit;
   fProj := nil;
-  //
+
   updateEditor;
   updateInspector;
   enabled := false;
@@ -308,6 +308,12 @@ begin
   if not Visible then
     exit;
 
+  if fProj.isSDL then
+  begin
+    edProp.Enabled:= false;
+    btnAcceptProp.Enabled:=false;
+  end;
+
   updateEditor;
   updateInspector;
 end;

src/ce_main.pas

@@ -3227,10 +3227,13 @@ begin
 end;
 
 procedure TCEMainForm.openProj(const fname: string);
+var
+  ext: string;
 begin
   if not closeProj then
     exit;
-  if fname.extractFileExt.upperCase = '.JSON' then
+  ext := fname.extractFileExt.upperCase;
+  if (ext = '.JSON') or (ext = '.SDL') then
     newDubProj
   else
     newNativeProj;
@@ -3260,6 +3263,11 @@ procedure TCEMainForm.actProjSaveAsExecute(Sender: TObject);
 begin
   if checkProjectLock then
     exit;
+  if (fProject.getFormat = pfDub) and TCEDubProject(fProject.getProject).isSDL then
+  begin
+    fMsgs.message(DubSdlWarning, fProject, amcProj, amkWarn);
+    exit;
+  end;
   with TSaveDialog.Create(nil) do
   try
     if execute then saveProjAs(filename);
@@ -3271,6 +3279,11 @@ end;
 procedure TCEMainForm.actProjSaveExecute(Sender: TObject);
 begin
   if fProject = nil then exit;
+  if (fProject.getFormat = pfDub) and TCEDubProject(fProject.getProject).isSDL then
+  begin
+    fMsgs.message(DubSdlWarning, fProject, amcProj, amkWarn);
+    exit;
+  end;
   if checkProjectLock then
     exit;
   if fProject.filename.isNotEmpty then saveProj
@@ -3311,6 +3324,11 @@ procedure TCEMainForm.actProjSourceExecute(Sender: TObject);
 begin
   if fProject = nil then exit;
   if not fProject.filename.fileExists then exit;
+  if (fProject.getFormat = pfDub) and TCEDubProject(fProject.getProject).isSDL then
+  begin
+    fMsgs.message(DubSdlWarning, fProject, amcProj, amkWarn);
+    exit;
+  end;
   //
   openFile(fProject.filename);
   fDoc.isProjectDescription := true;

src/ce_projutils.pas

@@ -36,17 +36,23 @@ procedure saveModifiedProjectFiles(project: ICECommonProject);
 implementation
 
 function isProject(const filename: string): boolean;
+var
+  ext: string;
 begin
-  if filename.extractFileExt = '.json' then
+  ext := filename.extractFileExt.upperCase;
+  if (ext = '.JSON') or (ext = '.SDL') then
     result := isValidDubProject(filename)
   else
     result := isValidNativeProject(filename);
 end;
 
 function projectFormat(const filename: string): TCEProjectFileFormat;
+var
+  ext: string;
 begin
   result := pffNone;
-  if filename.extractFileExt = '.json' then
+  ext := filename.extractFileExt.upperCase;
+  if (ext = '.JSON') or (ext = '.SDL') then
   begin
     if isValidDubProject(filename) then
       result := pffDub;