File: Snippets\VisualBasicSnippetExpansionLanguageHelper.vb
Web Access
Project: src\src\VisualStudio\VisualBasic\Impl\Microsoft.VisualStudio.LanguageServices.VisualBasic.vbproj (Microsoft.VisualStudio.LanguageServices.VisualBasic)
' Licensed to the .NET Foundation under one or more agreements.
' The .NET Foundation licenses this file to you under the MIT license.
' See the LICENSE file in the project root for more information.
 
Imports System.Composition
Imports System.Threading
Imports Microsoft.CodeAnalysis
Imports Microsoft.CodeAnalysis.AddImport
Imports Microsoft.CodeAnalysis.Editor.Shared.Extensions
Imports Microsoft.CodeAnalysis.Editor.[Shared].Utilities
Imports Microsoft.CodeAnalysis.Formatting
Imports Microsoft.CodeAnalysis.Host.Mef
Imports Microsoft.CodeAnalysis.Shared.Extensions
Imports Microsoft.CodeAnalysis.VisualBasic
Imports Microsoft.CodeAnalysis.VisualBasic.Extensions
Imports Microsoft.CodeAnalysis.VisualBasic.Syntax
Imports Microsoft.VisualStudio.LanguageServices.Snippets
Imports Microsoft.VisualStudio.Text
Imports Microsoft.VisualStudio.Text.Editor
Imports Microsoft.VisualStudio.TextManager.Interop
Imports VsTextSpan = Microsoft.VisualStudio.TextManager.Interop.TextSpan
 
Namespace Microsoft.VisualStudio.LanguageServices.VisualBasic.Snippets
    <ExportLanguageService(GetType(ISnippetExpansionLanguageHelper), LanguageNames.VisualBasic), [Shared]>
    Friend NotInheritable Class VisualBasicSnippetExpansionLanguageHelper
        Inherits AbstractSnippetExpansionLanguageHelper
 
        <ImportingConstructor>
        <Obsolete(MefConstruction.ImportingConstructorMessage, True)>
        Public Sub New(threadingContext As IThreadingContext)
            MyBase.New(threadingContext)
        End Sub
 
        Public Overrides ReadOnly Property LanguageServiceGuid As Guid = Guids.VisualBasicDebuggerLanguageId
 
        Public Overrides ReadOnly Property FallbackDefaultLiteral As String = "Nothing"
 
        Public Overrides Async Function AddImportsAsync(
                document As Document,
                addImportOptions As AddImportPlacementOptions,
                formattingOptions As SyntaxFormattingOptions,
                position As Integer,
                snippetNode As XElement,
                cancellationToken As CancellationToken) As Task(Of Document)
            Dim importsNode = snippetNode.Element(XName.Get("Imports", snippetNode.Name.NamespaceName))
            If importsNode Is Nothing OrElse
               Not importsNode.HasElements() Then
                Return document
            End If
 
            Dim newImportsStatements = Await GetImportsStatementsToAddAsync(
                document, snippetNode, importsNode, cancellationToken).ConfigureAwait(True)
            If Not newImportsStatements.Any() Then
                Return document
            End If
 
            ' In Venus/Razor, inserting imports statements into the subject buffer does not work.
            ' Instead, we add the imports through the contained language host.
 
            Dim memberImportsNamespaces = newImportsStatements.SelectMany(Function(s) s.ImportsClauses).OfType(Of SimpleImportsClauseSyntax).Select(Function(c) c.Name.ToString())
            If TryAddImportsToContainedDocument(document, memberImportsNamespaces) Then
                Return document
            End If
 
            Dim root = document.GetSyntaxRootSynchronously(cancellationToken)
 
            Dim newRoot = CType(root, CompilationUnitSyntax).AddImportsStatements(newImportsStatements, addImportOptions.PlaceSystemNamespaceFirst)
            Dim newDocument = document.WithSyntaxRoot(newRoot)
 
            Dim formattedDocument = Await Formatter.FormatAsync(newDocument, Formatter.Annotation, formattingOptions, cancellationToken).ConfigureAwait(True)
            Await document.Project.Solution.Workspace.ApplyDocumentChangesAsync(Me.ThreadingContext, formattedDocument, cancellationToken).configureawait(True)
 
            Return formattedDocument
        End Function
 
        Public Overrides Function InsertEmptyCommentAndGetEndPositionTrackingSpan(expansionSession As IVsExpansionSession, textView As ITextView, subjectBuffer As ITextBuffer) As ITrackingSpan
            Dim endSpanInSurfaceBuffer(1) As VsTextSpan
            If expansionSession.GetEndSpan(endSpanInSurfaceBuffer) <> VSConstants.S_OK Then
                Return Nothing
            End If
 
            Dim endSpan As SnapshotSpan = Nothing
            If Not TryGetSubjectBufferSpan(textView, subjectBuffer, endSpanInSurfaceBuffer(0), endSpan) Then
                Return Nothing
            End If
 
            Dim endPositionLine = subjectBuffer.CurrentSnapshot.GetLineFromPosition(endSpan.Start.Position)
            Dim endLineText = endPositionLine.GetText()
 
            If endLineText.Trim() = String.Empty Then
                Dim commentString = "'"
                subjectBuffer.Insert(endSpan.Start.Position, commentString)
 
                Dim commentSpan = New Span(endSpan.Start.Position, commentString.Length)
                Return subjectBuffer.CurrentSnapshot.CreateTrackingSpan(commentSpan, SpanTrackingMode.EdgeExclusive)
            End If
 
            Return Nothing
        End Function
 
        Private Shared Async Function GetImportsStatementsToAddAsync(document As Document, snippetNode As XElement, importsNode As XElement, cancellationToken As CancellationToken) As Task(Of IList(Of ImportsStatementSyntax))
            Dim root = document.GetSyntaxRootSynchronously(cancellationToken)
            Dim localImportsClauses = CType(root, CompilationUnitSyntax).Imports.SelectMany(Function(x) x.ImportsClauses)
            Dim compilation = Await document.Project.GetCompilationAsync(cancellationToken).ConfigureAwait(True)
            Dim options = CType(compilation.Options, VisualBasicCompilationOptions)
            Dim globalImportsClauses = options.GlobalImports.Select(Function(g) g.Clause)
 
            Dim membersImports = From clause In localImportsClauses.Union(globalImportsClauses).OfType(Of SimpleImportsClauseSyntax)
                                 Where clause.Alias Is Nothing
 
            Dim aliasImports = From clause In localImportsClauses.Union(globalImportsClauses).OfType(Of SimpleImportsClauseSyntax)
                               Where clause.Alias IsNot Nothing
 
            Dim xmlNamespaceImports = localImportsClauses.Union(globalImportsClauses).OfType(Of XmlNamespaceImportsClauseSyntax)
 
            Dim namespaceXmlName = XName.Get("Namespace", snippetNode.Name.NamespaceName)
            Dim ordinalIgnoreCaseStringComparer = StringComparer.OrdinalIgnoreCase
            Dim importsToAdd = New List(Of ImportsStatementSyntax)
 
            For Each import In importsNode.Elements(XName.Get("Import", snippetNode.Name.NamespaceName))
                Dim namespaceElement = import.Element(namespaceXmlName)
                If namespaceElement Is Nothing Then
                    Continue For
                End If
 
                Dim namespaceToImport = namespaceElement.Value.Trim()
 
                If String.IsNullOrEmpty(namespaceToImport) Then
                    Continue For
                End If
 
                AddUniqueClausesOfImport(namespaceToImport, importsToAdd, membersImports, aliasImports, xmlNamespaceImports, ordinalIgnoreCaseStringComparer)
            Next
 
            Return importsToAdd
        End Function
 
        Private Shared Sub AddUniqueClausesOfImport(
           namespaceToImport As String,
           importsToAdd As List(Of ImportsStatementSyntax),
           membersImports As IEnumerable(Of SimpleImportsClauseSyntax),
           aliasImports As IEnumerable(Of SimpleImportsClauseSyntax),
           xmlNamespaceImports As IEnumerable(Of XmlNamespaceImportsClauseSyntax),
           ordinalIgnoreCaseStringComparer As StringComparer)
 
            Dim importsStatement = TryCast(SyntaxFactory.ParseExecutableStatement("Imports " + namespaceToImport), ImportsStatementSyntax)
            If importsStatement Is Nothing Then
                Return
            End If
 
            Dim usableClauses = GetUniqueImportsClauses(importsStatement, membersImports, aliasImports, xmlNamespaceImports, ordinalIgnoreCaseStringComparer)
            If Not usableClauses.Any() Then
                Return
            End If
 
            Dim filteredImportsStatement = SyntaxFactory.ImportsStatement(
                SyntaxFactory.Token(SyntaxKind.ImportsKeyword).WithTrailingTrivia(SyntaxFactory.Space),
                SyntaxFactory.SeparatedList(usableClauses))
 
            importsToAdd.Add(filteredImportsStatement.WithAdditionalAnnotations(Formatter.Annotation) _
                .WithAppendedTrailingTrivia(SyntaxFactory.CarriageReturnLineFeed))
        End Sub
 
        Private Shared Function GetUniqueImportsClauses(
           importsStatement As ImportsStatementSyntax,
           membersImports As IEnumerable(Of SimpleImportsClauseSyntax),
           aliasImports As IEnumerable(Of SimpleImportsClauseSyntax),
           xmlNamespaceImports As IEnumerable(Of XmlNamespaceImportsClauseSyntax),
           ordinalIgnoreCaseStringComparer As StringComparer) As IEnumerable(Of ImportsClauseSyntax)
 
            Dim uniqueClauses = New List(Of ImportsClauseSyntax)
 
            For Each clause In importsStatement.ImportsClauses
                Dim simpleImportsClause = TryCast(clause, SimpleImportsClauseSyntax)
                If simpleImportsClause IsNot Nothing Then
                    If simpleImportsClause.Alias Is Nothing Then
                        If Not membersImports.Any(Function(c) ordinalIgnoreCaseStringComparer.Equals(c.Name.ToString(), simpleImportsClause.Name.ToString())) Then
                            uniqueClauses.Add(clause)
                        End If
                    Else
                        If Not aliasImports.Any(Function(a) ordinalIgnoreCaseStringComparer.Equals(a.Alias.Identifier.ToString(), simpleImportsClause.Alias.Identifier.ToString()) AndAlso
                                                        ordinalIgnoreCaseStringComparer.Equals(a.Name.ToString(), simpleImportsClause.Name.ToString())) Then
                            uniqueClauses.Add(clause)
                        End If
                    End If
 
                    Continue For
                End If
 
                Dim xmlNamespaceImportsClause = TryCast(clause, XmlNamespaceImportsClauseSyntax)
                If xmlNamespaceImportsClause IsNot Nothing Then
                    If Not xmlNamespaceImports.Any(Function(x) ordinalIgnoreCaseStringComparer.Equals(x.XmlNamespace.Name.ToString(), xmlNamespaceImportsClause.XmlNamespace.Name.ToString()) AndAlso
                                                               ordinalIgnoreCaseStringComparer.Equals(x.XmlNamespace.Value.ToString(), xmlNamespaceImportsClause.XmlNamespace.Value.ToString())) Then
                        uniqueClauses.Add(clause)
                    End If
 
                    Continue For
                End If
            Next
 
            Return uniqueClauses
        End Function
    End Class
End Namespace