0byt3m1n1
Path:
C:
/
Program Files
/
RStudio
/
resources
/
app
/
R
/
modules
/
[
Home
]
File: SessionRCompletions.R
# # SessionRCompletions.R # # Copyright (C) 2022 by Posit Software, PBC # # Unless you have received this program directly from Posit Software pursuant # to the terms of a commercial license agreement with Posit Software, then # this program is licensed to you under the terms of version 3 of the # GNU Affero General Public License. This program is distributed WITHOUT # ANY EXPRESS OR IMPLIED WARRANTY, INCLUDING THOSE OF NON-INFRINGEMENT, # MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Please refer to the # AGPL (http://www.gnu.org/licenses/agpl-3.0.txt) for more details. # # # Put the autocompletion types in the .rs.Env environment so they're accessible # everywhere (sync with RCompletionManager.java) assign(x = ".rs.acContextTypes", envir = as.environment("tools:rstudio"), value = list( UNKNOWN = 0, FUNCTION = 1, SINGLE_BRACKET = 2, DOUBLE_BRACKET = 3, NAMESPACE_EXPORTED = 4, NAMESPACE_ALL = 5, DOLLAR = 6, AT = 7, FILE = 8, CHUNK = 9, ROXYGEN = 10, HELP = 11, ARGUMENT = 12, PACKAGE = 13, PLUMBER = 14 ) ) # Sync with RCompletionType.java assign(x = ".rs.acCompletionTypes", envir = as.environment("tools:rstudio"), value = list( UNKNOWN = 0, VECTOR = 1, ARRAY = 2, DATAFRAME = 3, LIST = 4, ENVIRONMENT = 5, FUNCTION = 6, ARGUMENT = 7, S4_CLASS = 8, S4_OBJECT = 9, S4_GENERIC = 10, S4_METHOD = 11, R5_CLASS = 12, R5_OBJECT = 13, R5_METHOD = 14, FILE = 15, DIRECTORY = 16, CHUNK = 17, ROXYGEN = 18, HELP = 19, STRING = 20, PACKAGE = 21, KEYWORD = 22, OPTION = 23, DATASET = 24, COLUMN = 27, R6_OBJECT = 28, DATATABLE_SPECIAL_SYMBOL = 29, SECUNDARY_ARGUMENT = 30, ACTIVE_BINDING = 31, CONTEXT = 99 ) ) .rs.addFunction("getCompletionType", function(object) { # Control-flow keywords if (identical(object, base::`break`) || identical(object, base::`next`) || identical(object, base::`repeat`)) .rs.acCompletionTypes$KEYWORD # Reference classes else if (inherits(object, "refMethodDef")) .rs.acCompletionTypes$R5_METHOD else if (inherits(object, "refObjectGenerator")) .rs.acCompletionTypes$R5_CLASS else if (inherits(object, "refClass")) .rs.acCompletionTypes$R5_OBJECT # R6 else if (inherits(object, "R6")) .rs.acCompletionTypes$R6_OBJECT # S4 else if (isS4(object)) { if (inherits(object, "standardGeneric") || inherits(object, "nonstandardGenericFunction")) .rs.acCompletionTypes$S4_GENERIC else if (inherits(object, "MethodDefinition")) .rs.acCompletionTypes$S4_METHOD else .rs.acCompletionTypes$S4_OBJECT } # Base else if (is.function(object)) .rs.acCompletionTypes$FUNCTION else if (is.array(object)) .rs.acCompletionTypes$ARRAY else if (inherits(object, "data.frame")) .rs.acCompletionTypes$DATAFRAME else if (is.list(object)) .rs.acCompletionTypes$LIST else if (is.environment(object)) .rs.acCompletionTypes$ENVIRONMENT else if (is.vector(object)) .rs.acCompletionTypes$VECTOR else if (is.factor(object)) .rs.acCompletionTypes$VECTOR else .rs.acCompletionTypes$UNKNOWN }) .rs.addFunction("roxygenTagMetadata", function() { if (.rs.isPackageVersionInstalled("roxygen2", "7.2.1.9000")) { tagsFile <- system.file("roxygen2-tags.yml", package = "roxygen2") contents <- readLines(tagsFile, warn = FALSE) yaml <- .rs.fromYAML(contents) n <- length(yaml) map_chr <- function(...) vapply(..., FUN.VALUE = character(1), USE.NAMES = FALSE) map_lgl <- function(...) vapply(..., FUN.VALUE = logical(1), USE.NAMES = FALSE) tags <- map_chr(yaml, function(.) .$name) snippet <- map_chr(yaml, function(.) { out <- .$template if (is.null(out)) { out <- "" } out }) tags <- paste0("@", tags, snippet) descriptions <- map_chr(yaml, function(.) { .rs.markdownToHTML(.$description) }) vignette <- map_chr(yaml, function(.) { out <- .$vignette if (is.null(out)) out <- NA_character_ out }) recommend <- map_lgl(yaml, function(.) isTRUE(.$recommend)) } else { # All known Roxygen2 tags, in alphabetical order # # library(roxygen2) # methods <- as.vector(methods("roxy_tag_parse")) # prefix <- "roxy_tag_parse.roxy_tag_" # paste0("@", gsub(prefix, "", methods[grepl(prefix, methods, fixed = TRUE)], fixed = TRUE), " ") tags <- c( "@aliases ", "@author ", "@backref ", "@concept ", "@describeIn ", "@description ", "@details ", "@docType ", "@encoding ", "@eval ", "@evalNamespace ", "@evalRd ", "@example ", "@examples ", "@examplesIf ", "@export", "@exportClass ", "@exportMethod ", "@exportPattern ", "@exportS3Method ", "@family ", "@field ", "@format ", "@import ", "@importClassesFrom ", "@importFrom ", "@importMethodsFrom ", "@include ", "@includeRmd ", "@inherit ", "@inheritDotParams ", "@inheritParams ", "@inheritSection ", "@keywords ", "@md", "@method ", "@name ", "@note ", "@noMd", "@noRd", "@order ", "@param ", "@rawNamespace ", "@rawRd ", "@rdname ", "@references ", "@return ", "@returns ", "@section ", "@seealso ", "@slot ", "@source ", "@template ", "@templateVar ", "@title ", "@usage ", "@useDynLib " ) n <- length(tags) descriptions <- rep("", n) vignette <- rep("", n) recommend <- rep(TRUE, n) } list( tags = tags, descriptions = descriptions, recommend = recommend, vignette = vignette ) }) .rs.addFunction("attemptRoxygenTagCompletion", function(token, line) { emptyCompletions <- .rs.emptyCompletions(excludeOtherCompletions = TRUE) # fix up tokenization if (grepl("^\\s*#+'\\s*$", line) && token == "'") token <- "" # draw from 'man-roxygen' folder for '@template' completions if (grepl("^\\s*#+'\\s*@template\\s+", line)) { projDir <- .rs.getProjectDirectory() if (is.null(projDir)) return(emptyCompletions) manRoxygen <- file.path(projDir, "man-roxygen") if (!utils::file_test("-d", manRoxygen)) return(emptyCompletions) completions <- .rs.getCompletionsFile(token, path = manRoxygen, quote = FALSE) completions$results <- sub("[.][rR]$", "", completions$results) return(completions) } # allow the token to be empty only if we're attempting completions # at the start of the line if (token == "") { match <- grepl("^\\s*#+'\\s*$", line) if (!match) return(emptyCompletions) } else { match <- grepl("^@[a-zA-Z0-9]*$", token, perl = TRUE) if (!match) return(emptyCompletions) } tag <- sub(".*(?=@)", '', token, perl = TRUE) metadata <- .rs.roxygenTagMetadata() tags <- metadata$tags recommend <- metadata$recommend descriptions <- metadata$descriptions vignette <- metadata$vignette matching <- grepl(paste("^", tag, sep = ""), tags) # put recommended tags first keep <- c(which(matching & recommend), which(matching & !recommend)) .rs.makeCompletions(tag, results = tags[keep], type = .rs.acCompletionTypes$ROXYGEN, context = .rs.acContextTypes$ROXYGEN, meta = descriptions[keep], packages = vignette[keep], excludeOtherCompletions = TRUE, ) }) .rs.addFunction("attemptPlumberTagCompletion", function(token, line) { emptyCompletions <- .rs.emptyCompletions(excludeOtherCompletions = TRUE) # fix up tokenization if (grepl("^\\s*#+\\*\\s*$", line) && token == "*") token <- "" # allow the token to be empty only if we're attempting completions # at the start of the line if (token == "") { match <- grepl("^\\s*#+\\*\\s*$", line) if (!match) return(emptyCompletions) } else { match <- grepl("^@[a-zA-Z0-9]*$", token, perl = TRUE) if (!match) return(emptyCompletions) } tag <- sub(".*(?=@)", '', token, perl = TRUE) # All known Plumber tags, in alphabetical order tags <- c( "@apiBasePath ", "@apiConsumes ", "@apiContact ", "@apiDescription ", "@apiHost ", "@apiLicense ", "@apiProduces ", "@apiSchemes ", "@apiTOS ", "@apiTag ", "@apiTitle ", "@apiVersion ", "@assets ", "@delete ", "@filter ", "@get ", "@head ", "@jpeg ", "@options ", "@param ", "@parser", "@patch ", "@plumber ", "@png ", "@post ", "@preempt ", "@put ", "@response ", "@serializer ", "@svg ", "@tag ", "@use " ) matchingTags <- grep(paste("^", tag, sep = ""), tags, value = TRUE) .rs.makeCompletions(tag, matchingTags, type = .rs.acCompletionTypes$ROXYGEN, excludeOtherCompletions = TRUE, context = .rs.acContextTypes$PLUMBER) }) .rs.addFunction("getCompletionsVignettes", function(token) { doGetCompletionsVignettes <- function(token, vignettes) { vignettes <- sort(vignettes) .rs.makeCompletions(token = token, results = .rs.selectFuzzyMatches(vignettes, token), quote = TRUE, type = .rs.acCompletionTypes$VIGNETTE, excludeOtherCompletions = TRUE) } if (!is.null(vignettes <- .rs.get("vignettes"))) return(doGetCompletionsVignettes(token, vignettes$results[, "Item"])) vignettes <- vignette() .rs.assign("vignettes", vignettes) doGetCompletionsVignettes(token, vignettes$results[, "Item"]) }) .rs.addFunction("getCompletionsFile", function(token, path = getwd(), quote = FALSE, directoriesOnly = FALSE) { path <- suppressWarnings(.rs.normalizePath(path, winslash = "/")) ## Separate the token into a 'directory' prefix, and a 'name' prefix. We need ## to prefix the prefix as we will need to prepend it onto completions for ## non-relative completions. tokenPrefix <- "" tokenName <- token tokenSlashIndices <- c(gregexpr("[/\\\\]", token, perl = TRUE)[[1]]) if (!identical(tokenSlashIndices, -1L)) { maxIndex <- max(tokenSlashIndices) tokenPrefix <- substring(token, 1, maxIndex) tokenName <- substring(token, maxIndex + 1) } ## Figure out the directory to list files in. # The token itself might dictate the directory we want to search in, e.g. # if we see `~`, `/`, `[a-zA-Z]:`. In those cases, override the path argument. regex <- "^[~/\\\\]|^[a-zA-Z]:[/\\\\]" if (nzchar(token) && length(grep(regex, token, perl = TRUE))) { directory <- path <- suppressWarnings(normalizePath(dirname(paste(token, ".", sep = "")))) } # Check to see if there are delimiters in the token. If there are, but it's # a relative path, we need to further qualify the directory. else { if (!identical(tokenSlashIndices, -1L)) { maxIndex <- max(tokenSlashIndices) fullPath <- file.path(path, substring(token, 1, maxIndex - 1)) directory <- suppressWarnings(.rs.normalizePath(fullPath, winslash = "/")) } else { directory <- path } } # If we're trying to get completions from a directory that doesn't # exist, give up if (!file.exists(directory)) return(.rs.emptyCompletions(excludeOtherCompletions = TRUE)) # When checking if the path lies within the project directory, # we just do a substring check -- so make sure that the path # is actually within the project directory (append a trailing # slash to the directory we check) projDirEndsWithSlash <- paste(gsub("/*$", "", .rs.getProjectDirectory()), "/", sep = "") directory <- paste(gsub("/*$", "", directory), "/", sep = "") # If the directory lies within a folder that we're monitoring # for indexing, use that. cacheable <- TRUE usingFileMonitor <- .rs.hasFileMonitor() && .rs.startsWith(directory, projDirEndsWithSlash) absolutePaths <- character() if (usingFileMonitor) { if (directoriesOnly) index <- .rs.getIndexedFolders(tokenName, directory) else index <- .rs.getIndexedFilesAndFolders(tokenName, directory) cacheable <- !index$more_available absolutePaths <- index$paths } # Merge in completions from the current directory. This can be # slow on networked filesystems so do this with a timeout. dirPaths <- .rs.withTimeLimit(1, .rs.listFilesFuzzy(directory, tokenName)) if (is.null(dirPaths)) dirPaths <- character() if (directoriesOnly) { dirInfo <- .rs.fileInfo(dirPaths) dirPaths <- dirPaths[dirInfo$isdir] } absolutePaths <- sort(union(absolutePaths, dirPaths)) ## Bail out early if we didn't get any completions. if (!length(absolutePaths)) return(.rs.emptyCompletions(excludeOtherCompletions = TRUE)) ## Because the completions returned will replace the whole token, ## we need to be careful in how we construct the return result. In particular, ## we need to preserve the way the directory has been specified. ## ## Note that the directory may or may not end with a trailing slash, ## depending on how it was normalized. We have to check for that when ## determining the offset for constructing the relative path. Normally, ## the trailing slash is included for root directories, e.g. `/` on Unix-alikes ## or `C:/` on Windows. offset <- if (grepl("[/\\\\]$", directory, perl = TRUE)) nchar(directory) + 1L else nchar(directory) + 2L relativePaths <- substring(absolutePaths, offset) ## Order completions starting with alpha-numeric entries first if the ## token name is blank if (!nzchar(tokenName)) { startsWithAlnum <- grepl("^[[:alnum:]]", relativePaths, perl = TRUE) order <- c( which(startsWithAlnum), which(!startsWithAlnum) ) relativePaths <- relativePaths[order] absolutePaths <- absolutePaths[order] } paths <- paste(tokenPrefix, relativePaths, sep = "") # If we were able to use the file index and only wanted directories, we know that # all completions must be directories if (usingFileMonitor && directoriesOnly) { type <- rep.int(.rs.acCompletionTypes$DIRECTORY, length(absolutePaths)) } # Otherwise, query the file info for the set of completions we're using else { isDir <- .rs.fileInfo(absolutePaths)[, "isdir"] %in% TRUE ## protect against NA type <- ifelse(isDir, .rs.acCompletionTypes$DIRECTORY, .rs.acCompletionTypes$FILE) if (directoriesOnly) { paths <- paths[isDir] type <- type[isDir] } } # Order completions by depth matches <- gregexpr("/", paths, fixed = TRUE) depth <- vapply(matches, function(match) { if (identical(c(match), -1L)) 0 else length(match) }, numeric(1)) idx <- order(depth) paths <- paths[idx] type <- type[idx] .rs.makeCompletions(token = token, results = paths, type = type, quote = quote, excludeOtherCompletions = TRUE, cacheable = cacheable) }) .rs.addFunction("resolveFormals", function(token, object, functionName, functionCall, matchedCall, envir) { tryCatch( .rs.resolveFormalsImpl(token, object, functionName, functionCall, matchedCall, envir), error = function(e) NULL ) }) .rs.addFunction("resolveFormalsImpl", function(token, object, functionName, functionCall, matchedCall, envir) { # first, try to resolve via S3 dispatch if possible data <- .rs.resolveFormalsImplS3Dispatch( token, object, functionName, functionCall, matchedCall, envir ) # otherwise, resolve from function itself if (is.null(data)) { formals <- .rs.getFunctionArgumentNames(object) methods <- rep.int(functionName, length(formals)) data <- list(formals = formals, methods = methods) } keep <- .rs.fuzzyMatches(data$formals, token) & # keep only formals matching token !(data$formals %in% names(functionCall)) # leave out formals already in call # subset based on kept formals data$formals <- data$formals[keep] data$methods <- data$methods[keep] # done! data }) .rs.addFunction("resolveFormalsImplS3Dispatch", function(token, object, functionName, functionCall, matchedCall, envir) { # validate that this is an S3 generic ok <- length(functionCall) > 1 && .rs.isS3Generic(object) if (!ok) return(NULL) # S3 generics normally dispatch on the first argument, # so verify that this has been supplied dispatchArgumentName <- names(formals(object)[1]) dispatchArgumentSymbol <- matchedCall[[dispatchArgumentName]] if (is.null(dispatchArgumentSymbol)) return(NULL) # try to retrieve the object objectForDispatch <- .rs.getAnywhere( matchedCall[[dispatchArgumentName]], envir = envir ) if (is.null(objectForDispatch)) return(NULL) # handle e.g. dplyr::mutate(): the generic is "mutate", not "dplyr::mutate" functionName <- sub("^.*:{2,3}", "", functionName) # iterate over the known classes for the object, and see if we have # an appropriate S3 method that could be used for dispatch classes <- class(objectForDispatch) for (class in c(classes, "default")) { # It is possible that which S3 method will be used may depend on where # the generic f is called from: getS3method returns the method found if # f were called from the same environment. call <- substitute( utils::getS3method(functionName, class), list(functionName = functionName, class = class) ) method <- tryCatch( eval(call, envir = envir), error = function(e) NULL ) if (is.null(method)) next # ok, we found a method -- return it formals <- .rs.getFunctionArgumentNames(method) methods <- rep.int( paste(functionName, class, sep = "."), length(formals) ) data <- list(formals = formals, methods = methods) return(data) } # nothing found; return NULL NULL }) .rs.addFunction("matchCall", function(func, call, numCommas = NULL) { names <- names(call) if (is.null(names)) names <- rep("", length(call)) funFormals <- names(formals(func)) hasDots <- any(funFormals == "...") if (is.null(numCommas)) numCommas <- length(call) j <- 1L # used to track how many commas have been seen i <- 2L # the current argument, relative to modified call while (TRUE) { if (i > length(call)) break # dropping from the call: # - explicit ... # - unnamed arguments after the cursor # - named arguments not in the formals of fun (unless fun has ...) if (identical(call[[i]], quote(`...`)) || (names[i] == "" && j > numCommas) || (!hasDots && names[i] != "" && !any(names[i] == funFormals))) { call <- call[-i] names <- names[-i] } else { # keep this argument, and move on to the next one i <- i + 1 } # in any case, this has seen one more comma j <- j + 1L } tryCatch(match.call(func, call), error = function(e) call) }) .rs.addFunction("getCompletionsInstallPackages", function(token) { contrib.url <- contrib.url(getOption("repos"), getOption("pkgType")) packages <- Reduce(union, lapply(contrib.url, function(url) { # Try to get a package list from the cache result <- .rs.getCachedAvailablePackages(url) # If it's null, there were no packages available if (is.null(result)) .rs.downloadAvailablePackages(url) # Try again result <- .rs.getCachedAvailablePackages(url) # And return result })) .rs.makeCompletions(token = token, results = .rs.selectFuzzyMatches(packages, token), quote = TRUE, type = .rs.acCompletionTypes$PACKAGE, excludeOtherCompletions = TRUE) }) .rs.addFunction("resolveObjectFromFunctionCall", function(functionCall, envir) { string <- .rs.format(functionCall[[1]])[[1]] splat <- strsplit(string, ":{2,3}", perl = TRUE)[[1]] object <- NULL if (length(splat) == 1) { stripped <- .rs.stripSurrounding(string) envir <- .rs.resolveEnvironment(envir) object <- .rs.tryCatch( .rs.getAnywhere( name = stripped, envir = envir ) ) } else if (length(splat) == 2) { namespaceString <- .rs.stripSurrounding(splat[[1]]) functionString <- string <- .rs.stripSurrounding(splat[[2]]) if (namespaceString %in% loadedNamespaces()) { object <- .rs.tryCatch( eval( expr = parse(text = functionString), envir = asNamespace(namespaceString) ) ) } } # Special casing for variants of read.table which hide additional # arguments in ... if ("utils" %in% loadedNamespaces()) { readers <- list( utils::read.csv, utils::read.csv2, utils::read.delim, utils::read.delim2 ) if (any(sapply(readers, identical, object))) object <- utils::read.table # Similarly for write.csv writers <- list( utils::write.csv, utils::write.csv2 ) if (any(sapply(writers, identical, object))) object <- utils::write.table } if (inherits(object, "error")) return(NULL) object }) # Get completions appropriate within a particular function call. # This typically implies retrieving the function formals. .rs.addFunction("getCompletionsFunction", function(token, string, functionCall, numCommas, envir = parent.frame(), object = .rs.resolveObjectFromFunctionCall(functionCall, envir)) { result <- .rs.emptyCompletions() if (is.null(object) || !is.function(object)) return(result) # If we're attempting to get completions for an R6 'new()' function, # then use a separate code path to derive that -- derive formals from # the 'initialize()' method instead. if (.rs.isR6NewMethod(object)) object <- .rs.getR6ClassGeneratorMethod(object, "initialize") matchedCall <- .rs.matchCall(object, functionCall, numCommas = numCommas) # Try to figure out what function arguments are # eligible for completion. Note that, on success, # this should be an R list with character fields # 'formals' and (optionally) 'methods'. formals <- NULL ## Special cases # We handle special cases for function argument completions first. # If we're completing a knitr getter function, then try # to produce auto-completions for potential argument names if (.rs.isKnitrObject(object) && "knitr" %in% loadedNamespaces()) { ns <- asNamespace("knitr") # Get the knitr getters and setters for various # options tryGetKnitrGetter <- function(name, ns = asNamespace("knitr")) tryCatch(get(name, envir = ns)$get, error = function(e) NULL) tryGetKnitrSetter <- function(name, ns = asNamespace("knitr")) tryCatch(get(name, envir = ns)$set, error = function(e) NULL) tryGet <- function(name, ns = asNamespace("knitr")) list(getter = tryGetKnitrGetter(name, ns), setter = tryGetKnitrSetter(name, ns)) knitrOpts <- list( tryGet("opts_chunk", ns), tryGet("opts_knit", ns), tryGet("opts_current", ns), tryGet("opts_template", ns), tryGet("knit_hooks", ns), tryGet("knit_theme", ns) ) for (opt in knitrOpts) { # If we're identical to the getter, short-circuit # and just return the names of parameters if (identical(object, opt$getter)) { results <- .rs.selectFuzzyMatches( names(opt$getter()), token ) return(.rs.makeCompletions(token = token, results = results, type = .rs.acCompletionTypes$STRING, quote = TRUE)) } # If we're identical to the setter, get the # names from the getter as named arguments to use if (identical(object, opt$setter)) { formals <- list(formals = names(opt$getter())) break } } } # Resolve formals from a classGeneratorFunction based # on its slots if (is.null(formals) && inherits(object, "classGeneratorFunction")) { try(silent = TRUE, { class <- object@className defn <- getClass(class) slots <- defn@slots formals <- list( formals = names(slots), methods = rep(class, length(slots)) ) }) } # Resolve formals from the function itself if (is.null(formals)) { formals <- .rs.resolveFormals(token, object, string, functionCall, matchedCall, envir) } # If we have formals, quote them as appropriate and append ' = '. if (length(formals$formals)) { formals$formals <- vapply(formals$formals, function(fml) { paste(deparse(as.name(fml), backtick = TRUE), "= ") }, FUN.VALUE = character(1)) } # If we're getting completions for the `base::c` function, just discard # the argument completions, since other context completions are more # likely and more useful if (identical(object, base::c) || identical(object, base::list)) { formals <- list(formals = character(), methods = character()) } # Get the current argument -- we can resolve this based on # 'numCommas' and the number of named formals. The idea is, e.g. # in a function call # # rnorm(|, n = 1, sd = 2) # # we should infer that the current argument name is 'mean'. We do this # by looking at which arguments have yet to be matched, and using the # first argument in that list. activeArg <- .rs.getActiveArgument(object, matchedCall) if (length(activeArg) == 0L || is.na(activeArg)) activeArg <- "" # Special casing for 'group_by' from dplyr # TODO: Should we just allow for any function named 'group_by', ie, # enable this even if 'dplyr' isn't loaded? if (!is.null(activeArg) && activeArg == "..." && "dplyr" %in% loadedNamespaces() && identical(object, get("group_by", envir = asNamespace("dplyr")))) { .data <- .rs.getAnywhere(matchedCall[[".data"]], envir = envir) if (!is.null(.data)) { # potential completions .names <- .rs.selectFuzzyMatches(.rs.getNames(.data), token) if (length(.names)) { namesCall <- names(matchedCall) # drop from .names: # - the named argument, e.g. group_by(a = foo()) .drop <- setdiff(namesCall, c("", ".data", ".drop", ".keep")) # - the unnamed arguments that are symbols unnamed <- as.list(matchedCall)[namesCall == ""][-1] for (arg in unnamed) { if (is.symbol(arg)) .drop <- c(.drop, as.character(arg)) } groupByCompletions <- .rs.makeCompletions(token = token, results = setdiff(.names, .drop), quote = FALSE, type = .rs.acCompletionTypes$COLUMN, packages = as.character(matchedCall[[".data"]])) return(groupByCompletions) } } } # Get completions for the current active argument argCompletions <- .rs.getCompletionsArgument( token = token, activeArg = activeArg, functionCall = functionCall, envir = envir ) # If the active argument was 'formula' and we were able # to retrieve completions, it is unlikely that we also # want search path completions or otherwise -- just return # those completions. if (identical(activeArg, "formula") && !is.null(argCompletions) && !.rs.isEmptyCompletion(argCompletions)) { return(argCompletions) } fguess <- if (length(formals$methods)) formals$methods[[1]] else "" # arguments that are already used by the matched call used <- names(as.list(matchedCall)[-1]) keep <- !names(formals$formals) %in% used # TODO: Should we include aesthetics for 'geom_*()' functions? # for 'geom_' functions, try to get aesthetic names ggplotCompletions <- NULL if (grepl("(?:^|::)geom_", fguess)) { .rs.tryCatch({ geomFunc <- eval(as.symbol(fguess), envir = envir) layerInfo <- geomFunc() aesthetics <- c( layerInfo$geom$required_aes, layerInfo$stat$required_aes, names(layerInfo$geom$default_aes), names(layerInfo$stat$default_aes) ) aesthetics <- aesthetics[!grepl("|", aesthetics, fixed = TRUE)] aesthetics <- aesthetics[!duplicated(aesthetics)] results <- .rs.selectFuzzyMatches(aesthetics, token) ggplotCompletions <- .rs.makeCompletions( token = token, results = paste(results, "= "), packages = fguess, type = .rs.acCompletionTypes$ARGUMENT, quote = FALSE ) }) } result <- .rs.appendCompletions( argCompletions, .rs.makeCompletions( token = token, results = formals$formals[keep], packages = formals$methods[keep], type = .rs.acCompletionTypes$ARGUMENT, excludeOtherCompletions = FALSE, excludeOtherArgumentCompletions = TRUE, fguess = fguess, orderStartsWithAlnumFirst = FALSE ) ) result <- .rs.appendCompletions(result, ggplotCompletions) result }) .rs.addFunction("getSourceIndexCompletions", function(token) { .Call("rs_getSourceIndexCompletions", token) }) .rs.addFunction("getCompletionsNamespace", function(token, string, exportsOnly, envir) { result <- .rs.emptyCompletions(excludeOtherCompletions = TRUE) if (!(string %in% loadedNamespaces())) { tryCatch( suppressPackageStartupMessages(requireNamespace(string, quietly = TRUE)), error = function(e) NULL ) } if (string %in% loadedNamespaces()) { namespace <- asNamespace(string) objectNames <- if (exportsOnly) getNamespaceExports(namespace) else { # Take advantage of 'sorted' argument if available, # as we only want to sort a filtered subset and will # sort again later arguments <- list() arguments[["name"]] <- namespace arguments[["all.names"]] <- TRUE if ("sorted" %in% names(formals(objects))) arguments[["sorted"]] <- FALSE do.call(objects, arguments) } # For `::`, we also want to grab items in the 'lazydata' environment # within the namespace. lazydata <- new.env(parent = emptyenv()) dataNames <- character() if (exportsOnly && exists(".__NAMESPACE__.", envir = namespace)) { .__NAMESPACE__. <- get(".__NAMESPACE__.", envir = namespace) if (exists("lazydata", envir = .__NAMESPACE__.)) { lazydata <- get("lazydata", envir = .__NAMESPACE__.) dataNames <- objects(lazydata, all.names = TRUE) } } # Filter our results objectNames <- .rs.selectFuzzyMatches(objectNames, token) dataNames <- .rs.selectFuzzyMatches(dataNames, token) # Collect the object types objectTypes <- vapply( mget(objectNames, envir = namespace, inherits = TRUE), FUN.VALUE = numeric(1), USE.NAMES = FALSE, .rs.getCompletionType ) # Let 'lazydata' be lazy -- don't force evaluation. dataTypes <- rep(.rs.acCompletionTypes$DATAFRAME, length(dataNames)) # Construct a data.frame to hold our results (because we'll # need to re-sort our items) df <- data.frame( names = c(objectNames, dataNames), types = c(objectTypes, dataTypes), stringsAsFactors = FALSE ) # Sort by 'names' df <- df[order(df$names), ] # Construct the completion result completions <- df$names type <- df$types result <- .rs.makeCompletions( token = token, results = completions, packages = string, quote = FALSE, type = type, excludeOtherCompletions = TRUE, context = if (exportsOnly) .rs.acContextTypes$NAMESPACE_EXPORTED else .rs.acContextTypes$NAMESPACE_ALL ) } result }) .rs.addFunction("emptyCompletions", function(token = "", excludeOtherCompletions = FALSE, overrideInsertParens = FALSE, orderStartsWithAlnumFirst = TRUE, language = "R") { .rs.makeCompletions( token = token, results = character(), packages = character(), quote = logical(), type = numeric(), fguess = "", excludeOtherCompletions = .rs.scalar(excludeOtherCompletions), overrideInsertParens = .rs.scalar(overrideInsertParens), orderStartsWithAlnumFirst = .rs.scalar(orderStartsWithAlnumFirst), language = .rs.scalar(language), context = numeric() ) }) .rs.addFunction("isEmptyCompletion", function(completions) { length(completions$results) == 0 }) .rs.addFunction("fuzzyMatches", function(completions, token) { reStrip <- "(?!^)[._]" token <- gsub(reStrip, "", token, perl = TRUE) completions <- gsub(reStrip, "", completions, perl = TRUE) .rs.startsWith(tolower(completions), tolower(token)) }) .rs.addFunction("selectFuzzyMatches", function(completions, token) { types <- attr(completions, "types") meta <- attr(completions, "meta") matches <- .rs.fuzzyMatches(completions, token) completions <- completions[matches] if (!is.null(types)) attr(completions, "types") <- types[matches] if (!is.null(meta)) attr(completions, "meta") <- meta[matches] completions }) .rs.addFunction("formCompletionVector", function(object, default, n) { if (length(object) == 0) rep(default, length.out = n) else if (length(object) == 1) rep.int(object, n) else if (length(object) == n) object else rep(object, length.out = n) }) .rs.addFunction("makeCompletions", function(token, results, packages = character(), quote = logical(), type = numeric(), meta = character(), fguess = "", excludeOtherCompletions = FALSE, excludeOtherArgumentCompletions = FALSE, overrideInsertParens = FALSE, orderStartsWithAlnumFirst = TRUE, cacheable = TRUE, helpHandler = NULL, language = "R", context = numeric(), suggestOnAccept = NULL) { if (is.null(results)) results <- character() if (is.null(token)) token <- "" if (length(meta) == 0L) { meta <- attr(results, "meta", exact = TRUE) } # Ensure other 'vector' completions are of the same length as 'results' n <- length(results) packages <- .rs.formCompletionVector(packages, "", n) quote <- .rs.formCompletionVector(quote, FALSE, n) type <- .rs.formCompletionVector(type, .rs.acCompletionTypes$UNKNOWN, n) meta <- .rs.formCompletionVector(meta, "", n) context <- .rs.formCompletionVector(context, .rs.acCompletionTypes$UNKNOWN, n) if (!is.null(suggestOnAccept)) suggestOnAccept <- .rs.formCompletionVector(suggestOnAccept, FALSE, n) # Favor completions starting with a letter if (orderStartsWithAlnumFirst) { startsWithLetter <- grepl("^[a-zA-Z0-9]", results, perl = TRUE) first <- which(startsWithLetter) last <- which(!startsWithLetter) order <- c(first, last) results <- results[order] packages <- packages[order] quote <- quote[order] type <- type[order] meta <- meta[order] context <- context[order] if (!is.null(suggestOnAccept)) suggestOnAccept <- suggestOnAccept[order] } # Avoid generating too many completions limit <- 2000 if (length(results) > limit) { cacheable <- FALSE idx <- seq_len(limit) results <- results[idx] packages <- packages[idx] quote <- quote[idx] type <- type[idx] meta <- meta[idx] context <- context[idx] if (!is.null(suggestOnAccept)) suggestOnAccept <- suggestOnAccept[idx] } list(token = token, results = results, packages = packages, quote = quote, type = type, meta = meta, fguess = fguess, excludeOtherCompletions = .rs.scalar(excludeOtherCompletions), excludeOtherArgumentCompletions = .rs.scalar(excludeOtherArgumentCompletions), overrideInsertParens = .rs.scalar(overrideInsertParens), cacheable = .rs.scalar(cacheable), helpHandler = .rs.scalar(helpHandler), language = .rs.scalar(language), context = context, suggestOnAccept = suggestOnAccept) }) .rs.addFunction("subsetCompletions", function(completions, indices) { for (name in c("results", "packages", "quote", "type", "context")) completions[[name]] <- completions[[name]][indices] if (!is.null(completions[["suggestOnAccept"]])) completions[["suggestOnAccept"]] <- completions[["suggestOnAccept"]][indices] completions }) .rs.addFunction("appendCompletionsOptionalElement", function(old, new, name, default) { oldHas <- !is.null(old[[name]]) newHas <- !is.null(new[[name]]) if (oldHas) { if (newHas) { return(c(old[[name]], new[[name]])) } else { return(c(old[[name]], rep(default, length(new$results)))) } } else { if (newHas) { return(c(rep(default, length(old$results)), new[[name]])) } else { return(NULL) } } }) .rs.addFunction("appendCompletions", function(old, new) { if (is.null(new)) return(old) old[["suggestOnAccept"]] <- .rs.appendCompletionsOptionalElement(old, new, "suggestOnAccept", FALSE) for (name in c("results", "packages", "quote", "type", "meta", "context")) old[[name]] <- c(old[[name]], new[[name]]) # resolve duplicates -- a completion is duplicated if its result # and package are identical (if 'type' or 'quote' differs, it's probably a bug?) drop <- intersect( which(duplicated(old$results)), which(duplicated(old$packages)) ) if (length(drop)) { for (name in c("results", "packages", "quote", "type", "meta", "context")) old[[name]] <- old[[name]][-c(drop)] if (!is.null(old[["suggestOnAccept"]])) { old[["suggestOnAccept"]] <- old[["suggestOnAccept"]][-c(drop)] } } if (length(new$token) && new$token != "") old$token <- new$token if (length(new$fguess) && new$fguess != "") old$fguess <- new$fguess if (length(new$excludeOtherCompletions) && new$excludeOtherCompletions) old$excludeOtherCompletions <- new$excludeOtherCompletions if (length(new$excludeOtherArgumentCompletions) && new$excludeOtherArgumentCompletions) old$excludeOtherArgumentCompletions <- new$excludeOtherArgumentCompletions if (length(new$overrideInsertParens) && new$overrideInsertParens) old$overrideInsertParens <- new$overrideInsertParens # If one completion states we are not cacheable, that setting is 'sticky' if (length(new$cacheable) && !new$cacheable) old$cacheable <- new$cacheable if (length(new$helpHandler)) old$helpHandler <- new$helpHandler old }) .rs.addFunction("sortCompletions", function(completions, token, shortestFirst = FALSE) { # type based scores typeScores <- rep(100, length(completions$results)) typeScores[completions$type == .rs.acCompletionTypes$ARGUMENT] <- 1 typeScores[completions$type == .rs.acCompletionTypes$COLUMN] <- 2 typeScores[completions$type == .rs.acCompletionTypes$DATATABLE_SPECIAL_SYMBOL] <- 3 # data has high priority, unless it's requested from a :: or ::: context # rationale: https://github.com/rstudio/rstudio/issues/12678) typeScores[ completions$type == .rs.acCompletionTypes$DATAFRAME & ! completions$context %in% c(.rs.acContextTypes$NAMESPACE_EXPORTED, .rs.acContextTypes$NAMESPACE_ALL) ] <- 4 typeScores[completions$type == .rs.acCompletionTypes$SECUNDARY_ARGUMENT] <- 5 typeScores[completions$type == .rs.acCompletionTypes$PACKAGE] <- 101 typeScores[completions$type == .rs.acCompletionTypes$CONTEXT] <- 102 # additional scores based on the result scores <- if (nzchar(token)) .rs.scoreMatches(completions$results, token) # Protect against NULL / otherwise invalid scores. # TODO: figure out what, upstream, might cause this if (!length(scores)) scores <- rep(0L, length(completions$results)) order <- if (shortestFirst) order(typeScores, scores, nchar(completions$results)) else order(typeScores, scores) completions <- .rs.subsetCompletions(completions, order) completions }) .rs.addFunction("getDataTableSpecialSymbolsCompletions", function(token, symbols) { results <- symbols[.rs.fuzzyMatches(sub("^.", "", symbols), token)] .rs.makeCompletions(token = token, results = results, quote = FALSE, packages = "data.table", type = .rs.acCompletionTypes$DATATABLE_SPECIAL_SYMBOL) }) .rs.addFunction("getDataTableJCompletions", function(token) { .rs.getDataTableSpecialSymbolsCompletions(token, c(".SD", ".BY", ".N", ".I", ".GRP", ".NGRP")) }) .rs.addFunction("getDataTableByCompletions", function(token) { .rs.getDataTableSpecialSymbolsCompletions(token, ".EACHI") }) .rs.addFunction("getDataTableColumnsCompletions", function(token, name, object) { .rs.makeCompletions(token = token, results = .rs.selectFuzzyMatches(names(object), token), packages = name, quote = FALSE, type = .rs.acCompletionTypes$COLUMN, fguess = "[.data.table") }) .rs.addFunction("getDataTableUnnamedArgumentCompletions", function(token, name, object, functionCall, numCommas, includeArguments = TRUE, envir) { # column names completions <- .rs.getDataTableColumnsCompletions(token, name, object) # j = if (numCommas == 1) completions <- .rs.appendCompletions(completions, .rs.getDataTableJCompletions(token)) # by|keyby = if (numCommas == 2 || numCommas == 3) completions <- .rs.appendCompletions(completions, .rs.getDataTableByCompletions(token)) # finally, offer the arguments of data.table:::`[.data.table` if (isTRUE(includeArguments) && isNamespaceLoaded("data.table")) { argCompletions <- .rs.getCompletionsFunction(token, "[.data.table", functionCall, numCommas, envir = envir, object = data.table:::`[.data.table`) argCompletions$type[argCompletions$type == .rs.acCompletionTypes$ARGUMENT] <- .rs.acCompletionTypes$SECUNDARY_ARGUMENT completions <- .rs.appendCompletions( completions, argCompletions ) } completions }) .rs.addFunction("getDataTableNamedArgumentCompletions", function(token, name, object, activeArg, functionCall) { # column names completions <- .rs.getDataTableColumnsCompletions(token, as.character(name), object) if (identical(activeArg, "j")) completions <- .rs.appendCompletions(completions, .rs.getDataTableJCompletions(token)) if (activeArg %in% c("by", "keyby")) completions <- .rs.appendCompletions(completions, .rs.getDataTableByCompletions(token)) completions }) .rs.addFunction("isDataTableExtractCall", function(string, envir) { tryCatch({ # NOTE: We don't retrieve the name from the function call as this could # be a complex parse tree (e.g. dt[, y := 1][, y]$x); it is substantially # easier to strip the object name from the 'string' constituting the parsed object bracketIdx <- regexpr("[", string, fixed = TRUE) if (bracketIdx == -1) return(FALSE) objectName <- substring(string, 1L, bracketIdx - 1L) inherits(.rs.getAnywhere(objectName, envir = envir), "data.table") }, error = function(e) FALSE) }) ## NOTE: for '@' as well (set in the 'isAt' parameter) .rs.addFunction("getCompletionsDollar", function(token, string, functionCall, envir, isAt) { # bail if string would call [] on a data.table # because this might side-effect modify the data table if (.rs.isDataTableExtractCall(string, envir = envir)) return(.rs.emptyCompletions(excludeOtherCompletions = TRUE)) object <- .rs.getAnywhere(string, envir) if (is.null(object)) return(.rs.emptyCompletions(excludeOtherCompletions = TRUE)) allNames <- character() names <- character() type <- numeric() helpHandler <- NULL if (isAt) { if (exists(".AtNames")) { .rs.tryCatch({ code <- substitute( utils::.AtNames(object, pattern = ""), list(object = object) ) allNames <- eval(code, envir = globalenv()) names <- .rs.selectFuzzyMatches(allNames, token) type <- attr(names, "types") }) } else if (isS4(object)) { .rs.tryCatch({ allNames <- .slotNames(object) names <- .rs.selectFuzzyMatches(allNames, token) # NOTE: Getting the types forces evaluation; we avoid that if # there are too many names to evaluate. if (length(names) > 2E2) { type <- .rs.acCompletionTypes$UNKNOWN } else { type <- numeric(length(names)) for (i in seq_along(names)) { type[[i]] <- suppressWarnings(tryCatch( .rs.getCompletionType(eval(call("@", quote(object), names[[i]]))), error = function(e) .rs.acCompletionTypes$UNKNOWN )) } } }) } } else { # Check to see if an overloaded .DollarNames method has been provided, # and use that to resolve names if possible. dollarNamesMethod <- .rs.getDollarNamesMethod(object, TRUE, envir = envir) if (is.function(dollarNamesMethod)) { allNames <- dollarNamesMethod(object, "") # detect completion systems that append closing parentheses # to the completion item, and assume those are functions # rJava and Rcpp will do this for some objects # for example: # - rJava:::.DollarNames.jobjref # - Rcpp:::.DollarNames.C++Object types <- ifelse( grepl("[()]\\s*$", allNames), .rs.acCompletionTypes$FUNCTION, .rs.acCompletionTypes$UNKNOWN ) allNames <- gsub("[()]*\\s*$", "", allNames) attr(allNames, "types") <- as.integer(types) # check for custom helpHandler helpHandler <- attr(allNames, "helpHandler", exact = TRUE) } # Reference class generators / objects else if (inherits(object, "refObjectGenerator")) { allNames <- Reduce(union, list( objects(object@generator@.xData, all.names = TRUE), objects(object$def@refMethods, all.names = TRUE), c("new", "help", "methods", "fields", "lock", "accessors") )) } # Reference class objects else if (inherits(object, "refClass")) { suppressWarnings(tryCatch({ refClassDef <- object$.refClassDef allNames <- c( ls(refClassDef@fieldPrototypes, all.names = TRUE), ls(refClassDef@refMethods, all.names = TRUE) ) # Place the 'less interesting' methods lower baseMethods <- c("callSuper", "copy", "export", "field", "getClass", "getRefClass", "import", "initFields", "show", "trace", "untrace", "usingMethods") allNames <- c( setdiff(allNames, baseMethods), baseMethods ) }, error = function(e) NULL)) } # Objects for which 'names' returns non-NULL. This branch is used # to provide completions for S4 objects, essentially adhering to # the `.DollarNames.default` behaviour. (It looks like if an S4 # object is able to supply names through the `names` method, then # those names are also valid for `$` completions.) else if (isS4(object) && length(names(object))) { allNames <- .rs.getNames(object) } # Environments (note that some S4 objects 'are' environments; # e.g. 'hash' objects from the 'hash' package) else if (is.environment(object)) { allNames <- .rs.getNames(object) } # Other objects else { # '$' operator is invalid for atomic vectors if (is.atomic(object)) return(.rs.emptyCompletions(excludeOtherCompletions = TRUE)) # Don't allow S4 objects for dollar name resolution # They will need to have defined a .DollarNames method, which # should have been resolved previously if (!isS4(object)) { allNames <- .rs.getNames(object) } } names <- .rs.selectFuzzyMatches(allNames, token) # See if types were provided types <- attr(names, "types") if (is.integer(types) && length(types) == length(names)) type <- types else if (inherits(object, "data.frame")) type <- .rs.acCompletionTypes$COLUMN # NOTE: Getting the types forces evaluation; we avoid that if # there are too many names to evaluate. else if (length(names) > 2E2) type <- .rs.acCompletionTypes$UNKNOWN else { type <- numeric(length(names)) for (i in seq_along(names)) { type[[i]] <- suppressWarnings(tryCatch( if (is.environment(object) && bindingIsActive(names[[i]], object)) .rs.acCompletionTypes$UNKNOWN else .rs.getCompletionType(eval(call("$", quote(object), names[[i]]))), error = function(e) .rs.acCompletionTypes$UNKNOWN )) } } } .rs.makeCompletions( token = token, results = names, packages = string, quote = FALSE, type = type, excludeOtherCompletions = TRUE, helpHandler = helpHandler, context = if (isAt) .rs.acContextTypes$AT else .rs.acContextTypes$DOLLAR ) }) .rs.addFunction("getCompletionsSingleBracket", function(token, string, functionCall, numCommas, index, envir) { result <- .rs.emptyCompletions() # bail if string would call [] on a data.table # because this might side-effect modify the data table if (.rs.isDataTableExtractCall(string, envir = envir)) return(.rs.emptyCompletions(excludeOtherCompletions = TRUE)) object <- .rs.getAnywhere(string, envir) if (is.null(object)) return(result) # data.table special case if (inherits(object, "data.table")) { return(.rs.getDataTableUnnamedArgumentCompletions( token, name = string, object = object, functionCall = functionCall, numCommas = numCommas, includeArguments = (index == 1L), envir = envir )) } completions <- character() # Get completions from dimension names for arrays if (is.array(object) && !is.null(dn <- dimnames(object))) { if (numCommas + 1 <= length(dn)) completions <- dimnames(object)[[numCommas + 1]] string <- if (numCommas == 0) paste("rownames(", string, ")", sep = "") else if (numCommas == 1) paste("colnames(", string, ")", sep = "") else paste("dimnames(", string, ")[", numCommas + 1, "]", sep = "") } # Get completions from rownames for data.frames if we have no commas, e.g. # `mtcars[|` else if (inherits(object, "data.frame") && numCommas == 0) { info <- .row_names_info(object, type = 0L) if (is.character(info)) completions <- info } # Just get the names of the object else { completions <- .rs.getNames(object) } completions <- .rs.selectFuzzyMatches(completions, token) if (length(completions)) { type <- if (is.data.frame(object)) .rs.acCompletionTypes$COLUMN else .rs.acCompletionTypes$STRING result <- .rs.makeCompletions( token = token, results = completions, packages = string, quote = !inherits(object, "data.table"), type = type ) } result }) .rs.addFunction("getCompletionsDoubleBracket", function(token, string, functionCall, envir = parent.frame()) { result <- .rs.emptyCompletions() # bail if string would call [] on a data.table # because this might side-effect modify the data table if (.rs.isDataTableExtractCall(string, envir = envir)) return(result) object <- .rs.getAnywhere(string, envir) if (is.null(object)) return(result) completions <- .rs.getNames(object) completions <- .rs.selectFuzzyMatches(completions, token) if (length(completions)) { type <- if (is.data.frame(object)) .rs.acCompletionTypes$COLUMN else .rs.acCompletionTypes$STRING result <- .rs.makeCompletions( token = token, results = completions, packages = string, quote = TRUE, type = type, overrideInsertParens = TRUE ) } result }) .rs.addFunction("listIndexedPackages", function() { .Call("rs_listIndexedPackages", PACKAGE = "(embedding)") }) .rs.addFunction("getCompletionsPackages", function(token, appendColons = FALSE, excludeOtherCompletions = FALSE, quote = !appendColons) { allPackages <- sort(basename(.rs.listIndexedPackages())) # In case indexing is disabled, include any loaded namespaces by default allPackages <- union(allPackages, loadedNamespaces()) # Not sure why 'DESCRIPTION' might show up here, but let's take it out allPackages <- setdiff(allPackages, "DESCRIPTION") # Also remove any '00LOCK' directories -- these might be leftovers # from earlier failed package installations if (length(allPackages)) { isLockDir <- substring(allPackages, 1, 6) == "00LOCK" allPackages <- allPackages[!isLockDir] } # Construct our completions, and we're done matches <- .rs.selectFuzzyMatches(allPackages, token) results <- if (appendColons && length(matches)) paste(matches, "::", sep = "") else matches completions <- .rs.makeCompletions( token = token, results = results, packages = matches, quote = quote, type = .rs.acCompletionTypes$PACKAGE, excludeOtherCompletions = excludeOtherCompletions, context = .rs.acContextTypes$PACKAGE ) .rs.sortCompletions( completions = completions, token = token ) }) .rs.addFunction("getCompletionsData", function(token) { # Suppress warnings e.g. # # Warning messages: # 1: In data(package = .packages(all.available = TRUE)) : # datasets have been moved from package 'base' to package 'datasets' # 2: In data(package = .packages(all.available = TRUE)) : # datasets have been moved from package 'stats' to package 'datasets' # availableData <- suppressWarnings(data()$results) # Don't include aliases indices <- intersect( which(.rs.fuzzyMatches(availableData[, "Item"], token)), grep(" ", availableData[, "Item"], fixed = TRUE, invert = TRUE) ) results <- availableData[indices, "Item"] packages <- availableData[indices, "Package"] .rs.makeCompletions(token, results, packages, quote = TRUE, type = .rs.acCompletionTypes$DATASET) }) .rs.addFunction("getCompletionsGetOption", function(token) { allOptions <- names(options()) .rs.makeCompletions(token = token, results = .rs.selectFuzzyMatches(allOptions, token), packages = "options", quote = TRUE, type = .rs.acCompletionTypes$OPTION) }) .rs.addFunction("getCompletionsOptions", function(token) { allOptions <- names(options()) completions <- .rs.selectFuzzyMatches(allOptions, token) if (length(completions)) completions <- paste(completions, "= ") .rs.makeCompletions(token, completions, type = .rs.acCompletionTypes$OPTION) }) .rs.addFunction("getCompletionsActiveFrame", function(token, envir) { currentEnv <- envir encounteredEnvs <- list() completions <- character() types <- numeric() empty <- emptyenv() while (!(identical(currentEnv, empty) || identical(currentEnv, .GlobalEnv) || identical(currentEnv, .BaseNamespaceEnv))) { for (i in seq_along(encounteredEnvs)) { if (identical(currentEnv, encounteredEnvs[[i]])) return(.rs.emptyCompletions()) } objects <- objects(currentEnv, all.names = TRUE) completions <- c(completions, objects) types <- c( types, vapply(objects, USE.NAMES = FALSE, FUN.VALUE = numeric(1), function(object) { tryCatch( .rs.getCompletionType(get(object, envir = currentEnv, inherits = TRUE)), error = function(e) .rs.acCompletionTypes$UNKNOWN ) }) ) encounteredEnvs <- c(encounteredEnvs, currentEnv) currentEnv <- parent.env(currentEnv) } keep <- .rs.fuzzyMatches(completions, token) .rs.makeCompletions(token = token, results = completions[keep], type = types[keep]) }) .rs.addFunction("getNAMESPACEImportedSymbols", function(documentId) { .Call("rs_getNAMESPACEImportedSymbols", documentId) }) .rs.addFunction("getCompletionsNAMESPACE", function(token, documentId) { symbols <- .rs.getNAMESPACEImportedSymbols(documentId) if (!length(symbols)) return(.rs.emptyCompletions()) n <- vapply(symbols, function(x) length(x[[1]]), USE.NAMES = FALSE, FUN.VALUE = numeric(1)) output <- list( exports = unlist(lapply(symbols, `[[`, "exports"), use.names = FALSE), types = unlist(lapply(symbols, `[[`, "types"), use.names = FALSE), packages = rep.int(names(symbols), times = n) ) keep <- .rs.fuzzyMatches(output$exports, token) .rs.makeCompletions(token = token, results = output$exports[keep], packages = output$packages[keep], type = output$types[keep], quote = FALSE) }) .rs.addFunction("getCompletionsSearchPath", function(token, overrideInsertParens = FALSE) { objects <- if (.rs.startsWith(token, ".")) .rs.objectsOnSearchPath(".") else .rs.objectsOnSearchPath() objects[["keywords"]] <- c( "NULL", "NA", "TRUE", "FALSE", "T", "F", "Inf", "NaN", "NA_integer_", "NA_real_", "NA_character_", "NA_complex_" ) names <- names(objects) results <- unlist(objects, use.names = FALSE) packages <- unlist(lapply(1:length(objects), function(i) { rep.int(names[i], length(objects[[i]])) })) # discover completion matches for this token keep <- .rs.fuzzyMatches(results, token) results <- results[keep] packages <- packages[keep] # remove duplicates (assume first element masks next) dupes <- duplicated(results) results <- results[!dupes] packages <- packages[!dupes] # re-order the completion results (lexically) order <- order(results) # If the token is 'T' or 'F', prefer 'TRUE' and 'FALSE' completions if (token == "T") { TRUEpos <- which(results == "TRUE") order <- c(TRUEpos, order[-c(TRUEpos)]) } if (token == "F") { FALSEpos <- which(results == "FALSE") order <- c(FALSEpos, order[-c(FALSEpos)]) } results <- results[order] packages <- packages[order] type <- vapply(seq_along(results), function(i) { if (packages[[i]] == "keywords") return(.rs.acCompletionTypes$KEYWORD) if (packages[[i]] == "") return(.rs.acCompletionTypes$UNKNOWN) name <- results[[i]] env <- as.environment(packages[[i]]) if (bindingIsActive(name, env)) return(.rs.acCompletionTypes$ACTIVE_BINDING) object <- tryCatch( get(name, envir = env), error = identity ) if (inherits(object, "error")) return(.rs.acCompletionTypes$UNKNOWN) type <- .rs.getCompletionType(object) # fix up source package for S4 generics if (type %in% .rs.acCompletionTypes$S4_GENERIC) { package <- attr(object, "package", exact = TRUE) if (is.character(package) && nzchar(package)) packages[[i]] <<- package } return(type) }, FUN.VALUE = numeric(1), USE.NAMES = FALSE) # Keywords are really from the base package packages[packages == "keywords"] <- "base" .rs.makeCompletions(token = token, results = results, packages = packages, quote = FALSE, type = type, overrideInsertParens = overrideInsertParens) }) .rs.addFunction("finishExpression", function(string) { .Call("rs_finishExpression", as.character(string), PACKAGE = "(embedding)") }) .rs.addFunction("getCompletionsAttr", function(token, functionCall, envir) { result <- tryCatch({ wrapper <- function(x, which, exact = FALSE) {} matched <- .rs.matchCall(wrapper, functionCall) if (is.null(matched[["x"]])) return(.rs.emptyCompletions()) objectExpr <- matched[["x"]] objectName <- capture.output(print(objectExpr)) object <- eval(objectExpr, envir = envir) completions <- .rs.selectFuzzyMatches( names(attributes(object)), token ) result <- .rs.makeCompletions( token, completions, paste("attributes(", objectName, ")", sep = ""), quote = TRUE, type = .rs.acCompletionTypes$STRING ) }, error = function(e) .rs.emptyCompletions()) result }) .rs.addFunction("isBrowserActive", function() { .Call("rs_isBrowserActive") }) # NOTE: This function attempts to find an active frame (if # any) in the current caller's context, which may be a # function environment if we're currently in the debugger, # and just the .GlobalEnv otherwise. Because the # '.rs.rpc.get_completions' call gets its own set of 'stack # frames', we must poke into 'sys.frames()' and get the last # frame not part of that stack. In practice, this means # discarding the current frame, as well as any extra frames # from the caller (hence, the 'offset' argument). Of course, # when there is no debug frame active, we just want to draw # our completions from the global environment. .rs.addFunction("getActiveFrame", function(offset = 1L) { frames <- c(.GlobalEnv, sys.frames()) frames[[length(frames) - 1L - offset]] }) .rs.addFunction("getCompletionsNativeRoutine", function(token, interface) { # For a package which has dynamic symbol loading, just get the strings. # For other packages, search the namespace for the symbol. loadedDLLs <- getLoadedDLLs() routines <- lapply(loadedDLLs, getDLLRegisteredRoutines) isDynamic <- unlist(lapply(loadedDLLs, `[[`, "dynamicLookup")) dynRoutines <- c( routines[isDynamic], routines["(embedding)"] ) dynRoutineNames <- lapply(dynRoutines, function(x) { names(x[[interface]]) }) if (is.null(names(dynRoutineNames))) return(.rs.emptyCompletions()) dynResults <- .rs.namedVectorAsList(dynRoutineNames) dynIndices <- .rs.fuzzyMatches(dynResults$values, token) .rs.makeCompletions(token = token, results = dynResults$values[dynIndices], packages = dynResults$names[dynIndices], quote = TRUE, type = .rs.acCompletionTypes$STRING) }) .rs.addFunction("mightBeShinyFunction", function(string) { # Try seeing if there's a function with this name on the # search path, and return TRUE if it has 'inputId' or # 'outputId' as parameters. result <- tryCatch(get(string, pos = 0), error = function(e) NULL) if (is.function(result) && !is.primitive(result)) { formalNames <- names(formals(result)) if (any(c("inputId", "outputId") %in% formalNames)) return(TRUE) } # Try seeing if there's a function of this name # in the 'shiny' completion database. shinyFunctions <- .rs.getInferredCompletions("shiny")$functions if (string %in% names(shinyFunctions)) return(TRUE) return(FALSE) }) .rs.addFunction("getKnitParamsForDocument", function(documentId) { .Call("rs_getKnitParamsForDocument", documentId) }) .rs.addFunction("knitParams", function(content) { if (!("knitr" %in% loadedNamespaces())) if (!requireNamespace("knitr", quietly = TRUE)) return(NULL) if (!("knit_params" %in% getNamespaceExports(asNamespace("knitr")))) return(NULL) Encoding(content) <- "UTF-8" knitr::knit_params(content) }) .rs.addFunction("getCompletionsRMarkdownParams", function(token, type, documentId) { # TODO: Bail if 'params' is already defined? if (exists("params", envir = .GlobalEnv)) return(NULL) params <- .rs.getKnitParamsForDocument(documentId) if (!length(params)) return(.rs.emptyCompletions()) names <- vapply(params, FUN.VALUE = character(1), USE.NAMES = FALSE, function(x) { x$name }) completions <- .rs.selectFuzzyMatches(names, token) .rs.makeCompletions(token = token, results = completions) }) .rs.addFunction("injectKnitrParamsObject", function(documentId) { if (exists("params", envir = .GlobalEnv)) return(FALSE) params <- .rs.getKnitParamsForDocument(documentId) if (!length(params)) return(FALSE) mockedObject <- lapply(params, `[[`, "value") names(mockedObject) <- unlist(lapply(params, `[[`, "name")) class(mockedObject) <- "rstudio_mock" assign("params", mockedObject, envir = .GlobalEnv) return(TRUE) }) .rs.addFunction("removeKnitrParamsObject", function() { if (exists("params", envir = .GlobalEnv)) { params <- get("params", envir = .GlobalEnv) if (inherits(params, "rstudio_mock")) remove(params, envir = .GlobalEnv) } }) .rs.addFunction("getCompletionsPythonVirtualEnvironments", function(token) { home <- Sys.getenv("WORKON_HOME", unset = "~/.virtualenvs") candidates <- list.files(home) results <- .rs.selectFuzzyMatches(candidates, token) .rs.makeCompletions(token = token, results = results, quote = TRUE, type = .rs.acCompletionTypes$STRING) }) .rs.addFunction("getCompletionsEnvironmentVariables", function(token) { candidates <- names(Sys.getenv()) results <- .rs.selectFuzzyMatches(candidates, token) .rs.makeCompletions(token = token, results = results, quote = TRUE, type = .rs.acCompletionTypes$STRING) }) .rs.addFunction("readlineCompletions", function(token) { nframes <- sys.nframe() for (i in seq_len(nframes)) { fun <- sys.function(i) if (identical(fun, base::readline)) { frame <- sys.frame(i) rx <- "^.*(\\(|\\[)(.*)(\\)|\\]).*$" prompt <- frame$prompt if (is.character(prompt) && grepl(rx, prompt)) { results <- strsplit(sub(rx, "\\2", prompt), "/")[[1L]] # capitalized first as this is likely to be the default cap <- grepl("^[A-Z]", results) c(results[cap], results[!cap]) return(.rs.makeCompletions(token = token, results = results, quote = FALSE, type = .rs.acCompletionTypes$STRING)) } else { return(.rs.emptyCompletions(excludeOtherCompletions = TRUE)) } } } }) .rs.addJsonRpcHandler("get_completions", function(token, contextData, functionCallString, statementBounds, chainObjectName, additionalArgs, excludeArgs, excludeArgsFromObject, filePath, documentId, line, isConsole) { # Map from 0-based indexes to 1-based indexes in ranges for (i in seq_along(contextData)) contextData[[i]]$range <- .rs.reindexRange(contextData[[i]]$range) statementBounds <- .rs.reindexRange(statementBounds) # To avoid too much code churn, unpack the contextData members into # the expected (older) variable names. string <- lapply(contextData, `[[`, 1L) context <- lapply(contextData, `[[`, 2L) numCommas <- lapply(contextData, `[[`, 3L) # Ensure UTF-8 encoding, as that's the encoding set when passed down from # the client token <- .rs.setEncodingUnknownToUTF8(token) string <- .rs.setEncodingUnknownToUTF8(string) functionCallString <- .rs.setEncodingUnknownToUTF8(functionCallString) chainObjectName <- .rs.setEncodingUnknownToUTF8(chainObjectName) additionalArgs <- .rs.setEncodingUnknownToUTF8(additionalArgs) excludeArgs <- .rs.setEncodingUnknownToUTF8(excludeArgs) excludeArgsFromObject <- .rs.setEncodingUnknownToUTF8(excludeArgsFromObject) filePath <- .rs.setEncodingUnknownToUTF8(filePath) # if base::readline() is on the stack, try to extract choices i.e. (yes/no) # and offer those as completions. readLineCompletions <- .rs.readlineCompletions(token) if (!is.null(readLineCompletions)) return(readLineCompletions) # If the R console is requesting completions, but the Python REPL is # active, then delegate to that machinery. if (isConsole && .rs.reticulate.replIsActive()) return(.rs.rpc.python_get_completions(line, NULL)) # Inject 'params' into the global env to provide for completions in # parameterized R Markdown documents if (.rs.injectKnitrParamsObject(documentId)) on.exit(.rs.removeKnitrParamsObject(), add = TRUE) # If custom completions have been set through # 'rc.options("custom.completions")', # then use the internal R completions instead. if (.rs.isCustomCompletionsEnabled()) { completions <- tryCatch( .rs.getCustomRCompletions(line), error = identity ) if (!inherits(completions, "error")) return(completions) } # Get the currently active frame envir <- .rs.getActiveFrame() filePath <- suppressWarnings(.rs.normalizePath(filePath)) ## NOTE: these are passed in as lists of strings; convert to character additionalArgs <- as.character(additionalArgs) excludeArgs <- as.character(excludeArgs) ## For magrittr completions, we may see a pipe thrown in as part of the 'string' ## and 'functionCallString'. In such a case, we need to strip off everything before ## a '%>%' and augment the numCommas isPiped <- nzchar(chainObjectName) if (length(string)) { pipes <- c("%>%", "%<>%", "%T>%", "%>>%", "\\|>") pattern <- paste(pipes, collapse = "|") stringPipeMatches <- gregexpr( pattern, string[[1]], perl = TRUE )[[1]] if (!identical(c(stringPipeMatches), -1L)) { n <- length(stringPipeMatches) idx <- stringPipeMatches[n] + attr(stringPipeMatches, "match.length")[n] isPiped <- TRUE string[[1]] <- gsub("^[\\s\\n]*", "", substring(string[[1]], idx), perl = TRUE) ## Figure out the 'parent object' of the call. We munge the ## function call and place that back in, so S3 dispatch and such ## can work. firstPipeIdx <- stringPipeMatches[[1]] parentObject <- .rs.trimWhitespace( substring(functionCallString, 1, firstPipeIdx - 1L) ) functionCallString <- gsub( "^\\s*", "", substring(functionCallString, idx), perl = TRUE ) # Add the argument back in functionCallString <- sub( "(", paste("(", parentObject, ",", sep = ""), functionCallString, fixed = TRUE ) } else if (nzchar(chainObjectName)) { functionCallString <- sub( "(", paste("(", chainObjectName, ",", sep = ""), functionCallString, fixed = TRUE ) } } # the functionCallString was altered, so we need to bump the first numCommas if (isPiped && length(context) && context[[1L]] == .rs.acContextTypes$FUNCTION) numCommas[[1L]] <- numCommas[[1L]] + 1L ## Try to parse the function call string functionCall <- tryCatch({ parse(text = .rs.finishExpression(functionCallString))[[1]] }, error = function(e) NULL ) ## Handle some special cases early # custom help handler for arguments if (length(context) && .rs.acContextTypes$FUNCTION %in% context[[1]]) { completions <- .rs.getCompletionsCustomHelpHandler(token, string[[1]]) if (!is.null(completions)) return(completions) } # help if (.rs.acContextTypes$HELP %in% context) return(.rs.getCompletionsHelp(token)) # Roxygen if (.rs.acContextTypes$ROXYGEN %in% context) return(.rs.attemptRoxygenTagCompletion(token, line)) # Plumber if (.rs.acContextTypes$PLUMBER %in% context) return(.rs.attemptPlumberTagCompletion(token, line)) # install.packages if (length(string) && string[[1]] == "install.packages" && numCommas[[1]] == 0) return(.rs.getCompletionsInstallPackages(token)) # example / help if (nzchar(token) && length(string) && string[[1]] %in% c("help", "example") && numCommas[[1]] == 0) { return(.rs.getCompletionsHelp(token, quote = TRUE)) } # vignettes if (length(string) && string[[1]] == "vignette" && numCommas[[1]] == 0) return(.rs.getCompletionsVignettes(token)) # .Call, .C, .Fortran, .External if (length(string) && string[[1]] %in% c(".Call", ".C", ".Fortran", ".External") && numCommas[[1]] == 0) { return(.rs.getCompletionsNativeRoutine(token, string[[1]])) } # data if (length(context) && context[[1]] == .rs.acContextTypes$FUNCTION && string[[1]] == "data" && numCommas[[1]] == 0) { return(.rs.getCompletionsData(token)) } # package name if (.rs.acContextTypes$PACKAGE %in% context) return(.rs.getCompletionsPackages(token = token, appendColons = TRUE, excludeOtherCompletions = TRUE)) # environment variables if (length(string) && string[[1]] %in% c("Sys.getenv", "Sys.setenv") && numCommas[[1]] == 0) return(.rs.getCompletionsEnvironmentVariables(token)) # Python virtual environments if (length(string) && string[[1]] %in% c("use_virtualenv", "reticulate::use_virtualenv") && numCommas[[1]] == 0) { return(.rs.getCompletionsPythonVirtualEnvironments(token)) } # No information on completions other than token if (!length(string)) { # If there was no token, give up if (!nzchar(token)) return(.rs.emptyCompletions(excludeOtherCompletions = TRUE)) # Otherwise, complete from the search path + available packages completions <- Reduce(.rs.appendCompletions, list( .rs.getCompletionsSearchPath(token), .rs.getCompletionsNAMESPACE(token, documentId), .rs.getCompletionsPackages(token, TRUE), .rs.getCompletionsActiveFrame(token, envir), .rs.getCompletionsLibraryContext(token, string, context, numCommas, functionCall, documentId, envir) )) # remove all queries that start with a '.' unless the # token itself starts with a dot if (!.rs.startsWith(token, ".")) { startsWithDot <- .rs.startsWith(completions$results, ".") completions <- .rs.subsetCompletions(completions, which(!startsWithDot)) } # try completing from the source index if this is an # R file within a package if (.rs.isRScriptInPackageBuildTarget(filePath)) { # get the active package pkgName <- .rs.packageNameForSourceFile(filePath) completions <- .rs.appendCompletions( completions, .rs.getCompletionsActivePackage(token, pkgName) ) } # Ensure case-sensitive matches come first. return(.rs.sortCompletions(completions, token)) } # transform 'install.packages' to 'utils::install.packages' to avoid # getting arguments from the RStudio hook if ("install.packages" %in% string[[1]]) { fn <- .rs.getAnywhere("install.packages", envir) if (is.function(fn) && identical(names(formals(fn)), "...")) { string[[1]] <- "utils::install.packages" } } # library, require, requireNamespace, loadNamespace if (string[[1]] %in% c("library", "require", "requireNamespace") && numCommas[[1]] == 0) { quote <- !(string[[1]] %in% c("library", "require")) return(.rs.getCompletionsPackages(token, excludeOtherCompletions = TRUE, quote = quote)) } ## File-based completions if (.rs.acContextTypes$FILE %in% context) { whichIndex <- which(context == .rs.acContextTypes$FILE) tokenToUse <- string[[whichIndex]] directoriesOnly <- FALSE if (length(string) > whichIndex) { if (string[[whichIndex + 1]] %in% c("list.files", "list.dirs", "dir", "setwd")) { directoriesOnly <- TRUE } } # NOTE: For Markdown link completions, we overload the meaning of the # function call string here, and use it as a signal to generate paths # relative to the R markdown path. isNotebook <- .rs.endsWith(tolower(filePath), ".rmd") || .rs.endsWith(tolower(filePath), ".qmd") path <- NULL # if in an Rmd file, ask it for its desired working dir (can be changed # with the knitr root.dir option) if (isNotebook) { path <- .Call("rs_getNotebookWorkingDir", filePath, documentId) } if (is.null(path) && isNotebook) { # for R Markdown documents without an explicit working dir, # use preferences instead path <- .rs.markdown.resolveCompletionRoot(filePath) } if (is.null(path)) { # in all other cases, use the current working directory for # completions path <- getwd() } return(.rs.getCompletionsFile(token = tokenToUse, path = path, quote = FALSE, directoriesOnly = directoriesOnly)) } # Shiny completions ## Completions for server.r (from ui.r) if (context[[1]] %in% c(.rs.acContextTypes$DOLLAR, .rs.acContextTypes$DOUBLE_BRACKET) && tolower(basename(filePath)) == "server.r" && string[[1]] %in% c("input", "output")) { completions <- .rs.getCompletionsFromShinyUI(token, filePath, string[[1]], context[[1]]) if (!is.null(completions)) return(completions) } ## Completions for server.r, on session if (context[[1]] == .rs.acContextTypes$DOLLAR && tolower(basename(filePath)) == "server.r" && string[[1]] == "session") { completions <- .rs.getCompletionsShinySession(token) if (!is.null(completions)) return(completions) } ## Completions for ui.r (from server.r) if (context[[1]] == .rs.acContextTypes$FUNCTION && tolower(basename(filePath)) == "ui.r" && numCommas[[1]] == 0 && .rs.mightBeShinyFunction(string[[1]])) { completions <- .rs.getCompletionsFromShinyServer(token, filePath, string[[1]], context[[1]]) if (!is.null(completions)) return(completions) } ## Other special cases (but we may still want completions from ## other contexts) triedGgplot2Completions <- FALSE # attr completions <- if (string[[1]] == "attr") { .rs.getCompletionsAttr(token, functionCall, envir) } # getOption else if (string[[1]] == "getOption" && numCommas[[1]] == 0) { .rs.getCompletionsGetOption(token) } # options else if (string[[1]] == "options" && context[[1]] == .rs.acContextTypes$FUNCTION) { .rs.getCompletionsOptions(token) } # ggplot2 else if (is.call(functionCall)) { lhs <- functionCall[[1L]] if (is.symbol(lhs)) { lhs <- as.character(lhs) if (lhs %in% c("aes") || grepl("^facet_", lhs)) { triedGgplot2Completions <- TRUE completions <- tryCatch( .rs.getCompletionsGgplot2(token, contextData, statementBounds, documentId, envir), error = function(e) .rs.emptyCompletions(token) ) } } } if (is.null(completions)) completions <- .rs.emptyCompletions(token) ## If we are getting completions from a '$', '@', '::' or ':::' then we do not ## want to look for completions in other contexts # dollar context dontLookBack <- length(context) && context[[1]] %in% c( .rs.acContextTypes$DOLLAR, .rs.acContextTypes$AT, .rs.acContextTypes$NAMESPACE_EXPORTED, .rs.acContextTypes$NAMESPACE_ALL ) if (dontLookBack) { # dollar context if (context[[1]] %in% c(.rs.acContextTypes$DOLLAR, .rs.acContextTypes$AT)) { completions <- .rs.getCompletionsDollar( token, string[[1]], functionCall, envir, context[[1]] == .rs.acContextTypes$AT ) } # namespace context else if (context[[1]] %in% c(.rs.acContextTypes$NAMESPACE_EXPORTED, .rs.acContextTypes$NAMESPACE_ALL)) { completions <- .rs.getCompletionsNamespace( token, string[[1]], context[[1]] == .rs.acContextTypes$NAMESPACE_EXPORTED, envir ) } } # otherwise, look through the contexts and pick up completions else { for (i in seq_along(string)) { # Don't provide function completions if we just provided # argument name completions stopGeneratingCompletions <- i > 1 && context[[i]] == .rs.acContextTypes$FUNCTION && context[[i - 1]] == .rs.acContextTypes$ARGUMENT if (stopGeneratingCompletions) break # Ignore completions from the 'aes()' function if we've # already tried to retrieve more relevant aesthetics skipFunctionCompletions <- triedGgplot2Completions && context[[i]] == .rs.acContextTypes$FUNCTION && string[[i]] %in% "aes" if (skipFunctionCompletions) next completions <- .rs.appendCompletions( completions, .rs.getRCompletions(token, i, string[[i]], context[[i]], numCommas[[i]], functionCall, completions$excludeOtherCompletions, documentId, envir) ) } } ## If the caller has supplied information about chain completions (e.g. ## for completions from ## ## x %>% foo() %>% bar() ## ## then retrieve those completions. ## unless it's a group_by() completion which has been dealt with already if (!(context[[1]] == .rs.acContextTypes$FUNCTION && string[[1]] == "group_by")) { completions <- .rs.appendCompletions( completions, .rs.getRChainCompletions(token, chainObjectName, additionalArgs, excludeArgs, excludeArgsFromObject, envir) ) } # get completions from the search path for the 'generic' contexts if (token != "" && context[[1]] %in% c(.rs.acContextTypes$UNKNOWN, .rs.acContextTypes$FUNCTION, .rs.acContextTypes$ARGUMENT, .rs.acContextTypes$SINGLE_BRACKET, .rs.acContextTypes$DOUBLE_BRACKET)) { completions <- Reduce(.rs.appendCompletions, list( completions, .rs.getCompletionsSearchPath(token), .rs.getCompletionsNAMESPACE(token, documentId), .rs.getCompletionsActiveFrame(token, envir), .rs.getCompletionsLibraryContext(token, string[[1]], context[[1]], numCommas[[1]], functionCall, documentId, envir) )) if (.rs.isRScriptInPackageBuildTarget(filePath)) { pkgName <- .rs.packageNameForSourceFile(filePath) completions <- .rs.appendCompletions( completions, .rs.getCompletionsActivePackage(token, pkgName) ) } } ## Package completions (e.g. `stats::`) if (token != "" && .rs.acContextTypes$UNKNOWN %in% context) completions <- .rs.appendCompletions( completions, .rs.getCompletionsPackages(token, TRUE) ) ## Override param insertion if the function was 'debug' or 'trace' for (i in seq_along(context)) { if (context[[i]] %in% c(.rs.acContextTypes$FUNCTION, .rs.acContextTypes$UNKNOWN)) { ## Exclude certain functions if (string[[i]] %in% c("help", "str", "args", "debug", "debugonce", "trace")) { completions$overrideInsertParens <- .rs.scalar(TRUE) } else { ## Exclude based on formals of the function object <- .rs.getAnywhere(string[[i]], envir) if (is.function(object)) { argNames <- .rs.getFunctionArgumentNames(object) if (any(c("f", "fun", "func") %in% tolower(gsub("[^a-zA-Z]", "", argNames)))) completions$overrideInsertParens <- .rs.scalar(TRUE) } } } } completions <- .rs.sortCompletions(completions, token) completions$token <- token completions }) .rs.addFunction("getTextRange", function(contents, range) { # extract text from the rows in use rows <- seq(from = range$start$row, to = range$end$row) inner <- contents[rows] n <- length(inner) # subset based on provided columns if (n == 1L) { inner[[1L]] <- substring( inner[[1L]], range$start$column, range$end$column ) } else { inner[[1L]] <- substring(inner[[1L]], range$start$column) inner[[n]] <- substring(inner[[n]], 1L, range$end$column) } # return collapsed text paste(inner, collapse = "\n") }) .rs.addFunction("ggplot2.defaultAesthetics", function() { c("x", "y", "fill", "colour", "alpha", "shape", "size", "linewidth", "linetype", "group") }) .rs.addFunction("getCompletionsGgplot2", function(token, contextData, statementBounds, documentId, envir) { # get document contents document <- .rs.getSourceDocument(documentId, TRUE) contents <- strsplit(document$contents, "\n", fixed = TRUE)[[1L]] # the data object associated with the aes() call, if any data <- NULL # search for a context relating to a geom_ invocation geomContext <- NULL for (i in seq_along(contextData)) { if (grepl("(?:^|::)facet_", contextData[[i]]$data)) { break } else if (grepl("(?:^|::)geom_", contextData[[i]]$data)) { geomContext <- contextData[[i]] break } } # if we have a geom context, check it for a data argument if (!is.null(geomContext)) { geomText <- .rs.getTextRange(contents, geomContext$range) geomCall <- parse(text = .rs.finishExpression(geomText))[[1L]] if ("data" %in% names(geomCall)) data <- geomCall[["data"]] } # if we don't have a data argument, check if we can extract it # from the current statement being evaluated if (is.null(data)) { # get current call currentStatement <- .rs.getTextRange(contents, statementBounds) currentCall <- parse(text = .rs.finishExpression(currentStatement))[[1L]] # find the top-most call in the hierarchy while (identical(currentCall[[1L]], as.symbol("+"))) currentCall <- currentCall[[2L]] # check for a data argument data <- currentCall[["data"]] if (is.null(data) && length(currentCall) >= 2L) data <- currentCall[[2L]] } # if 'data' is a call, check the contents to see if this is a plain pipe usage if (is.call(data)) { .rs.tryCatch({ newlineIndex <- regexpr("\n", currentStatement, fixed = TRUE) firstLine <- substring(currentStatement, 1L, newlineIndex - 1L) firstLine <- gsub("\\|\\>\\s*(?:#|$)", "", firstLine, perl = TRUE) firstLine <- gsub("%[^%]+%\\s*(?:#|$)", "", firstLine, perl = TRUE) firstCall <- parse(text = .rs.finishExpression(firstLine))[[1L]] if (is.call(firstCall) && length(firstCall) == 3L) firstCall <- firstCall[[2L]] if (is.symbol(firstCall)) data <- firstCall }) } # NOTE: We use 'eval()' here to ensure that things like datasets # are properly resolved; e.g. if working with mtcars from the datasets package. value <- NULL if (is.symbol(data)) { source <- .rs.deparse(data) value <- eval(data, envir = envir) if (inherits(value, "gg")) value <- value$data } # check whether we should complete aesthetic names in this context completions <- .rs.emptyCompletions(token) # skip arguments on context stack includeAestheticNames <- "aes" %in% contextData[[1L]]$data && .rs.acContextTypes$FUNCTION %in% contextData[[1L]]$type if (includeAestheticNames && requireNamespace("ggplot2", quietly = TRUE)) { if (is.null(geomContext)) { aestheticNames <- .rs.ggplot2.defaultAesthetics() aestheticSource <- "ggplot2" } else { geomName <- geomContext$data parts <- strsplit(geomName, ":{2,3}")[[1L]] if (length(parts) == 2L) { geomName <- parts[[2L]] envir <- asNamespace(parts[[1L]]) } ggplot2 <- asNamespace("ggplot2") geomFunc <- if (exists(geomName, envir = envir)) eval(as.symbol(geomName), envir = envir) else if (exists(geomName, envir = ggplot2)) eval(as.symbol(geomName), envir = ggplot2) layerInfo <- geomFunc() aesthetics <- c( layerInfo$geom$required_aes, layerInfo$stat$required_aes, names(layerInfo$geom$default_aes), names(layerInfo$stat$default_aes), "group" ) aestheticNames <- unlist(strsplit(aesthetics, "|", fixed = TRUE)) aestheticNames <- aestheticNames[!duplicated(aestheticNames)] aestheticSource <- geomName } # exclude argument names which already been used .rs.tryCatch({ aesRange <- contextData[[1]]$range aesText <- .rs.getTextRange(contents, aesRange) aesCall <- parse(text = aesText)[[1L]] aestheticNames <- setdiff(aestheticNames, names(aesCall)) }) results <- .rs.selectFuzzyMatches(aestheticNames, token) if (length(results)) { completions <- .rs.makeCompletions( token = token, results = paste(results, "= "), packages = aestheticSource, type = .rs.acCompletionTypes$ARGUMENT, quote = FALSE ) } } # now, add on completions from the source data object if (!is.null(value)) { completions <- .rs.appendCompletions( completions, .rs.makeCompletions( token = token, results = .rs.selectFuzzyMatches(names(value), token), quote = FALSE, type = .rs.acCompletionTypes$COLUMN, packages = source, excludeOtherCompletions = TRUE, excludeOtherArgumentCompletions = TRUE ) ) } completions }) .rs.addFunction("hasColumns", function(object) { if (inherits(object, c("data.frame", "tbl"))) return(TRUE) arrow <- isNamespaceLoaded("arrow") && inherits(object, c("ArrowTabular", "Dataset", "arrow_dplyr_query")) if (arrow) return(TRUE) FALSE }) .rs.addFunction("getRChainCompletions", function(token, chainObjectName, additionalArgs, excludeArgs, excludeArgsFromObject, envir) { result <- .rs.emptyCompletions() # chainObjectName will be provided if the client detected # that we were performing completions within an e.g. # `%>%` chain -- use completions from the associated data object. if (is.null(chainObjectName)) return(result) # prevent evaluation of data.table `[` calls, e.g. # # dt[, y := 2] %>% ... %>% filter() if (.rs.isDataTableExtractCall(chainObjectName, envir = envir)) return(result) object <- .rs.getAnywhere(chainObjectName, envir = envir) if (inherits(object, "python.builtin.object")) return(result) # additional completions from the client, e.g. rename(a = <...>) if (length(additionalArgs)) { additionalArgsCompletions <- .rs.makeCompletions( token = token, results = .rs.selectFuzzyMatches(additionalArgs, token), packages = paste0(chainObjectName, " %>% ..."), type = .rs.acCompletionTypes$COLUMN ) result <- .rs.appendCompletions(result, additionalArgsCompletions) } if (!excludeArgsFromObject && .rs.hasColumns(object)) { columnCompletions <- .rs.makeCompletions( token = token, results = .rs.selectFuzzyMatches(setdiff(.rs.getNames(object), additionalArgs), token), packages = chainObjectName, quote = FALSE, type = .rs.acCompletionTypes$COLUMN ) result <- .rs.appendCompletions(result, columnCompletions) } if (length(excludeArgs)) { indices <- which(!(result$results %in% excludeArgs)) result <- .rs.subsetCompletions(result, indices) } result }) .rs.addFunction("getRCompletions", function(token, index, string, context, numCommas, functionCall, excludeOtherCompletions, documentId, envir) { completions <- if (context == .rs.acContextTypes$FUNCTION) .rs.getCompletionsFunction(token, string, functionCall, numCommas, envir) else if (context == .rs.acContextTypes$ARGUMENT) .rs.getCompletionsArgument(token, string, functionCall, envir) else if (context == .rs.acContextTypes$SINGLE_BRACKET) .rs.getCompletionsSingleBracket(token, string, functionCall, numCommas, index, envir) else if (context == .rs.acContextTypes$DOUBLE_BRACKET) .rs.getCompletionsDoubleBracket(token, string, functionCall, envir) else .rs.emptyCompletions() if (index == 1L && !excludeOtherCompletions) { libraryContextCompletions <- .rs.getCompletionsLibraryContext(token, string, context, numCommas, functionCall, documentId, envir) # prefer argument completions from libraryContextCompletions # because it contains the package name too if (any(libraryContextCompletions$type == .rs.acCompletionTypes$ARGUMENT)) { completions <- .rs.subsetCompletions(completions, completions$type != .rs.acCompletionTypes$ARGUMENT) } completions <- .rs.appendCompletions(completions, libraryContextCompletions) } completions }) .rs.addFunction("getCompletionsCustomHelpHandler", function(token, scope) { custom <- .rs.findCustomHelpContext(scope, "help_formals_handler") if (is.null(custom)) return(NULL) formals <- .rs.tryCatch(custom$handler(custom$topic, custom$source)) if (inherits(formals, "error")) return(NULL) if (length(formals) == 0L) return(.rs.emptyCompletions(excludeOtherCompletions = TRUE)) completions <- paste(formals$formals, sep = "= ") .rs.makeCompletions( token = token, results = .rs.selectFuzzyMatches(completions, token), packages = scope, type = .rs.acCompletionTypes$ARGUMENT, excludeOtherCompletions = TRUE, helpHandler = formals$helpHandler, context = .rs.acContextTypes$FUNCTION ) }) ## NOTE: This is a modified version of 'matchAvailableTopics' ## in 'completions.R' of the R sources. .rs.addFunction("getCompletionsHelp", function(token, quote = FALSE) { ## Attempt to find the help topic item in the local ## cache, as reading files from disk multiple times ## could be slow pkgCacheName <- ".completions.attachedPackagesCache" helpTopicsName <- ".completions.helpTopics" attachedPackagesCache <- tryCatch( get(pkgCacheName, envir = .rs.toolsEnv()), error = function(e) character() ) ## If the current search paths have changed, invalidate ## the cache and update our aliases paths <- searchpaths()[substring(search(), 1, 8) == "package:"] if (!identical(basename(paths), attachedPackagesCache)) { assign(pkgCacheName, basename(paths), envir = .rs.toolsEnv()) # Get the set of help topics topics <- lapply(paths, .rs.readAliases) names(topics) <- basename(paths) assign(helpTopicsName, topics, envir = .rs.toolsEnv()) } aliases <- get(helpTopicsName, envir = .rs.toolsEnv()) ## If the token is of the form `<pkg>::<topic>`, ## then attempt to get the topic 'topic' for that ## package. if (regexpr(":{2,3}", token, perl = TRUE) != -1) { splat <- strsplit(token, ":{2,3}", perl = TRUE)[[1]] pkg <- splat[[1]] token <- if (length(splat) > 1) splat[[2]] else "" ## If the help topics for this package have not been loaded, ## explicitly load and save them now. if (!(pkg %in% names(aliases))) { pkgPath <- tryCatch( find.package(pkg, quiet = TRUE), error = function(e) NULL ) if (!is.null(pkgPath)) { aliases[[pkg]] <- .rs.readAliases(pkgPath) assign(helpTopicsName, aliases, envir = .rs.toolsEnv()) } } # filter the aliases list to just this package aliases <- aliases[names(aliases) %in% pkg] } filtered <- lapply(aliases, function(alias) { .rs.selectFuzzyMatches(alias, token) }) listed <- .rs.namedVectorAsList(filtered) completions <- .rs.makeCompletions( token = token, results = listed$values, packages = listed$names, quote = quote, type = .rs.acCompletionTypes$HELP, overrideInsertParens = TRUE, context = .rs.acContextTypes$HELP ) .rs.sortCompletions(completions, token) }) .rs.addFunction("readDevAliases", function(path) { meta <- pkgload::dev_meta(basename(path)) if (!is.null(meta)) return(pkgload:::dev_topic_index(path)) }) .rs.addFunction("readAliases", function(path) { if (!length(path)) return(character()) # Check for packages loaded via devtools::load_all() devIndex <- .rs.tryCatch(.rs.readDevAliases(path)) if (is.character(devIndex)) return(names(devIndex)) # Otherwise, read aliases directly aliasesPath <- file.path(path, "help/aliases.rds") if (file.exists(aliasesPath)) names(readRDS(aliasesPath)) else character() }) .rs.addFunction("getCompletionsActivePackage", function(token, pkgName) { # Get completions from the source index sourceIndexCompletions <- .rs.getSourceIndexCompletions(token) # format completions for return to R if (!length(sourceIndexCompletions$completions)) { completions <- .rs.emptyCompletions() } else { results <- sourceIndexCompletions$completions # TODO: more granular lookup on the object type for source index completions type <- ifelse(sourceIndexCompletions$isFunction, .rs.acCompletionTypes$FUNCTION, .rs.acCompletionTypes$UNKNOWN) completions <- .rs.makeCompletions(token = token, results = results, packages = pkgName, quote = FALSE, type = type) } # get completions from the imports of the package importCompletions <- tryCatch( getNamespaceImports(asNamespace(pkgName)), error = function(e) NULL ) # workaround for devtools::load_all() clobbering the # namespace imports if (length(importCompletions) && is.null(names(importCompletions))) { try({ env <- new.env(parent = emptyenv()) for (el in importCompletions) { # Length one element: get all exports from that package if (length(el) == 1) { env[[el]] <- c(env[[el]], getNamespaceExports(asNamespace(el))) } # Length >1 element: 'importFrom()'. else if (length(el) > 1) { env[[el]] <- c(env[[el]], tail(el, n = -1)) } } importCompletions <- as.list(env) }, silent = TRUE) } # remove 'base' element if it's just TRUE if (length(importCompletions)) { if (isTRUE(importCompletions[["base"]])) importCompletions$base <- NULL } # if we have import completions, use them if (length(importCompletions) && !is.null(names(importCompletions))) { importCompletionsList <- .rs.namedVectorAsList(importCompletions) # filter completions indices <- .rs.fuzzyMatches(importCompletionsList$values, token) importCompletionsList <- lapply(importCompletionsList, function(x) { x[indices] }) objects <- lapply(seq_along(importCompletionsList$values), function(i) { tryCatch( expr = get(importCompletionsList$values[[i]], envir = asNamespace(importCompletionsList$names[[i]])), error = function(e) NULL ) }) type <- vapply(objects, FUN.VALUE = numeric(1), USE.NAMES = FALSE, .rs.getCompletionType) completions <- .rs.appendCompletions( completions, .rs.makeCompletions(token = token, results = importCompletionsList$values, packages = paste("package:", importCompletionsList$names, sep = ""), type = type) ) } completions }) .rs.addFunction("getCompletionsFromShinyServer", function(token, filePath, string, type) { dir <- dirname(filePath) serverPath <- file.path(dir, "server.R") uiPath <- file.path(dir, "ui.R") name <- tolower(basename(filePath)) if (!file.exists(serverPath)) return(NULL) completions <- .rs.shinyServerCompletions(serverPath) results <- if (.rs.endsWith(string, "Input")) .rs.selectFuzzyMatches(completions$input, token) else .rs.selectFuzzyMatches(completions$output, token) return(.rs.makeCompletions(token = token, results = results, packages = serverPath, quote = TRUE, type = .rs.acCompletionTypes$CONTEXT, excludeOtherCompletions = TRUE)) }) .rs.addFunction("getCompletionsFromShinyUI", function(token, filePath, string, type) { dir <- dirname(filePath) serverPath <- file.path(dir, "server.R") uiPath <- file.path(dir, "ui.R") name <- tolower(basename(filePath)) if (!file.exists(uiPath)) return(NULL) completions <- .rs.shinyUICompletions(uiPath) results <- if (string == "input") .rs.selectFuzzyMatches(completions$input, token) else .rs.selectFuzzyMatches(completions$output, token) return(.rs.makeCompletions(token = token, results = results, packages = uiPath, quote = type == .rs.acContextTypes$DOUBLE_BRACKET, type = .rs.acCompletionTypes$CONTEXT, excludeOtherCompletions = type == .rs.acContextTypes$DOLLAR)) }) .rs.addFunction("shinyUICompletions", function(file) { # Check to see if we can re-use cached completions fileCacheName <- paste(file, "shinyUILastModifiedTime", sep = "-") completionsCacheName <- paste(file, "shinyUICompletions", sep = "-") info <- .rs.fileInfo(file) mtime <- info[1, "mtime"] if (identical(mtime, .rs.get(fileCacheName)) && !is.null(.rs.get(completionsCacheName))) { return(.rs.get(completionsCacheName)) } # Otherwise, get the completions parsed <- tryCatch( suppressWarnings(parse(file)), error = function(e) NULL ) if (is.null(parsed)) return(NULL) # We fill environments (since these can grow efficiently / by reference) inputEnv <- new.env(parent = emptyenv()) outputEnv <- new.env(parent = emptyenv()) inputCount <- new.env(parent = emptyenv()) inputCount$count <- 1 outputCount <- new.env(parent = emptyenv()) outputCount$count <- 1 shinyFunctions <- .rs.getInferredCompletions("shiny")$functions lapply(parsed, function(object) { .rs.doShinyUICompletions(object, inputEnv, outputEnv, inputCount, outputCount, shinyFunctions) }) completions <- list(input = unlist(mget(objects(inputEnv), envir = inputEnv), use.names = FALSE), output = unlist(mget(objects(outputEnv), envir = outputEnv), use.names = FALSE)) .rs.assign(fileCacheName, mtime) .rs.assign(completionsCacheName, completions) completions }) .rs.addFunction("extractFunctionNameFromCall", function(object) { if (!is.call(object)) return("") if (.rs.isSymbolCalled(object[[1]], "::") || .rs.isSymbolCalled(object[[1]], ":::") || (is.character(object[[1]]) && object[[1]] %in% c("::", ":::"))) { if (length(object) > 2) return(as.character(object[[3]])) else return("") } if (is.character(object[[1]]) || is.symbol(object[[1]])) return(as.character(object[[1]])) if (is.call(object[[1]])) return(.rs.extractFunctionNameFromCall(object[[1]])) return("") }) .rs.addFunction("doShinyUICompletions", function(object, inputs, outputs, inputCount, outputCount, shinyFunctions) { if (is.call(object) && length(object) > 1) { functionName <- .rs.extractFunctionNameFromCall(object) firstArgName <- if (is.character(object[[2]]) && length(object[[2]]) == 1) object[[2]] else "" if (nzchar(firstArgName)) { functionArgs <- shinyFunctions[[functionName]] if ("outputId" %in% functionArgs || .rs.endsWith(functionName, "Output")) { outputCount$count <- outputCount$count + 1 outputs[[as.character(outputCount$count)]] <- firstArgName } else if ("inputId" %in% functionArgs || .rs.endsWith(functionName, "Input")) { inputCount$count <- inputCount$count + 1 inputs[[as.character(inputCount$count)]] <- firstArgName } } for (j in 2:length(object)) { if (is.call(object[[j]])) { .rs.doShinyUICompletions(object[[j]], inputs, outputs, inputCount, outputCount, shinyFunctions) } } } }) .rs.addFunction("shinyServerCompletions", function(file) { # Check to see if we can re-use cached completions fileCacheName <- paste(file, "shinyServerLastModifiedTime", sep = "-") completionsCacheName <- paste(file, "shinyServerCompletions", sep = "-") info <- .rs.fileInfo(file) mtime <- info[1, "mtime"] if (identical(mtime, .rs.get(fileCacheName)) && !is.null(.rs.get(completionsCacheName))) { return(.rs.get(completionsCacheName)) } # Otherwise, get the completions parsed <- tryCatch( suppressWarnings(parse(file)), error = function(e) NULL ) if (is.null(parsed)) return(NULL) # We fill environments (since these can grow efficiently / by reference) inputEnv <- new.env(parent = emptyenv()) outputEnv <- new.env(parent = emptyenv()) inputCount <- new.env(parent = emptyenv()) inputCount$count <- 1 outputCount <- new.env(parent = emptyenv()) outputCount$count <- 1 lapply(parsed, function(object) { .rs.doShinyServerCompletions(object, inputEnv, outputEnv, inputCount, outputCount) }) completions <- list(input = unlist(mget(objects(inputEnv), envir = inputEnv), use.names = FALSE), output = unlist(mget(objects(outputEnv), envir = outputEnv), use.names = FALSE)) .rs.assign(fileCacheName, mtime) .rs.assign(completionsCacheName, completions) completions }) .rs.addFunction("doShinyServerCompletions", function(object, inputs, outputs, inputCount, outputCount) { if (is.call(object)) { operator <- as.character(object[[1]]) if (length(object) == 3 && (operator == "$" || operator == "[[")) { name <- if (is.symbol(object[[2]])) as.character(object[[2]]) else if (is.character(object[[2]]) && length(object[[2]]) == 1) object[[2]] else "" value <- as.character(object[[3]]) if (name == "output") { outputCount$count <- outputCount$count + 1 outputs[[as.character(outputCount$count)]] <- .rs.stripSurrounding(value) } if (name == "input") { inputCount$count <- inputCount$count + 1 inputs[[as.character(inputCount$count)]] <- .rs.stripSurrounding(value) } } if (length(object) > 1) { for (j in 2:length(object)) { if (is.call(object[[j]])) { .rs.doShinyServerCompletions(object[[j]], inputs, outputs, inputCount, outputCount) } } } } }) .rs.addFunction("getCompletionsShinySession", function(token) { # Use cached completions if possible if (!is.null(results <- .rs.get("shinySessionCompletions"))) return(results) # Get completions from shiny if available if (!("shiny" %in% loadedNamespaces())) return(NULL) # Check to see if this version of Shiny has a completions # function we can use completionGetter <- tryCatch( eval(call(":::", "shiny", "session_completions")), error = function(e) NULL ) if (is.null(completionGetter)) return(NULL) # Get the completions from Shiny completions <- tryCatch( completionGetter(), error = function(e) NULL ) if (is.null(completions)) return(NULL) # Ensure that this is a character vector if (!is.character(completions)) return(NULL) # Return completions results <- .rs.selectFuzzyMatches(completions, token) output <- .rs.makeCompletions(token = token, results = results, type = .rs.acCompletionTypes$CONTEXT, excludeOtherCompletions = TRUE) # Cache for later use .rs.assign("shinySessionCompletions", output) output }) # Get relevant completions for a particular argument, e.g. in # # library(package = |) # # That is, if we're completing an argument called 'package', then infer # that package names are an appropriate completion result. .rs.addFunction("getCompletionsArgument", function(token, activeArg, functionCall = NULL, envir = NULL) { completions <- .rs.emptyCompletions() # data.table completions special case for single bracket + named argument case # dt[, by = |] if (identical(functionCall[[1]], quote(`[`))) { # only consider the case where the data is a symbol (rule out calls) name <- functionCall[[2]] if (is.symbol(name)) { name <- as.character(name) # and only consider data.table objects object <- try(.rs.getAnywhere(name, envir = envir)) if (inherits(object, "data.table")) { return(.rs.getDataTableNamedArgumentCompletions( token, name = name, object = object, activeArg = activeArg, functionCall = functionCall )) } } } object <- if (!is.null(functionCall)) .rs.resolveObjectFromFunctionCall(functionCall, envir) matchedCall <- if (!is.null(object)) .rs.matchCall(object, functionCall) # Get completions from a data object name if the active argument is 'formula'. # Useful for formula incantations in e.g. # # lm(|, data = mtcars) # # In this special case, we _override_ argument completions (since they # are often less interesting in this special case) if (.rs.startsWith(activeArg, "form") && !is.null(matchedCall[["data"]])) { dataObject <- .rs.getAnywhere(matchedCall[["data"]]) if (!is.null(dataObject)) { dataNames <- .rs.getNames(dataObject) return(.rs.makeCompletions( token = token, results = .rs.selectFuzzyMatches(dataNames, token), quote = FALSE )) } } # Check for knitr chunk completions, if possible if ("knitr" %in% loadedNamespaces()) { ns <- asNamespace("knitr") tryGet <- function(name, ns) tryCatch(get(name, envir = ns)$set, error = function(e) NULL) setter <- tryGet("opts_chunk", ns) if (identical(object, setter)) { opts <- knitr:::opts_chunk_attr if (activeArg %in% names(opts)) { # Options to fill in the various if statements foundCompletions <- FALSE results <- character() quote <- TRUE if (is.list(opts[[activeArg]])) { foundCompletions <- TRUE potentials <- unlist(opts[[activeArg]]) results <- .rs.selectFuzzyMatches(potentials, token) quote <- TRUE } if (identical(opts[[activeArg]], "logical")) { foundCompletions <- TRUE potentials <- c(TRUE, FALSE) results <- .rs.selectFuzzyMatches(potentials, token) quote <- FALSE } if (foundCompletions) return(.rs.makeCompletions(token = token, type = .rs.acCompletionTypes$ARGUMENT, quote = quote, results = results)) } } } # Get 'help', 'example' completions if (activeArg %in% "topic" && (identical(object, utils::example) || identical(object, utils::help))) { completions <- .rs.appendCompletions( completions, .rs.getCompletionsHelp(token, quote = TRUE) ) } # Get package names for completions if (activeArg %in% c("pkg", "package")) { completions <- .rs.appendCompletions( completions, .rs.getCompletionsPackages(token = token, appendColons = FALSE, excludeOtherCompletions = FALSE) ) } completions }) .rs.addFunction("listInferredPackages", function(documentId) { .Call("rs_listInferredPackages", documentId) }) .rs.addFunction("getInferredCompletions", function(packages = character(), simplify = TRUE) { # get completions from database completionList <- .Call("rs_getInferredCompletions", as.character(packages), PACKAGE = "(embedding)") # append dataset completions on to export vector completionList <- lapply(completionList, function(completion) { datasetTypes <- rep.int(.rs.acCompletionTypes$DATASET, length(completion$datasets)) completion$exports <- c(completion$exports, completion$datasets) completion$types <- c(completion$types, datasetTypes) completion$datasets <- NULL completion }) # simplify if requested if (simplify && length(completionList) == 1) return(completionList[[1]]) completionList }) .rs.addFunction("getCompletionsLibraryContextArgumentNames", function(token, string, numCommas, functionCall, completions) { ## Figure out which package + args we actually want to use pkg <- NULL args <- NULL for (i in seq_along(completions)) { if (string[[1]] %in% names(completions[[i]]$functions)) { pkg <- names(completions)[[i]] args <- completions[[i]]$functions[[string[[1]]]] break } } # Bail if we couldn't find anything if (is.null(pkg)) return(.rs.emptyCompletions()) ## Make a dummy function to match a call against argsText <- paste(args, collapse = ", ") dummyFunction <- tryCatch( suppressWarnings( eval(parse(text = paste("function(", argsText, ") {}", sep = ""))) ), error = function(e) NULL ) if (is.null(dummyFunction)) return(.rs.emptyCompletions()) matchedCall <- .rs.matchCall(dummyFunction, functionCall, numCommas = numCommas) if (is.null(matchedCall)) return(.rs.emptyCompletions()) formals <- .rs.resolveFormals(token, dummyFunction, string[[1]], functionCall, matchedCall, envir = environment()) # Protect against failure if (is.null(formals)) return(.rs.emptyCompletions()) results <- .rs.selectFuzzyMatches(formals$formals, token) if (length(results)) results <- paste(results, "= ") .rs.makeCompletions(token = token, results = results, packages = paste(pkg, string[[1]], sep = "::"), type = .rs.acCompletionTypes$ARGUMENT, fguess = string[[1]]) }) .rs.addFunction("getCompletionsLibraryContext", function(token, string, context, numCommas, functionCall, documentId, envir) { # Bail on null / empty documentId (necessary for e.g. the console) if (is.null(documentId) || !nzchar(documentId)) return(.rs.emptyCompletions()) ## If we detect that particular 'library' calls are in the source document, ## and those packages are actually available (but the package is not currently loaded), ## then we get an asynchronously-updated set of completions. We encode them as 'context' ## completions just so the user has a small hint that, even though we provide the ## completions, the package isn't actually loaded. packages <- .rs.listInferredPackages(documentId) if (!length(packages)) return(.rs.emptyCompletions()) # Remove any packages that are on the search path searchNames <- paste("package", packages, sep = ":") packages <- packages[!(searchNames %in% search())] if (!length(packages)) return(.rs.emptyCompletions()) completions <- .rs.getInferredCompletions(packages, simplify = FALSE) results <- .rs.emptyCompletions() # If we're getting completions for a particular function's arguments, # use those if (length(context) && context[[1]] == .rs.acContextTypes$FUNCTION) { results <- .rs.appendCompletions( results, .rs.getCompletionsLibraryContextArgumentNames(token, string, numCommas, functionCall, completions) ) } # Add completions for exported items. results <- .rs.appendCompletions( results, Reduce(.rs.appendCompletions, lapply(seq_along(completions), function(i) { completion <- completions[[i]] package <- names(completions)[[i]] keep <- .rs.fuzzyMatches(completion$exports, token) .rs.makeCompletions(token = token, results = completion$exports[keep], packages = package, type = completion$types[keep]) })) ) }) .rs.addFunction("isKnitrObject", function(object) { if (!("knitr" %in% loadedNamespaces())) return(FALSE) ns <- asNamespace("knitr") if (identical(environment(object), ns)) return(TRUE) parent <- tryCatch( parent.env(environment(object)), error = function(e) NULL ) if (identical(parent, ns)) return(TRUE) return(FALSE) }) .rs.addJsonRpcHandler("transform_snippet", function(snippet) { Encoding(snippet) <- "UTF-8" # Extract any R code from the snippet reRCode <- "`[Rr]\\s+[^`]+`" matches <- gregexpr(reRCode, snippet, perl = TRUE)[[1]] if (identical(c(matches), -1L)) return(snippet) match.length <- attr(matches, "match.length") if (is.null(match.length)) return(snippet) ranges <- lapply(seq_along(matches), function(i) { c(matches[[i]], matches[[i]] + match.length[[i]]) }) extracted <- lapply(ranges, function(range) { substring( snippet, range[[1]] + 2, # skip "`r " range[[2]] - 2 # leave out trailing "`" ) }) frame <- parent.frame() evaluated <- lapply(extracted, function(code) { tryCatch({ captured <- capture.output( result <- paste(collapse = " ", as.character(suppressWarnings( eval(parse(text = code), envir = frame) ))) ) if (!length(result) && length(captured)) paste(captured, collapse = " ") else result }, error = function(e) "" ) }) newSnippet <- snippet for (i in seq_along(evaluated)) { range <- ranges[[i]] text <- substring(snippet, range[[1]], range[[2]] - 1) replacement <- evaluated[[i]] newSnippet <- gsub(text, replacement, newSnippet, fixed = TRUE) } .rs.scalar(newSnippet) }) .rs.addFunction("isCustomCompletionsEnabled", function() { completer <- utils::rc.getOption("custom.completer") is.function(completer) }) .rs.addFunction("getCustomRCompletions", function(line) { utils:::.assignLinebuffer(line) utils:::.assignEnd(nchar(line)) token <- utils:::.guessTokenFromLine() utils:::.completeToken() results <- utils:::.retrieveCompletions() packages <- NULL type <- .rs.formCompletionVector( attr(results, "type"), .rs.acCompletionTypes$UNKNOWN, length(results) ) if (type[[1]] %in% c(.rs.acCompletionTypes$UNKNOWN, .rs.acCompletionTypes$FUNCTION)) { packages <- sub('^package:', '', .rs.which(results)) # ensure spaces around = results <- sub("=$", " = ", results) choose <- packages == '.GlobalEnv' results <- c(results[choose], results[!choose]) packages <- c(packages[choose], packages[!choose]) type <- c(type[choose], type[!choose]) packages <- sub('^\\.GlobalEnv$', '', packages) } .rs.makeCompletions( token = token, results = results, packages = packages, type = type ) })