WIP: Move thisfile() to this package

DESCRIPTION

@@ -32,4 +32,5 @@ Collate:
     'root.R'
     'rprojroot-package.R'
     'shortcut.R'
+    'thisfile.R'
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -31,5 +31,11 @@ export(is_svn_root)
 export(is_testthat)
 export(is_vcs_root)
 export(root_criterion)
+export(thisfile)
+export(thisfile_knit)
+export(thisfile_r)
+export(thisfile_rscript)
+export(thisfile_source)
 import(backports)
 importFrom(utils,str)
+importFrom(utils,tail)

R/thisfile.R

@@ -0,0 +1,94 @@
+#' @title Determines the path of the currently running script
+#' @description \R does not store nor export the path of the currently running
+#'   script.  This is an attempt to circumvent this limitation by applying
+#'   heuristics (such as call stack and argument inspection) that work in many
+#'   cases.
+#' **CAVEAT**: Use this function only if your workflow does not permit other
+#' solution: if a script needs to know its location, it should be set outside
+#' the context of the script if possible.
+#'
+#' @details This functions currently work only if the script was `source`d,
+#'   processed with `knitr`,
+#'   or run with `Rscript` or using the `--file` parameter to the
+#'   `R` executable.  For code run with `Rscript`, the exact value
+#'   of the parameter passed to `Rscript` is returned.
+#' @return The path of the currently running script, NULL if it cannot be
+#'   determined.
+#' @seealso [base::source()], [utils::Rscript()], [base::getwd()]
+#' @references [http://stackoverflow.com/q/1815606/946850]()
+#' @author Kirill Müller, Hadley Wickham, Michael R. Head
+#' @examples
+#' \dontrun{thisfile()}
+#' @export
+thisfile <- function() {
+  if (!is.null(res <- thisfile_source())) res
+  else if (!is.null(res <- thisfile_r())) res
+  else if (!is.null(res <- thisfile_rscript())) res
+  else if (!is.null(res <- thisfile_knit())) res
+  else NULL
+}
+
+#' @rdname thisfile
+#' @export
+thisfile_source <- function() {
+  for (i in -(1:sys.nframe())) {
+    if (identical(args(sys.function(i)), args(base::source)))
+      return (normalizePath(sys.frame(i)$ofile))
+  }
+
+  NULL
+}
+
+#' @rdname thisfile
+#' @importFrom utils tail
+#' @export
+thisfile_r <- function() {
+  cmd_args <- commandArgs(trailingOnly = FALSE)
+  if (!grepl("^R(?:|[.]exe)$", basename(cmd_args[[1L]]), ignore.case = TRUE))
+    return (NULL)
+
+  cmd_args_trailing <- commandArgs(trailingOnly = TRUE)
+  leading_idx <-
+    seq.int(from=1, length.out=length(cmd_args) - length(cmd_args_trailing))
+  cmd_args <- cmd_args[leading_idx]
+  file_idx <- c(which(cmd_args == "-f") + 1, which(grepl("^--file=", cmd_args)))
+  res <- gsub("^(?:|--file=)(.*)$", "\\1", cmd_args[file_idx])
+
+  # If multiple --file arguments are given, R uses the last one
+  res <- tail(res[res != ""], 1)
+  if (length(res) > 0)
+    return (res)
+
+  NULL
+}
+
+#' @rdname thisfile
+#' @importFrom utils tail
+#' @export
+thisfile_rscript <- function() {
+  cmd_args <- commandArgs(trailingOnly = FALSE)
+  if (!grepl("^Rscript(?:|[.]exe)$", basename(cmd_args[[1L]]), ignore.case = TRUE))
+    return(NULL)
+
+  cmd_args_trailing <- commandArgs(trailingOnly = TRUE)
+  leading_idx <-
+    seq.int(from=1, length.out=length(cmd_args) - length(cmd_args_trailing))
+  cmd_args <- cmd_args[leading_idx]
+  res <- gsub("^(?:--file=(.*)|.*)$", "\\1", cmd_args)
+
+  # If multiple --file arguments are given, R uses the last one
+  res <- tail(res[res != ""], 1)
+  if (length(res) > 0)
+    return (res)
+
+  NULL
+}
+
+#' @rdname thisfile
+#' @export
+thisfile_knit <- function() {
+  if (requireNamespace("knitr"))
+    return (knitr::current_input(dir = TRUE))
+
+  NULL
+}

tests/testthat/scripts/thisfile-cat.R

@@ -0,0 +1 @@
+cat(rprojroot::thisfile(), "\n", sep="")

tests/testthat/scripts/thisfile.R

@@ -0,0 +1 @@
+thisfile()

tests/testthat/scripts/thisfile.Rmd

@@ -0,0 +1 @@
+`r rprojroot::thisfile_knit()`

tests/testthat/test-thisfile.R

@@ -0,0 +1,52 @@
+context("thisfile")
+
+test_that("thisfile works with source", {
+  res <- source("scripts/thisfile.R")
+  expect_true(grepl("thisfile.R$", res$value))
+})
+
+test_that("thisfile works with Rscript", {
+  p <- pipe("Rscript scripts/thisfile-cat.R")
+  on.exit(close(p))
+  res <- readLines(p)
+  expect_equal("scripts/thisfile-cat.R", res)
+})
+
+test_that("thisfile works with R", {
+  p <- pipe("R --quiet --vanilla --no-save -f scripts/thisfile-cat.R")
+  on.exit(close(p))
+  res <- readLines(p)
+  expect_equal("scripts/thisfile-cat.R", res[[2]])
+})
+
+test_that("thisfile works with knitr", {
+  out <- tempfile(pattern = "rprojroot", fileext = ".md")
+  knitr::knit("scripts/thisfile.Rmd", output = out, quiet = TRUE)
+  res <- readLines(out)
+  expect_equal(normalizePath("scripts/thisfile.Rmd"), normalizePath(res))
+})
+
+test_that("thisfile works with rmarkdown", {
+  out <- tempfile(pattern = "rprojroot", fileext = ".md")
+  rmarkdown::render("scripts/thisfile.Rmd", output_file = out,
+                    output_format = "md_document", quiet = TRUE)
+  res <- readLines(out)
+  expect_equal(normalizePath("scripts/thisfile.Rmd"), normalizePath(res))
+})
+
+test_that("thisfile works with spin", {
+  skip("TODO")
+  out <- tempfile(pattern = "rprojroot", fileext = ".md")
+  knitr::spin("scripts/thisfile-cat.R", format = "Rmd", precious = TRUE)
+  res <- readLines(out)
+  expect_equal(normalizePath("scripts/thisfile.Rmd"), normalizePath(res))
+})
+
+test_that("thisfile works with rendering an R script", {
+  skip("TODO")
+  out <- tempfile(pattern = "rprojroot", fileext = ".md")
+  rmarkdown::render("scripts/thisfile-cat.R", output_file = out,
+                    output_format = "md_document", quiet = TRUE)
+  res <- readLines(out)
+  expect_equal(normalizePath("scripts/thisfile.Rmd"), normalizePath(res))
+})

vignettes/rprojroot.Rmd

@@ -92,11 +92,11 @@ pass that absolute path to `root$make_fix_file()`:
 root_file <- root$make_fix_file("C:\\Users\\User Name\\...")
 ```
 
-Get the path of standalone R scripts or vignettes
-using the `thisfile()` function in the *kimisc* package:
+As a last resort, you can get the path of standalone R scripts or vignettes
+using the `thisfile()` function:
 
 ```r
-root_file <- root$make_fix_file(dirname(kimisc::thisfile()))
+root_file <- root$make_fix_file(dirname(thisfile()))
 ```
 
 The remainder of this vignette describes implementation details and advanced features.
@@ -317,8 +317,7 @@ withr::with_dir(
 
 The `make_fix_file()` member function also accepts an optional `path` argument,
 in case you know your project's root but the current working directory is somewhere outside.
-Take a look at the `thisfile()` function in the *kimisc* package for getting
-the path to the current script or `knitr` document.
+The path to the current script or `knitr` document can be obtained using the `thisfile()` function, but it's much easier and much more robust to just run your scripts with the working directory somewhere below your project root.
 
 
 ## `testthat` files