0byt3m1n1
Path:
C:
/
Program Files
/
RStudio
/
resources
/
app
/
R
/
modules
/
[
Home
]
File: SessionSource.R
# # SessionSource.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. # # .rs.addJsonRpcHandler("save_active_document", function(contents, sweave, rnwWeave) { # manage working directory previousWd = getwd() setwd("~/") on.exit(setwd(previousWd)) activeRStudioDoc <- "~/.active-rstudio-document" if (file.exists(activeRStudioDoc)) file.remove(activeRStudioDoc) # The contents are always passed as UTF-8 from the client and # we want to make sure this is preserved on disk. Note that # when the source command is issued by the client for # "~/active-rstudio-document" UTF-8 is specified explicitly # (see TextEditingTarget.sourceActiveDocument) Encoding(contents) <- "UTF-8" writeLines(contents, activeRStudioDoc, useBytes = TRUE) if (sweave) { op <- function() { .Call("rs_rnwTangle", activeRStudioDoc, "UTF-8", rnwWeave) file.remove(activeRStudioDoc) file.rename(paste(activeRStudioDoc, ".R", sep=""), activeRStudioDoc) } capture.output(op()) } .Call("rs_ensureFileHidden", activeRStudioDoc) return() }) .rs.addFunction("iconvcommon", function() { # NOTE: we originally included MacRoman and HZ-GB-2312 in our list of # common encodings however MacRoman isn't available on Windows or Linux # and HZ-GB-2312 isn't available on Linux so we removed them from the # common list (in the interest of providing a list of portable encodings # so that projects could reliably use common encodings and not run # into issues moving from system to system # common <- c( 'ASCII', 'UTF-8', # Western 'ISO-8859-1', 'Windows-1252', # 'MacRoman', # Japanese 'Shift-JIS', 'ISO-2022-JP', #'EUC-JP', 'Shift-JISX0213', # Trad Chinese 'Big5', #'Big5-HKSCS', # Korean 'ISO-2022-KR', # Arabic #'ISO-8859-6', #'Windows-1256', # Hebrew #'ISO-8859-8', #'Windows-1255', # Greek 'ISO-8859-7', #'Windows-1253', # Cyrillic #'ISO-8859-5', 'MacCyrillic', 'KOI8-R', 'Windows-1251', # Ukrainian #'KOI8-U', # Simplified Chinese 'GB2312', #'HZ-GB-2312', # Chinese 'GB18030', # Central European 'ISO-8859-2' #'ISO-8859-4', 'MacCentralEurope', 'Windows-1250' # Vietnamese #'Windows-1258', # Turkish #'ISO-8859-5', 'Windows-1254', # Baltic #'Windows-1257' ) toupper(common) }) .rs.addJsonRpcHandler("iconvlist", function() { list(common=sort(intersect(.rs.iconvcommon(), toupper(iconvlist()))), all=sort(iconvlist())) }) .rs.addGlobalFunction('source.with.encoding', function(path, encoding, echo=getOption('verbose'), print.eval=echo, max.deparse.length=150, chdir=FALSE) { warning("source.with.encoding is deprecated and will be removed in a ", "future release of RStudio. Use source(..., encoding = '", encoding, "') instead.") conn = file(path, open='r', encoding=encoding) on.exit(close(conn)) source(conn, echo=echo, print.eval=print.eval, max.deparse.length=max.deparse.length, chdir=chdir) }) ### Detect free variables ### # Callback when code walker encounters function call. # It's mostly looking for variable assignment--if it sees # a symbol being assigned, it sets the symbol equal to true # in w$assigned. Otherwise, it recurses. # # Functions are handled specially, they redefine w$assigned # to be their sub-environment, with a parent reference to # the containing environment. .rs.addFunction("detectFreeVars_Call", function(e, w) { freeVars <- character(0) func <- e[[1]] funcName <- as.character(func) args <- as.list(e[-1]) if (typeof(func) == 'language') { freeVars <- c(freeVars, codetools:::walkCode(func, w)) } else if (funcName %in% c('<-', '<<-', '=', 'for') && length(args) > 1 && typeof(args[[1]]) != 'language') { lvalue <- as.character(args[[1]]) # Need to walk the right side of an assignment, before # considering the lvalue (e.g.: x <- x + 1) args <- args[-1] if (length(args) > 0) { for (ee in args) freeVars <- c(freeVars, codetools:::walkCode(ee, w)) } args <- c() # Clear out `args` so they aren't walked later if (funcName == '<<-') assign(lvalue, T, envir=w$assignedGlobals) else assign(lvalue, T, envir=w$assigned) } else if (funcName == '$') { # In foo$bar, ignore bar args <- args[-2] } else if (funcName == 'function') { params <- args[[1]] w$assigned <- new.env(parent=w$assigned) for (param in names(params)) { assign(param, T, envir=w$assigned) freeVars <- c(freeVars, codetools:::walkCode(params[[param]], w)) } args <- args[-1] } if (length(args) > 0) { # Needs to access the list via index in case of empty strings # see https://github.com/rstudio/rstudio/issues/5285 for (i in seq_along(args)) freeVars <- c(freeVars, codetools:::walkCode(args[[i]], w)) } return(unique(freeVars)) }) # Lets us know when we've seen a symbol. If the symbol hasn't # been assigned yet (i.e. it doesn't exist in w$assigned) then # we can assume it's a free variable. .rs.addFunction("detectFreeVars_Leaf", function(e, w) { if (typeof(e) == 'symbol' && nchar(as.character(e)) > 0 && !exists(as.character(e), envir=w$assigned)) return(as.character(e)) else return(character(0)) }) .rs.addJsonRpcHandler("detect_free_vars", function(code) { globals <- new.env(parent=emptyenv()) # Ignore predefined symbols like T and F assign('T', T, envir=globals) assign('F', T, envir=globals) w <- codetools:::makeCodeWalker(assigned=globals, assignedGlobals=globals, call=.rs.detectFreeVars_Call, leaf=.rs.detectFreeVars_Leaf) freeVars <- character(0) for (e in parse(text=code)) freeVars <- c(freeVars, codetools:::walkCode(e, w)) return(unique(freeVars)) }) .rs.addFunction("createDefaultShellRd", function(`_name`, `_type`) { # create a tempdir and switch to it for the duration of the function dirName <- tempfile("RdShell") dir.create(dirName) previousWd <- getwd() on.exit(setwd(previousWd)) setwd(dirName) if (identical(`_type`, "function")) { assign(`_name`, function(x) {}) return (.rs.normalizePath(paste(getwd(), utils::prompt(name = `_name`), sep="/"))) } else if (identical(`_type`, "data")) { assign(`_name`, data.frame(x=integer(), y=integer())) return (.rs.normalizePath(paste(getwd(), utils::promptData(name = `_name`), sep="/"))) } else { return ("") } }) .rs.addFunction("createShellRd", function(name, type, package) { # create a tempdir and switch to it for the duration of the function dirName <- tempfile("RdShell") dir.create(dirName) previousWd <- getwd() on.exit(setwd(previousWd)) setwd(dirName) if (identical(type, "function")) { func <- .rs.getPackageFunction(name, package) if (!is.null(func)) { funcRd <- utils::prompt(func, name = name) return (.rs.normalizePath(paste(getwd(),funcRd,sep="/"))) } else { return ("") } } else if (identical(type, "data")) { dataRd <- tryCatch(suppressWarnings({ library(package,character.only=TRUE) eval(parse(text = paste("data(", name, "); ", "utils::promptData(", name, ");", sep="")), envir = globalenv()) }), error = function(e) {print(e); ""}) if (nzchar(dataRd) == TRUE) return (.rs.normalizePath(paste(getwd(), dataRd, sep="/"))) else return ("") } else { return ("") } }) .rs.addFunction("initSource", function() { .rs.registerReplaceHook("file.edit", "utils", function(original, ...) { # just take unnamed arguments (those are the files) args <- c(...) names <- names(args) if (!is.null(names)) args <- args[names(args) == ""] # call rstudio fileEdit function invisible(.Call("rs_fileEdit", args, PACKAGE = "(embedding)")) }) }) .rs.addFunction("getSourceDocument", function(id, includeContents = FALSE) { .Call( "rs_getSourceDocument", as.character(id), as.logical(includeContents), PACKAGE = "(embedding)" ) }) .rs.addFunction("getSourceDocumentProperties", function(path, includeContents = FALSE) { if (is.null(path) || !file.exists(path)) return(NULL) path <- normalizePath(path, winslash = "/", mustWork = TRUE) .Call("rs_getDocumentProperties", path, includeContents) })