PROTOTYPING: Make it possible to return globalenv() instead of emptye…

…nv()

Related to HenrikBengtsson/future#515

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: globals
-Version: 0.14.0-9002
+Version: 0.14.0-9003
 Depends:
     R (>= 3.1.2)
 Imports:

NEWS

@@ -1,7 +1,13 @@
 Package: globals
 ================
 
-Version: 0.14.0-9002 [2022-05-06]
+Version: 0.14.0-9003 [2022-05-06]
+
+NEW FEATURES:
+
+ * Any 'globals.*' options specific to this packages can now be set
+   via environment variables 'R_GLOBALS_*' when the package is loaded.
+   For example, R_GLOBALS_DEBUG=true sets option globals.debug = TRUE.
 
 BUG FIXES:
 

R/environment_of.R

@@ -1,9 +1,9 @@
 # A safe version of base::environment() that returns emptyenv()
 # if NULL is passed, instead of the calling environment.
 # Related to https://github.com/HenrikBengtsson/globals/issues/79
-environment_of <- function(obj) {
-  if (is.null(obj)) return(emptyenv())
+environment_of <- function(obj, default = getOption("globals.environment_of.default", emptyenv())) {
+  if (is.null(obj)) return(default)
   e <- environment(obj)
-  if (is.null(e)) return(emptyenv())
+  if (is.null(e)) return(default)
   e
 }

R/utils.R

@@ -128,13 +128,24 @@ hexpr <- function(expr, trim = TRUE, collapse = "; ", max_head = 6L,
 } # hexpr()
 
 
+now <- function(x = Sys.time(), format = "[%H:%M:%OS3] ") {
+  ## format(x, format = format) ## slower
+  format(as.POSIXlt(x, tz = ""), format = format)
+}
+
 ## From future 1.3.0
 mdebug <- function(...) {
   if (!getOption("globals.debug", FALSE)) return(invisible(FALSE))
   message(sprintf(...))
   invisible(TRUE)
 } ## mdebug()
 
+
+mdebugf <- function(..., appendLF = TRUE, prefix = now(), debug = getOption("globals.debug", FALSE)) {
+  if (!debug) return()
+  message(prefix, sprintf(...), appendLF = appendLF)
+}
+
 #' @importFrom utils capture.output str
 mstr <- function(...) {
   bfr <- capture.output(str(...))
@@ -171,6 +182,8 @@ envname <- function(env) {
   name
 }
 
+commaq <- function(x, sep = ", ") paste(sQuote(x), collapse = sep)
+
 ## When 'default' is specified, this is 30x faster than
 ## base::getOption().  The difference is that here we use
 ## use names(.Options) whereas in 'base' names(options())

R/zzz.R

@@ -1,5 +1,11 @@
 ## covr: skip=all
 .onLoad <- function(libname, pkgname) {
+  update_package_option("globals.debug", mode = "logical")
+  debug <- getOption("globals.debug", FALSE)
+
+  ## Set future options based on environment variables
+  update_package_options(debug = debug)
+
   ## Memoize: Already here, when the package is loaded, record whether
   ## some packages are 'base' packages or not.
   ## Packages that most likely are 'base' packages:

tests/Globals.R

@@ -249,6 +249,8 @@ message("*** Globals() - empty ... DONE")
 message("*** Globals() - NULL ...")
 ## https://github.com/HenrikBengtsson/globals/issues/79
 
+denv <- getOption("globals.environment_of.default", emptyenv())
+
 globals <- as.Globals(list(a = NULL))
 str(globals)
 where <- attr(globals, "where")
@@ -258,7 +260,7 @@ stopifnot(
   all(names(where) == names(globals)),
   identical(names(globals), c("a")),
   is.null(globals[["a"]]),
-  identical(where[["a"]], emptyenv())
+  identical(where[["a"]], denv)
 )
 
 globals <- c(Globals(), list(a = NULL))
@@ -270,7 +272,7 @@ stopifnot(
   all(names(where) == names(globals)),
   identical(names(globals), c("a")),
   is.null(globals[["a"]]),
-  identical(where[["a"]], emptyenv())
+  identical(where[["a"]], denv)
 )
 
 message("*** Globals() - NULL ... DONE")