Skip to content

Commit d726201

Browse files
committed
Merge pull request #1738 from rubberduck-vba/next
v2.0b
2 parents 29f98b9 + f459715 commit d726201

File tree

829 files changed

+57943
-36859
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

829 files changed

+57943
-36859
lines changed

.gitignore

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -83,6 +83,7 @@ _TeamCity*
8383
# NCrunch
8484
*.ncrunch*
8585
.*crunch*.local.xml
86+
_Ncrunch*
8687

8788
# Installshield output folder
8889
[Ee]xpress/

Installer Build Script.iss

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
#define AddinDLL "Rubberduck.dll"
44
#define AppVersion GetFileVersion(SourcePath + "RetailCoder.VBE\bin\release\Rubberduck.dll")
55
#define AppPublisher "Rubberduck"
6-
#define AppURL "http://rubberduck-vba.com"
6+
#define AppURL "http://rubberduckvba.com"
77
#define License SourcePath + "\License.rtf"
88
#define OutputDirectory SourcePath + "\Installers"
99
#define AddinProgId "Rubberduck.Extension"
@@ -95,14 +95,16 @@ end;
9595
function GetOfficeBitness(): Integer;
9696
var
9797
appBitness: Integer;
98-
officeExeNames: array[0..4] of String;
98+
officeExeNames: array[0..6] of String;
9999
i: Integer;
100100
begin
101101
officeExeNames[0] := 'excel.exe';
102102
officeExeNames[1] := 'msaccess.exe';
103103
officeExeNames[2] := 'winword.exe';
104104
officeExeNames[3] := 'outlook.exe';
105105
officeExeNames[4] := 'powerpnt.exe';
106+
officeExeNames[5] := 'mspub.exe';
107+
officeExeNames[6] := 'winproj.exe';
106108
107109
for i := 0 to 4 do begin
108110
appBitness := GetOfficeAppBitness(officeExeNames[i]);

README.md

Lines changed: 17 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -8,36 +8,31 @@
88
[nextBuildStatus]:https://ci.appveyor.com/api/projects/status/we3pdnkeebo4nlck/branch/next?svg=true
99
[masterBuildStatus]:https://ci.appveyor.com/api/projects/status/we3pdnkeebo4nlck/branch/master?svg=true
1010

11-
Rubberduck is a COM Add-In for the VBA IDE that makes VBA development even more enjoyable, by extending the Visual Basic Editor (VBE) with menus, toolbars and toolwindows that enable things we didn't even think were possible when we first started this project.
11+
[![Average time to resolve an issue](http://isitmaintained.com/badge/resolution/rubberduck-vba/rubberduck.svg)](http://isitmaintained.com/project/rubberduck-vba/rubberduck "Average time to resolve an issue") [![Percentage of issues still open](http://isitmaintained.com/badge/open/rubberduck-vba/rubberduck.svg)](http://isitmaintained.com/project/rubberduck-vba/rubberduck "Percentage of issues still open")
1212

13-
If you're learning VBA, Rubberduck can help you avoid a few common beginner mistakes, and can probably show you a trick or two - even if you're only ever writing *macros*. If you're a more advanced programmer, you will appreciate the richness of [Rubberduck's feature set](https://github.com/retailcoder/Rubberduck/wiki/Features).
14-
15-
[**Follow us on Twitter!**](https://twitter.com/rubberduckvba)
16-
17-
[**Rubberduck Wiki**](https://github.com/retailcoder/Rubberduck/wiki)
13+
> **[rubberduckvba.com](http://rubberduckvba.com)** [Wiki](https://github.com/retailcoder/Rubberduck/wiki) [Rubberduck News](https://rubberduckvba.wordpress.com/)
14+
> contact@rubberduckvba.com
15+
> Follow [@rubberduckvba](https://twitter.com/rubberduckvba) on Twitter
1816
1917
---
2018

21-
#[Contributing](https://github.com/rubberduck-vba/Rubberduck/wiki/Contributing)
19+
##What is Rubberduck?
2220

23-
If you're a C# developer looking for a fun project to contribute to, feel free to fork the project and
24-
[come meet the devs in Code Review's "VBA Rubberducking" chatroom][chat] - we'll be happy to answer your questions and help you help us!
21+
It's an add-in for the VBA IDE, the glorious *Visual Basic Editor* (VBE) - which hasn't seen an update in this century, but that's still in use everywhere around the world. Rubberduck wants to give its users access to features you would find in the VBE if it had kept up with the features of Visual Studio and other IDE's in the past, oh, *decade* or so.
2522

26-
We follow a [development branch workflow][branch], so please submit any Pull Requests to the `next` branch.
23+
Rubberduck wants to help its users write better, cleaner, maintainable code. The many **code inspections** and **refactoring tools** help harmlessly making changes to the code, and **unit testing** helps writing a *safety net* that makes it easy to know exactly what broke when you made that *small little harmless modification*.
2724

28-
[chat]:http://chat.stackexchange.com/rooms/14929
29-
[helpwanted]:https://github.com/rubberduck-vba/Rubberduck/labels/help-wanted
30-
[branch]:https://github.com/rubberduck-vba/Rubberduck/issues/288
25+
Rubberduck wants to bring VBA into the 21st century, and wants to see more open-source VBA repositories on [GitHub](https://github.com/) - VBA code and **source control** don't traditionally exactly work hand in hand; unless you've automated it, exporting each module one by one to your local repository, fetching the remote changes, re-importing every module one by one back into the project, ...is *a little bit* tedious. Rubberduck integrates Git into the IDE, and handles all the file handling behind the scenes - a bit like Visual Studio's *Team Explorer*.
3126

3227
---
3328

34-
#[Installing](https://github.com/rubberduck-vba/Rubberduck/wiki/Installing)
29+
If you're learning VBA, Rubberduck can help you avoid a few common beginner mistakes, and can probably show you a trick or two - even if you're only ever writing *macros*. If you're a more advanced programmer, you will appreciate the richness of [Rubberduck's feature set](https://github.com/retailcoder/Rubberduck/wiki/Features). See the [Installing](https://github.com/rubberduck-vba/Rubberduck/wiki/Installing) wiki page.
3530

36-
This section was moved to a dedicated wiki page.
31+
If you're a C# developer looking for a fun project to contribute to, see the [Contributing](https://github.com/rubberduck-vba/Rubberduck/wiki/Contributing) wiki page.
3732

3833
---
3934

40-
#License
35+
##License
4136

4237
Rubberduck is a COM add-in for the VBA IDE (VBE).
4338

@@ -92,6 +87,12 @@ This library makes localizing WPF applications at runtime using resx files a bre
9287

9388
> Licensed under [The Code Project Open License](http://www.codeproject.com/info/cpol10.aspx).
9489
90+
###[Using Raw Input from C# to handle multiple keyboards](http://www.codeproject.com/Articles/17123/Using-Raw-Input-from-C-to-handle-multiple-keyboard)
91+
92+
A library using the Raw Input API for reacting to low level keyboard/mouse events.
93+
94+
> Licensed under [The Code Project Open License](http://www.codeproject.com/info/cpol10.aspx).
95+
9596
##Icons
9697

9798
We didn't come up with these icons ourselves! Here's who did what:

RetailCoder.VBE/API/Accessibility.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,4 +12,4 @@ public enum Accessibility
1212
Friend,
1313
Static,
1414
}
15-
}
15+
}

RetailCoder.VBE/API/Declaration.cs

Lines changed: 33 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
1-
using System.ComponentModel;
1+
using System.Collections.Generic;
2+
using System.ComponentModel;
23
using System.Linq;
34
using System.Runtime.InteropServices;
45
using RubberduckDeclaration = Rubberduck.Parsing.Symbols.Declaration;
@@ -39,18 +40,46 @@ internal Declaration(RubberduckDeclaration declaration)
3940

4041
protected RubberduckDeclaration Instance { get { return _declaration; } }
4142

43+
public bool IsArray { get { return _declaration.IsArray; } }
4244
public string Name { get { return _declaration.IdentifierName; } }
4345
public Accessibility Accessibility { get { return (Accessibility)_declaration.Accessibility; } }
44-
public DeclarationType DeclarationType {get { return (DeclarationType)_declaration.DeclarationType; }}
46+
public DeclarationType DeclarationType {get { return TypeMappings[_declaration.DeclarationType]; }}
4547
public string TypeName { get { return _declaration.AsTypeName; } }
46-
public bool IsArray { get { return _declaration.IsArray(); } }
48+
49+
private static readonly IDictionary<Parsing.Symbols.DeclarationType,DeclarationType> TypeMappings =
50+
new Dictionary<Parsing.Symbols.DeclarationType, DeclarationType>
51+
{
52+
{ Parsing.Symbols.DeclarationType.Project, DeclarationType.Project },
53+
{ Parsing.Symbols.DeclarationType.ProceduralModule, DeclarationType.StandardModule },
54+
{ Parsing.Symbols.DeclarationType.ClassModule, DeclarationType.ClassModule },
55+
{ Parsing.Symbols.DeclarationType.Control, DeclarationType.Control },
56+
{ Parsing.Symbols.DeclarationType.UserForm, DeclarationType.UserForm },
57+
{ Parsing.Symbols.DeclarationType.Document, DeclarationType.Document },
58+
{ Parsing.Symbols.DeclarationType.ModuleOption, DeclarationType.ModuleOption },
59+
{ Parsing.Symbols.DeclarationType.Procedure, DeclarationType.Procedure },
60+
{ Parsing.Symbols.DeclarationType.Function, DeclarationType.Function },
61+
{ Parsing.Symbols.DeclarationType.PropertyGet, DeclarationType.PropertyGet },
62+
{ Parsing.Symbols.DeclarationType.PropertyLet, DeclarationType.PropertyLet },
63+
{ Parsing.Symbols.DeclarationType.PropertySet, DeclarationType.PropertySet },
64+
{ Parsing.Symbols.DeclarationType.Parameter, DeclarationType.Parameter },
65+
{ Parsing.Symbols.DeclarationType.Variable, DeclarationType.Variable },
66+
{ Parsing.Symbols.DeclarationType.Constant, DeclarationType.Constant },
67+
{ Parsing.Symbols.DeclarationType.Enumeration, DeclarationType.Enumeration },
68+
{ Parsing.Symbols.DeclarationType.EnumerationMember, DeclarationType.EnumerationMember },
69+
{ Parsing.Symbols.DeclarationType.Event, DeclarationType.Event },
70+
{ Parsing.Symbols.DeclarationType.UserDefinedType, DeclarationType.UserDefinedType },
71+
{ Parsing.Symbols.DeclarationType.UserDefinedTypeMember, DeclarationType.UserDefinedTypeMember },
72+
{ Parsing.Symbols.DeclarationType.LibraryFunction, DeclarationType.LibraryFunction },
73+
{ Parsing.Symbols.DeclarationType.LibraryProcedure, DeclarationType.LibraryProcedure },
74+
{ Parsing.Symbols.DeclarationType.LineLabel, DeclarationType.LineLabel },
75+
};
4776

4877
private Declaration _parentDeclaration;
4978
public Declaration ParentDeclaration
5079
{
5180
get
5281
{
53-
return _parentDeclaration ?? (_parentDeclaration = new Declaration(Instance));
82+
return _parentDeclaration ?? (_parentDeclaration = new Declaration(Instance.ParentDeclaration));
5483
}
5584
}
5685

Lines changed: 29 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -1,36 +1,36 @@
1-
using System;
2-
using System.Runtime.InteropServices;
1+
using System.Runtime.InteropServices;
32

43
namespace Rubberduck.API
54
{
65
[ComVisible(true)]
7-
[Flags]
6+
//[Flags]
87
public enum DeclarationType
98
{
10-
Project = 1 << 0,
11-
Module = 1 << 1,
12-
Class = 1 << 2,
13-
Control = 1 << 3,
14-
UserForm = 1 << 4,
15-
Document = 1 << 5,
16-
ModuleOption = 1 << 6,
17-
Member = 1 << 7,
18-
Procedure = 1 << 8 | Member,
19-
Function = 1 << 9 | Member,
20-
Property = 1 << 10 | Member,
21-
PropertyGet = 1 << 11 | Property | Function,
22-
PropertyLet = 1 << 12 | Property | Procedure,
23-
PropertySet = 1 << 13 | Property | Procedure,
24-
Parameter = 1 << 14,
25-
Variable = 1 << 15,
26-
Constant = 1 << 16,
27-
Enumeration = 1 << 17,
28-
EnumerationMember = 1 << 18 | Constant,
29-
Event = 1 << 19,
30-
UserDefinedType = 1 << 20,
31-
UserDefinedTypeMember = 1 << 21 | Variable,
32-
LibraryFunction = 1 << 22 | Function,
33-
LibraryProcedure = 1 << 23 | Procedure,
34-
LineLabel = 1 << 24
9+
Project, //= 1 << 0,
10+
StandardModule, //= 1 << 1,
11+
ClassModule,// = 1 << 2,
12+
Control, //= 1 << 3,
13+
UserForm,// = 1 << 4,
14+
Document,// = 1 << 5,
15+
ModuleOption,// = 1 << 6,
16+
Procedure, //= 1 << 8,
17+
Function,// = 1 << 9,
18+
PropertyGet,// = 1 << 11,
19+
PropertyLet, //= 1 << 12,
20+
PropertySet, //= 1 << 13,
21+
Parameter, //= 1 << 14,
22+
Variable, //= 1 << 15,
23+
Constant,// = 1 << 16,
24+
Enumeration, //= 1 << 17,
25+
EnumerationMember, //= 1 << 18,
26+
Event, //= 1 << 19,
27+
UserDefinedType,// = 1 << 20,
28+
UserDefinedTypeMember,// = 1 << 21,
29+
LibraryFunction,// = 1 << 22,
30+
LibraryProcedure,// = 1 << 23,
31+
LineLabel,// = 1 << 24,
32+
//Member = Procedure | Function | PropertyGet | PropertyLet | PropertySet,
33+
//Property = PropertyGet | PropertyLet | PropertySet,
34+
//Module = StandardModule | ClassModule | UserForm | Document
3535
}
36-
}
36+
}

RetailCoder.VBE/API/IdentifierReference.cs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ public interface IIdentifierReference
1010
Declaration Declaration { get; }
1111
Declaration ParentScope { get; }
1212
Declaration ParentNonScoping { get; }
13+
bool IsAssignment { get; }
1314
int StartLine { get; }
1415
int StartColumn { get; }
1516
int EndLine { get; }
@@ -51,6 +52,8 @@ public Declaration ParentNonScoping
5152
get { return _parentNonScoping ?? (_parentNonScoping = new Declaration(_reference.ParentNonScoping)); }
5253
}
5354

55+
public bool IsAssignment { get { return _reference.IsAssignment; } }
56+
5457
public int StartLine { get { return _reference.Selection.StartLine; } }
5558
public int EndLine { get { return _reference.Selection.EndLine; } }
5659
public int StartColumn { get { return _reference.Selection.StartColumn; } }

RetailCoder.VBE/API/ParserState.cs

Lines changed: 31 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,9 @@
55
using Microsoft.Vbe.Interop;
66
using Rubberduck.Common;
77
using Rubberduck.Parsing.VBA;
8+
using Rubberduck.UI.Command.MenuItems;
9+
using Rubberduck.Parsing.Preprocessing;
10+
using System.Globalization;
811

912
namespace Rubberduck.API
1013
{
@@ -37,20 +40,19 @@ public interface IParserStateEvents
3740
[ComDefaultInterface(typeof(IParserState))]
3841
[ComSourceInterfaces(typeof(IParserStateEvents))]
3942
[EditorBrowsable(EditorBrowsableState.Always)]
40-
public class ParserState : IParserState
43+
public sealed class ParserState : IParserState, IDisposable
4144
{
4245
private const string ClassId = "28754D11-10CC-45FD-9F6A-525A65412B7A";
4346
private const string ProgId = "Rubberduck.ParserState";
4447

4548
private readonly RubberduckParserState _state;
46-
private readonly AttributeParser _attributeParser;
47-
49+
private AttributeParser _attributeParser;
4850
private RubberduckParser _parser;
4951

5052
public ParserState()
5153
{
54+
UiDispatcher.Initialize();
5255
_state = new RubberduckParserState();
53-
_attributeParser = new AttributeParser(new ModuleExporter());
5456

5557
_state.StateChanged += _state_StateChanged;
5658
}
@@ -61,8 +63,9 @@ public void Initialize(VBE vbe)
6163
{
6264
throw new InvalidOperationException("ParserState is already initialized.");
6365
}
64-
65-
_parser = new RubberduckParser(vbe, _state, _attributeParser);
66+
Func<IVBAPreprocessor> preprocessorFactory = () => new VBAPreprocessor(double.Parse(vbe.Version, CultureInfo.InvariantCulture));
67+
_attributeParser = new AttributeParser(new ModuleExporter(), preprocessorFactory);
68+
_parser = new RubberduckParser(vbe, _state, _attributeParser, preprocessorFactory);
6669
}
6770

6871
/// <summary>
@@ -80,7 +83,7 @@ public void Parse()
8083
public void BeginParse()
8184
{
8285
// non-blocking call
83-
_state.OnParseRequested(this);
86+
UiDispatcher.Invoke(() => _state.OnParseRequested(this));
8487
}
8588

8689
public event Action OnParsed;
@@ -100,35 +103,51 @@ private void _state_StateChanged(object sender, System.EventArgs e)
100103
var errorHandler = OnError;
101104
if (_state.Status == Parsing.VBA.ParserState.Error && errorHandler != null)
102105
{
103-
errorHandler.Invoke();
106+
UiDispatcher.Invoke(errorHandler.Invoke);
104107
}
105108

106109
var parsedHandler = OnParsed;
107110
if (_state.Status == Parsing.VBA.ParserState.Parsed && parsedHandler != null)
108111
{
109-
parsedHandler.Invoke();
112+
UiDispatcher.Invoke(parsedHandler.Invoke);
110113
}
111114

112115
var readyHandler = OnReady;
113116
if (_state.Status == Parsing.VBA.ParserState.Ready && readyHandler != null)
114117
{
115-
readyHandler.Invoke();
118+
UiDispatcher.Invoke(readyHandler.Invoke);
116119
}
117120
}
118121

119122
private Declaration[] _allDeclarations;
120123

121124
public Declaration[] AllDeclarations
122125
{
123-
[return: MarshalAs(UnmanagedType.SafeArray, SafeArraySubType = VarEnum.VT_VARIANT)]
126+
//[return: MarshalAs(UnmanagedType.SafeArray/*, SafeArraySubType = VarEnum.VT_VARIANT*/)]
124127
get { return _allDeclarations; }
125128
}
126129

127130
private Declaration[] _userDeclarations;
128131
public Declaration[] UserDeclarations
129132
{
130-
[return: MarshalAs(UnmanagedType.SafeArray, SafeArraySubType = VarEnum.VT_VARIANT)]
133+
//[return: MarshalAs(UnmanagedType.SafeArray/*, SafeArraySubType = VarEnum.VT_VARIANT*/)]
131134
get { return _userDeclarations; }
132135
}
136+
137+
private bool _disposed;
138+
public void Dispose()
139+
{
140+
if (_disposed)
141+
{
142+
return;
143+
}
144+
145+
if (_state != null)
146+
{
147+
_state.StateChanged -= _state_StateChanged;
148+
}
149+
150+
_disposed = true;
151+
}
133152
}
134153
}

0 commit comments

Comments
 (0)