1
- using Antlr4 . Runtime ;
1
+ using System ;
2
+ using System . Collections . Generic ;
3
+ using System . Diagnostics ;
4
+ using System . Linq ;
5
+ using Antlr4 . Runtime ;
6
+ using Rubberduck . Parsing ;
2
7
using Rubberduck . Parsing . Symbols ;
8
+ using Rubberduck . Parsing . VBA ;
9
+ using Rubberduck . VBEditor ;
3
10
using Rubberduck . VBEditor . SafeComWrappers . Abstract ;
4
11
5
12
namespace Rubberduck . Common
6
13
{
7
14
public static class CodeModuleExtensions
8
15
{
16
+ /// <summary>
17
+ /// Removes a <see cref="Declaration"/> and its <see cref="Declaration.References"/>.
18
+ /// </summary>
19
+ /// <param name="module">The <see cref="ICodeModule"/> to modify.</param>
20
+ /// <param name="target"></param>
21
+ public static void Remove ( this ICodeModule module , Declaration target )
22
+ {
23
+ if ( ! module . Equals ( target . QualifiedName . QualifiedModuleName . Component . CodeModule ) )
24
+ {
25
+ throw new ArgumentException ( "Target is not declared in specified module." ) ;
26
+ }
27
+
28
+ var sortedItems = target . References
29
+ . Where ( reference => module . Equals ( reference . QualifiedModuleName . Component . CodeModule ) )
30
+ . Select ( reference => Tuple . Create ( ( object ) reference , reference . Selection ) )
31
+ . Concat ( new [ ] { Tuple . Create ( ( object ) target , target . Selection ) } )
32
+ . OrderByDescending ( t => t . Item2 ) ;
33
+
34
+ foreach ( var tuple in sortedItems )
35
+ {
36
+ if ( tuple . Item1 is Declaration )
37
+ {
38
+ RemoveDeclarationOnly ( module , target ) ;
39
+ }
40
+ else
41
+ {
42
+ var reference = ( IdentifierReference ) tuple . Item1 ;
43
+ Remove ( reference . QualifiedModuleName . Component . CodeModule , reference ) ;
44
+ }
45
+ }
46
+ }
47
+
48
+ private static void RemoveDeclarationOnly ( this ICodeModule module , Declaration target )
49
+ {
50
+ var multipleDeclarations = target . DeclarationType == DeclarationType . Variable && target . HasMultipleDeclarationsInStatement ( ) ;
51
+ var context = GetStmtContext ( target ) ;
52
+ var declarationText = context . GetText ( ) . Replace ( " _" + Environment . NewLine , Environment . NewLine ) ;
53
+ var selection = GetStmtContextSelection ( target ) ;
54
+ Debug . Assert ( selection . StartColumn > 0 ) ;
55
+
56
+ var oldLines = module . GetLines ( selection ) ;
57
+ var indent = oldLines . IndexOf ( oldLines . FirstOrDefault ( c => c != ' ' ) ) + 1 ;
58
+
59
+ var newLines = oldLines
60
+ . Replace ( " _" + Environment . NewLine , Environment . NewLine )
61
+ . Remove ( selection . StartColumn - 1 , declarationText . Length - selection . StartColumn + indent ) ;
62
+
63
+ if ( multipleDeclarations )
64
+ {
65
+ selection = GetStmtContextSelection ( target ) ;
66
+ newLines = RemoveExtraComma ( module . GetLines ( selection ) . Replace ( oldLines , newLines ) ,
67
+ target . CountOfDeclarationsInStatement ( ) , target . IndexOfVariableDeclarationInStatement ( ) ) ;
68
+ }
69
+
70
+ var newLinesWithoutExcessSpaces = newLines . Split ( new [ ] { Environment . NewLine } , StringSplitOptions . None ) ;
71
+ for ( var i = 0 ; i < newLinesWithoutExcessSpaces . Length ; i ++ )
72
+ {
73
+ newLinesWithoutExcessSpaces [ i ] = newLinesWithoutExcessSpaces [ i ] . RemoveExtraSpacesLeavingIndentation ( ) ;
74
+ }
75
+
76
+ for ( var i = newLinesWithoutExcessSpaces . Length - 1 ; i >= 0 ; i -- )
77
+ {
78
+ if ( newLinesWithoutExcessSpaces [ i ] . Trim ( ) == string . Empty )
79
+ {
80
+ continue ;
81
+ }
82
+
83
+ if ( newLinesWithoutExcessSpaces [ i ] . EndsWith ( " _" ) )
84
+ {
85
+ newLinesWithoutExcessSpaces [ i ] =
86
+ newLinesWithoutExcessSpaces [ i ] . Remove ( newLinesWithoutExcessSpaces [ i ] . Length - 2 ) ;
87
+ }
88
+ break ;
89
+ }
90
+
91
+ // remove all lines with only whitespace
92
+ newLinesWithoutExcessSpaces = newLinesWithoutExcessSpaces . Where ( str => str . Any ( c => ! char . IsWhiteSpace ( c ) ) ) . ToArray ( ) ;
93
+
94
+ module . DeleteLines ( selection ) ;
95
+ if ( newLinesWithoutExcessSpaces . Any ( ) )
96
+ {
97
+ module . InsertLines ( selection . StartLine , string . Join ( Environment . NewLine , newLinesWithoutExcessSpaces ) ) ;
98
+ }
99
+ }
100
+
101
+ private static Selection GetStmtContextSelection ( Declaration target )
102
+ {
103
+ switch ( target . DeclarationType )
104
+ {
105
+ case DeclarationType . Variable :
106
+ return target . GetVariableStmtContextSelection ( ) ;
107
+ case DeclarationType . Constant :
108
+ return target . GetConstStmtContextSelection ( ) ;
109
+ default :
110
+ return target . Context . GetSelection ( ) ;
111
+ }
112
+ }
113
+
114
+ private static ParserRuleContext GetStmtContext ( Declaration target )
115
+ {
116
+ switch ( target . DeclarationType )
117
+ {
118
+ case DeclarationType . Variable :
119
+ return target . GetVariableStmtContext ( ) ;
120
+ case DeclarationType . Constant :
121
+ return target . GetConstStmtContext ( ) ;
122
+ default :
123
+ return target . Context ;
124
+ }
125
+ }
126
+
127
+ private static string RemoveExtraComma ( string str , int numParams , int indexRemoved )
128
+ {
129
+ #region usage example
130
+ // Example use cases for this method (fields and variables):
131
+ // Dim fizz as Boolean, dizz as Double
132
+ // Private fizz as Boolean, dizz as Double
133
+ // Public fizz as Boolean, _
134
+ // dizz as Double
135
+ // Private fizz as Boolean _
136
+ // , dizz as Double _
137
+ // , iizz as Integer
138
+
139
+ // Before this method is called, the parameter to be removed has
140
+ // already been removed. This means 'str' will look like:
141
+ // Dim fizz as Boolean,
142
+ // Private , dizz as Double
143
+ // Public fizz as Boolean, _
144
+ //
145
+ // Private _
146
+ // , dizz as Double _
147
+ // , iizz as Integer
148
+
149
+ // This method is responsible for removing the redundant comma
150
+ // and returning a string similar to:
151
+ // Dim fizz as Boolean
152
+ // Private dizz as Double
153
+ // Public fizz as Boolean _
154
+ //
155
+ // Private _
156
+ // dizz as Double _
157
+ // , iizz as Integer
158
+ #endregion
159
+ var commaToRemove = numParams == indexRemoved ? indexRemoved - 1 : indexRemoved ;
160
+ return str . Remove ( str . NthIndexOf ( ',' , commaToRemove ) , 1 ) ;
161
+ }
162
+
163
+ public static void Remove ( this ICodeModule module , IdentifierReference target )
164
+ {
165
+ var parent = target . Context . Parent as ParserRuleContext ;
166
+ module . Remove ( parent . GetSelection ( ) , parent ) ;
167
+ }
168
+
169
+ public static void Remove ( this ICodeModule module , IEnumerable < IdentifierReference > targets )
170
+ {
171
+ foreach ( var target in targets . OrderByDescending ( e => e . Selection ) )
172
+ {
173
+ module . Remove ( target ) ;
174
+ }
175
+ }
176
+
177
+ public static void Remove ( this ICodeModule module , Selection selection , ParserRuleContext instruction )
178
+ {
179
+ var originalCodeLines = module . GetLines ( selection . StartLine , selection . LineCount ) ;
180
+ var originalInstruction = instruction . GetText ( ) ;
181
+ module . DeleteLines ( selection . StartLine , selection . LineCount ) ;
182
+
183
+ var newCodeLines = originalCodeLines . Replace ( originalInstruction , string . Empty ) ;
184
+ if ( ! string . IsNullOrEmpty ( newCodeLines ) )
185
+ {
186
+ module . InsertLines ( selection . StartLine , newCodeLines ) ;
187
+ }
188
+ }
189
+
9
190
public static void ReplaceToken ( this ICodeModule module , IToken token , string replacement )
10
191
{
11
192
var original = module . GetLines ( token . Line , 1 ) ;
@@ -22,13 +203,14 @@ public static void ReplaceIdentifierReferenceName(this ICodeModule module, Ident
22
203
23
204
public static void InsertLines ( this ICodeModule module , int startLine , string [ ] lines )
24
205
{
25
- int lineNumber = startLine ;
26
- for ( int idx = 0 ; idx < lines . Length ; idx ++ )
206
+ var lineNumber = startLine ;
207
+ for ( var idx = 0 ; idx < lines . Length ; idx ++ )
27
208
{
28
209
module . InsertLines ( lineNumber , lines [ idx ] ) ;
29
210
lineNumber ++ ;
30
211
}
31
212
}
213
+
32
214
private static string ReplaceStringAtIndex ( string original , string toReplace , string replacement , int startIndex )
33
215
{
34
216
var modifiedContent = original . Remove ( startIndex , toReplace . Length ) ;
0 commit comments