Support static member and constructor intelligence for R6, S4 and S7

.github/workflows/s7-compatibility.yml

@@ -0,0 +1,50 @@
+name: S7 compatibility
+
+on:
+  pull_request:
+    branches: [master]
+  push:
+    branches: [master]
+
+permissions: read-all
+
+concurrency:
+  group: ${{ github.workflow }}-${{ github.head_ref || github.run_id }}
+  cancel-in-progress: true
+
+jobs:
+  s7-compatibility:
+    runs-on: ubuntu-latest
+    name: S7 (${{ matrix.s7 }})
+    strategy:
+      fail-fast: false
+      matrix:
+        s7: [stable, development]
+    env:
+      NOT_CRAN: true
+      TESTTHAT_CPUS: 1
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v7
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          r-version: release
+          use-public-rspm: true
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::remotes
+      - name: Install stable S7
+        if: matrix.s7 == 'stable'
+        run: remotes::install_version("S7", version = "0.2.2", upgrade = "never")
+        shell: Rscript {0}
+      - name: Install pinned S7 1.0 development revision
+        if: matrix.s7 == 'development'
+        run: remotes::install_github("RConsortium/S7@021846758e5d4520a56330d477066c25bd46d4f9", upgrade = "never")
+        shell: Rscript {0}
+      - name: Install languageserver
+        run: R CMD INSTALL .
+      - name: Test member providers
+        run: |
+          message("Testing S7 ", packageVersion("S7"))
+          testthat::test_local(filter = "^member-", load_package = "installed", reporter = "summary")
+        shell: Rscript {0}

DESCRIPTION

@@ -39,13 +39,16 @@ Imports:
 Suggests:
     covr (>= 3.4.0),
     magrittr (>= 1.5),
+    methods,
     mockery (>= 0.4.2),
     pacman,
     processx (>= 3.4.1),
     purrr (>= 0.3.3),
     testthat (>= 2.1.0),
     withr (>= 2.3.0),
     rmarkdown (>= 2.0),
+    S7,
+    stats4,
     stringr
 ByteCompile: yes
 Encoding: UTF-8

NEWS.md

@@ -1,5 +1,25 @@
 # languageserver 0.3.20
 
+- Complete chained `$` members using static receiver analysis, including source
+  list/environment factories, declarative R6 classes and package method
+  registries. Package metadata is prepared in a background worker; completion
+  never calls document expressions, constructors, methods or active getters.
+- Use the same static member inference for signature help and hover, including
+  chained methods and named argument documentation. Member requests wait for the
+  current parse after edits, fixing stale completions on the first `$` trigger.
+- Resolve member names across line breaks and infer `self`, `super` and
+  `private` inside supported R6 methods for completion, hover and signatures.
+- Complete S4 `@` slots from source declarations and installed class metadata,
+  including inheritance, aliases and factory results. Show slot types on hover
+  and signatures for slots whose function definitions are known statically.
+- Complete S7 `@` properties and constructor arguments from source declarations
+  and installed descriptors, with constructor/property hover and signatures.
+  Infer inheritance, nested properties and supported custom constructors
+  without calling constructors, getters, setters, validators or defaults.
+  Follow installed S7 constructor semantics, including 1.0 development class
+  references, forwarding constructors, named bindings, list property updates,
+  external class references, S4 parents and deprecation declarations.
+
 - Run full-document, range, and multiple-range formatting in a lazy, cancellable
   background worker so other editor requests remain responsive during formatting (#764, #251).
 - Stabilize diagnostics for Quarto and R Markdown documents by preserving

R/capabilities.R

@@ -18,7 +18,7 @@
 
 CompletionOptions <- list(
     resolveProvider = TRUE,
-    triggerCharacters = list(".", ":")
+    triggerCharacters = list(".", ":", "$", "@")
 )
 
 SignatureHelpOptions <- list(
@@ -120,7 +120,7 @@
     # RenameOptions may only be specified if the client states that
     # it supports prepareSupport in its initial initialize request
     if (isTRUE(server_capabilities$renameProvider) &&
         isTRUE(client_capabilities$textDocument$rename$prepareSupport)) {
         server_capabilities$renameProvider <- RenameOptions
     }
 

R/completion.R

@@ -400,7 +400,7 @@
                 data = list(
                     type = "function",
                     package = nsname
             ))
         })
     } else {
         completions <- lapply(functs, function(object) {
@@ -411,7 +411,7 @@
                 data = list(
                     type = "function",
                     package = nsname
             ))
         })
     }
     completions
@@ -441,7 +441,7 @@
                     data = list(
                         type = "function",
                         package = nsname
                 ))
             } else {
                 item <- list(label = object,
                     kind = CompletionItemKind$Function,
@@ -450,7 +450,7 @@
                     data = list(
                         type = "function",
                         package = nsname
                 ))
             }
             idx <- idx + 1L
             completions[[idx]] <- item
@@ -898,7 +898,7 @@
 #' The response to a textDocument/completion request
 #' @noRd
 completion_reply <- function(id, uri, workspace, document, point, capabilities) {
-    if (!check_scope(uri, document, point)) {
+    if (!check_scope(uri, document, point) && is.null(member_cursor(document, point))) {
         return(Response$new(
             id,
             result = list(
@@ -911,6 +911,15 @@
     snippet_support <- isTRUE(capabilities$completionItem$snippetSupport) &&
         lsp_settings$get("snippet_support")
     nmax <- lsp_settings$get("max_completions")
+    if (isTRUE(lsp_settings$get("member_completion"))) {
+        members <- tryCatch(member_completion(uri, workspace, document, point,
+            snippet_support, nmax), error = function(e) {
+                logger$info("static member completion:", e)
+                NULL
+            })
+        if (!is.null(members)) return(Response$new(id, result = list(
+            isIncomplete = isTRUE(attr(members, "truncated")), items = unname(members))))
+    }
 
     token_result <- document$detect_token(point, forward = FALSE)
 
@@ -946,12 +955,15 @@
     if (token_result$accessor == "") {
         call_result <- document$detect_call(point)
         if (nzchar(call_result$token)) {
+            constructor_args <- if (isTRUE(lsp_settings$get("member_completion"))) {
+                member_constructor_arguments(uri, workspace, document, point, token)
+            }
             completions <- c(
                 completions,
-                arg_completion(uri, workspace, point, token,
+                if (!is.null(constructor_args)) constructor_args else arg_completion(uri, workspace, point, token,
                     call_result$token, call_result$package,
                     exported_only = call_result$accessor != ":::"),
-                arg_value_completion(uri, workspace, document, point, token,
+                if (is.null(constructor_args)) arg_value_completion(uri, workspace, document, point, token,
                     call_result$token, call_result$package,
                     exported_only = call_result$accessor != ":::"))
         }
@@ -1006,7 +1018,19 @@
     resolved <- FALSE
     if (is.null(params$data) || is.null(params$data$type)) {
     } else {
-        if (params$data$type == "package") {
+        if (params$data$type == "member") {
+            if (isTRUE(capabilities$completionItem$labelDetailsSupport) &&
+                    !is.null(params$data$signature)) params$labelDetails <- list(
+                detail = substring(params$data$signature, nchar(params$label) + 1L))
+            if (!is.null(params$data$package) && is.character(params$data$function_id) &&
+                    length(params$data$function_id) == 1L && !is.na(params$data$function_id)) {
+                doc <- workspace$get_documentation(params$data$function_id,
+                    params$data$package, isf = TRUE, uri = params$data$context_uri)
+                if (is.list(doc) && !is.null(doc$description)) params$documentation <- list(
+                    kind = "markdown", value = doc$description)
+            }
+            resolved <- TRUE
+        } else if (params$data$type == "package") {
             if (length(find.package(params$label, quiet = TRUE))) {
                 desc <- utils::packageDescription(params$label, fields = c("Title", "Description"))
                 description <- gsub("\\s*\n\\s*", " ", desc$Description)

R/document.R

@@ -13,6 +13,7 @@ Document <- R6::R6Class(
         regions = NULL,
         loaded_packages = NULL,
         requested_packages = NULL,
+        member_refresh = FALSE,
         pending_diagnostics = FALSE,
         diagnostics_delay = 0,
 
@@ -153,7 +154,8 @@ Document <- R6::R6Class(
                 full_token = result$full_token,
                 package = result$package,
                 accessor = result$accessor,
-                token = result$token
+                token = result$token,
+                opening = list(row = loc[[1L]], col = loc[[2L]])
             )
         },
 
@@ -568,6 +570,7 @@ parse_document <- function(uri, content, is_rmarkdown = FALSE,
         env$xml_data <- NULL
         env$xml_doc <- NULL
         env$completion_data <- completion_parse_data(NULL)
+        env$member_data <- NULL
         env$semantic_data <- empty_semantic_data()
         env$range_data <- range_provider_parse_data(NULL, content)
         env$source_specs <- list()
@@ -632,6 +635,7 @@ parse_document <- function(uri, content, is_rmarkdown = FALSE,
 
         env$packages <- basename(find.package(env$packages, quiet = TRUE))
         data <- utils::getParseData(expr)
+        env$member_data <- member_document_index(content, expr)
         env$completion_data <- completion_parse_data(data)
         env$semantic_data <- semantic_parse_data(data, content)
         env$range_data <- range_provider_parse_data(data, content)
@@ -648,6 +652,7 @@ parse_document <- function(uri, content, is_rmarkdown = FALSE,
         # Keep the parse version current even while the user is typing an
         # incomplete expression. Providers can now return an empty result
         # instead of leaving requests queued until some later valid version.
+        env$member_data <- member_document_index(content)
         env$parse_error <- TRUE
         env$xml_data <- paste0(
             "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\" ?>\n",
@@ -709,8 +714,9 @@ parse_callback <- function(self, uri, version, parse_data) {
 
     if (!isTRUE(parse_data$parse_error)) {
         requested_packages <- normalize_package_request(parse_data$packages)
-        if (is.null(previous_packages) ||
+        if (is.null(previous_packages) || isTRUE(doc$member_refresh) ||
                 !identical(previous_packages, requested_packages)) {
+            doc$member_refresh <- FALSE
             doc$requested_packages <- requested_packages
             self$resolve_task_manager$add_task(
                 uri,
@@ -787,6 +793,18 @@ parse_task <- function(self, uri, document, delay = 0) {
 resolve_callback <- function(self, uri, version, packages) {
     workspace <- self$get_workspace(uri)
     if (!workspace$documents$has(uri)) return(NULL)
+    doc <- workspace$documents$get(uri)
+    if (!identical(doc$version, version) &&
+            !(is.list(packages) && !is.null(packages$requested) &&
+                identical(doc$requested_packages, packages$requested))) return(NULL)
+    if (is.list(packages) && !is.null(packages$members)) {
+        for (package in names(packages$members)) {
+            snapshot <- packages$members[[package]]
+            index <- member_index_thaw(snapshot)
+            if (!is.null(index)) workspace$member_metadata$set(package, as.list(index))
+        }
+        packages <- packages$packages
+    }
     logger$info("resolve_callback called:", list(uri = uri, version = version))
     workspace$load_packages(packages)
     doc <- workspace$documents$get(uri)
@@ -797,10 +815,12 @@ resolve_callback <- function(self, uri, version, packages) {
 resolve_task <- function(self, uri, document, packages, delay = 0) {
     version <- document$version
     create_task(
-        target = resolve_attached_packages,
-        args = list(pkgs = packages),
+        target = package_call(member_resolve_packages),
+        args = list(pkgs = packages, lib_paths = .libPaths(),
+            prepare = isTRUE(lsp_settings$get("member_completion"))),
         callback = function(result) resolve_callback(self, uri, version, result),
         error = function(e) logger$info("resolve_task:", e),
-        delay = 0
+        delay = delay,
+        profiles = FALSE
     )
 }

R/handlers-langfeatures.R

@@ -30,6 +30,18 @@ text_document_completion  <- function(self, id, params) {
     document <- workspace$documents$get(uri)
     if (is.null(document)) return(self$deliver(Response$new(id = id, result = NULL)))
     point <- document$from_lsp_position(params$position)
+    # didChange schedules a debounced background parse. A member request can
+    # arrive immediately after the edit; falling back then uses stale tokens
+    # and the client keeps that list until another completion is triggered.
+    if (isTRUE(lsp_settings$get("member_completion")) &&
+        !identical(document$version, document$parse_data$version) &&
+        (!is.null(member_cursor(document, point)) ||
+                    !is.null(member_call_location(document, point, symbols = TRUE)))) {
+        enqueue_latest_reply(self, uri, "textDocument/completion", list(
+            id = id, version = document$version, params = params
+        ))
+        return(invisible(NULL))
+    }
     self$deliver(completion_reply(id, uri, workspace, document, point,
         self$ClientCapabilities$textDocument$completion))
 }
@@ -41,6 +53,7 @@ text_document_completion  <- function(self, id, params) {
 completion_item_resolve  <- function(self, id, params) {
     # Resolve uri from completion item if possible
     uri <- params$data$uri
+    if (is.null(uri)) uri <- params$data$context_uri
     if (is.null(uri)) uri <- params$data$textDocument$uri
     workspace <- self$get_workspace(uri)
 
@@ -60,6 +73,16 @@ text_document_hover  <- function(self, id, params) {
     document <- workspace$documents$get(uri)
     if (is.null(document)) return(self$deliver(Response$new(id = id, result = NULL)))
     point <- document$from_lsp_position(params$position)
+    if (isTRUE(lsp_settings$get("member_completion")) &&
+        !identical(document$version, document$parse_data$version) &&
+        (!is.null(member_hover_location(document, point)) ||
+                    !is.null(member_argument_location(document, point, symbols = TRUE)) ||
+                    !is.null(member_symbol_location(document, point)))) {
+        enqueue_latest_reply(self, uri, "textDocument/hover", list(
+            id = id, version = document$version, params = params
+        ))
+        return(invisible(NULL))
+    }
     self$deliver(hover_reply(id, uri, workspace, document, point))
 }
 
@@ -75,6 +98,14 @@ text_document_signature_help  <- function(self, id, params) {
     document <- workspace$documents$get(uri)
     if (is.null(document)) return(self$deliver(Response$new(id = id, result = NULL)))
     point <- document$from_lsp_position(params$position)
+    if (isTRUE(lsp_settings$get("member_completion")) &&
+        !identical(document$version, document$parse_data$version) &&
+        !is.null(member_call_location(document, point, symbols = TRUE))) {
+        enqueue_latest_reply(self, uri, "textDocument/signatureHelp", list(
+            id = id, version = document$version, params = params
+        ))
+        return(invisible(NULL))
+    }
     self$deliver(signature_reply(id, uri, workspace, document, point))
 }
 

R/handlers-textsync.R

@@ -144,6 +144,7 @@ text_document_did_save <- function(self, params) {
             message = "Request superseded by updated document content")
     }
     doc$set_content(doc$version, content)
+    doc$member_refresh <- isTRUE(lsp_settings$get("member_completion"))
     doc$did_open()
     update_document_index(
         self, workspace, uri, doc$content, cacheable = TRUE)

R/hover.R

@@ -18,17 +18,20 @@ function_argument_hover_contents <- function(workspace, funct, package, paramete
             funct, package, isf = TRUE, uri = uri)
     }
     if (!is.list(doc)) return(NULL)
+    sig <- if (is.null(uri)) workspace$get_signature(funct, package)
+    else call_with_optional_uri(
+        workspace$get_signature, funct, package, uri = uri)
+    argument_hover_contents(doc, sig, parameter)
+}
 
+argument_hover_contents <- function(doc, sig, parameter) {
+    if (!is.list(doc)) return(NULL)
     doc_string <- doc$arguments[[parameter]]
     if (is.null(doc_string)) {
         doc_string <- doc$arguments$...
         parameter <- "..."
     }
     if (is.null(doc_string)) return(NULL)
-
-    sig <- if (is.null(uri)) workspace$get_signature(funct, package)
-    else call_with_optional_uri(
-        workspace$get_signature, funct, package, uri = uri)
     if (is.null(sig)) return(doc_string)
 
     c(
@@ -43,6 +46,18 @@ function_argument_hover_contents <- function(workspace, funct, package, paramete
 #' if it exists in the current [Workspace].
 #' @noRd
 hover_reply <- function(id, uri, workspace, document, point) {
+    if (isTRUE(lsp_settings$get("member_completion"))) {
+        location <- member_hover_location(document, point)
+        if (is.null(location)) location <- member_argument_location(document, point)
+        if (!is.null(location)) {
+            return(member_hover_reply(id, uri, workspace, document, location))
+        }
+        location <- member_argument_location(document, point, symbols = TRUE)
+        if (is.null(location)) location <- member_symbol_location(document, point)
+        if (!is.null(member_constructor_symbol(uri, workspace, document, location))) {
+            return(member_hover_reply(id, uri, workspace, document, location))
+        }
+    }
     if (!check_scope(uri, document, point)) {
         return(Response$new(id))
     }

R/languageserver.R

@@ -332,6 +332,9 @@ LanguageServer <- R6::R6Class("LanguageServer",
             diagnostics_delay = delay) {
             if (!self$pending_replies$has(uri)) {
                 self$pending_replies$set(uri, list(
+                    `textDocument/completion` = collections::queue(),
+                    `textDocument/hover` = collections::queue(),
+                    `textDocument/signatureHelp` = collections::queue(),
                     `textDocument/documentSymbol` = collections::queue(),
                     `textDocument/foldingRange` = collections::queue(),
                     `textDocument/documentLink` = collections::queue(),