diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs b/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs index 415b38798b1..ab8ae82eff1 100644 --- a/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs +++ b/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs @@ -55,14 +55,13 @@ module internal QuickInfoViewProvider = | TaggedText (TextTag.LineBreak, _) -> Some() | _ -> None - let wrapContent (elements: obj list) = - ContainerElement(ContainerElementStyle.Wrapped, elements |> Seq.map box) + let wrapContent (elements: obj seq) = + ContainerElement(ContainerElementStyle.Wrapped, elements) - let stackContent (elements: obj list) = - ContainerElement(ContainerElementStyle.Stacked, elements |> Seq.map box) + let stackContent (elements: obj seq) = + ContainerElement(ContainerElementStyle.Stacked, elements) - let encloseRuns runs = - ClassifiedTextElement(runs |> List.rev) |> box + let encloseRuns runs : obj = ClassifiedTextElement(runs |> List.rev) let provideContent ( @@ -78,8 +77,8 @@ module internal QuickInfoViewProvider = match (text: TaggedText list) with | [] when runs |> List.isEmpty -> stackContent (stack |> List.rev) | [] -> stackContent (encloseRuns runs :: stack |> List.rev) - // smaller gap instead of huge double line break - | LineBreak :: rest when runs |> List.isEmpty -> loop rest [] (box (Separator false) :: stack) + // smaller paragraph spacing instead of huge double line break + | LineBreak :: rest when runs |> List.isEmpty -> loop rest [] (Paragraph :: stack) | LineBreak :: rest -> loop rest [] (encloseRuns runs :: stack) | :? NavigableTaggedText as item :: rest when navigation.IsTargetValid item.Range -> let classificationTag = layoutTagToClassificationTag item.Tag @@ -93,17 +92,14 @@ module internal QuickInfoViewProvider = let run = ClassifiedTextRun(layoutTagToClassificationTag item.Tag, item.Text) loop rest (run :: runs) stack - loop text [] [] |> box + loop text [] [] let innerElement = match imageId with | Some imageId -> wrapContent [ stackContent [ ImageElement(imageId) ]; encloseText description ] | None -> ContainerElement(ContainerElementStyle.Wrapped, encloseText description) - wrapContent [ stackContent [ innerElement; encloseText documentation ] ] + wrapContent [ stackContent [ innerElement; encloseText documentation ]; CustomLinkStyle ] let stackWithSeparators elements = - elements - |> List.map box - |> List.intersperse (box (Separator true)) - |> stackContent + elements |> List.map box |> List.intersperse Separator |> stackContent diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/WpfFactories.fs b/vsintegration/src/FSharp.Editor/QuickInfo/WpfFactories.fs index 84f157edc67..1abf13001aa 100644 --- a/vsintegration/src/FSharp.Editor/QuickInfo/WpfFactories.fs +++ b/vsintegration/src/FSharp.Editor/QuickInfo/WpfFactories.fs @@ -7,83 +7,64 @@ 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 -open Microsoft.VisualStudio.Text.Classification +open Microsoft.VisualStudio.FSharp -type Separator = - | Separator of visible: bool - // preserve old behavior on mac +type internal FSharpStyle = + | Separator + | Paragraph + | CustomLinkStyle + + // Render as strings for cross platform look. override this.ToString() = match this with - | Separator true -> XmlDocumentation.separatorText - | _ -> System.Environment.NewLine + | Separator -> Editor.XmlDocumentation.separatorText + | Paragraph -> System.Environment.NewLine + | CustomLinkStyle -> "" +// Provide nicer look for the QuickInfo on Windows. [)>] -[] -[, typeof)>] -type WpfClassifiedTextElementFactory [] - ( - classificationformatMapService: IClassificationFormatMapService, - classificationTypeRegistry: IClassificationTypeRegistryService, - settings: EditorOptions - ) = - let resources = Microsoft.VisualStudio.FSharp.UIResources.NavStyles().Resources - let formatMap = classificationformatMapService.GetClassificationFormatMap("tooltip") - - interface IViewElementFactory with - member _.CreateViewElement(_textView: ITextView, model: obj) = - match model with - | :? ClassifiedTextElement as text -> - let tb = TextBlock() - tb.FontSize <- formatMap.DefaultTextProperties.FontRenderingEmSize - tb.FontFamily <- formatMap.DefaultTextProperties.Typeface.FontFamily - tb.TextWrapping <- TextWrapping.Wrap +[] +[, typeof)>] +type internal WpfFSharpStyleFactory [] (settings: Editor.EditorOptions) = + let linkStyleUpdater () = + let key = + if settings.QuickInfo.DisplayLinks then + $"{settings.QuickInfo.UnderlineStyle.ToString().ToLower()}_underline" + else + "no_underline" - for run in text.Runs do - let ctype = - classificationTypeRegistry.GetClassificationType(run.ClassificationTypeName) + let style = UIResources.NavStyles().Resources[key] :?> Style - let props = formatMap.GetTextProperties(ctype) - let inl = Documents.Run(run.Text, Foreground = props.ForegroundBrush) + // Some assumptions are made here about the shape of QuickInfo visual tree rendered by VS. + // If some future VS update were to render QuickInfo with different WPF elements + // the links will still work, just without their custom styling. + let rec styleLinks (element: DependencyObject) = + match element with + | :? TextBlock as t -> + for run in t.Inlines do + if run :? Documents.Hyperlink then + run.Style <- style + | :? Panel as p -> + for e in p.Children do + styleLinks e + | _ -> () - match run.NavigationAction |> Option.ofObj with - | Some action -> - let link = - { new Documents.Hyperlink(inl, ToolTip = run.Tooltip) with - override _.OnClick() = action.Invoke() - } + // Return an invisible FrameworkElement which will traverse it's siblings + // to find HyperLinks and update their style, when inserted into the visual tree. + { new FrameworkElement() with + override this.OnVisualParentChanged _ = styleLinks this.Parent + } - let key = - match settings.QuickInfo.UnderlineStyle with - | QuickInfoUnderlineStyle.Solid -> "solid_underline" - | QuickInfoUnderlineStyle.Dash -> "dash_underline" - | QuickInfoUnderlineStyle.Dot -> "dot_underline" - - link.Style <- downcast resources[key] - link.Foreground <- props.ForegroundBrush - tb.Inlines.Add(link) - | _ -> tb.Inlines.Add(inl) - - box tb :?> _ - | _ -> - 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 as Separator visible -> - if visible then - Controls.Separator(Opacity = 0.3, Margin = Thickness(0, 8, 0, 8)) - else - Controls.Separator(Opacity = 0) + | :? FSharpStyle as fSharpStyle -> + match fSharpStyle with + | CustomLinkStyle -> linkStyleUpdater () + | Separator -> Controls.Separator(Opacity = 0.3, Margin = Thickness(0, 8, 0, 8)) + | Paragraph -> Controls.Separator(Opacity = 0) |> box :?> _ - | _ -> failwith $"Invalid type conversion. Supported conversion is {typeof.Name} to {typeof.Name}." + | _ -> failwith $"Invalid type conversion. Supported conversion is {typeof.Name} to {typeof.Name}." diff --git a/vsintegration/src/FSharp.UIResources/NavStyles.xaml b/vsintegration/src/FSharp.UIResources/NavStyles.xaml index a800818ee55..6421aeee9c2 100644 --- a/vsintegration/src/FSharp.UIResources/NavStyles.xaml +++ b/vsintegration/src/FSharp.UIResources/NavStyles.xaml @@ -8,8 +8,8 @@ mc:Ignorable="d" d:DesignHeight="450" d:DesignWidth="800"> - - + + @@ -26,7 +26,7 @@ - +