Skip to content

Commit c3e1731

Browse files
committed
Move refactorings away from FindVariable
Instead, an ISelectedDeclarationProvider is used to find the variable to refactor. This has the effect that the refactorings can no longer be executed for some selections, e.g. for selections containing the As type clause. This is in line with the declaration shown in the status bar. This affects IntroduceField, IntroduceParameter, EncapsulateField and MoveCloserToUsage.
1 parent 53007cd commit c3e1731

20 files changed

+203
-254
lines changed

Rubberduck.Core/UI/Command/Refactorings/RefactorEncapsulateFieldCommand.cs

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -32,14 +32,20 @@ private bool SpecializedEvaluateCanExecute(object parameter)
3232
var target = GetTarget();
3333

3434
return target != null
35-
&& target.DeclarationType == DeclarationType.Variable
36-
&& !target.ParentScopeDeclaration.DeclarationType.HasFlag(DeclarationType.Member)
3735
&& !_state.IsNewOrModified(target.QualifiedModuleName);
3836
}
3937

4038
private Declaration GetTarget()
4139
{
42-
return _selectedDeclarationProvider.SelectedDeclaration();
40+
var selectedDeclaration = _selectedDeclarationProvider.SelectedDeclaration();
41+
if (selectedDeclaration == null
42+
|| selectedDeclaration.DeclarationType != DeclarationType.Variable
43+
|| selectedDeclaration.ParentScopeDeclaration.DeclarationType.HasFlag(DeclarationType.Member))
44+
{
45+
return null;
46+
}
47+
48+
return selectedDeclaration;
4349
}
4450
}
4551
}
Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
1-
using Rubberduck.Common;
2-
using Rubberduck.Parsing.Symbols;
1+
using Rubberduck.Parsing.Symbols;
32
using Rubberduck.Parsing.VBA;
43
using Rubberduck.Refactorings.IntroduceField;
54
using Rubberduck.UI.Command.Refactorings.Notifiers;
@@ -10,15 +9,18 @@ namespace Rubberduck.UI.Command.Refactorings
109
public class RefactorIntroduceFieldCommand : RefactorCodePaneCommandBase
1110
{
1211
private readonly RubberduckParserState _state;
12+
private readonly ISelectedDeclarationProvider _selectedDeclarationProvider;
1313

1414
public RefactorIntroduceFieldCommand (
1515
IntroduceFieldRefactoring refactoring,
1616
IntroduceFieldFailedNotifier introduceFieldFailedNotifier,
1717
RubberduckParserState state,
18-
ISelectionProvider selectionProvider)
18+
ISelectionProvider selectionProvider,
19+
ISelectedDeclarationProvider selectedDeclarationProvider)
1920
:base(refactoring, introduceFieldFailedNotifier, selectionProvider, state)
2021
{
2122
_state = state;
23+
_selectedDeclarationProvider = selectedDeclarationProvider;
2224

2325
AddToCanExecuteEvaluation(SpecializedEvaluateCanExecute);
2426
}
@@ -28,22 +30,20 @@ private bool SpecializedEvaluateCanExecute(object parameter)
2830
var target = GetTarget();
2931

3032
return target != null
31-
&& !_state.IsNewOrModified(target.QualifiedModuleName)
32-
&& target.ParentScopeDeclaration.DeclarationType.HasFlag(DeclarationType.Member);
33+
&& !_state.IsNewOrModified(target.QualifiedModuleName);
3334
}
3435

3536
private Declaration GetTarget()
3637
{
37-
var activeSelection = SelectionProvider.ActiveSelection();
38-
if (!activeSelection.HasValue)
38+
var selectedDeclaration = _selectedDeclarationProvider.SelectedDeclaration();
39+
if (selectedDeclaration == null
40+
|| selectedDeclaration.DeclarationType != DeclarationType.Variable
41+
|| !selectedDeclaration.ParentScopeDeclaration.DeclarationType.HasFlag(DeclarationType.Member))
3942
{
4043
return null;
4144
}
4245

43-
var target = _state.DeclarationFinder
44-
.UserDeclarations(DeclarationType.Variable)
45-
.FindVariable(activeSelection.Value);
46-
return target;
46+
return selectedDeclaration;
4747
}
4848
}
4949
}
Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
1-
using Rubberduck.Common;
2-
using Rubberduck.Parsing.Symbols;
1+
using Rubberduck.Parsing.Symbols;
32
using Rubberduck.Parsing.VBA;
43
using Rubberduck.Refactorings.IntroduceParameter;
54
using Rubberduck.UI.Command.Refactorings.Notifiers;
@@ -10,15 +9,18 @@ namespace Rubberduck.UI.Command.Refactorings
109
public class RefactorIntroduceParameterCommand : RefactorCodePaneCommandBase
1110
{
1211
private readonly RubberduckParserState _state;
12+
private readonly ISelectedDeclarationProvider _selectedDeclarationProvider;
1313

1414
public RefactorIntroduceParameterCommand (
1515
IntroduceParameterRefactoring refactoring,
1616
IntroduceParameterFailedNotifier introduceParameterFailedNotifier,
1717
RubberduckParserState state,
18-
ISelectionProvider selectionProvider)
18+
ISelectionProvider selectionProvider,
19+
ISelectedDeclarationProvider selectedDeclarationProvider)
1920
:base(refactoring, introduceParameterFailedNotifier, selectionProvider, state)
2021
{
2122
_state = state;
23+
_selectedDeclarationProvider = selectedDeclarationProvider;
2224

2325
AddToCanExecuteEvaluation(SpecializedEvaluateCanExecute);
2426
}
@@ -28,22 +30,20 @@ private bool SpecializedEvaluateCanExecute(object parameter)
2830
var target = GetTarget();
2931

3032
return target != null
31-
&& !_state.IsNewOrModified(target.QualifiedModuleName)
32-
&& target.ParentScopeDeclaration.DeclarationType.HasFlag(DeclarationType.Member);
33+
&& !_state.IsNewOrModified(target.QualifiedModuleName);
3334
}
3435

3536
private Declaration GetTarget()
3637
{
37-
var activeSelection = SelectionProvider.ActiveSelection();
38-
if (!activeSelection.HasValue)
38+
var selectedDeclaration = _selectedDeclarationProvider.SelectedDeclaration();
39+
if (selectedDeclaration == null
40+
|| selectedDeclaration.DeclarationType != DeclarationType.Variable
41+
|| !selectedDeclaration.ParentScopeDeclaration.DeclarationType.HasFlag(DeclarationType.Member))
3942
{
4043
return null;
4144
}
4245

43-
var target = _state.DeclarationFinder
44-
.UserDeclarations(DeclarationType.Variable)
45-
.FindVariable(activeSelection.Value);
46-
return target;
46+
return selectedDeclaration;
4747
}
4848
}
4949
}

Rubberduck.Core/UI/Command/Refactorings/RefactorMoveCloserToUsageCommand.cs

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -32,14 +32,21 @@ private bool SpecializedEvaluateCanExecute(object parameter)
3232

3333
return target != null
3434
&& !_state.IsNewOrModified(target.QualifiedModuleName)
35-
&& (target.DeclarationType == DeclarationType.Variable
36-
|| target.DeclarationType == DeclarationType.Constant)
3735
&& target.References.Any();
3836
}
3937

4038
private Declaration GetTarget()
4139
{
42-
return _selectedDeclarationProvider.SelectedDeclaration();
40+
var selectedDeclaration = _selectedDeclarationProvider.SelectedDeclaration();
41+
if (selectedDeclaration == null
42+
|| (selectedDeclaration.DeclarationType != DeclarationType.Variable
43+
&& selectedDeclaration.DeclarationType != DeclarationType.Constant)
44+
|| !selectedDeclaration.References.Any())
45+
{
46+
return null;
47+
}
48+
49+
return selectedDeclaration;
4350
}
4451
}
4552
}

Rubberduck.Parsing/VBA/SelectedDeclarationProvider.cs

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -106,6 +106,13 @@ private static Declaration SelectedDeclarationViaReference(QualifiedSelection qu
106106

107107
private static Declaration SelectedDeclarationViaDeclaration(QualifiedSelection qualifiedSelection, DeclarationFinder finder)
108108
{
109+
//There cannot be the identifier of a reference at this selection, but the module itself has this selection.
110+
//Resolving to the module would skip several valid alternatives.
111+
if (qualifiedSelection.Selection.Equals(Selection.Home))
112+
{
113+
return null;
114+
}
115+
109116
var declarationsInModule = finder.Members(qualifiedSelection.QualifiedName);
110117
return declarationsInModule
111118
.Where(declaration => declaration.IsSelected(qualifiedSelection))

Rubberduck.Refactorings/Common/DeclarationExtensions.cs

Lines changed: 0 additions & 189 deletions
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,6 @@
44
using System.Globalization;
55
using System.Linq;
66
using Antlr4.Runtime;
7-
using Rubberduck.Parsing;
8-
using Rubberduck.Parsing.Grammar;
97
using Rubberduck.Parsing.Symbols;
108
using Rubberduck.Parsing.VBA;
119
using Rubberduck.Resources;
@@ -24,146 +22,6 @@ public static string ToLocalizedString(this DeclarationType type)
2422
return RubberduckUI.ResourceManager.GetString("DeclarationType_" + type, CultureInfo.CurrentUICulture);
2523
}
2624

27-
/// <summary>
28-
/// Returns the Selection of a VariableStmtContext.
29-
/// </summary>
30-
/// <exception cref="ArgumentException">Throws when target's DeclarationType is not Variable.</exception>
31-
/// <param name="target"></param>
32-
/// <returns></returns>
33-
public static Selection GetVariableStmtContextSelection(this Declaration target)
34-
{
35-
if (target.DeclarationType != DeclarationType.Variable)
36-
{
37-
throw new ArgumentException("Target DeclarationType is not Variable.", nameof(target));
38-
}
39-
40-
var statement = GetVariableStmtContext(target) ?? target.Context; // undeclared variables don't have a VariableStmtContext
41-
return statement.GetSelection();
42-
}
43-
44-
/// <summary>
45-
/// Returns the Selection of a ConstStmtContext.
46-
/// </summary>
47-
/// <exception cref="ArgumentException">Throws when target's DeclarationType is not Constant.</exception>
48-
/// <param name="target"></param>
49-
/// <returns></returns>
50-
public static Selection GetConstStmtContextSelection(this Declaration target)
51-
{
52-
if (target.DeclarationType != DeclarationType.Constant)
53-
{
54-
throw new ArgumentException("Target DeclarationType is not Constant.", nameof(target));
55-
}
56-
57-
var statement = GetConstStmtContext(target);
58-
return statement.GetSelection();
59-
}
60-
61-
/// <summary>
62-
/// Returns a VariableStmtContext.
63-
/// </summary>
64-
/// <exception cref="ArgumentException">Throws when target's DeclarationType is not Variable.</exception>
65-
/// <param name="target"></param>
66-
/// <returns></returns>
67-
public static VBAParser.VariableStmtContext GetVariableStmtContext(this Declaration target)
68-
{
69-
if (target.DeclarationType != DeclarationType.Variable)
70-
{
71-
throw new ArgumentException("Target DeclarationType is not Variable.", nameof(target));
72-
}
73-
74-
Debug.Assert(target.IsUndeclared || target.Context is VBAParser.VariableSubStmtContext);
75-
var statement = target.Context.Parent.Parent as VBAParser.VariableStmtContext;
76-
if (statement == null && !target.IsUndeclared)
77-
{
78-
throw new MissingMemberException("Statement not found");
79-
}
80-
81-
return statement;
82-
}
83-
84-
/// <summary>
85-
/// Returns a ConstStmtContext.
86-
/// </summary>
87-
/// <exception cref="ArgumentException">Throws when target's DeclarationType is not Constant.</exception>
88-
/// <param name="target"></param>
89-
/// <returns></returns>
90-
public static VBAParser.ConstStmtContext GetConstStmtContext(this Declaration target)
91-
{
92-
if (target.DeclarationType != DeclarationType.Constant)
93-
{
94-
throw new ArgumentException("Target DeclarationType is not Constant.", nameof(target));
95-
}
96-
97-
var statement = target.Context.Parent as VBAParser.ConstStmtContext;
98-
if (statement == null)
99-
{
100-
throw new MissingMemberException("Statement not found");
101-
}
102-
103-
return statement;
104-
}
105-
106-
/// <summary>
107-
/// Returns whether a variable declaration statement contains multiple declarations in a single statement.
108-
/// </summary>
109-
/// <exception cref="ArgumentException">Throws when target's DeclarationType is not Variable.</exception>
110-
/// <param name="target"></param>
111-
/// <returns></returns>
112-
public static bool HasMultipleDeclarationsInStatement(this Declaration target)
113-
{
114-
if (target.DeclarationType != DeclarationType.Variable)
115-
{
116-
throw new ArgumentException("Target DeclarationType is not Variable.", nameof(target));
117-
}
118-
119-
return target.Context.Parent is VBAParser.VariableListStmtContext statement
120-
&& statement.children.OfType<VBAParser.VariableSubStmtContext>().Count() > 1;
121-
}
122-
123-
/// <summary>
124-
/// Returns the number of variable declarations in a single statement.
125-
/// </summary>
126-
/// <exception cref="ArgumentException">Throws when target's DeclarationType is not Variable.</exception>
127-
/// <param name="target"></param>
128-
/// <returns></returns>
129-
public static int CountOfDeclarationsInStatement(this Declaration target)
130-
{
131-
if (target.DeclarationType != DeclarationType.Variable)
132-
{
133-
throw new ArgumentException("Target DeclarationType is not Variable.", nameof(target));
134-
}
135-
136-
if (target.Context.Parent is VBAParser.VariableListStmtContext statement)
137-
{
138-
return statement.children.OfType<VBAParser.VariableSubStmtContext>().Count();
139-
}
140-
141-
throw new ArgumentException("'target.Context.Parent' is not type VBAParser.VariabelListStmtContext", nameof(target));
142-
}
143-
144-
/// <summary>
145-
/// Returns the number of variable declarations in a single statement. Adjusted to be 1-indexed rather than 0-indexed.
146-
/// </summary>
147-
/// <exception cref="ArgumentException">Throws when target's DeclarationType is not Variable.</exception>
148-
/// <param name="target"></param>
149-
/// <returns></returns>
150-
public static int IndexOfVariableDeclarationInStatement(this Declaration target)
151-
{
152-
if (target.DeclarationType != DeclarationType.Variable)
153-
{
154-
throw new ArgumentException("Target DeclarationType is not Variable.", nameof(target));
155-
}
156-
157-
if (target.Context.Parent is VBAParser.VariableListStmtContext statement)
158-
{
159-
return statement.children.OfType<VBAParser.VariableSubStmtContext>()
160-
.ToList()
161-
.IndexOf((VBAParser.VariableSubStmtContext)target.Context) + 1;
162-
}
163-
164-
throw new ArgumentException("'target.Context.Parent' is not type VBAParser.VariableListStmtContext", nameof(target));
165-
}
166-
16725
public static readonly DeclarationType[] ProcedureTypes =
16826
{
16927
DeclarationType.Procedure,
@@ -371,12 +229,6 @@ private static IEnumerable<Declaration> GetTypeMembers(this IEnumerable<Declarat
371229
return declarations.Where(item => Equals(item.ParentScopeDeclaration, type));
372230
}
373231

374-
public static Declaration FindTarget(this IEnumerable<Declaration> declarations, QualifiedSelection selection)
375-
{
376-
var items = declarations.ToList();
377-
return items.SingleOrDefault(item => item.IsSelected(selection) || item.References.Any(reference => reference.IsSelected(selection)));
378-
}
379-
380232
/// <summary>
381233
/// Returns the declaration contained in a qualified selection.
382234
/// To get the selection of a variable or field, use FindVariable(QualifiedSelection)
@@ -445,46 +297,5 @@ public static Declaration FindTarget(this IEnumerable<Declaration> declarations,
445297
}
446298
return target;
447299
}
448-
449-
/// <summary>
450-
/// Returns the variable which contains the passed-in QualifiedSelection. Returns null if the selection is not on a variable.
451-
/// </summary>
452-
/// <param name="declarations"></param>
453-
/// <param name="selection"></param>
454-
/// <returns></returns>
455-
public static Declaration FindVariable(this IEnumerable<Declaration> declarations, QualifiedSelection selection)
456-
{
457-
var items = declarations.Where(d => d.IsUserDefined && d.DeclarationType == DeclarationType.Variable).ToList();
458-
459-
var target = items
460-
.FirstOrDefault(item => item.IsSelected(selection) || item.References.Any(r => r.IsSelected(selection)));
461-
462-
if (target != null) { return target; }
463-
464-
var targets = items.Where(item => item.ComponentName == selection.QualifiedName.ComponentName);
465-
466-
foreach (var declaration in targets)
467-
{
468-
var declarationSelection = new Selection(declaration.Context.Start.Line,
469-
declaration.Context.Start.Column,
470-
declaration.Context.Stop.Line,
471-
declaration.Context.Stop.Column + declaration.Context.Stop.Text.Length);
472-
473-
if (declarationSelection.Contains(selection.Selection) ||
474-
!HasMultipleDeclarationsInStatement(declaration) && GetVariableStmtContextSelection(declaration).Contains(selection.Selection))
475-
{
476-
return declaration;
477-
}
478-
479-
var reference =
480-
declaration.References.FirstOrDefault(r => r.Selection.Contains(selection.Selection));
481-
482-
if (reference != null)
483-
{
484-
return reference.Declaration;
485-
}
486-
}
487-
return null;
488-
}
489300
}
490301
}

0 commit comments

Comments
 (0)