I've made a package for this, available on CRAN and GitHub, called this.path. The current version is 2.0.0 (2023-08-08), you can find it here:
https://CRAN.R-project.org/package=this.path
https://github.com/ArcadeAntics/this.path
Install it from CRAN:
utils::install.packages("this.path")
or install the development version from GitHub:
utils::install.packages("this.path",
repos = "https://raw.githubusercontent.com/ArcadeAntics/PACKAGES")
and then use it by:
this.path::this.path()
or
library(this.path)
this.path()
The answer below is my original answer, kept just for reference, though it is quite a bit less functional than the most recent versions available above. Improvements include:
- compatibility with more GUIs: 'Rgui' on Windows, 'VSCode', and 'Jupyter'
- compatibility with packages testthat, knitr, compiler, and box, particularly
testthat::source_file()
, knitr::knit()
, compiler::loadcmp()
, and box::use()
- handling filenames with spaces when running an R script from a shell under Unix-alikes
- handling both uses of running an R script from a shell (
-f
FILE
and --file=FILE
)
- correctly normalizes the path when using
source()
with argument (chdir = TRUE)
- handling of file URIs with
source()
such as source("file:///path/to/file")
and source("file:///C:/path/to/file")
- improved handling of a connection instead of a character string within
source()
- handling of URL pathnames in
source()
, that is:
source("https://host/path/to/file")
if this.path()
was used within the file, it would return "https://host/path/to/file"
. This also works for URLs beginning with "http://"
, "ftp://"
, and "ftps://"
. As an example, try:
source("https://raw.githubusercontent.com/ArcadeAntics/this.path/main/tests/this.path_w_URLs.R")
- introduces functions
here()
/ / this.proj()
, similar to here::here()
, for specifying absolute file paths relative to the executing script's directory / / executing script's project root
- saving the normalized path within its appropriate environment the first time
this.path()
is called within a script, making it faster to use subsequent times within the same script and being independent of working directory. This means that setwd()
will no longer break this.path()
(as long as setwd()
is used AFTER the first call to this.path()
within that script)
Original Answer:
My answer is an improvement upon Jerry T's answer. The issue I found is that they are guessing whether a source()
call was made by checking if variable ofile
is found in the first frame on the stack. This will not work with nested source calls, nor source calls made from a non-global environment. Additionally, the order is wrong. We must look for source call BEFORE checking the shell arguments. Here is my solution:
this.path <- function (verbose = getOption("verbose"))
{
## loop through functions that lead here from most recent to
## earliest looking for an appropriate source call (a call to
## function source / / sys.source / / debugSource in RStudio)
##
## an appropriate source call is one in which the file argument has
## been evaluated (forced)
##
## for example, `source(this.path())` is an inappropriate source
## call. the argument 'file' is stored as a promise containing the
## expression "this.path()". when the value of 'file' is requested,
## the expression is evaluated at which time there should be two
## functions on the calling stack being 'source' and 'this.path'.
## clearly, you don't want to request the 'file' argument from that
## source call because the value of 'file' is under evaluation
## right now! the trick is to ask if 'file' has already been
## evaluated, the easiest way of which is to ask if a variable
## exists, one which is only created after the expression is
## necessarily evaluated.
##
## if that variable does exist, then argument 'file' has been
## forced and the source call is deemed appropriate. For 'source',
## the filename we want is the variable 'ofile' from that
## function's evaluation environment. For 'sys.source', the
## filename we want is the variable 'file' from that function's
## evaluation environment.
##
## if that variable does NOT exist, then argument 'file' hasn't
## been forced and the source call is deemed inappropriate. the
## 'for' loop moves to the next function up the calling stack
##
## unfortunately, there is no way to check the argument 'fileName'
## has been forced for 'debugSource' since all the work is done
## internally in C. Instead, we have to use a 'tryCatch' statement.
## When we ask for an object by name using 'get', R is capable of
## realizing if a variable is asking for its own definition (a
## recursive promise). The exact error is "promise already under
## evaluation" which indicates that the promise evaluation is
## requesting its own value. So we use the 'tryCatch' to get the
## argument 'fileName' from the evaluation environment of
## 'debugSource', and if it does not raise an error, then we are
## safe to return that value. If not, the condition returns false
## and the 'for' loop moves to the next function up the calling
## stack
debugSource <- if (.Platform$GUI == "RStudio")
get("debugSource", "tools:rstudio", inherits = FALSE)
for (n in seq.int(to = 1L, by = -1L, length.out = sys.nframe() - 1L)) {
if (identical(sys.function(n), source) &&
exists("ofile", envir = sys.frame(n), inherits = FALSE))
{
path <- get("ofile", envir = sys.frame(n), inherits = FALSE)
if (!is.character(path))
path <- summary.connection(path)$description
if (verbose)
cat("Source: call to function source\n")
return(normalizePath(path, "/", TRUE))
}
else if (identical(sys.function(n), sys.source) &&
exists("exprs", envir = sys.frame(n), inherits = FALSE))
{
path <- get("file", envir = sys.frame(n), inherits = FALSE)
if (verbose)
cat("Source: call to function sys.source\n")
return(normalizePath(path, "/", TRUE))
}
else if (identical(sys.function(n), debugSource) &&
tryCatch({
path <- get("fileName", envir = sys.frame(n), inherits = FALSE)
TRUE
}, error = function(c) FALSE))
{
if (verbose)
cat("Source: call to function debugSource in RStudio\n")
return(normalizePath(path, "/", TRUE))
}
}
## no appropriate source call was found up the calling stack
## running from RStudio
if (.Platform$GUI == "RStudio") {
## ".rs.api.getSourceEditorContext" from "tools:rstudio"
## returns a list of information about the document open in the
## current tab
##
## element 'path' is a character string, the document's path
context <- get(".rs.api.getSourceEditorContext",
"tools:rstudio", inherits = FALSE)()
if (is.null(context))
stop("'this.path' used in an inappropriate fashion\n",
"* no appropriate source call was found up the calling stack\n",
"* R is being run from RStudio with no documents open\n",
" (or source document has no path)")
path <- context[["path"]]
if (nzchar(path)) {
Encoding(path) <- "UTF-8"
if (verbose)
cat("Source: document in RStudio\n")
return(normalizePath(path, "/", TRUE))
}
else stop("'this.path' used in an inappropriate fashion\n",
"* no appropriate source call was found up the calling stack\n",
"* document in RStudio does not exist")
}
## running from a shell
else if (.Platform$OS.type == "windows" && .Platform$GUI == "RTerm" || ## on Windows
.Platform$OS.type == "unix" && .Platform$GUI == "X11") ## under Unix-alikes
{
argv <- commandArgs()
## remove all trailing arguments
m <- match("--args", argv, 0L)
if (m)
argv <- argv[seq_len(m)]
argv <- argv[-1L]
## get all arguments starting with "--file="
FILE <- argv[startsWith(argv, "--file=")]
## remove "--file=" from the start of each string
FILE <- substring(FILE, 8L)
## remove strings "-"
FILE <- FILE[FILE != "-"]
n <- length(FILE)
if (n) {
FILE <- FILE[[n]]
if (verbose)
cat("Source: shell argument 'FILE'\n")
return(normalizePath(FILE, "/", TRUE))
} else {
stop("'this.path' used in an inappropriate fashion\n",
"* no appropriate source call was found up the calling stack\n",
"* R is being run from a shell where argument 'FILE' is missing")
}
}
## running from RGui on Windows
else if (.Platform$OS.type == "windows" && .Platform$GUI == "Rgui") {
stop("'this.path' used in an inappropriate fashion\n",
"* no appropriate source call was found up the calling stack\n",
"* R is being run from Rgui which is currently unimplemented",
" consider using RStudio until such a time when this is implemented")
}
## running from RGui on macOS
else if (.Platform$OS.type == "unix" && .Platform$GUI == "AQUA") {
stop("'this.path' used in an inappropriate fashion\n",
"* no appropriate source call was found up the calling stack\n",
"* R is being run from AQUA which is currently unimplemented\n",
" consider using RStudio until such a time when this is implemented")
}
## otherwise
else stop("'this.path' used in an inappropriate fashion\n",
"* no appropriate source call was found up the calling stack\n",
"* R is being run in an unrecognized manner")
}