I've made a package for this, available on CRAN and GitHub, called "this.path". The current version is 0.7.0 published on 2022-04-24, you can find it here:
https://CRAN.R-project.org/package=this.path
https://github.com/ArcadeAntics/this.path
Install it with:
utils::install.packages("this.path")
or
utils::install.packages("https://raw.githubusercontent.com/ArcadeAntics/this.path/main/this.path_0.7.0.tar.gz")
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:
- 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
base::source
with argument chdir = TRUE
- handling of file URLs with
base::source
(that is, "file://absolute or relative path" and "file:///absolute path")
- better handling of a connection instead of a character string within
base::source
this.path
is compatible with URLs 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 a URL 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")
- compatibility with package testthat, particularly
testthat::source_file
- introduces function
here
, similar to here::here
, for specifying an absolute file path, relative to the executing script's directory
- on Windows, in Rgui, added support for all languages listed by
list.dirs(system.file(package = "translations"), full.names = FALSE, recursive = FALSE)
- 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
when using relative paths within base::source
or when running R from a shell (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"))
{
where <- function(x) {
if (verbose)
cat("Source: ", x, "\n", sep = "")
}
# loop through functions that lead here from most recent to earliest looking
# for an appropriate source call (a call to function base::source or base::sys.source)
# an appropriate source call is a source call in which
# argument 'file' has been evaluated (forced)
# this means, for example, the following is an inappropriate source call:
# source(this.path())
# the argument 'file' is stored as a promise
# containing the expression "this.path()"
# when the value of 'file' is requested, it assigns the value
# returned by evaluating "this.path()" to variable 'file'
# there are two functions on the calling stack at
# this point 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 variable ('ofile' for base::source, 'exprs' for base::sys.source)
# exists in that function's evaluation environment. this is because that
# variable is created AFTER argument 'file' has been forced
# if that variable does exist, then argument 'file' has been forced and the
# source call is deemed appropriate. For base::source, the filename we want
# is the variable 'ofile' from that function's evaluation environment. For
# base::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 (if available)
#
# 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 definition). 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 (if available)
dbs <- if (.Platform$GUI == "RStudio")
get("debugSource", "tools:rstudio", inherits = FALSE)
for (n in seq.int(sys.nframe(), 1L)[-1L]) {
if (identical(sys.function(n), base::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
where("call to function source")
return(normalizePath(path, mustWork = TRUE))
}
else if (identical(sys.function(n), base::sys.source) &&
exists("exprs", envir = sys.frame(n), inherits = FALSE)) {
path <- get("file", envir = sys.frame(n), inherits = FALSE)
where("call to function sys.source")
return(normalizePath(path, mustWork = TRUE))
}
else if (identical(sys.function(n), dbs) &&
tryCatch({
path <- get("fileName", envir = sys.frame(n), inherits = FALSE)
TRUE
}, error = function(c) FALSE)) {
where("call to function debugSource in RStudio")
return(normalizePath(path, mustWork = TRUE))
}
}
# if the for loop is passed, no appropriate
# source call was found up the calling stack
# next, check if the user is running R from a shell
# on a Windows OS, the GUI is "RTerm"
# on a Unix OS, the GUI is "X11"
# if (running R from a shell)
if (.Platform$OS.type == "windows" && .Platform$GUI == "RTerm" || # on Windows
.Platform$OS.type == "unix" && .Platform$GUI == "X11") { # under Unix-alikes
# get all shell arguments that start with "--file="
# check the number of shell arguments starting with "--file="
# in case more or less than one were supplied
path <- grep("^--file=", commandArgs(), value = TRUE)
if (length(path) == 1L) {
path <- sub("^--file=", "", path)
where("shell argument 'FILE'")
return(normalizePath(path, mustWork = TRUE))
}
else if (length(path)) {
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 formal argument 'FILE' matched by multiple actual arguments")
}
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")
}
# if (running R from RStudio)
else if (.Platform$GUI == "RStudio") {
# function ".rs.api.getActiveDocumentContext" from the environment "tools:rstudio"
# returns a list of information about the document where your cursor is located
#
# function ".rs.api.getSourceEditorContext" from the environment "tools:rstudio"
# returns a list of information about the document open in the current tab
#
# element 'id' is a character string, an identification for the document
# element 'path' is a character string, the path of the document
adc <- get(".rs.api.getActiveDocumentContext",
"tools:rstudio", inherits = FALSE)()
if (adc$id != "#console") {
path <- adc$path
if (nzchar(path)) {
where("active document in RStudio")
return(normalizePath(path, mustWork = TRUE))
}
else stop("'this.path' used in an inappropriate fashion\n",
"* no appropriate source call was found up the calling stack\n",
"* active document in RStudio does not exist")
}
sec <- get(".rs.api.getSourceEditorContext",
"tools:rstudio", inherits = FALSE)()
if (!is.null(sec)) {
path <- sec$path
if (nzchar(path)) {
where("source document in RStudio")
return(normalizePath(path, mustWork = TRUE))
}
else stop("'this.path' used in an inappropriate fashion\n",
"* no appropriate source call was found up the calling stack\n",
"* source document in RStudio does not exist")
}
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 RStudio with no documents open")
}
# if (running R from RGui on Windows)
else if (.Platform$OS.type == "windows" && .Platform$GUI == "Rgui") {
# on a Windows OS only, the function "getWindowsHandles" from the base
# package "utils" returns a list of external pointers containing the windows
# handles. The thing of interest are the names of this list, these should
# be the names of the windows belonging to the current R process. Since
# RGui can have files besides R scripts open (such as images), a regular
# expression is used to subset only windows handles with names that exactly
# match the string "R Console" or end with " - R Editor". I highly suggest
# that you NEVER end a document's filename with " - R Editor". From there,
# similar checks are done as in the above section for 'RStudio'
wh <- names(utils::getWindowsHandles(pattern = "^R Console$| - R Editor$",
minimized = TRUE))
if (!length(wh))
stop("no windows in RGui; should never happen, please report!")
path <- wh[1L]
if (path != "R Console") {
path <- sub(" - R Editor$", "", path)
if (path != "Untitled") {
where("active document in RGui")
return(normalizePath(path, mustWork = TRUE))
}
else stop("'this.path' used in an inappropriate fashion\n",
"* no appropriate source call was found up the calling stack\n",
"* active document in RGui does not exist")
}
path <- wh[2L]
if (!is.na(path)) {
path <- sub(" - R Editor$", "", path)
if (path != "Untitled") {
where("source document in RGui")
return(normalizePath(path, mustWork = TRUE))
}
else stop("'this.path' used in an inappropriate fashion\n",
"* no appropriate source call was found up the calling stack\n",
"* source document in RGui does not exist")
}
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 RGui with no documents open")
}
# if (running R 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 requires a source call on the calling stack")
}
# 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")
}