Use Callbacks objects for bookmarking callbacks

R/bookmark-state.R

@@ -506,36 +506,43 @@ configureBookmarking <- function(store = c("url", "server", "disable"),
 }
 
 
+#' Add callbacks for Shiny session bookmarkingevents
+#'
+#' These functions are for registering callbacks on Shiny session events.
+#' \code{onBookmark} registers a function that will be called before Shiny flushes
+#' the reactive system. \code{onFlushed} registers a function that will be
+#' called after Shiny flushes the reactive system. \code{onSessionEnded}
+#' registers a function to be called after the client has disconnected.
+#'
+#' These functions should be called within the application's server function.
+#'
+#' All of these functions return a function which can be called with no
+#' arguments to cancel the registration.
+#'
+#' @param fun A callback function.
+#' @param once Should the function be run once, and then cleared, or should it
+#'   re-run each time the event occurs. (Only for \code{onFlush} and
+#'   \code{onFlushed}.)
+#' @param session A shiny session object.
+#'
 #' @export
 onBookmark <- function(fun, session = getDefaultReactiveDomain()) {
-  if (!is.function(fun) || length(fun) != 1) {
+  session$onBookmark(fun)
-    stop("`fun` must be a function that takes one argument")
-  }
-  session$bookmarkCallbacks$onBookmark <- fun
 }
 
 #' @export
 onBookmarked <- function(fun, session = getDefaultReactiveDomain()) {
-  if (!is.function(fun) || length(fun) != 1) {
+  session$onBookmarked(fun)
-    stop("`fun` must be a function that takes one argument")
-  }
-  session$bookmarkCallbacks$onBookmarked <- fun
 }
 
 #' @export
 onRestore <- function(fun, session = getDefaultReactiveDomain()) {
-  if (!is.function(fun) || length(fun) != 1) {
+  session$onRestore(fun)
-    stop("`fun` must be a function that takes one argument")
-  }
-  session$bookmarkCallbacks$onRestore <- fun
 }
 
 #' @export
 onRestored <- function(fun, session = getDefaultReactiveDomain()) {
-  if (!is.function(fun) || length(fun) != 1) {
+  session$onRestored(fun)
-    stop("`fun` must be a function that takes one argument")
-  }
-  session$bookmarkCallbacks$onRestored <- fun
 }
 
 

R/shiny.R

@@ -354,6 +354,11 @@ ShinySession <- R6Class(
     flushCallbacks = 'Callbacks',
     flushedCallbacks = 'Callbacks',
     inputReceivedCallbacks = 'Callbacks',
+    bookmarkCallbacks = 'Callbacks',
+    bookmarkedCallbacks = 'Callbacks',
+    restoreCallbacks = 'Callbacks',
+    restoredCallbacks = 'Callbacks',
+
     sendResponse = function(requestMsg, value) {
       if (is.null(requestMsg$tag)) {
         warning("Tried to send response for untagged message; method: ",
@@ -449,11 +454,7 @@ ShinySession <- R6Class(
                   input = session$input,
                   exclude = exclude,
                   onSave = function(state) {
-                    # Need to check for onBookmark at run time, because when
+                    private$bookmarkCallbacks$invoke(state)
-                    # this callback is defined, it probably won't exist yet.
-                    if (!is.null(session$bookmarkCallbacks$onBookmark)) {
-                      session$bookmarkCallbacks$onBookmark(state)
-                    }
                   }
                 )
 
@@ -475,8 +476,8 @@ ShinySession <- R6Class(
                 )
 
 
-                # If no onBookmarked function is provided, use one of these defaults.
+                # If no onBookmarked function was provided, use one of these defaults.
-                if (is.null(session$bookmarkCallbacks$onBookmarked)) {
+                if (private$bookmarkedCallbacks$count() == 0) {
                   if (store == "server") {
                     onBookmarked(function(url) {
                       showModal(urlModal(
@@ -494,7 +495,7 @@ ShinySession <- R6Class(
                   }
                 }
 
-                session$bookmarkCallbacks$onBookmarked(url)
+                private$bookmarkedCallbacks$invoke(url)
               }),
               error = function(e) {
                 msg <- paste0("Error bookmarking state: ", e$message)
@@ -519,20 +520,20 @@ ShinySession <- R6Class(
         # Run the onRestore function at the beginning of the flush cycle, but after
         # the server function has been executed.
         observe({
-          if (!is.null(session$bookmarkCallbacks$onRestore)) {
+          if (private$restoreCallbacks$count() > 0) {
             tryCatch(
               withLogErrors(
                 isolate({
                   rc <- getCurrentRestoreContext()
                   if (rc$active) {
                     restoreState <- getCurrentRestoreContext()$asList()
-                    session$bookmarkCallbacks$onRestore(restoreState)
+                    private$restoreCallbacks$invoke(restoreState)
                   }
                 })
               ),
               error = function(e) {
                 showNotification(
-                  paste0("Error calling onRestore(): ", e$message),
+                  paste0("Error calling onRestore callback: ", e$message),
                   duration = NULL, type = "error"
                 )
               }
@@ -543,7 +544,7 @@ ShinySession <- R6Class(
         # Run the onRestored function after the flush cycle completes and information
         # is sent to the client.
         session$onFlushed(function() {
-          if (!is.null(session$bookmarkCallbacks$onRestored)) {
+          if (private$restoredCallbacks$count() > 0) {
 
             tryCatch(
               withLogErrors(
@@ -551,12 +552,12 @@ ShinySession <- R6Class(
                   rc <- getCurrentRestoreContext()
                   if (rc$active) {
                     restoreState <- getCurrentRestoreContext()$asList()
-                    session$bookmarkCallbacks$onRestored(restoreState)
+                    private$restoredCallbacks$invoke(restoreState)
                   }
                 })
               ),
               error = function(e) {
-                msg <- paste0("Error calling onRestored(): ", e$message)
+                msg <- paste0("Error calling onRestored callback: ", e$message)
                 showNotification(msg, duration = NULL, type = "error")
               }
             )
@@ -568,7 +569,6 @@ ShinySession <- R6Class(
   ),
   public = list(
     restoreContext = NULL,
-    bookmarkCallbacks = NULL,   # Bookmark configuration info
     progressStack = 'Stack', # Stack of progress objects
     input       = 'reactivevalues', # Externally-usable S3 wrapper object for .input
     output      = 'ANY',    # Externally-usable S3 wrapper object for .outputs
@@ -611,12 +611,10 @@ ShinySession <- R6Class(
       private$.outputs <- list()
       private$.outputOptions <- list()
 
-      self$bookmarkCallbacks <- list(
+      private$bookmarkCallbacks <- Callbacks$new()
-        onBookmark = NULL,
+      private$bookmarkedCallbacks <- Callbacks$new()
-        onBookmarked = NULL,
+      private$restoreCallbacks <- Callbacks$new()
-        onRestore = NULL,
+      private$restoredCallbacks <- Callbacks$new()
-        onRestored = NULL
-      )
       private$createBookmarkObservers()
 
       private$registerSessionEndCallbacks()
@@ -943,6 +941,32 @@ ShinySession <- R6Class(
         return(dereg)
       }
     },
+
+    onBookmark = function(fun) {
+      if (!is.function(fun) || length(fun) != 1) {
+        stop("`fun` must be a function that takes one argument")
+      }
+      private$bookmarkCallbacks$register(fun)
+    },
+    onBookmarked = function(fun) {
+      if (!is.function(fun) || length(fun) != 1) {
+        stop("`fun` must be a function that takes one argument")
+      }
+      private$bookmarkedCallbacks$register(fun)
+    },
+    onRestore = function(fun) {
+      if (!is.function(fun) || length(fun) != 1) {
+        stop("`fun` must be a function that takes one argument")
+      }
+      private$restoreCallbacks$register(fun)
+    },
+    onRestored = function(fun) {
+      if (!is.function(fun) || length(fun) != 1) {
+        stop("`fun` must be a function that takes one argument")
+      }
+      private$restoredCallbacks$register(fun)
+    },
+
     reactlog = function(logEntry) {
       if (private$showcase)
         private$sendMessage(reactlog = logEntry)