FILE <- tempfile(fileext = ".R")
this.path:::write.code({
this.path::this.path(verbose = TRUE)
}, FILE)
# here we have a source-like function, suppose this
# function is in a package for which you have write permission
sourcelike <- function (file, envir = parent.frame())
{
file <- inside.source(file)
envir <- as.environment(envir)
exprs <- parse(n = -1, file = file, srcfile = NULL, keep.source = FALSE)
# this prints nicely
source(local = envir, echo = TRUE, exprs = exprs,
spaced = TRUE, verbose = FALSE, max.deparse.length = Inf)
# you could alternatively do:
# 'for (i in seq_along(exprs)) eval(exprs[i], envir)'
# which does no pretty printing
}
sourcelike(FILE)
sourcelike(con <- file(FILE)); close(con)
# here we have another source-like function, suppose this function
# is in a foreign package for which you do not have write permission
sourcelike2 <- function (pathname, envir = globalenv())
{
if (!(is.character(pathname) && file.exists(pathname)))
stop(gettextf("'%s' is not an existing file",
pathname, domain = "R-base"))
envir <- as.environment(envir)
exprs <- parse(n = -1, file = pathname, srcfile = NULL, keep.source = FALSE)
source(local = envir, echo = TRUE, exprs = exprs,
spaced = TRUE, verbose = FALSE, max.deparse.length = Inf)
}
# the above function is similar to sys.source(), and it
# expects a character string referring to an existing file
#
# with the following, you should be able to use 'this.path()' within 'FILE':
wrap.source(sourcelike2(FILE), path.only = TRUE)
# with R >= 4.1.0, use the forward pipe operator '|>' to
# make calls to 'wrap.source' more intuitive:
# sourcelike2(FILE) |> wrap.source(path.only = TRUE)
# 'wrap.source' can recognize arguments by name, so they
# do not need to appear in the same order as the formals
wrap.source(sourcelike2(envir = new.env(), pathname = FILE), path.only = TRUE)
# it it much easier to define a new function to do this
sourcelike3 <- function (...)
wrap.source(sourcelike2(...), path.only = TRUE)
# the same as before
sourcelike3(FILE)
# however, this is preferable:
sourcelike4 <- function (pathname, ...)
{
# pathname is now normalized
pathname <- inside.source(pathname, path.only = TRUE)
sourcelike2(pathname = pathname, ...)
}
sourcelike4(FILE)
unlink(FILE)
Run the code above in your browser using DataLab