Get event_data working on shiny modules

DESCRIPTION

@@ -56,3 +56,5 @@ Suggests:
 LazyData: true
 VignetteBuilder: knitr
 RoxygenNote: 5.0.1
+Remotes:
+  rstudio/shiny#1344

R/plotly.R

@@ -77,7 +77,8 @@
 plot_ly <- function(data = data.frame(), ..., type = NULL, group,
                     color, colors = NULL, alpha = 1, symbol, symbols = NULL, 
                     size, sizes = c(10, 100), linetype, linetypes = NULL,
-                    width = NULL, height = NULL, source = "A") {
+                    width = NULL, height = NULL, source = "A", 
+                    session = shiny::getDefaultReactiveDomain()) {
   if (!is.data.frame(data)) {
     stop("First argument, `data`, must be a data frame.", call. = FALSE)
   }
@@ -118,6 +119,10 @@ plot_ly <- function(data = data.frame(), ..., type = NULL, group,
   id <- new_id()
   # avoid weird naming clashes
   plotlyVisDat <- data
+  # automatically namespace source
+  if (!is.null(session)) {
+    source <- session$ns(source)
+  }
   p <- list(
     visdat = setNames(list(function() plotlyVisDat), id),
     cur_data = id,

R/shiny.R

@@ -47,12 +47,13 @@ renderPlotly <- function(expr, env = parent.frame(), quoted = FALSE) {
 #' }
 
 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], session$ns(source))
+  val <- session$rootScope()$input[[src]]
   if (is.null(val)) val else jsonlite::fromJSON(val)
 }

inst/examples/plotlyShinyModules/app.R

@@ -0,0 +1,39 @@
+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("ev")))
+  )
+}
+
+viz <- function(input, output, session) {
+  output$p1 <- renderPlotly({
+    plot_ly(mtcars, x = ~mpg, y = ~disp, 
+            key = row.names(mtcars), session = session)
+  })
+  output$p2 <- renderPlotly({
+    plot_ly(mtcars, x = ~mpg, y = ~disp, 
+            key = row.names(mtcars), session = session)
+  })
+  output$ev <- renderPrint({
+    d <- event_data("plotly_hover", session = session)
+    if (is.null(d)) print(paste("Module", session$ns(NULL))) else d
+  })
+}
+
+ui <- fluidPage(
+  reusableUI("one"),
+  reusableUI("two")
+)
+
+server <- function(input, output, session) {
+  callModule(viz, "one", session = session)
+  callModule(viz, "two", session = session)
+}
+
+shinyApp(ui, server)

inst/htmlwidgets/plotly.js

@@ -62,10 +62,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));
       };
     };