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.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()
        End Sub
 
        Public Overrides ReadOnly Property LanguageServiceGuid As Guid
            Get
                Return Guids.VisualBasicDebuggerLanguageId
            End Get
        End Property
 
        Public Overrides ReadOnly Property FallbackDefaultLiteral As String
            Get
                Return "Nothing"
            End Get
        End Property
 
        Public Overrides Function AddImports(document As Document, addImportOptions As AddImportPlacementOptions, formattingOptions As SyntaxFormattingOptions, position As Integer, snippetNode As XElement, cancellationToken As CancellationToken) As 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 = GetImportsStatementsToAdd(document, snippetNode, importsNode, cancellationToken)
            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 = Formatter.FormatAsync(newDocument, Formatter.Annotation, formattingOptions, cancellationToken).WaitAndGetResult(cancellationToken)
            document.Project.Solution.Workspace.ApplyDocumentChanges(formattedDocument, cancellationToken)
 
            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 Function GetImportsStatementsToAdd(document As Document, snippetNode As XElement, importsNode As XElement, cancellationToken As CancellationToken) As IList(Of ImportsStatementSyntax)
            Dim root = document.GetSyntaxRootSynchronously(cancellationToken)
            Dim localImportsClauses = CType(root, CompilationUnitSyntax).Imports.SelectMany(Function(x) x.ImportsClauses)
            Dim compilation = document.Project.GetCompilationAsync(cancellationToken).WaitAndGetResult(cancellationToken)
            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