VS: Use IViewElementFactory as intended

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

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.
 [<Export(typeof<IViewElementFactory>)>]
-[<Name("ClassifiedTextElement to UIElement")>]
-[<TypeConversion(typeof<ClassifiedTextElement>, typeof<UIElement>)>]
-type WpfClassifiedTextElementFactory [<ImportingConstructor>]
-    (
-        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
+[<Name("FSharpStyle to UIElement")>]
+[<TypeConversion(typeof<FSharpStyle>, typeof<UIElement>)>]
+type internal WpfFSharpStyleFactory [<ImportingConstructor>] (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<ClassifiedTextElement>.Name} to {typeof<UIElement>.Name}."
-
-[<Export(typeof<IViewElementFactory>)>]
-[<Name("Separator to UIElement")>]
-[<TypeConversion(typeof<Separator>, typeof<UIElement>)>]
-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<Separator>.Name} to {typeof<UIElement>.Name}."
+            | _ -> failwith $"Invalid type conversion.  Supported conversion is {typeof<FSharpStyle>.Name} to {typeof<UIElement>.Name}."

vsintegration/src/FSharp.UIResources/NavStyles.xaml

@@ -8,8 +8,8 @@
              mc:Ignorable="d" 
              d:DesignHeight="450" d:DesignWidth="800">
     <UserControl.Resources>
-        <SolidColorBrush x:Key="inherited_brush" Color="{Binding Path=Foreground.Color, RelativeSource={RelativeSource Mode=FindAncestor, AncestorType=Hyperlink}}"/>
-        <SolidColorBrush x:Key="inherited_semi_brush" Opacity="0.3" Color="{Binding Path=Foreground.Color, RelativeSource={RelativeSource Mode=FindAncestor, AncestorType=Hyperlink}}"/>
+        <SolidColorBrush x:Key="inherited_brush" Color="{Binding Path=Inlines.FirstInline.Foreground.Color, RelativeSource={RelativeSource Mode=FindAncestor, AncestorType=Hyperlink}}"/>
+        <SolidColorBrush x:Key="inherited_semi_brush" Opacity="0.3" Color="{Binding Path=Inlines.FirstInline.Foreground.Color, RelativeSource={RelativeSource Mode=FindAncestor, AncestorType=Hyperlink}}"/>
         <DashStyle x:Key="dash_dashstyle" Dashes="5 5"/>
         <DashStyle x:Key="dot_dashstyle" Dashes="1 5"/>
         <Pen x:Key="dot_pen" DashStyle="{StaticResource dot_dashstyle}" Brush="{StaticResource inherited_brush}"/>
@@ -26,7 +26,7 @@
             <TextDecoration Location="Underline" PenOffset="1" Pen="{StaticResource dot_pen}"/>
         </TextDecorationCollection>
         <TextDecorationCollection x:Key="full_deco">
-            <TextDecoration PenOffset="1" Pen="{StaticResource mouseover_pen}" />
+            <TextDecoration Location="Underline" PenOffset="1" Pen="{StaticResource mouseover_pen}" />
         </TextDecorationCollection>
         <Style x:Key="hyperlink_mouse_over" TargetType="Hyperlink">
             <Style.Triggers>