Get event_data working on shiny modules

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: plotly
 Title: Create Interactive Web Graphics via 'plotly.js'
-Version: 4.3.6
+Version: 4.3.7
 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
     email = "[email protected]"),
     person("Chris", "Parmer", role = c("aut", "cph"),
@@ -44,7 +44,7 @@ Suggests:
     testthat,
     knitr,
     devtools,
-    shiny,
+    shiny (>= 0.14),
     htmltools,
     curl,
     rmarkdown,

NEWS.md

@@ -1,3 +1,9 @@
+# 4.3.7 -- 11 September 2016
+
+## BUG FIXES
+
+* `event_data()` now works inside shiny modules (#659). For an example, see <https://github.com/ropensci/plotly/tree/master/inst/examples/plotlyShinyModules>
+
 # 4.3.6 -- 9 September 2016
 
 ## CHANGES

R/plotly_build.R

@@ -98,6 +98,8 @@ plotly_build.plotly <- function(p) {
     })
     dataArrayAttrs <- names(Attrs)[as.logical(isArray)]
     tr <- trace[names(trace) %in% c(npscales(), special_attrs(trace), dataArrayAttrs)]
+    # TODO: does it make sense to "train" matrices/2D-tables (e.g. z)?
+    tr <- tr[vapply(tr, function(x) is.null(dim(x)), logical(1))]
     builtData <- tibble::as_tibble(tr)
 
     # avoid clobbering I() (i.e., variables that shouldn't be scaled)

R/shiny.R

@@ -41,19 +41,21 @@ renderPlotly <- function(expr, env = parent.frame(), quoted = FALSE) {
 #' @param source Which plot should the listener be tied to? This 
 #' (character string) should match the value of \code{source} in 
 #' \code{\link{plot_ly}()}.
+#' @param session a shiny session object (the default should almost always be used).
 #' @export
 #' @author Carson Sievert
 #' @examples \dontrun{
 #' shiny::runApp(system.file("examples", "plotlyEvents", package = "plotly"))
 #' }
 
 event_data <- function(event = c("plotly_hover", "plotly_click", "plotly_selected", 
-                                 "plotly_relayout"), source = "A") {
-  session <- shiny::getDefaultReactiveDomain()
+                                 "plotly_relayout"), source = "A",
+                       session = shiny::getDefaultReactiveDomain()) {
   if (is.null(session)) {
     stop("No reactive domain detected. This function can only be called \n",
          "from within a reactive shiny context.")
   }
-  val <- session$input[[sprintf(".clientValue-%s-%s", event[1], source)]]
+  src <- sprintf(".clientValue-%s-%s", event[1], source)
+  val <- session$rootScope()$input[[src]]
   if (is.null(val)) val else jsonlite::fromJSON(val)
 }

inst/examples/plotlyShinyModules/app.R

@@ -0,0 +1,48 @@
+library(shiny)
+library(plotly)
+
+reusableUI <- function(id = NULL) {
+  ns <- NS(id)
+
+  fluidRow(
+    column(4, plotlyOutput(ns("p1"))),
+    column(4, plotlyOutput(ns("p2"))),
+    column(4, verbatimTextOutput(ns("ev1"))),
+    column(4, verbatimTextOutput(ns("ev2")))
+  )
+}
+
+viz <- function(input, output, session, src) {
+
+  # if you want, you can distinguish between events *within* a module
+  src2 <- paste0(src, "2")
+
+  output$p1 <- renderPlotly({
+    plot_ly(mtcars, x = ~mpg, y = ~disp, 
+            key = row.names(mtcars), source = src)
+  })
+  output$p2 <- renderPlotly({
+    plot_ly(mtcars, x = ~mpg, y = ~disp, 
+            key = row.names(mtcars), source = src2)
+  })
+  output$ev1 <- renderPrint({
+    event_data("plotly_hover", source = src)
+  })
+  output$ev2 <- renderPrint({
+    event_data("plotly_hover", source = src2)
+  })
+
+}
+
+ui <- fluidPage(
+  reusableUI("one"),
+  reusableUI("two")
+)
+
+server <- function(input, output, session) {
+  # use the src argument to namespace plotly events
+  callModule(viz, "one", src = "A")
+  callModule(viz, "two", src = "B")
+}
+
+shinyApp(ui, server)

inst/htmlwidgets/plotly.js

@@ -68,10 +68,8 @@ HTMLWidgets.widget({
           attachKey("key");
           return obj; 
         });
-        Shiny.onInputChange(
-          ".clientValue-" + eventType + "-" + x.source, 
-          JSON.stringify(d)
-        );
+        var src = ".clientValue-" + eventType + "-" + x.source;
+        Shiny.onInputChange(src, JSON.stringify(d));
       };
     };