Multi-app non-blocking mode for runApp()

DESCRIPTION

@@ -126,6 +126,7 @@ Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.3
 Collate:
+    'app-handle.R'
     'globals.R'
     'app-state.R'
     'app_template.R'

NEWS.md

@@ -1,5 +1,15 @@
 # shiny (development version)
 
+## New features
+
+* `runApp()`, `runExample()`, and `runGadget()` gain a `blocking` parameter.
+  When `blocking = FALSE`, the app runs in the background and returns a
+  `ShinyAppHandle` object immediately, without blocking the R session. The
+  handle provides `stop()`, `status()`, `url()`, and `result()` methods for
+  managing the app lifecycle. Multiple apps can run concurrently in
+  non-blocking mode. The default can be changed via
+  `options(shiny.blocking = FALSE)`.
+
 ## Bug fixes and minor improvements
 
 * Fixed an issue with `actionLink()` that extended the link underline to whitespace around the text. (#4348)

R/app-handle.R

@@ -0,0 +1,86 @@
+# Handle returned by runApp() when blocking = FALSE
+ShinyAppHandle <- R6::R6Class("ShinyAppHandle",
+  cloneable = FALSE,
+
+  public = list(
+    initialize = function(appUrl, appState, cleanupFn, registerCapture) {
+      private$appUrl <- appUrl
+      private$appState <- appState
+      private$cleanupFn <- cleanupFn
+
+      # Expose private captureResult to caller via callback registration
+      registerCapture(function() private$captureResult())
+
+      reg.finalizer(self, function(e) {
+        if (e$status() == "running") {
+          tryCatch(e$stop(), error = function(cnd) NULL, warning = function(cnd) NULL)
+        }
+      }, onexit = TRUE)
+    },
+
+    stop = function() {
+      if (self$status() != "running") {
+        warning("App is not running")
+        return(invisible(self))
+      }
+      # Order matters: capture result from appState (reads retval/reterror),
+      # then mark the app as stopped, then run cleanup (which NULLs appState
+      # fields and removes the app from the registry).
+      private$captureResult()
+      private$appState$stopped <- TRUE
+      private$cleanupFn()
+      private$cleanupFn <- NULL
+      invisible(self)
+    },
+
+    url = function() private$appUrl,
+
+    status = function() {
+      if (!private$stopped) {
+        "running"
+      } else if (!is.null(private$resultError)) {
+        "error"
+      } else {
+        "success"
+      }
+    },
+
+    result = function() {
+      if (self$status() == "running") {
+        stop("App is still running. Use status() to check if the app has stopped.")
+      }
+      if (!is.null(private$resultError)) {
+        stop(private$resultError)
+      }
+      private$resultValue
+    },
+
+    print = function(...) {
+      cat("Shiny app handle\n")
+      cat("  URL:   ", private$appUrl, "\n", sep = "")
+      cat("  Status:", self$status(), "\n")
+      invisible(self)
+    }
+  ),
+
+  private = list(
+    appUrl = NULL,
+    appState = NULL,
+    cleanupFn = NULL,
+    # Whether this handle has captured the result. Distinct from appState$stopped
+    # which tracks whether a stop was requested (set by stopApp() or stop()).
+    stopped = FALSE,
+    resultValue = NULL,
+    resultError = NULL,
+
+    captureResult = function() {
+      if (private$stopped) return()
+      private$stopped <- TRUE
+      if (isTRUE(private$appState$reterror)) {
+        private$resultError <- private$appState$retval
+      } else if (!is.null(private$appState$retval)) {
+        private$resultValue <- private$appState$retval$value
+      }
+    }
+  )
+)

R/app-state.R

@@ -4,23 +4,70 @@ NULL
 # The current app state is a place to read and hang state for the
 # currently-running application. This is useful for setting options that will
 # last as long as the application is running.
+#
+# Multiple apps can run concurrently (in non-blocking mode). Each app gets its
+# own appState env, stored in .globals$appStates (keyed by token). The direct
+# pointer .globals$currentAppState is set by the service loop before each
+# iteration, so getCurrentAppState() is a single env read on the hot path.
+#
+# Fields on each appState env (set across several files):
+#   token                    - unique ID (initCurrentAppState)
+#   app                      - the shiny.appobj (initCurrentAppState)
+#   options                  - per-app shinyOptions snapshot (initCurrentAppState)
+#   onStopCallbacks          - Callbacks registry (initCurrentAppState)
+#   onUnhandledErrorCallbacks - Callbacks registry (initCurrentAppState)
+#   handlerManager           - HandlerManager (startApp, server.R)
+#   showcaseDefault          - numeric showcase mode (setShowcaseDefault, showcase.R)
+#   showcaseOverride         - logical showcase override (setShowcaseDefault, showcase.R)
+#   IncludeWWW               - logical, include www/ in showcase (runApp)
+#   reterror                 - logical, TRUE if retval is an error (runApp)
+#   retval                   - return value or error from stopApp (runApp)
+#   stopped                  - logical, TRUE when stop requested (runApp / stopApp)
+#   .captureResult           - callback to capture result (serviceAsync, server.R)
+#   .cleanup                 - cleanup closure (serviceAsync, server.R)
 
-.globals$appState <- NULL
+.globals$appStates <- list()
+.globals$currentAppState <- NULL
+.globals$serviceLoopRunning <- FALSE
 
 initCurrentAppState <- function(appobj) {
-  if (!is.null(.globals$appState)) {
-    stop("Can't initialize current app state when another is currently active.")
-  }
-  .globals$appState <- new.env(parent = emptyenv())
-  .globals$appState$app <- appobj
+  appState <- new.env(parent = emptyenv())
+  appState$token <- createUniqueId(8)
+  appState$app <- appobj
   # Copy over global options
-  .globals$appState$options <- .globals$options
+  appState$options <- .globals$options
+  # Per-app callback registries
+  appState$onStopCallbacks <- Callbacks$new()
+  appState$onUnhandledErrorCallbacks <- Callbacks$new()
+  # Fields set later by runApp / startApp / serviceAsync; listed here for
+  # discoverability. See field inventory above.
+  appState$handlerManager <- NULL
+  appState$showcaseDefault <- NULL
+  appState$showcaseOverride <- NULL
+  appState$IncludeWWW <- NULL
+  appState$reterror <- NULL
+  appState$retval <- NULL
+  appState$stopped <- NULL
+  appState$.captureResult <- NULL
+  appState$.cleanup <- NULL
+  .globals$appStates[[appState$token]] <- appState
+  .globals$currentAppState <- appState
+  appState
 }
 
 getCurrentAppState <- function() {
-  .globals$appState
+  .globals$currentAppState
+}
+
+clearCurrentAppState <- function(token) {
+  .globals$appStates[[token]] <- NULL
+  # Clear pointer if it matches the token being removed
+  if (!is.null(.globals$currentAppState) &&
+      identical(.globals$currentAppState$token, token)) {
+    .globals$currentAppState <- NULL
+  }
 }
 
-clearCurrentAppState <- function() {
-  .globals$appState <- NULL
+anyAppRunning <- function() {
+  length(.globals$appStates) > 0
 }