Skip to content

Wrapping of user-supplied expressions in renderPlotly #1609

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Oct 8, 2019
Merged

Wrapping of user-supplied expressions in renderPlotly #1609

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
7fbb486
Revert "Revert "Merge pull request #1539 from ropensci/renderWidgetPr…
cpsievert Aug 30, 2019
1a714b8
pass along a quoted expr that calls func()
cpsievert Aug 30, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
31 changes: 21 additions & 10 deletions R/shiny.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,11 +37,20 @@ plotlyOutput <- function(outputId, width = "100%", height = "400px",
#' @rdname plotly-shiny
#' @export
renderPlotly <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) { expr <- substitute(expr) } # force quoted
# this makes it possible to pass a ggplot2 object to renderPlotly()
# https://github.com/ramnathv/htmlwidgets/issues/166#issuecomment-153000306
expr <- as.call(list(call(":::", quote("plotly"), quote("prepareWidget")), expr))
renderFunc <- shinyRenderWidget(expr, plotlyOutput, env, quoted = TRUE)
if (!quoted) {
quoted <- TRUE
expr <- substitute(expr)
}
# Install the (user-supplied) expression as a function
# This way, if the user-supplied expression contains a return()
# statement, we can capture that return value and pass it along
# to prepareWidget()
# prepareWidget() makes it possible to pass different non-plotly
# objects to renderPlotly() (e.g., ggplot2, promises). It also is used
# to inform event_data about what events have been registered
shiny::installExprFunction(expr, "func", env, quoted, assign.env = env)
expr <- quote(plotly:::prepareWidget(func()))
renderFunc <- shinyRenderWidget(expr, plotlyOutput, env, quoted)
# remove 'internal' plotly attributes that are known to cause false
# positive test results in shinytest (snapshotPreprocessOutput was added
# in shiny 1.0.3.9002, but we require >= 1.1)
Expand All @@ -57,13 +66,14 @@ renderPlotly <- function(expr, env = parent.frame(), quoted = FALSE) {

# Converts a plot, OR a promise of a plot, to plotly
prepareWidget <- function(x) {
p <- if (promises::is.promising(x)) {
promises::then(x, ggplotly)
if (promises::is.promising(x)) {
promises::then(
promises::then(x, ggplotly),
register_plot_events
)
} else {
ggplotly(x)
register_plot_events(ggplotly(x))
}
register_plot_events(p)
p
}

register_plot_events <- function(p) {
Expand All @@ -73,6 +83,7 @@ register_plot_events <- function(p) {
session$userData$plotlyShinyEventIDs,
eventIDs
))
p
}


Expand Down