Fix language-feature edge cases and speed up member preparation

NEWS.md

@@ -8,6 +8,38 @@
   Isolate provider tests from installed packages and startup worker timing while
   retaining real workspace/index coverage and conservative S3 precedence (#827).
 
+- Prepare member metadata with indexed namespace function matching and direct
+  eviction of unprotected cache entries, preserving exact identities, LRU order
+  and memory limits.
+- Coalesce repeated member refreshes: queued work is promoted and running work
+  finishes before one fresh validation, instead of restarting on every save.
+  Changed document, workspace and package contexts still replace obsolete work.
+- Split debug task timings into total, queued and running time using the elapsed
+  clock. Redact common credential variables from the debug session header.
+
+- Keep numeric and string request IDs distinct during cancellation, background
+  formatting and response dispatch. Normalize equivalent numeric IDs across
+  their integer and double representations.
+- Discover sourced files inside computed callees, including immediately invoked
+  anonymous functions, without evaluating project expressions. Refresh older
+  workspace-index caches so unchanged files recover these dependencies.
+
+- Keep argument-value completion working with namespace-qualified default
+  helpers and missing arguments. Escape suggested string literals so quotes,
+  backslashes and newlines retain their original values.
+- Preserve quoted symbol identity and complete ranges in definitions,
+  references, highlights and rename, including multiline names with Unicode.
+  Quote nonsyntactic replacement names and exclude shadowed local calls from
+  workspace function CodeLens counts.
+- Decode raw strings and escaped class, slot and member names in type hierarchy
+  and class member symbols without evaluating declarations.
+- Restart pending parses and refresh diagnostics when documents move between
+  workspace folders. Restore saved package content after closing an unsaved
+  buffer with workspace indexing disabled.
+- Reduce repeated copying during default extraction and rename edit creation,
+  invalidate pending disk snapshots once per edit, and share one UTF-8 byte
+  index across each CLI diagnostic batch.
+
 # languageserver 0.3.21
 
 - Preserve member completion for Polars conversions such as

R/backend-cli.R

@@ -58,17 +58,24 @@ backend_cli_failure <- function(request, result) {
             result$status, if (nzchar(detail)) paste0(": ", detail) else "."))
 }
 
-#' Convert half-open UTF-8 byte offsets against the submitted buffer
+#' Index the submitted buffer once for all CLI diagnostics
 #' @noRd
-backend_byte_range <- function(content, offsets) {
+backend_byte_index <- function(content) {
     bytes <- charToRaw(enc2utf8(paste(content, collapse = "\n")))
+    list(bytes = bytes, starts = c(0L, which(bytes == as.raw(10L))))
+}
+
+#' Convert half-open UTF-8 byte offsets against the submitted buffer
+#' @noRd
+backend_byte_range <- function(content, offsets, index = backend_byte_index(content)) {
+    bytes <- index$bytes
     offsets <- unlist(offsets, use.names = FALSE)
     if (!is.numeric(offsets) || length(offsets) != 2L || anyNA(offsets) ||
             any(!is.finite(offsets)) || any(offsets != floor(offsets)) ||
             offsets[[1L]] < 0 || offsets[[2L]] < offsets[[1L]] || offsets[[2L]] > length(bytes)) {
         backend_error("CLI diagnostic contains an invalid byte range.")
     }
-    starts <- c(0L, which(bytes == as.raw(10L)))
+    starts <- index$starts
     positions <- lapply(offsets, function(offset) {
         line <- findInterval(offset, starts) - 1L
         start <- starts[[line + 1L]]
@@ -111,11 +118,12 @@ jarl_diagnostics <- function(request) {
             !is.list(output$diagnostics) || !is.list(output$errors)) {
         backend_error("Jarl JSON must contain diagnostics and errors arrays.")
     }
+    index <- if (length(output$diagnostics) || length(output$errors)) backend_byte_index(request$content)
     diagnostics <- lapply(output$diagnostics, function(item) {
         if (!is.list(item) || !backend_string(item$message$body) || !backend_string(item$message$name)) {
             backend_error("Jarl returned an invalid diagnostic.")
         }
-        list(range = backend_byte_range(request$content, item$range),
+        list(range = backend_byte_range(request$content, item$range, index),
             severity = DiagnosticSeverity$Warning, source = "jarl",
             code = item$message$name, message = item$message$body,
             codeDescription = list(href = paste0("https://jarl.etiennebacher.com/rules/", item$message$name)))
@@ -130,7 +138,7 @@ jarl_diagnostics <- function(request) {
         for (syntax in error$syntax_errors) {
             if (!backend_string(syntax$message)) backend_error("Jarl returned an invalid syntax error.")
             diagnostics[[length(diagnostics) + 1L]] <- list(
-                range = backend_byte_range(request$content, syntax$range),
+                range = backend_byte_range(request$content, syntax$range, index),
                 severity = DiagnosticSeverity$Error, source = "jarl", message = syntax$message)
         }
     }

R/class_index.R

@@ -5,6 +5,22 @@ class_index_key <- function(type, name) paste(type, name, sep = "\r")
 class_xml_first <- function(node, xpath) xml_find_first(node, xpath, ns = character())
 class_xml_all <- function(node, xpath) xml_find_all(node, xpath, ns = character())
 
+#' Decode inert class names and member names using R literal syntax
+#' @noRd
+class_token_text <- function(text) {
+    quoted <- grep("^[\"'`]|^[rR][\"']", text)
+    if (!length(quoted)) return(text)
+    spellings <- unique(text[quoted])
+    decoded <- vapply(spellings, function(value) {
+        literal <- tryCatch(str2lang(value), error = function(e) NULL)
+        if (is.symbol(literal)) as.character(literal)
+        else if (is.character(literal) && length(literal) == 1L) literal
+        else value
+    }, character(1L), USE.NAMES = FALSE)
+    text[quoted] <- decoded[match(text[quoted], spellings)]
+    text
+}
+
 # Match inert argument indices, retaining each value's original XML location.
 # This gives class providers R's named/positional matching without evaluating
 # declarations, and keeps piped names and placeholders at their source ranges.
@@ -68,7 +84,7 @@ class_xml_index <- function(xdoc) {
     functions <- c("R6Class", "setClass", "setRefClass", "setMethod")
     result <- stats::setNames(vector("list", length(functions)), functions)
     unquote <- function(node) {
-        if (length(node)) gsub('["\047`]', "", xml_text(node)) else character()
+        if (length(node)) class_token_text(xml_text(node)) else character()
     }
     for (fun in functions) {
         calls <- class_xml_all(xdoc, paste0("//SYMBOL_FUNCTION_CALL[text() = '", fun,
@@ -84,20 +100,20 @@ class_xml_index <- function(xdoc) {
                 param <- class_xml_argument(call, "inherit")
                 symbol <- class_xml_first(param, "./SYMBOL | ./expr//SYMBOL")
                 if (length(symbol)) {
-                    parents[[i]] <- xml_text(symbol)
+                    parents[[i]] <- class_token_text(xml_text(symbol))
                 } else {
                     string <- class_xml_first(param, "./STR_CONST | ./expr//STR_CONST")
                     parents[[i]] <- unquote(if (length(string)) string else param)
                 }
             } else {
                 names[[i]] <- if (fun == "setMethod") {
                     strings <- class_xml_all(class_xml_argument(call, "signature"), ".//STR_CONST")
-                    gsub('["\047`]', "", xml_text(strings))
+                    class_token_text(xml_text(strings))
                 } else {
                     unquote(class_xml_name(call))
                 }
                 param <- class_xml_argument(call, "contains")
-                parents[[i]] <- gsub('["\047`]', "", xml_text(class_xml_all(param, ".//STR_CONST")))
+                parents[[i]] <- class_token_text(xml_text(class_xml_all(param, ".//STR_CONST")))
             }
         }
         groups <- function(values) {

R/code_lens.R

@@ -3,16 +3,17 @@
 current_parse_data <- function(uri, workspace, document) {
     parse_data <- workspace$get_parse_data(uri)
     if (is.null(parse_data) ||
-        (!is.null(parse_data$version) &&
-            !isTRUE(parse_data$version == document$version))) {
+            (!is.null(parse_data$version) &&
+                    !isTRUE(parse_data$version == document$version))) {
         return(NULL)
     }
     parse_data
 }
 
 #' Find calls to a workspace function without resolving every symbol
 #' @noRd
-function_call_locations <- function(workspace, symbol, context_uri = NULL) {
+function_call_locations <- function(workspace, symbol, context_uri = NULL,
+    definition_key = paste0("global:", symbol)) {
     token_quote <- xml_single_quote(symbol)
     locations <- list()
 
@@ -23,7 +24,7 @@ function_call_locations <- function(workspace, symbol, context_uri = NULL) {
         parse_data <- workspace$get_parse_data(doc_uri)
         indexed <- parse_data$reference_index
         if (!is.null(indexed)) {
-            selected <- reference_indices(indexed, symbol)
+            selected <- reference_indices(indexed, symbol, definition_key)
             selected <- selected[indexed$token[selected] == "SYMBOL_FUNCTION_CALL" &
                     !indexed$qualified_call[selected]]
             if (length(selected)) {
@@ -44,7 +45,7 @@ function_call_locations <- function(workspace, symbol, context_uri = NULL) {
                 "not(preceding-sibling::NS_GET or ",
                 "preceding-sibling::NS_GET_INT)]"
             ),
-                token_quote = token_quote)
+            token_quote = token_quote)
         )
         if (!length(nodes)) next
 

R/completion.R

@@ -206,29 +206,33 @@
         return(NULL)
     }
 
-    # If it's a call to c(), extract the arguments
-    if (is.call(default_expr) && length(default_expr) > 1) {
-        func_name <- as.character(default_expr[[1]])
-
-        if (identical(func_name, "c")) {
-            # Extract all arguments to c()
-            values <- character(0)
-            for (i in seq(2, length(default_expr))) {
-                arg <- default_expr[[i]]
-                # Only handle character literals
-                if (is.character(arg)) {
-                    values <- c(values, arg)
-                } else if (is.call(arg) && as.character(arg[[1]]) %in% c("I")) {
-                    # Handle I("value")
-                    if (length(arg) > 1 && is.character(arg[[2]])) {
-                        values <- c(values, arg[[2]])
-                    }
-                }
-            }
-            if (length(values) > 0) {
-                return(values)
+    literal_call <- function(expr, name) {
+        if (!is.call(expr)) return(FALSE)
+        head <- expr[[1L]]
+        if (is.symbol(head)) return(identical(as.character(head), name))
+        # Namespace-qualified calls have a language object as their head.
+        # Recognize only the base helpers and never evaluate other callees.
+        is.call(head) && length(head) == 3L &&
+            identical(head[[1L]], quote(`::`)) &&
+            identical(head[[2L]], quote(base)) && identical(head[[3L]], as.name(name))
+    }
+    if (literal_call(default_expr, "c") && length(default_expr) > 1L) {
+        # Language objects use pairlists; repeated [[i]] also walks/copies the
+        # argument chain. Convert once and collect literals before flattening.
+        args <- as.list(default_expr)[-1L]
+        values <- vector("list", length(args))
+        for (i in seq_along(args)) {
+            if (identical(args[[i]], quote(expr = ))) next
+            arg <- args[[i]]
+            if (is.character(arg)) {
+                values[[i]] <- arg
+            } else if (literal_call(arg, "I") && length(arg) == 2L &&
+                    !identical(arg[[2L]], quote(expr = )) && is.character(arg[[2L]])) {
+                values[[i]] <- arg[[2L]]
             }
         }
+        values <- unlist(values, use.names = FALSE)
+        if (length(values)) return(values)
     }
 
     # If it's a simple string, return it
@@ -267,9 +271,11 @@
 
     default_value <- formals_list[[arg_name]]
 
-    # Extract possible values from the default
-    values <- extract_default_values(default_value)
-
+    argument_value_items(extract_default_values(default_value), funct, package,
+        arg_name, token, uri)
+}
+
+argument_value_items <- function(values, funct, package, arg_name, token, uri) {
     if (is.null(values) || length(values) == 0) {
         return(list())
     }
@@ -284,7 +290,7 @@
             kind = CompletionItemKind$Value,
             detail = paste0("value for ", arg_name),
             sortText = paste0(sort_prefixes$arg, value),
-            insertText = sprintf('"%s"', value),
+            insertText = encodeString(value, quote = "\""),
             insertTextFormat = InsertTextFormat$PlainText,
             data = list(
                 type = "argument_value",
@@ -320,24 +326,13 @@
 
     # Get all parameters with character vector defaults
     param_names <- names(formals_list)
-    all_completions <- list()
-
-    for (param_name in param_names) {
-        values <- extract_default_values(formals_list[[param_name]])
-        if (!is.null(values) && length(values) > 0) {
-            # Filter values that match the current token
-            matching_values <- values[match_with(values, token)]
-            if (length(matching_values) > 0) {
-                # Generate completions for this parameter
-                param_completions <- argument_value_completion(
-                    workspace, funct, package_for_call, param_name, token,
-                    exported_only, formals_list, uri = uri)
-                all_completions <- c(all_completions, param_completions)
-            }
-        }
-    }
-
-    all_completions
+    if (is.null(param_names)) return(list())
+    all_completions <- lapply(seq_along(formals_list), function(i) {
+        argument_value_items(extract_default_values(formals_list[[i]]),
+            funct, package_for_call, param_names[[i]], token, uri)
+    })
+    items <- unlist(all_completions, recursive = FALSE, use.names = FALSE)
+    if (length(items)) items else list()
 }
 
 #' Complete a function argument
@@ -449,7 +444,7 @@
                 data = list(
                     type = "function",
                     package = nsname
             ))
         })
     } else {
         completions <- lapply(functs, function(object) {
@@ -461,7 +456,7 @@
                 data = list(
                     type = "function",
                     package = nsname
             ))
             if (!identical(inserted, object)) item$insertText <- inserted
             item
         })
@@ -493,7 +488,7 @@
                     data = list(
                         type = "function",
                         package = nsname
                 ))
             } else {
                 inserted <- quote_completion_name(object)
                 item <- list(label = object,
@@ -503,7 +498,7 @@
                     data = list(
                         type = "function",
                         package = nsname
                 ))
                 if (!identical(inserted, object)) item$insertText <- inserted
             }
             idx <- idx + 1L
@@ -578,7 +573,7 @@
                 value
             }
         }
         candidates[[length(candidates) + 1L]] <<- list(
             label = objects,
             kind = recycle(kind),
             detail = recycle(detail),
@@ -1319,7 +1314,7 @@
     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
             })

R/definition.R

@@ -20,11 +20,11 @@ definition_reply <- function(id, uri, workspace, document, point,
         return(Response$new(id))
     }
 
-    token_result <- document$detect_token(point)
+    parse_data <- workspace$get_parse_data(uri)
+    token_result <- reference_token_at(document, parse_data, point)
     resolved <- FALSE
     result <- NULL
 
-    parse_data <- workspace$get_parse_data(uri)
     syntax <- parse_data$syntax_data
     if (token_result$accessor == "" && !is.null(syntax)) {
         row <- point$row + 1L