I've made a package for this as of 2020-12-03 available on CRAN called "this.path".
Install it using:
install.packages("this.path")
and then use it by:
this.path::this.path()
or
library(this.path)
this.path()
I still have my original answer below, though it is less functional than the version in the package. On a Unix-alike OS, strange characters (such as " ") in the 'Rscript' command-line argument 'file' are replaced (such as "~+~"). R does this so that it is easier to use that filename for other system commands, but this isn't what we want. Given that we want a path usable in R, any such strange character sequences must be replaced.
Original Answer:
My answer is an improvement upon Jerry T's answer. The issue I found is that he is 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, a source call must be looked for before checking the command-line arguments, that has also been fixed. 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)
if (.Platform$GUI == "RStudio")
dbs <- get("debugSource", mode = "function", "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 (.Platform$GUI == "RStudio" && 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 the command-line
# on a Windows OS, the GUI is "RTerm"
# on a Unix OS, the GUI is "X11"
if (.Platform$OS.type == "windows" && .Platform$GUI == "RTerm" || # running from Windows command-line
.Platform$OS.type == "unix" && .Platform$GUI == "X11") { # running from Unix command-line
# get all command-line arguments that start with "--file="
# check the number of command-line 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("Command-line 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 the command-line and formal argument \"--file=\" matched by multiple actual arguments\n")
}
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 the command-line and argument \"--file=\" is missing\n")
}
else if (.Platform$GUI == "RStudio") { # running R from '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",
mode = "function", "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\n")
}
sec <- get(".rs.api.getSourceEditorContext", mode = "function",
"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\n")
}
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\n")
}
else if (.Platform$OS.type == "windows" && .Platform$GUI == "Rgui") { # running R from 'RGui' on Windows
# 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("this error SHOULD be unreachable, as far as I know it's impossible to have an R\n",
" process running without the R Console open. If you reached this error, please\n",
" send a bug report to the package maintainer")
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\n")
}
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\n")
}
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\n")
}
else if (.Platform$OS.type == "unix" && .Platform$GUI == "AQUA") { # running R from 'RGui' on Unix
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\n")
}
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\n")
}