Read script carets without blocking the UI thread

docs/release-notes/.VisualStudio/18.vNext.md

@@ -20,6 +20,7 @@
 * Reduce allocations in the VS project options reactor: the command-line options and project options caches and the mailbox reply payloads now hold struct tuples, and `IProjectSite.CompilationBinOutputPath` returns `string voption` picked with a new `Array.tryPickV`. ([PR #20413](https://github.com/dotnet/fsharp/pull/20413))
 * Build a single-file project's `OtherOptions` reference flags with one array comprehension instead of two `Array.ofSeq` calls and an `Array.append`. ([PR #20499](https://github.com/dotnet/fsharp/pull/20499))
 * Fix syntax coloring being lost for a whole file when one symbol resolves into metadata that could not be read. ([Issue #20269](https://github.com/dotnet/fsharp/issues/20269), [PR #20274](https://github.com/dotnet/fsharp/pull/20274))
+* Fix a hang when the UI thread waits on project options for a script or a file in F# Miscellaneous Files: the project options reactor reads the caret the UI thread publishes instead of asking the UI thread for it, and only for scripts. ([Issue #20522](https://github.com/dotnet/fsharp/issues/20522), [PR #20523](https://github.com/dotnet/fsharp/pull/20523))
 
 ### Changed
 

vsintegration/src/FSharp.Editor/Common/Extensions.fs

@@ -7,15 +7,9 @@ open System
 open System.IO
 open System.Collections.Immutable
 open System.Collections.Generic
-open System.Runtime.InteropServices
 open System.Threading
 open System.Threading.Tasks
 
-open Microsoft.VisualStudio
-open Microsoft.VisualStudio.Shell
-open Microsoft.VisualStudio.Shell.Interop
-open Microsoft.VisualStudio.TextManager.Interop
-
 open Microsoft.CodeAnalysis
 open Microsoft.CodeAnalysis.Text
 open Microsoft.CodeAnalysis.Host
@@ -25,10 +19,6 @@ open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
 
 open Microsoft.VisualStudio.FSharp.Editor
-open Microsoft.VisualStudio.Editor
-open Microsoft.VisualStudio.Text.Editor
-open Microsoft.VisualStudio
-open Microsoft.VisualStudio.OLE.Interop
 
 type private FSharpGlyph = FSharp.Compiler.EditorServices.FSharpGlyph
 type private FSharpRoslynGlyph = Microsoft.CodeAnalysis.ExternalAccess.FSharp.FSharpGlyph
@@ -69,56 +59,6 @@ type Project with
 
     member this.IsFSharp = this.Language = LanguageNames.FSharp
 
-type TextViewEventsHandler
-    (
-        onChangeCaretHandler: (IVsTextView * int * int -> unit) option,
-        onKillFocus: (IVsTextView -> unit) option,
-        onSetFocus: (IVsTextView -> unit) option
-    ) =
-    interface IVsTextViewEvents with
-        member this.OnChangeCaretLine(view: IVsTextView, newline: int, oldline: int) =
-            onChangeCaretHandler
-            |> Option.iter (fun handler -> handler (view, newline, oldline))
-
-        member this.OnChangeScrollInfo
-            (_view: IVsTextView, _iBar: int, _iMinUnit: int, _iMaxUnits: int, _iVisibleUnits: int, _iFirstVisibleUnit: int)
-            =
-            ()
-
-        member this.OnKillFocus(view: IVsTextView) =
-            onKillFocus |> Option.iter (fun handler -> handler (view))
-
-        member this.OnSetBuffer(_view: IVsTextView, _buffer: IVsTextLines) = ()
-
-        member this.OnSetFocus(view: IVsTextView) =
-            onSetFocus |> Option.iter (fun handler -> handler (view))
-
-type ConnectionPointSubscription = System.IDisposable option
-
-// Usage example:
-//  If a handler is None, to not handle that event
-//  let subscription = subscribeToTextViewEvents (textView, onChangeCaretHandler, onKillFocus, onSetFocus)
-//  Unsubscribe using subscription.Dispose()
-let subscribeToTextViewEvents (textView: IVsTextView, onChangeCaretHandler, onKillFocus, onSetFocus) : ConnectionPointSubscription =
-    let handler = TextViewEventsHandler(onChangeCaretHandler, onKillFocus, onSetFocus)
-
-    match textView with
-    | :? IConnectionPointContainer as cpContainer ->
-        let riid = typeof<IVsTextViewEvents>.GUID
-        let mutable cookie = 0u
-
-        match cpContainer.FindConnectionPoint(ref riid) with
-        | null -> None
-        | cp ->
-            Some(
-                cp.Advise(handler, &cookie)
-
-                { new IDisposable with
-                    member _.Dispose() = cp.Unadvise(cookie)
-                }
-            )
-    | _ -> None
-
 type Document with
 
     member this.TryGetLanguageService<'T when 'T :> ILanguageService>() =
@@ -129,32 +69,6 @@ type Document with
             | null -> None
             | languageServices -> languageServices.GetService<'T>() |> Some
 
-    member this.TryGetIVsTextView() : IVsTextView option =
-        match ServiceProvider.GlobalProvider.GetService(typeof<SVsTextManager>) with
-        | :? IVsTextManager as textManager ->
-            // Grab IVsRunningDocumentTable
-            match ServiceProvider.GlobalProvider.GetService(typeof<SVsRunningDocumentTable>) with
-            | :? IVsRunningDocumentTable as rdt ->
-                match rdt.FindAndLockDocument(uint32 _VSRDTFLAGS.RDT_NoLock, this.FilePath) with
-                | hr, _, _, docData, _ when ErrorHandler.Succeeded(hr) && docData <> IntPtr.Zero ->
-                    match Marshal.GetObjectForIUnknown docData with
-                    | :? IVsTextBuffer as ivsTextBuffer ->
-                        match textManager.GetActiveView(0, ivsTextBuffer) with
-                        | hr, vsTextView when ErrorHandler.Succeeded(hr) -> Some vsTextView
-                        | _ -> None
-                    | _ -> None
-                | _ -> None
-            | _ -> None
-        | _ -> None
-
-    member this.TryGetTextViewAndCaretPos() : (IVsTextView * Position) option =
-        match this.TryGetIVsTextView() with
-        | Some textView ->
-            match textView.GetCaretPos() with
-            | hr, line, column when ErrorHandler.Succeeded(hr) -> Some(textView, Position.fromZ line column)
-            | _ -> None
-        | None -> None
-
     member this.IsFSharpScript = isScriptFile this.FilePath
 
     member this.IsFSharpSignatureFile = isSignatureFile this.FilePath

vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj

@@ -50,6 +50,7 @@
     <Compile Include="LanguageService\ProvideBraceCompletionAttribute.fs" />
     <Compile Include="LanguageService\FSharpEditorFactory.fs" />
     <Compile Include="LanguageService\TextViewCreationListener.fs" />
+    <Compile Include="LanguageService\FocusedCaret.fs" />
     <Compile Include="LanguageService\Tokenizer.fs" />
     <Compile Include="LanguageService\Symbols.fs" />
     <Compile Include="LanguageService\IProjectSite.fs" />

vsintegration/src/FSharp.Editor/LanguageService/FSharpProjectOptionsManager.fs

@@ -20,7 +20,6 @@ open Microsoft.VisualStudio.FSharp.Editor.Extensions
 open System.Windows
 open Microsoft.VisualStudio
 open FSharp.Compiler.Text
-open Microsoft.VisualStudio.TextManager.Interop
 
 #nowarn "57"
 
@@ -129,7 +128,7 @@ type private FSharpProjectOptionsReactor(checker: FSharpChecker) =
         ConcurrentDictionary<ProjectId, struct (Project * FSharpParsingOptions * FSharpProjectOptions)>()
 
     let singleFileCache =
-        ConcurrentDictionary<DocumentId, Project * VersionStamp * FSharpParsingOptions * FSharpProjectOptions * ConnectionPointSubscription>()
+        ConcurrentDictionary<DocumentId, Project * VersionStamp * FSharpParsingOptions * FSharpProjectOptions * IDisposable option>()
 
     // This is used to not constantly emit the same compilation.
     let weakPEReferences = ConditionalWeakTable<Compilation, FSharpReferencedProject>()
@@ -204,36 +203,29 @@ type private FSharpProjectOptionsReactor(checker: FSharpChecker) =
         cancellableTask {
             let! ct = CancellableTask.getCancellationToken ()
             let! fileStamp = document.GetTextVersionAsync(ct)
-            let textViewAndCaret () : (IVsTextView * Position) option = document.TryGetTextViewAndCaretPos()
 
             match singleFileCache.TryGetValue(document.Id) with
             | false, _ ->
                 let! sourceText = document.GetTextAsync(ct)
 
-                let getProjectOptionsFromScript textViewAndCaret =
-                    let caret = textViewAndCaret ()
-
-                    match caret with
-                    | None ->
-                        checker.GetProjectOptionsFromScript(
-                            document.FilePath,
-                            sourceText.ToFSharpSourceText(),
-                            previewEnabled = SessionsProperties.fsiPreview,
-                            assumeDotNetFramework = not SessionsProperties.fsiUseNetCore,
-                            userOpName = userOpName
-                        )
-
-                    | Some(_, caret) ->
-                        checker.GetProjectOptionsFromScript(
-                            document.FilePath,
-                            sourceText.ToFSharpSourceText(),
-                            caret,
-                            previewEnabled = SessionsProperties.fsiPreview,
-                            assumeDotNetFramework = not SessionsProperties.fsiUseNetCore,
-                            userOpName = userOpName
-                        )
-
-                let! scriptProjectOptions, _ = getProjectOptionsFromScript textViewAndCaret
+                // FCS reads the caret only to skip resolving the `#r "nuget: …"` line being typed, and only scripts have those.
+                let focusedCaret =
+                    if isScriptFile document.FilePath then
+                        FocusedCaret.TryGet sourceText
+                    else
+                        ValueNone
+
+                let getProjectOptionsFromScript () =
+                    checker.GetProjectOptionsFromScript(
+                        document.FilePath,
+                        sourceText.ToFSharpSourceText(),
+                        ?caret = (focusedCaret |> ValueOption.toOption |> Option.bind _.Position),
+                        previewEnabled = SessionsProperties.fsiPreview,
+                        assumeDotNetFramework = not SessionsProperties.fsiUseNetCore,
+                        userOpName = userOpName
+                    )
+
+                let! scriptProjectOptions, _ = getProjectOptionsFromScript ()
                 let project = document.Project
 
                 let otherOptions =
@@ -270,25 +262,20 @@ type private FSharpProjectOptionsReactor(checker: FSharpChecker) =
 
                 let updateProjectOptions () =
                     async {
-                        let! scriptProjectOptions, _ = getProjectOptionsFromScript textViewAndCaret
+                        let! scriptProjectOptions, _ = getProjectOptionsFromScript ()
 
                         checker.NotifyFileChanged(document.FilePath, scriptProjectOptions)
                         |> Async.Start
                     }
                     |> Async.Start
 
-                let onChangeCaretHandler (_, _newline: int, _oldline: int) = updateProjectOptions ()
-                let onKillFocus (_) = updateProjectOptions ()
-                let onSetFocus (_) = updateProjectOptions ()
-
                 let addToCacheAndSubscribe value =
                     match value with
                     | projectId, fileStamp, parsingOptions, projectOptions, _ ->
                         let subscription =
-                            match textViewAndCaret () with
-                            | Some(textView, _) ->
-                                subscribeToTextViewEvents (textView, (Some onChangeCaretHandler), (Some onKillFocus), (Some onSetFocus))
-                            | None -> None
+                            focusedCaret
+                            |> ValueOption.map _.LineChanged.Subscribe(updateProjectOptions)
+                            |> ValueOption.toOption
 
                         (projectId, fileStamp, parsingOptions, projectOptions, subscription)
 

vsintegration/src/FSharp.Editor/LanguageService/FocusedCaret.fs

@@ -0,0 +1,79 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace Microsoft.VisualStudio.FSharp.Editor
+
+open System.ComponentModel.Composition
+
+open Microsoft.CodeAnalysis.Text
+open Microsoft.VisualStudio.Text.Editor
+open Microsoft.VisualStudio.Utilities
+
+open FSharp.Compiler.Text
+
+/// The caret of the focused editor on a text buffer, published by the UI thread for the project options
+/// reactor: the UI thread can be blocked waiting for the reactor, so the reactor must never wait for it.
+[<Sealed>]
+type internal FocusedCaret() =
+
+    // A reference, not an option: the reactor reads it while the UI thread writes, and must never see a torn struct.
+    [<VolatileField>]
+    let mutable position: Position option = None
+
+    let lineChanged = Event<unit>()
+
+    /// None while no editor on the buffer has focus.
+    member _.Position = position
+
+    /// Raised on the UI thread when the caret moves to another line, or focus enters or leaves the buffer's editors.
+    member _.LineChanged = lineChanged.Publish
+
+    member _.Update(newPosition: Position option) =
+        let hasLineChanged =
+            (position |> Option.map _.Line) <> (newPosition |> Option.map _.Line)
+
+        position <- newPosition
+
+        if hasLineChanged then
+            lineChanged.Trigger()
+
+    static member TryGet(sourceText: SourceText) =
+        match sourceText.Container.TryGetTextBuffer() with
+        | null -> ValueNone
+        | buffer ->
+            match buffer.Properties.TryGetProperty<FocusedCaret>(typeof<FocusedCaret>) with
+            | true, caret -> ValueSome caret
+            | _ -> ValueNone
+
+[<Export(typeof<IWpfTextViewCreationListener>)>]
+[<ContentType(FSharpConstants.FSharpContentTypeName)>]
+[<TextViewRole(PredefinedTextViewRoles.Editable)>]
+type internal FocusedCaretTracker() =
+
+    let caretOf (textView: ITextView) =
+        let caret = textView.Caret.Position.BufferPosition
+        let line = caret.GetContainingLine()
+        Position.fromZ line.LineNumber (caret.Position - line.Start.Position)
+
+    interface IWpfTextViewCreationListener with
+        member _.TextViewCreated(textView) =
+            let focusedCaret =
+                textView.TextBuffer.Properties.GetOrCreateSingletonProperty(fun () -> FocusedCaret())
+
+            let publish _ =
+                focusedCaret.Update(Some(caretOf textView))
+
+            let subscriptions =
+                [
+                    textView.Caret.PositionChanged.Subscribe(fun _ ->
+                        if textView.HasAggregateFocus then
+                            publish ())
+                    textView.GotAggregateFocus.Subscribe publish
+                    textView.LostAggregateFocus.Subscribe(fun _ -> focusedCaret.Update None)
+                ]
+
+            if textView.HasAggregateFocus then
+                publish ()
+
+            textView.Closed.Add(fun _ ->
+                for subscription in subscriptions do
+                    subscription.Dispose())