Skip to content

Commit f293486

Browse files
committed
force user to specify inputs/events to register as part of plot object
1 parent 8377bec commit f293486

File tree

7 files changed

+133
-361
lines changed

7 files changed

+133
-361
lines changed

R/layout.R

Lines changed: 29 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -101,6 +101,8 @@ rangeslider <- function(p, start = NULL, end = NULL, ...) {
101101
#' (see [here](https://github.com/ropensci/plotly/blob/master/inst/examples/rmd/MathJax/index.Rmd)
102102
#' for an **rmarkdown** example and
103103
#' [here](https://github.com/ropensci/plotly/blob/master/inst/examples/rmd/MathJax/index.Rmd) for a **shiny** example).
104+
#' @param shinyInputs plotly.js events to register as shiny input values
105+
#' @param shinyEvents plotly.js events to register as shiny input values with event priority
104106
#' @author Carson Sievert
105107
#' @export
106108
#' @examples
@@ -131,7 +133,9 @@ rangeslider <- function(p, start = NULL, end = NULL, ...) {
131133
#' config(p, locale = "zh-CN")
132134
#'
133135

134-
config <- function(p, ..., collaborate = TRUE, cloud = FALSE, locale = NULL, mathjax = NULL) {
136+
config <- function(p, ..., collaborate = TRUE, cloud = FALSE, locale = NULL, mathjax = NULL,
137+
shinyInputs = c("plotly_hover", "plotly_click", "plotly_selected", "plotly_relayout"),
138+
shinyEvents = c("plotly_doubleclick", "plotly_deselect", "plotly_afterplot")) {
135139

136140
if (!is.null(locale)) {
137141
p$dependencies <- c(
@@ -170,6 +174,30 @@ config <- function(p, ..., collaborate = TRUE, cloud = FALSE, locale = NULL, mat
170174
}
171175

172176
p$x$config$cloud <- cloud
177+
p$x$config$shinyInputs <- I(validate_event_names(shinyInputs))
178+
p$x$config$shinyEvents <- I(validate_event_names(shinyEvents))
173179

174180
p
175181
}
182+
183+
validate_event_names <- function(events) {
184+
illegalEvents <- setdiff(events, shiny_input_events())
185+
if (!length(illegalEvents)) return(events)
186+
187+
stop(
188+
sprintf(
189+
"The following shiny input events are not supported: '%s'",
190+
paste(illegalEvents, collapse = "', '")
191+
),
192+
call. = FALSE
193+
)
194+
}
195+
196+
shiny_input_events <- function() {
197+
c(
198+
"plotly_hover", "plotly_unhover", "plotly_click", "plotly_doubleclick",
199+
"plotly_selected", "plotly_selecting", "plotly_brushed", "plotly_brushing",
200+
"plotly_deselect", "plotly_relayout", "plotly_restyle", "plotly_legendclick",
201+
"plotly_legenddoubleclick", "plotly_clickannotation", "plotly_afterplot"
202+
)
203+
}

R/shiny.R

Lines changed: 1 addition & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -73,9 +73,6 @@ prepareWidget <- function(x) {
7373
#' with the `source` argument in [plot_ly()] (or [ggplotly()]) to respond to
7474
#' events emitted from that specific plot.
7575
#' @param session a shiny session object (the default should almost always be used).
76-
#' @param priority the priority of the relevant shiny input. If equal to `"event"`,
77-
#' then [event_data()] always triggers re-execution, instead of re-executing
78-
#' only when the relevant shiny input value changes (the default).
7976
#' @export
8077
#' @references
8178
#' * <https://plotly-book.cpsievert.me/shiny-plotly-inputs.html>
@@ -93,8 +90,7 @@ event_data <- function(
9390
"plotly_legenddoubleclick", "plotly_clickannotation", "plotly_afterplot"
9491
),
9592
source = "A",
96-
session = shiny::getDefaultReactiveDomain(),
97-
priority = c("input", "event")
93+
session = shiny::getDefaultReactiveDomain()
9894
) {
9995
if (is.null(session)) {
10096
stop("No reactive domain detected. This function can only be called \n",
@@ -103,26 +99,6 @@ event_data <- function(
10399

104100
# make sure the input event is sensible
105101
event <- match.arg(event)
106-
priority <- match.arg(priority)
107-
108-
isNullEvent <- event %in% c("plotly_doubleclick", "plotly_deselect", "plotly_afterplot")
109-
if (isNullEvent && priority != "event") {
110-
message(
111-
"The input value tied to a '", event, "' event never changes. ",
112-
"Setting `priority = 'event'` so that the event actually triggers re-execution."
113-
)
114-
priority <- "event"
115-
}
116-
117-
# register event on client-side
118-
session$onFlushed(function() {
119-
session$sendCustomMessage(
120-
type = "plotlyEventData",
121-
message = list(event = event, source = source, priority = priority)
122-
)
123-
})
124-
125-
126102
src <- sprintf(".clientValue-%s-%s", event, source)
127103
val <- session$rootScope()$input[[src]]
128104

inst/examples/shiny/event_data/app.R

Lines changed: 18 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -17,13 +17,26 @@ server <- function(input, output, session) {
1717
nms <- row.names(mtcars)
1818

1919
output$plot <- renderPlotly({
20-
if (identical(input$plotType, "ggplotly")) {
21-
p <- ggplot(mtcars, aes(x = mpg, y = wt, key = nms)) + geom_point()
22-
ggplotly(p) %>% layout(dragmode = "select")
20+
p <- if (identical(input$plotType, "ggplotly")) {
21+
ggplotly(
22+
ggplot(mtcars, aes(x = mpg, y = wt, key = nms)) + geom_point()
23+
)
2324
} else {
24-
plot_ly(mtcars, x = ~mpg, y = ~wt, key = nms) %>%
25-
layout(dragmode = "select")
25+
plot_ly(mtcars, x = ~mpg, y = ~wt, key = nms)
2626
}
27+
p %>%
28+
layout(dragmode = "select") %>%
29+
config(
30+
shinyInputs = c(
31+
"plotly_hover",
32+
"plotly_hover",
33+
"plotly_click",
34+
"plotly_selected",
35+
"plotly_selecting",
36+
"plotly_brushed",
37+
"plotly_brushing"
38+
)
39+
)
2740
})
2841

2942
output$hover <- renderPrint({

inst/examples/shiny/event_data_annotation/app.R

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,8 @@ server <- function(input, output, session) {
1010

1111
output$p <- renderPlotly({
1212
plot_ly(mtcars) %>%
13-
add_annotations(x = ~wt, y = ~mpg, text = row.names(mtcars), captureevents = TRUE)
13+
add_annotations(x = ~wt, y = ~mpg, text = row.names(mtcars), captureevents = TRUE) %>%
14+
config(shinyInputs = "plotly_clickannotation")
1415
})
1516

1617
observeEvent(input$edit, {

0 commit comments

Comments
 (0)