diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index 2cb8c75010..732ca73f02 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -88,8 +88,7 @@ - - + diff --git a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs index 882b2ab574..59ef5dedf7 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs @@ -493,7 +493,7 @@ type internal GoToDefinition(metadataAsSource: FSharpMetadataAsSourceService) = else statusBar.TempMessage (SR.CannotNavigateUnknown()) -type internal QuickInfo = +type internal FSharpQuickInfo = { StructuredText: ToolTipText Span: TextSpan Symbol: FSharpSymbol option @@ -512,7 +512,7 @@ module internal FSharpQuickInfo = declRange: range, cancellationToken: CancellationToken ) - : Async = + : Async = asyncMaybe { let userOpName = "getQuickInfoFromRange" @@ -553,7 +553,7 @@ module internal FSharpQuickInfo = position: int, cancellationToken: CancellationToken ) - : Async<(range * QuickInfo option * QuickInfo option) option> = + : Async<(range * FSharpQuickInfo option * FSharpQuickInfo option) option> = asyncMaybe { let userOpName = "getQuickInfo" diff --git a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs index acb31c364c..ad19ac2f0c 100644 --- a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs +++ b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs @@ -127,7 +127,7 @@ module internal OptionsUI = let view = IntelliSenseOptionControl() view.charTyped.Unchecked.Add <| fun _ -> view.charDeleted.IsChecked <- System.Nullable false - let path = "EnterKeySetting" + let path = nameof EnterKeySetting bindRadioButton view.nevernewline path EnterKeySetting.NeverNewline bindRadioButton view.newlinecompleteline path EnterKeySetting.NewlineOnCompleteWord bindRadioButton view.alwaysnewline path EnterKeySetting.AlwaysNewline @@ -139,11 +139,11 @@ module internal OptionsUI = inherit AbstractOptionPage() override this.CreateView() = let view = QuickInfoOptionControl() - let path = "UnderlineStyle" + let path = nameof QuickInfoOptions.Default.UnderlineStyle bindRadioButton view.solid path QuickInfoUnderlineStyle.Solid bindRadioButton view.dot path QuickInfoUnderlineStyle.Dot bindRadioButton view.dash path QuickInfoUnderlineStyle.Dash - bindCheckBox view.displayLinks "DisplayLinks" + bindCheckBox view.displayLinks (nameof QuickInfoOptions.Default.DisplayLinks) upcast view [] diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/NavigableTextRun.fs b/vsintegration/src/FSharp.Editor/QuickInfo/NavigableTextRun.fs deleted file mode 100644 index 006041e0a9..0000000000 --- a/vsintegration/src/FSharp.Editor/QuickInfo/NavigableTextRun.fs +++ /dev/null @@ -1,9 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.VisualStudio.FSharp.Editor - -[] -type NavigableTextRun(classificationTypeName:string, text:string, navigateAction:unit -> unit) = - member _.ClassificationTypeName = classificationTypeName - member _.Text = text - member _.NavigateAction = navigateAction diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs b/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs index fc90c793bf..8c1a301c58 100644 --- a/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs +++ b/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs @@ -1,8 +1,9 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor +namespace Microsoft.VisualStudio.FSharp.Editor.QuickInfo open System +open System.IO open System.Threading open System.Threading.Tasks open System.ComponentModel.Composition @@ -16,21 +17,17 @@ open Microsoft.VisualStudio.Shell open Microsoft.VisualStudio.Shell.Interop open Microsoft.VisualStudio.Text open Microsoft.VisualStudio.Utilities +open Microsoft.VisualStudio.FSharp.Editor -open FSharp.Compiler -open FSharp.Compiler.CodeAnalysis -open FSharp.Compiler.EditorServices -open FSharp.Compiler.Symbols open FSharp.Compiler.Text -open FSharp.Compiler.Tokenization +open Microsoft.IO type internal FSharpAsyncQuickInfoSource ( statusBar: StatusBar, xmlMemberIndexService: IVsXMLMemberIndexService, metadataAsSource: FSharpMetadataAsSourceService, - textBuffer:ITextBuffer, - _settings: EditorOptions + textBuffer: ITextBuffer ) = // test helper @@ -40,7 +37,7 @@ type internal FSharpAsyncQuickInfoSource return! sigQuickInfo |> Option.orElse targetQuickInfo } - static member BuildSingleQuickInfoItem (documentationBuilder:IDocumentationBuilder) (quickInfo:QuickInfo) = + static member BuildSingleQuickInfoItem (documentationBuilder:IDocumentationBuilder) (quickInfo:FSharpQuickInfo) = let mainDescription, documentation, typeParameterMap, usage, exceptions = ResizeArray(), ResizeArray(), ResizeArray(), ResizeArray(), ResizeArray() XmlDocumentation.BuildDataTipText(documentationBuilder, mainDescription.Add, documentation.Add, typeParameterMap.Add, usage.Add, exceptions.Add, quickInfo.StructuredText) let docs = RoslynHelpers.joinWithLineBreaks [documentation; typeParameterMap; usage; exceptions] @@ -60,6 +57,14 @@ type internal FSharpAsyncQuickInfoSource asyncMaybe { let document = textBuffer.CurrentSnapshot.GetOpenDocumentInCurrentContextWithChanges() let! symbolUseRange, sigQuickInfo, targetQuickInfo = FSharpQuickInfo.getQuickInfo(document, triggerPoint.Position, cancellationToken) + + let getTooltip filePath = + let solutionDir = Path.GetDirectoryName(document.Project.Solution.FilePath) + let projectDir = Path.GetDirectoryName(document.Project.FilePath) + [ Path.GetRelativePath(projectDir, filePath) + Path.GetRelativePath(solutionDir, filePath) ] + |> List.minBy String.length + let getTrackingSpan (span:TextSpan) = textBuffer.CurrentSnapshot.CreateTrackingSpan(span.Start, span.Length, SpanTrackingMode.EdgeInclusive) @@ -71,7 +76,7 @@ type internal FSharpAsyncQuickInfoSource let mainDescription, docs = FSharpAsyncQuickInfoSource.BuildSingleQuickInfoItem documentationBuilder quickInfo let imageId = Tokenizer.GetImageIdForSymbol(quickInfo.Symbol, quickInfo.SymbolKind) let navigation = FSharpNavigation(statusBar, metadataAsSource, document, symbolUseRange) - let content = QuickInfoViewProvider.provideContent(imageId, mainDescription, docs, navigation) + let content = QuickInfoViewProvider.provideContent(imageId, mainDescription |> List.ofSeq, [docs |> List.ofSeq], navigation, getTooltip) let span = getTrackingSpan quickInfo.Span return QuickInfoItem(span, content) @@ -88,20 +93,21 @@ type internal FSharpAsyncQuickInfoSource |> string if String.IsNullOrWhiteSpace text then None else Some text - let documentation = + let documentationParts: TaggedText list list = [ match getText targetDocumentation, getText sigDocumentation with | None, None -> () - | None, Some _ -> yield! sigDocumentation - | Some _, None -> yield! targetDocumentation + | None, Some _ -> sigDocumentation |> List.ofSeq + | Some _, None -> targetDocumentation |> List.ofSeq | Some implText, Some sigText when implText.Equals (sigText, StringComparison.OrdinalIgnoreCase) -> - yield! sigDocumentation + sigDocumentation |> List.ofSeq | Some _ , Some _ -> - yield! RoslynHelpers.joinWithLineBreaks [ sigDocumentation; [ TaggedText.tagText "-------------" ]; targetDocumentation ] - ] |> ResizeArray - let docs = RoslynHelpers.joinWithLineBreaks [documentation; typeParameterMap; usage; exceptions] + sigDocumentation |> List.ofSeq + targetDocumentation |> List.ofSeq + RoslynHelpers.joinWithLineBreaks [typeParameterMap; usage; exceptions] |> List.ofSeq + ] let imageId = Tokenizer.GetImageIdForSymbol(targetQuickInfo.Symbol, targetQuickInfo.SymbolKind) let navigation = FSharpNavigation(statusBar, metadataAsSource, document, symbolUseRange) - let content = QuickInfoViewProvider.provideContent(imageId, mainDescription, docs, navigation) + let content = QuickInfoViewProvider.provideContent(imageId, mainDescription |> List.ofSeq, documentationParts, navigation, getTooltip) let span = getTrackingSpan targetQuickInfo.Span return QuickInfoItem(span, content) } |> Async.map Option.toObj @@ -115,8 +121,7 @@ type internal FSharpAsyncQuickInfoSourceProvider [] ( [)>] serviceProvider: IServiceProvider, - metadataAsSource: FSharpMetadataAsSourceService, - settings: EditorOptions + metadataAsSource: FSharpMetadataAsSourceService ) = interface IAsyncQuickInfoSourceProvider with @@ -125,4 +130,4 @@ type internal FSharpAsyncQuickInfoSourceProvider // It is safe to do it here (see #4713) let statusBar = StatusBar(serviceProvider.GetService()) let xmlMemberIndexService = serviceProvider.XMLMemberIndexService - new FSharpAsyncQuickInfoSource(statusBar, xmlMemberIndexService, metadataAsSource, textBuffer, settings) :> IAsyncQuickInfoSource + new FSharpAsyncQuickInfoSource(statusBar, xmlMemberIndexService, metadataAsSource, textBuffer) :> IAsyncQuickInfoSource diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs b/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs index 5284a2c65f..5523f10b95 100644 --- a/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs +++ b/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs @@ -1,18 +1,18 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor +namespace Microsoft.VisualStudio.FSharp.Editor.QuickInfo -open System.Collections.Generic open System.Threading open FSharp.Compiler.Text open Microsoft.CodeAnalysis.Classification open Microsoft.VisualStudio.Core.Imaging -open Microsoft.VisualStudio.Language.StandardClassification open Microsoft.VisualStudio.Text.Adornments +open Microsoft.VisualStudio.FSharp.Editor + module internal QuickInfoViewProvider = - let layoutTagToClassificationTag (layoutTag:TextTag) = + let layoutTagToClassificationTag (layoutTag: TextTag) = match layoutTag with | TextTag.ActivePatternCase | TextTag.ActivePatternResult @@ -49,54 +49,57 @@ module internal QuickInfoViewProvider = | TextTag.UnknownEntity | TextTag.Text -> ClassificationTypeNames.Text + let (|TaggedText|) (tt: TaggedText) = tt.Tag, tt.Text + + let (|LineBreak|_|) = + function TaggedText (TextTag.LineBreak, _) -> Some () | _ -> None + + let (|DocSeparator|_|) = + function LineBreak :: TaggedText (TextTag.Text, "-------------") :: LineBreak :: rest -> Some rest | _ -> None + + let wrapContent (elements: obj list) = + ContainerElement(ContainerElementStyle.Wrapped, elements |> Seq.map box) + + let stackContent (elements: obj list) = + ContainerElement(ContainerElementStyle.Stacked, elements |> Seq.map box) + + let encloseRuns runs = wrapContent (runs |> List.rev) |> box + + let emptyLine = wrapContent [ ClassifiedTextRun(ClassificationTypeNames.WhiteSpace, "") |> box ] + let provideContent ( - imageId:ImageId option, - description: seq, - documentation: seq, - navigation:FSharpNavigation + imageId: ImageId option, + description: TaggedText list, + documentation: TaggedText list list, + navigation: FSharpNavigation, + getTooltip ) = - let buildContainerElement (itemGroup: seq) = - let finalCollection = List() - let currentContainerItems = List() - let runsCollection = List() - let flushRuns() = - if runsCollection.Count > 0 then - let element = ClassifiedTextElement(runsCollection) - currentContainerItems.Add(element :> obj) - runsCollection.Clear() - let flushContainer() = - if currentContainerItems.Count > 0 then - let element = ContainerElement(ContainerElementStyle.Wrapped, currentContainerItems) - finalCollection.Add(element) - currentContainerItems.Clear() - for item in itemGroup do - let classificationTag = layoutTagToClassificationTag item.Tag - match item with - | :? NavigableTaggedText as nav when navigation.IsTargetValid nav.Range -> - flushRuns() - let navigableTextRun = NavigableTextRun(classificationTag, item.Text, fun () -> navigation.NavigateTo(nav.Range, CancellationToken.None)) - currentContainerItems.Add(navigableTextRun :> obj) - | _ when item.Tag = TextTag.LineBreak -> - flushRuns() - // preserve succesive linebreaks - if currentContainerItems.Count = 0 then - runsCollection.Add(ClassifiedTextRun(PredefinedClassificationTypeNames.Other, System.String.Empty)) - flushRuns() - flushContainer() - | _ -> - let newRun = ClassifiedTextRun(classificationTag, item.Text) - runsCollection.Add(newRun) - flushRuns() - flushContainer() - ContainerElement(ContainerElementStyle.Stacked, finalCollection |> Seq.map box) + let encloseText text = + let rec loop text runs stack = + match (text: TaggedText list) with + | [] -> stackContent (encloseRuns runs :: stack |> List.rev) + | DocSeparator (LineBreak :: rest) + | DocSeparator rest -> loop rest [] (box Separator :: encloseRuns runs :: stack) + | LineBreak :: rest when runs |> List.isEmpty -> loop rest [] (emptyLine :: stack) + | LineBreak :: rest -> loop rest [] (encloseRuns runs :: stack) + | :? NavigableTaggedText as item :: rest when navigation.IsTargetValid item.Range -> + let classificationTag = layoutTagToClassificationTag item.Tag + let action = fun () -> navigation.NavigateTo(item.Range, CancellationToken.None) + let run = ClassifiedTextRun(classificationTag, item.Text, action, getTooltip item.Range.FileName) + loop rest (run :: runs) stack + | item :: rest -> + let run = ClassifiedTextRun(layoutTagToClassificationTag item.Tag, item.Text) + loop rest (run :: runs) stack + + loop text [] [] |> box let innerElement = match imageId with - | Some imageId -> - ContainerElement(ContainerElementStyle.Wrapped, ImageElement(imageId), buildContainerElement description) - | None -> - ContainerElement(ContainerElementStyle.Wrapped, buildContainerElement description) + | Some imageId -> wrapContent [ stackContent [ ImageElement(imageId) ]; encloseText description ] + | None -> ContainerElement(ContainerElementStyle.Wrapped, encloseText description) + + let separated = stackContent (documentation |> List.map encloseText) - ContainerElement(ContainerElementStyle.Stacked, innerElement, buildContainerElement documentation) + wrapContent [ stackContent [ innerElement; separated ] ] diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/WpfFactories.fs b/vsintegration/src/FSharp.Editor/QuickInfo/WpfFactories.fs new file mode 100644 index 0000000000..607b1e2f3d --- /dev/null +++ b/vsintegration/src/FSharp.Editor/QuickInfo/WpfFactories.fs @@ -0,0 +1,60 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Microsoft.VisualStudio.FSharp.Editor.QuickInfo + +open System.ComponentModel.Composition +open System.Windows +open System.Windows.Controls + +open Microsoft.VisualStudio.Text.Adornments +open Microsoft.VisualStudio.Text.Editor +open Microsoft.VisualStudio.Utilities + +open Microsoft.VisualStudio.FSharp.Editor + +type Separator = Separator + +[)>] +[] +[, typeof)>] +type WpfNavigableTextRunFactory [] (viewElementFactoryService: IViewElementFactoryService, settings: EditorOptions) = + let resources = Microsoft.VisualStudio.FSharp.UIResources.NavStyles().Resources + + interface IViewElementFactory with + member _.CreateViewElement(textView: ITextView, model: obj) = + match model with + | :? ClassifiedTextRun as classifiedTextRun -> + // use the default converters to get a UIElement + let classifiedTextElement = ClassifiedTextElement([ classifiedTextRun ]) + + let convertedElement = + viewElementFactoryService.CreateViewElement(textView, classifiedTextElement) + // Apply custom underline. + match convertedElement with + | :? TextBlock as tb when classifiedTextRun.NavigationAction <> null && settings.QuickInfo.DisplayLinks -> + match tb.Inlines.FirstInline with + | :? Documents.Hyperlink as hyperlink -> + let key = + match settings.QuickInfo.UnderlineStyle with + | QuickInfoUnderlineStyle.Solid -> "solid_underline" + | QuickInfoUnderlineStyle.Dash -> "dash_underline" + | QuickInfoUnderlineStyle.Dot -> "dot_underline" + // Fix color and apply styles. + hyperlink.Foreground <- hyperlink.Inlines.FirstInline.Foreground + hyperlink.Style <- downcast resources[key] + | _ -> () + | _ -> () + + box convertedElement :?> _ + | _ -> + failwith $"Invalid type conversion. Supported conversion is {typeof.Name} to {typeof.Name}." + +[)>] +[] +[, typeof)>] +type WpfSeparatorFactory() = + interface IViewElementFactory with + member _.CreateViewElement(_, model: obj) = + match model with + | :? Separator -> Controls.Separator(Opacity = 0.4, Margin = Thickness(0, 10, 0, 10)) |> box :?> _ + | _ -> failwith $"Invalid type conversion. Supported conversion is {typeof.Name} to {typeof.Name}." diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/WpfNagivableTextRunViewElementFactory.fs b/vsintegration/src/FSharp.Editor/QuickInfo/WpfNagivableTextRunViewElementFactory.fs deleted file mode 100644 index 134105e9ef..0000000000 --- a/vsintegration/src/FSharp.Editor/QuickInfo/WpfNagivableTextRunViewElementFactory.fs +++ /dev/null @@ -1,63 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.VisualStudio.FSharp.Editor - -open System -open System.ComponentModel.Composition -open System.Windows -open System.Windows.Controls - -open Microsoft.VisualStudio.Text.Adornments -open Microsoft.VisualStudio.Text.Editor -open Microsoft.VisualStudio.Utilities - -[)>] -[] -[, typeof)>] -[] -type WpfNavigableTextRunViewElementFactory - [] - ( - viewElementFactoryService:IViewElementFactoryService, - settings: EditorOptions - ) = - let styles = Microsoft.VisualStudio.FSharp.UIResources.NavStyles() - interface IViewElementFactory with - override _.CreateViewElement<'TView when 'TView: not struct>(textView:ITextView, model:obj) : 'TView = - if not (model :? NavigableTextRun) || typeof<'TView> <> typeof then - failwith <| sprintf "Invalid type conversion. Supported conversion is `%s` to `%s`." typeof.Name typeof.Name - - // use the default converters to get a UIElement - let navigableTextRun = model :?> NavigableTextRun - let classifiedTextRun = ClassifiedTextRun(navigableTextRun.ClassificationTypeName, navigableTextRun.Text) - let classifiedTextElement = ClassifiedTextElement([classifiedTextRun]) - let convertedElement = viewElementFactoryService.CreateViewElement(textView, classifiedTextElement) - - // apply HTML-like styles - match convertedElement with - | :? TextBlock as tb -> - let underlineStyle = - let key = - if settings.QuickInfo.DisplayLinks then - match settings.QuickInfo.UnderlineStyle with - | QuickInfoUnderlineStyle.Solid -> "solid_underline" - | QuickInfoUnderlineStyle.Dash -> "dash_underline" - | QuickInfoUnderlineStyle.Dot -> "dot_underline" - else - "no_underline" - styles.Resources.[key] :?> Style - - // we need to enclose the generated Inline, which is actually a Run element, - // because fancy styling does not seem to work properly with Runs - let inl = tb.Inlines.FirstInline - let color = inl.Foreground - // clear the color here to make it inherit - inl.ClearValue(Documents.TextElement.ForegroundProperty) |> ignore - // this constructor inserts into TextBlock - Documents.Underline(tb.Inlines.FirstInline, tb.ContentStart, Foreground = color) |> ignore - tb.Resources.[typeof] <- underlineStyle - | _ -> () - - // add navigation - convertedElement.MouseDown.Add(fun _ -> navigableTextRun.NavigateAction()) - convertedElement :> obj :?> 'TView diff --git a/vsintegration/src/FSharp.UIResources/NavStyles.xaml b/vsintegration/src/FSharp.UIResources/NavStyles.xaml index 345ab98a35..a800818ee5 100644 --- a/vsintegration/src/FSharp.UIResources/NavStyles.xaml +++ b/vsintegration/src/FSharp.UIResources/NavStyles.xaml @@ -8,43 +8,43 @@ mc:Ignorable="d" d:DesignHeight="450" d:DesignWidth="800"> - - - - - - - - - - - - - - - - - - - - - - - - - + + + + diff --git a/vsintegration/tests/FSharp.Editor.Tests/QuickInfoProviderTests.fs b/vsintegration/tests/FSharp.Editor.Tests/QuickInfoProviderTests.fs index 4f16652edc..26402791e7 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/QuickInfoProviderTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/QuickInfoProviderTests.fs @@ -7,6 +7,7 @@ open Xunit open FSharp.Compiler.EditorServices open FSharp.Compiler.CodeAnalysis open Microsoft.VisualStudio.FSharp.Editor +open Microsoft.VisualStudio.FSharp.Editor.QuickInfo open FSharp.Editor.Tests.Helpers open FSharp.Test diff --git a/vsintegration/tests/FSharp.Editor.Tests/QuickInfoTests.fs b/vsintegration/tests/FSharp.Editor.Tests/QuickInfoTests.fs index e1d0774062..4d4730f82c 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/QuickInfoTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/QuickInfoTests.fs @@ -3,6 +3,7 @@ namespace FSharp.Editor.Tests open Microsoft.VisualStudio.FSharp.Editor +open Microsoft.VisualStudio.FSharp.Editor.QuickInfo open Xunit open FSharp.Editor.Tests.Helpers