Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Improve SC-style import commands around types for which we use workar…
…ounds for import
  • Loading branch information
MDoerner committed Nov 1, 2019
1 parent 6113d06 commit af68499
Show file tree
Hide file tree
Showing 8 changed files with 346 additions and 64 deletions.
40 changes: 15 additions & 25 deletions Rubberduck.Core/UI/CodeExplorer/Commands/ImportCommand.cs
Expand Up @@ -7,6 +7,7 @@
using Rubberduck.Parsing.VBA;
using Rubberduck.Resources;
using Rubberduck.VBEditor.Events;
using Rubberduck.VBEditor.Extensions;
using Rubberduck.VBEditor.SafeComWrappers;
using Rubberduck.VBEditor.SafeComWrappers.Abstract;

Expand Down Expand Up @@ -41,9 +42,7 @@ public class ImportCommand : CodeExplorerCommandBase

AddToCanExecuteEvaluation(SpecialEvaluateCanExecute);

ComponentTypeForExtension = vbe.Kind == VBEKind.Hosted
? VBAComponentTypeForExtension
: VB6ComponentTypeForExtension;
ComponentTypeForExtension = ComponentTypeExtensions.ComponentTypeForExtension(_vbe.Kind);

_importableExtensions = ComponentTypeForExtension.Keys.ToList();
_filterExtensions = string.Join("; ", _importableExtensions.Select(ext => $"*{ext}"));
Expand Down Expand Up @@ -150,8 +149,19 @@ protected virtual void ImportFiles(ICollection<string> filesToImport, IVBProject
{
foreach (var filename in filesToImport)
{
//We have to dispose the return value.
using (components.Import(filename)) {}
var fileExtension = Path.GetExtension(filename);
if (fileExtension != null
&& ComponentTypeForExtension.TryGetValue(fileExtension, out var componentType)
&& componentType == ComponentType.Document)
{
//We have to dispose the return value.
using (components.ImportSourceFile(filename)) { }
}
else
{
//We have to dispose the return value.
using (components.Import(filename)) { }
}
}
}
}
Expand Down Expand Up @@ -181,25 +191,5 @@ protected override void OnExecute(object parameter)
}

protected IDictionary<string, ComponentType> ComponentTypeForExtension { get; }

private static IDictionary<string, ComponentType> VBAComponentTypeForExtension = new Dictionary<string, ComponentType>
{
[".bas"] = ComponentType.StandardModule,
[".cls"] = ComponentType.ClassModule,
[".frm"] = ComponentType.UserForm
//TODO: find out what ".doccls" corresponds to.
//[".doccls"] = ???
};

private static IDictionary<string, ComponentType> VB6ComponentTypeForExtension = new Dictionary<string, ComponentType>
{
[".bas"] = ComponentType.StandardModule,
[".cls"] = ComponentType.ClassModule,
[".frm"] = ComponentType.VBForm,
//TODO: double check whether the guesses below are correct.
[".ctl"] = ComponentType.UserControl,
[".pag"] = ComponentType.PropPage,
[".dob"] = ComponentType.DocObject,
};
}
}
@@ -1,6 +1,8 @@
using System.Collections.Generic;
using System.Linq;
using Rubberduck.Parsing.VBA;
using Rubberduck.VBEditor.Events;
using Rubberduck.VBEditor.SafeComWrappers;
using Rubberduck.VBEditor.SafeComWrappers.Abstract;

namespace Rubberduck.UI.CodeExplorer.Commands
Expand All @@ -25,14 +27,15 @@ protected override void ImportFiles(ICollection<string> filesToImport, IVBProjec

private void RemoveReimportableComponents(IVBProject project)
{
var importableComponentTypes = ComponentTypeForExtension.Values;
var reimportableComponentTypes = ComponentTypeForExtension.Values
.Where(componentType => componentType != ComponentType.Document);
using(var components = project.VBComponents)
{
foreach(var component in components)
{
using (component)
{
if (importableComponentTypes.Contains(component.Type))
if (reimportableComponentTypes.Contains(component.Type))
{
components.Remove(component);
}
Expand Down
105 changes: 73 additions & 32 deletions Rubberduck.Core/UI/CodeExplorer/Commands/UpdateFromFileCommand.cs
@@ -1,14 +1,16 @@
using System.Collections.Generic;
using System.IO;
using System.Linq;
using System.Text;
using Rubberduck.Parsing.VBA;
using Rubberduck.Parsing.VBA.DeclarationCaching;
using Rubberduck.Parsing.VBA.Extensions;
using Rubberduck.VBEditor;
using Rubberduck.VBEditor.Events;
using Rubberduck.VBEditor.ComManagement;
using Rubberduck.VBEditor.Extensions;
using Rubberduck.VBEditor.SafeComWrappers;
using Rubberduck.VBEditor.SafeComWrappers.Abstract;
using Rubberduck.VBEditor.Utility;

namespace Rubberduck.UI.CodeExplorer.Commands
{
Expand Down Expand Up @@ -39,6 +41,19 @@ protected override void ImportFiles(ICollection<string> filesToImport, IVBProjec

var moduleNames = ModuleNames(filesToImport);

var formBinaryModuleNames = moduleNames
.Where(kvp => ComponentTypeExtensions.FormBinaryExtension.Equals(Path.GetExtension(kvp.Key)))
.Select(kvp => kvp.Value)
.ToHashSet();

var formFilesWithoutBinaries = FormFilesWithoutBinaries(moduleNames, formBinaryModuleNames);

//We cannot import the the binary separately.
foreach (var formBinaryModuleName in formBinaryModuleNames)
{
moduleNames.Remove(formBinaryModuleName);
}

if (!ValuesAreUnique(moduleNames))
{
//TODO: report this to the user.
Expand All @@ -53,6 +68,39 @@ protected override void ImportFiles(ICollection<string> filesToImport, IVBProjec
return;
}

var documentFiles = moduleNames
.Select(kvp => kvp.Key)
.Where(filename => Path.GetExtension(filename) != null
&& ComponentTypeForExtension.TryGetValue(Path.GetExtension(filename), out var componentType)
&& componentType == ComponentType.Document)
.ToHashSet();

//We can only insert inte existing documents.
if (!documentFiles.All(filename => modules.ContainsKey(filename)))
{
//TODO: report this to the user.
return;
}

//We must not remove document modules.
foreach (var filename in documentFiles)
{
modules.Remove(filename);
}

//We import the standalone code behind by replacing the code in an existing form.
//So, the form has to exist already.
if (!formFilesWithoutBinaries.All(filename => modules.ContainsKey(filename)))
{
//TODO: report this to the user.
return;
}

foreach (var filename in formFilesWithoutBinaries)
{
modules.Remove(filename);
}

using (var components = targetProject.VBComponents)
{
foreach (var filename in filesToImport)
Expand All @@ -63,8 +111,16 @@ protected override void ImportFiles(ICollection<string> filesToImport, IVBProjec
components.Remove(component);
}

//We have to dispose the return value.
using (components.Import(filename)) { }
if(documentFiles.Contains(filename) || formBinaryModuleNames.Contains(filename))
{
//We have to dispose the return value.
using (components.ImportSourceFile(filename)) { }
}
else
{
//We have to dispose the return value.
using (components.Import(filename)) { }
}
}
}
}
Expand Down Expand Up @@ -116,6 +172,17 @@ private bool ValuesAreUnique(Dictionary<string, string> moduleNames)
.All(moduleNameGroup => moduleNameGroup.Count() == 1);
}

private ICollection<string> FormFilesWithoutBinaries(IDictionary<string, string> moduleNames, ICollection<string> formBinaryModuleNames)
{
return moduleNames
.Where(kvp => Path.GetExtension(kvp.Key) != null
&& ComponentTypeForExtension.TryGetValue(Path.GetExtension(kvp.Key), out var componentType)
&& componentType == ComponentType.UserForm
&& !formBinaryModuleNames.Contains(kvp.Value))
.Select(kvp => kvp.Key)
.ToHashSet();
}

private QualifiedModuleName? Module(string moduleName, string projectId, DeclarationFinder finder)
{
foreach(var module in finder.AllModules)
Expand All @@ -133,35 +200,9 @@ private bool ValuesAreUnique(Dictionary<string, string> moduleNames)
private bool HasMatchingFileExtension(string filename, QualifiedModuleName module)
{
var fileExtension = Path.GetExtension(filename);
return ComponentTypeForExtension.TryGetValue(fileExtension, out var componentType)
? module.ComponentType.Equals(componentType)
: false;
}
}

public interface IModuleNameFromFileExtractor
{
string ModuleName(string filename);
}

public class ModuleNameFromFileExtractor : IModuleNameFromFileExtractor
{
public string ModuleName(string filename)
{
if (!File.Exists(filename))
{
return null;
}

var contents = File.ReadLines(filename, Encoding.Default);
var nameLine = contents.FirstOrDefault(line => line.StartsWith("Attribute VB_Name = "));
if (nameLine == null)
{
return Path.GetFileNameWithoutExtension(filename);
}

//The format is Attribute VB_Name = "ModuleName"
return nameLine.Substring("Attribute VB_Name = ".Length + 1, nameLine.Length - "Attribute VB_Name = ".Length - 2);
return fileExtension != null
&& ComponentTypeForExtension.TryGetValue(fileExtension, out var componentType)
&& module.ComponentType.Equals(componentType);
}
}
}
39 changes: 38 additions & 1 deletion Rubberduck.VBEEditor/Extensions/ComponentTypeExtensions.cs
@@ -1,3 +1,4 @@
using System.Collections.Generic;
using Rubberduck.VBEditor.SafeComWrappers;

namespace Rubberduck.VBEditor.Extensions
Expand All @@ -10,12 +11,18 @@ public static class ComponentTypeExtensions
public const string FormBinaryExtension = ".frx";
public const string DocClassExtension = ".doccls";

//TODO: double check whether the guesses below are correct.
public const string UserControlExtension = ".ctl";
public const string PropertyPageExtension = ".pag";
public const string DocObjectExtension = ".dob";

/// <summary>
/// Returns the proper file extension for the Component Type.
/// </summary>
/// <remarks>Document classes should properly have a ".cls" file extension.
/// However, because they cannot be removed and imported like other component types, we need to make a distinction.</remarks>
/// <param name="componentType"></param>
/// <param name="vbeKind"></param>
/// <returns>File extension that includes a preceeding "dot" (.) </returns>
public static string FileExtension(this ComponentType componentType)
{
Expand All @@ -30,10 +37,40 @@ public static string FileExtension(this ComponentType componentType)
case ComponentType.Document:
// documents should technically be a ".cls", but we need to be able to tell them apart.
return DocClassExtension;
case ComponentType.ActiveXDesigner:
case ComponentType.PropPage:
return PropertyPageExtension;
case ComponentType.UserControl:
return UserControlExtension;
case ComponentType.DocObject:
return DocObjectExtension;
default:
return string.Empty;
}
}

public static IDictionary<string, ComponentType> ComponentTypeForExtension(VBEKind vbeKind)
{
return vbeKind == VBEKind.Hosted
? VBAComponentTypeForExtension
: VB6ComponentTypeForExtension;
}

private static readonly IDictionary<string, ComponentType> VBAComponentTypeForExtension = new Dictionary<string, ComponentType>
{
[StandardExtension] = ComponentType.StandardModule,
[ClassExtension] = ComponentType.ClassModule,
[FormExtension] = ComponentType.UserForm,
[DocClassExtension] = ComponentType.Document
};

private static readonly IDictionary<string, ComponentType> VB6ComponentTypeForExtension = new Dictionary<string, ComponentType>
{
[StandardExtension] = ComponentType.StandardModule,
[ClassExtension] = ComponentType.ClassModule,
[FormExtension] = ComponentType.VBForm,
[UserControlExtension] = ComponentType.UserControl,
[PropertyPageExtension] = ComponentType.PropPage,
[DocObjectExtension] = ComponentType.DocObject,
};
}
}
39 changes: 39 additions & 0 deletions Rubberduck.VBEEditor/Utility/ModuleNameFromFileExtractor.cs
@@ -0,0 +1,39 @@
using System.IO;
using System.Linq;
using System.Text;
using Rubberduck.VBEditor.Extensions;

namespace Rubberduck.VBEditor.Utility
{
public interface IModuleNameFromFileExtractor
{
string ModuleName(string filename);
}

public class ModuleNameFromFileExtractor : IModuleNameFromFileExtractor
{
public string ModuleName(string filename)
{
if (!File.Exists(filename))
{
return null;
}

//We cannot read binary files.
if(ComponentTypeExtensions.FormBinaryExtension.Equals(Path.GetExtension(filename)))
{
return Path.GetFileNameWithoutExtension(filename);
}

var contents = File.ReadLines(filename, Encoding.Default);
var nameLine = contents.FirstOrDefault(line => line.StartsWith("Attribute VB_Name = "));
if (nameLine == null)
{
return Path.GetFileNameWithoutExtension(filename);
}

//The format is Attribute VB_Name = "ModuleName"
return nameLine.Substring("Attribute VB_Name = ".Length + 1, nameLine.Length - "Attribute VB_Name = ".Length - 2);
}
}
}
3 changes: 2 additions & 1 deletion Rubberduck.VBEditor.VB6/SafeComWrappers/VB/VBComponents.cs
Expand Up @@ -72,7 +72,8 @@ public override int GetHashCode()

public IVBComponent ImportSourceFile(string path)
{
throw new NotSupportedException("ImportSourceFile not supported in VB6");
//Since we have no special handling as in VBA, we just forward to Import.
return Import(path);
}

public void RemoveSafely(IVBComponent component)
Expand Down

0 comments on commit af68499

Please sign in to comment.