force user to specify inputs/events to register as part of plot object

Author: cpsievert

R/layout.R

@@ -101,6 +101,8 @@ rangeslider <- function(p, start = NULL, end = NULL, ...) {
 #' (see [here](https://github.com/ropensci/plotly/blob/master/inst/examples/rmd/MathJax/index.Rmd) 
 #' for an **rmarkdown** example and 
 #' [here](https://github.com/ropensci/plotly/blob/master/inst/examples/rmd/MathJax/index.Rmd) for a **shiny** example).
+#' @param shinyInputs plotly.js events to register as shiny input values
+#' @param shinyEvents plotly.js events to register as shiny input values with event priority
 #' @author Carson Sievert
 #' @export
 #' @examples
@@ -131,7 +133,9 @@ rangeslider <- function(p, start = NULL, end = NULL, ...) {
 #' config(p, locale = "zh-CN")
 #' 
 
-config <- function(p, ..., collaborate = TRUE, cloud = FALSE, locale = NULL, mathjax = NULL) {
+config <- function(p, ..., collaborate = TRUE, cloud = FALSE, locale = NULL, mathjax = NULL, 
+                   shinyInputs = c("plotly_hover", "plotly_click", "plotly_selected", "plotly_relayout"),
+                   shinyEvents = c("plotly_doubleclick", "plotly_deselect", "plotly_afterplot")) {
 
   if (!is.null(locale)) {
     p$dependencies <- c(
@@ -170,6 +174,30 @@ config <- function(p, ..., collaborate = TRUE, cloud = FALSE, locale = NULL, mat
   }
 
   p$x$config$cloud <- cloud
+  p$x$config$shinyInputs <- I(validate_event_names(shinyInputs))
+  p$x$config$shinyEvents <- I(validate_event_names(shinyEvents))
 
   p
 }
+
+validate_event_names <- function(events) {
+  illegalEvents <- setdiff(events, shiny_input_events())
+  if (!length(illegalEvents)) return(events)
+  
+  stop(
+    sprintf(
+      "The following shiny input events are not supported: '%s'", 
+      paste(illegalEvents, collapse = "', '")
+    ),
+    call. = FALSE
+  )
+}
+
+shiny_input_events <- function() {
+  c(
+    "plotly_hover", "plotly_unhover", "plotly_click", "plotly_doubleclick",
+    "plotly_selected", "plotly_selecting", "plotly_brushed", "plotly_brushing", 
+    "plotly_deselect", "plotly_relayout", "plotly_restyle", "plotly_legendclick", 
+    "plotly_legenddoubleclick", "plotly_clickannotation", "plotly_afterplot"
+  )
+}

R/shiny.R

@@ -73,9 +73,6 @@ prepareWidget <- function(x) {
 #' with the `source` argument in [plot_ly()] (or [ggplotly()]) to respond to  
 #' events emitted from that specific plot.
 #' @param session a shiny session object (the default should almost always be used).
-#' @param priority the priority of the relevant shiny input. If equal to `"event"`, 
-#' then [event_data()] always triggers re-execution, instead of re-executing
-#' only when the relevant shiny input value changes (the default).
 #' @export
 #' @references 
 #'   * <https://plotly-book.cpsievert.me/shiny-plotly-inputs.html> 
@@ -93,8 +90,7 @@ event_data <- function(
     "plotly_legenddoubleclick", "plotly_clickannotation", "plotly_afterplot"
   ), 
   source = "A",
-  session = shiny::getDefaultReactiveDomain(),
-  priority = c("input", "event")
+  session = shiny::getDefaultReactiveDomain()
 ) {
   if (is.null(session)) {
     stop("No reactive domain detected. This function can only be called \n",
@@ -103,26 +99,6 @@ event_data <- function(
 
   # make sure the input event is sensible
   event <- match.arg(event)
-  priority <- match.arg(priority)
-  
-  isNullEvent <- event %in% c("plotly_doubleclick", "plotly_deselect", "plotly_afterplot")
-  if (isNullEvent && priority != "event") {
-    message(
-      "The input value tied to a '", event, "' event never changes. ", 
-      "Setting `priority = 'event'` so that the event actually triggers re-execution."
-    )
-    priority <- "event"
-  }
-  
-  # register event on client-side
-  session$onFlushed(function() {
-    session$sendCustomMessage(
-      type = "plotlyEventData",
-      message = list(event = event, source = source, priority = priority)
-    )
-  })
-  
-  
   src <- sprintf(".clientValue-%s-%s", event, source)
   val <- session$rootScope()$input[[src]]
 

inst/examples/shiny/event_data/app.R

@@ -17,13 +17,26 @@ server <- function(input, output, session) {
   nms <- row.names(mtcars)
 
   output$plot <- renderPlotly({
-    if (identical(input$plotType, "ggplotly")) {
-      p <- ggplot(mtcars, aes(x = mpg, y = wt, key = nms)) + geom_point()
-      ggplotly(p) %>% layout(dragmode = "select")
+    p <- if (identical(input$plotType, "ggplotly")) {
+      ggplotly(
+        ggplot(mtcars, aes(x = mpg, y = wt, key = nms)) + geom_point()
+      )
     } else {
-      plot_ly(mtcars, x = ~mpg, y = ~wt, key = nms) %>%
-        layout(dragmode = "select")
+      plot_ly(mtcars, x = ~mpg, y = ~wt, key = nms) 
     }
+    p %>% 
+      layout(dragmode = "select") %>% 
+      config(
+        shinyInputs = c(
+          "plotly_hover", 
+          "plotly_hover", 
+          "plotly_click",
+          "plotly_selected",
+          "plotly_selecting",
+          "plotly_brushed",
+          "plotly_brushing"
+        ) 
+      )
   })
 
   output$hover <- renderPrint({

inst/examples/shiny/event_data_annotation/app.R

@@ -10,7 +10,8 @@ server <- function(input, output, session) {
 
   output$p <- renderPlotly({
     plot_ly(mtcars) %>% 
-      add_annotations(x = ~wt, y = ~mpg, text = row.names(mtcars), captureevents = TRUE)
+      add_annotations(x = ~wt, y = ~mpg, text = row.names(mtcars), captureevents = TRUE) %>%
+      config(shinyInputs = "plotly_clickannotation")
   })
 
   observeEvent(input$edit, {