Add sustainEnvAndQuoted(). Remove getQuosure()

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 1.6.0.9021
+Version: 1.6.0.9022
 Authors@R: c(
     person("Winston", "Chang", role = c("aut", "cre"), email = "[email protected]", comment = c(ORCID = "0000-0002-1576-2126")),
     person("Joe", "Cheng", role = "aut", email = "[email protected]"),

NAMESPACE

@@ -119,7 +119,6 @@ export(getCurrentOutputInfo)
 export(getCurrentTheme)
 export(getDefaultReactiveDomain)
 export(getQueryString)
-export(getQuosure)
 export(getShinyOption)
 export(getUrlHash)
 export(get_devmode_option)
@@ -274,6 +273,7 @@ export(stopApp)
 export(strong)
 export(submitButton)
 export(suppressDependencies)
+export(sustainEnvAndQuoted)
 export(tabPanel)
 export(tabPanelBody)
 export(tableOutput)
@@ -379,6 +379,7 @@ importFrom(htmltools,tags)
 importFrom(htmltools,validateCssUnit)
 importFrom(htmltools,withTags)
 importFrom(lifecycle,deprecated)
+importFrom(lifecycle,is_present)
 importFrom(promises,"%...!%")
 importFrom(promises,"%...>%")
 importFrom(promises,as.promise)
@@ -387,10 +388,13 @@ importFrom(promises,promise)
 importFrom(promises,promise_reject)
 importFrom(promises,promise_resolve)
 importFrom(rlang,"%||%")
+importFrom(rlang,"fn_body<-")
+importFrom(rlang,"fn_fmls<-")
 importFrom(rlang,as_function)
 importFrom(rlang,as_quosure)
 importFrom(rlang,enexpr)
 importFrom(rlang,enquo)
+importFrom(rlang,enquo0)
 importFrom(rlang,enquos)
 importFrom(rlang,enquos0)
 importFrom(rlang,eval_tidy)
@@ -409,4 +413,8 @@ importFrom(rlang,new_function)
 importFrom(rlang,new_quosure)
 importFrom(rlang,pairlist2)
 importFrom(rlang,quo)
+importFrom(rlang,quo_get_expr)
+importFrom(rlang,quo_is_missing)
+importFrom(rlang,quo_set_env)
+importFrom(rlang,quo_set_expr)
 importFrom(rlang,zap_srcref)

R/deprecated.R

@@ -9,13 +9,19 @@
 #' @param details Additional information to be added after a new line to the displayed message
 #' @keywords internal
 shinyDeprecated <- function(
-  version, what, with = NULL, details = NULL
+  version,
+  what,
+  with = NULL,
+  details = NULL,
+  type = c("deprecated", "superseded")
 ) {
   if (is_false(getOption("shiny.deprecation.messages"))) {
     return(invisible())
   }
 
-  msg <- paste0("`", what, "` is deprecated as of shiny ", version, ".")
+  type <- match.arg(type)
+
+  msg <- paste0("`", what, "` is ", type, " as of shiny ", version, ".")
   if (!is.null(with)) {
     msg <- paste0(msg, "\n", "Please use `", with, "` instead.")
   }
@@ -60,7 +66,7 @@ diskCache <- function(
   logfile = NULL
 ) {
   shinyDeprecated("1.6.0", "diskCache()", "cachem::cache_disk()")
-  if (lifecycle::is_present(exec_missing)) {
+  if (is_present(exec_missing)) {
     shinyDeprecated("1.6.0", "diskCache(exec_missing =)")
   }
 
@@ -93,7 +99,7 @@ memoryCache <- function(
   logfile = NULL)
 {
   shinyDeprecated("1.6.0", "diskCache()", "cachem::cache_mem()")
-  if (lifecycle::is_present(exec_missing)) {
+  if (is_present(exec_missing)) {
     shinyDeprecated("1.6.0", "diskCache(exec_missing =)")
   }
 

R/map.R

@@ -1,4 +1,3 @@
-#' @importFrom fastmap fastmap
 Map <- R6Class(
   'Map',
   portable = FALSE,

R/reactives.R

@@ -945,12 +945,12 @@ Observable <- R6Class(
 #' See the [Shiny tutorial](https://shiny.rstudio.com/tutorial/) for
 #' more information about reactive expressions.
 #'
-#' @param x For `reactive`, an expression (quoted or unquoted). For
+#' @param x TODO-barret docs; For `reactive`, an expression (quoted or unquoted). For
 #'   `is.reactive`, an object to test.
-#' @param env The parent environment for the reactive expression. By default,
+#' @param env TODO-barret docs; The parent environment for the reactive expression. By default,
 #'   this is the calling environment, the same as when defining an ordinary
 #'   non-reactive expression.
-#' @param quoted Is the expression quoted? By default, this is `FALSE`.
+#' @param quoted TODO-barret docs; Is the expression quoted? By default, this is `FALSE`.
 #'   This is useful when you want to use an expression that is stored in a
 #'   variable; to do so, it must be quoted with `quote()`.
 #' @param label A label for the reactive expression, useful for debugging.
@@ -961,6 +961,7 @@ Observable <- R6Class(
 #' @return a function, wrapped in a S3 class "reactive"
 #'
 #' @examples
+#' # TODO-barret docs; with quosures, not env / quoted
 #' values <- reactiveValues(A=1)
 #'
 #' reactiveB <- reactive({
@@ -979,28 +980,30 @@ Observable <- R6Class(
 #' isolate(reactiveC())
 #' isolate(reactiveD())
 #' @export
-reactive <- function(x, env = parent.frame(), quoted = FALSE,
+reactive <- function(
+  x,
+  env = deprecated(),
+  quoted = deprecated(),
   ...,
   label = NULL,
   domain = getDefaultReactiveDomain(),
   ..stacktraceon = TRUE)
 {
   check_dots_empty()
 
-  x <- getQuosure(x, env, quoted)
-  fun <- as_function(x)
-  # as_function returns a function that takes `...`. We need one that takes no
-  # args.
-  formals(fun) <- list()
+  q <- enquo0(x)
+  q <- sustainEnvAndQuotedInternal(q, x, env, quoted)
+  fun <- quoToSimpleFunction(q)
 
   # Attach a label and a reference to the original user source for debugging
-  label <- exprToLabel(get_expr(x), "reactive", label)
+  q_expr <- quo_get_expr(q)
+  label <- exprToLabel(q_expr, "reactive", label)
 
   o <- Observable$new(fun, label, domain, ..stacktraceon = ..stacktraceon)
   structure(
     o$getValue,
     observable = o,
-    cacheHint = list(userExpr = zap_srcref(get_expr(x))),
+    cacheHint = list(userExpr = zap_srcref(q_expr)),
     class = c("reactiveExpr", "reactive", "function")
   )
 }
@@ -1325,10 +1328,10 @@ Observer <- R6Class(
 #'
 #' @param x An expression (quoted or unquoted). Any return value will be
 #'   ignored.
-#' @param env The parent environment for the reactive expression. By default,
+#' @param env TODO-barret docs; The parent environment for the reactive expression. By default,
 #'   this is the calling environment, the same as when defining an ordinary
 #'   non-reactive expression.
-#' @param quoted Is the expression quoted? By default, this is `FALSE`.
+#' @param quoted TODO-barret docs; Is the expression quoted? By default, this is `FALSE`.
 #'   This is useful when you want to use an expression that is stored in a
 #'   variable; to do so, it must be quoted with `quote()`.
 #' @param label A label for the observer, useful for debugging.
@@ -1383,6 +1386,7 @@ Observer <- R6Class(
 #'   }
 #'
 #' @examples
+#' # TODO-barret docs; examples are outdated
 #' values <- reactiveValues(A=1)
 #'
 #' obsB <- observe({
@@ -1400,7 +1404,10 @@ Observer <- R6Class(
 #' # are at the console, you can force a flush with flushReact()
 #' shiny:::flushReact()
 #' @export
-observe <- function(x, env = parent.frame(), quoted = FALSE,
+observe <- function(
+  x,
+  env = deprecated(),
+  quoted = deprecated(),
   ...,
   label = NULL,
   suspended = FALSE,
@@ -1411,14 +1418,12 @@ observe <- function(x, env = parent.frame(), quoted = FALSE,
 {
   check_dots_empty()
 
-  x <- getQuosure(x, env, quoted)
-  fun <- as_function(x)
-  # as_function returns a function that takes `...`. We need one that takes no
-  # args.
-  formals(fun) <- list()
+  q <- enquo0(x)
+  q <- sustainEnvAndQuotedInternal(q, x, env, quoted)
+  fun <- quoToSimpleFunction(q)
 
   if (is.null(label)) {
-    label <- sprintf('observe(%s)', paste(deparse(get_expr(x)), collapse='\n'))
+    label <- sprintf('observe(%s)', paste(deparse(quo_get_expr(q)), collapse='\n'))
   }
 
   o <- Observer$new(
@@ -2146,17 +2151,17 @@ maskReactiveContext <- function(expr) {
 #'   scope.
 #' @param event.env The parent environment for `eventExpr`. By default,
 #'   this is the calling environment.
-#' @param event.quoted Is the `eventExpr` expression quoted? By default,
+#' @param event.quoted TODO-barret docs; Is the `eventExpr` expression quoted? By default,
 #'   this is `FALSE`. This is useful when you want to use an expression
 #'   that is stored in a variable; to do so, it must be quoted with
 #'   `quote()`.
-#' @param handler.env The parent environment for `handlerExpr`. By default,
+#' @param handler.env TODO-barret docs; The parent environment for `handlerExpr`. By default,
 #'   this is the calling environment.
-#' @param handler.quoted Is the `handlerExpr` expression quoted? By
+#' @param handler.quoted TODO-barret docs; Is the `handlerExpr` expression quoted? By
 #'   default, this is `FALSE`. This is useful when you want to use an
 #'   expression that is stored in a variable; to do so, it must be quoted with
 #'   `quote()`.
-#' @param value.env The parent environment for `valueExpr`. By default,
+#' @param value.env TODO-barret docs; The parent environment for `valueExpr`. By default,
 #'   this is the calling environment.
 #' @param value.quoted Is the `valueExpr` expression quoted? By default,
 #'   this is `FALSE`. This is useful when you want to use an expression
@@ -2265,24 +2270,26 @@ maskReactiveContext <- function(expr) {
 #' }
 #' @export
 observeEvent <- function(eventExpr, handlerExpr,
-  event.env = parent.frame(), event.quoted = FALSE,
-  handler.env = parent.frame(), handler.quoted = FALSE,
+  event.env = deprecated(), event.quoted = deprecated(),
+  handler.env = deprecated(), handler.quoted = deprecated(),
   ...,
   label = NULL, suspended = FALSE, priority = 0,
   domain = getDefaultReactiveDomain(), autoDestroy = TRUE,
   ignoreNULL = TRUE, ignoreInit = FALSE, once = FALSE)
 {
   check_dots_empty()
 
-  eventExpr   <- getQuosure(eventExpr,   event.env,   event.quoted)
-  handlerExpr <- getQuosure(handlerExpr, handler.env, handler.quoted)
+  eventQ <- enquo0(eventExpr)
+  handlerQ <- enquo0(handlerExpr)
+  eventQ <- sustainEnvAndQuotedInternal(eventQ, eventExpr, event.env, event.quoted)
+  handlerQ <- sustainEnvAndQuotedInternal(handlerQ, handlerExpr, handler.env, handler.quoted)
 
   if (is.null(label)) {
-    label <- sprintf('observeEvent(%s)', paste(deparse(get_expr(eventExpr)), collapse='\n'))
+    label <- sprintf('observeEvent(%s)', paste(deparse(get_expr(eventQ)), collapse='\n'))
   }
 
   handler <- inject(observe(
-    !!handlerExpr,
+    !!handlerQ,
     label = label,
     suspended = suspended,
     priority = priority,
@@ -2296,7 +2303,7 @@ observeEvent <- function(eventExpr, handlerExpr,
     ignoreInit = ignoreInit,
     once = once,
     label = label,
-    !!eventExpr,
+    !!eventQ,
     x = handler
   ))
 
@@ -2306,27 +2313,29 @@ observeEvent <- function(eventExpr, handlerExpr,
 #' @rdname observeEvent
 #' @export
 eventReactive <- function(eventExpr, valueExpr,
-  event.env = parent.frame(), event.quoted = FALSE,
-  value.env = parent.frame(), value.quoted = FALSE,
+  event.env = deprecated(), event.quoted = deprecated(),
+  value.env = deprecated(), value.quoted = deprecated(),
   ...,
   label = NULL, domain = getDefaultReactiveDomain(),
   ignoreNULL = TRUE, ignoreInit = FALSE)
 {
   check_dots_empty()
 
-  eventExpr <- getQuosure(eventExpr, event.env, event.quoted)
-  valueExpr <- getQuosure(valueExpr, value.env, value.quoted)
+  eventQ <- enquo0(eventExpr)
+  valueQ <- enquo0(valueExpr)
+  eventQ <- sustainEnvAndQuotedInternal(eventQ, eventExpr, event.env, event.quoted)
+  valueQ <- sustainEnvAndQuotedInternal(valueQ, valueExpr, value.env, value.quoted)
 
   if (is.null(label)) {
-    label <- sprintf('eventReactive(%s)', paste(deparse(get_expr(eventExpr)), collapse='\n'))
+    label <- sprintf('eventReactive(%s)', paste(deparse(get_expr(eventQ)), collapse='\n'))
   }
 
   invisible(inject(bindEvent(
     ignoreNULL = ignoreNULL,
     ignoreInit = ignoreInit,
     label = label,
-    !!eventExpr,
-    x = reactive(!!valueExpr, domain = domain, label = label)
+    !!eventQ,
+    x = reactive(!!valueQ, domain = domain, label = label)
   )))
 }
 

R/render-plot.R

@@ -46,8 +46,8 @@
 #'   decorative images.
 #' @param ... Arguments to be passed through to [grDevices::png()].
 #'   These can be used to set the width, height, background color, etc.
-#' @param env The environment in which to evaluate `expr`.
-#' @param quoted Is `expr` a quoted expression (with `quote()`)? This
+#' @param env TODO-barret docs; The environment in which to evaluate `expr`.
+#' @param quoted TODO-barret docs; Is `expr` a quoted expression (with `quote()`)? This
 #'   is useful if you want to save an expression in a variable.
 #' @param execOnResize If `FALSE` (the default), then when a plot is
 #'   resized, Shiny will *replay* the plot drawing commands with
@@ -61,14 +61,15 @@
 #' @export
 renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
                        alt = NA,
-                       env = parent.frame(), quoted = FALSE,
+                       env = deprecated(), quoted = deprecated(),
                        execOnResize = FALSE, outputArgs = list()
 ) {
 
-  expr <- getQuosure(expr, env, quoted)
+  q <- enquo0(expr)
+  q <- sustainEnvAndQuotedInternal(q, expr, env, quoted)
   # This ..stacktraceon is matched by a ..stacktraceoff.. when plotFunc
   # is called
-  func <- quoToFunction(expr, "renderPlot", ..stacktraceon = TRUE)
+  func <- quoToFunction(q, "renderPlot", ..stacktraceon = TRUE)
 
   args <- list(...)
 
@@ -186,7 +187,7 @@ renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
     outputFunc,
     renderFunc,
     outputArgs,
-    cacheHint = list(userExpr = get_expr(expr), res = res)
+    cacheHint = list(userExpr = get_expr(q), res = res)
   )
   class(markedFunc) <- c("shiny.renderPlot", class(markedFunc))
   markedFunc

R/render-table.R

@@ -42,8 +42,8 @@
 #'   (i.e. they either evaluate to `NA` or `NaN`).
 #' @param ... Arguments to be passed through to [xtable::xtable()]
 #'   and [xtable::print.xtable()].
-#' @param env The environment in which to evaluate `expr`.
-#' @param quoted Is `expr` a quoted expression (with `quote()`)?
+#' @param env TODO-barret docs; The environment in which to evaluate `expr`.
+#' @param quoted TODO-barret docs; Is `expr` a quoted expression (with `quote()`)?
 #'   This is useful if you want to save an expression in a variable.
 #' @param outputArgs A list of arguments to be passed through to the
 #'   implicit call to [tableOutput()] when `renderTable` is
@@ -71,11 +71,12 @@ renderTable <- function(expr, striped = FALSE, hover = FALSE,
                         width = "auto", align = NULL,
                         rownames = FALSE, colnames = TRUE,
                         digits = NULL, na = "NA", ...,
-                        env = parent.frame(), quoted = FALSE,
+                        env = deprecated(), quoted = deprecated(),
                         outputArgs=list())
 {
-  expr <- getQuosure(expr, env, quoted)
-  func <- quoToFunction(expr, "renderTable")
+  q <- enquo0(expr)
+  q <- sustainEnvAndQuotedInternal(q, expr, env, quoted)
+  func <- quoToFunction(q, "renderTable")
 
   if (!is.function(spacing)) spacing <- match.arg(spacing)