Shiny.setInputValue only works on the 2nd try

Question

@yonicd recently created a new R package to generate screenshots of shinyapps (and elements of a shinyapp) and it works well (https://github.com/yonicd/snapper). For another app i'm working on, I wanted to (1) show the snapper screenshot in a modal and then (2) extract the img and save it to disk. In the example below the "Download (snapper)" button works as expect. However, the "Download (shiny)" button fails the first time you click it because "input$img_src" returns NULL. Click it a 2nd time, and it works fine. Of course, I want it to work the first time as well.

I can see in the browser console that the image is available ($("#screenshot_link_preview img").attr("src");) but it seems input$img_src is not being updated quickly enough. I tried using sleep in js and R but no luck. Any suggestions?

Why this custom button? If I can get this to work, it should also be possible to save images server-side using shinyFiles which is ultimately what I need.

EDIT: @Stéphane Laurent solution works great with shinyFiles (development version) and a shiny download button. See gist for a full example

library(shiny)
# remotes::install_github("yonicd/snapper")
library(snapper)
library(base64enc)
library(png)

js <- '
Shiny.addCustomMessageHandler("get_img_src", get_img_src);

function get_img_src(message) {
  var img_src = $("#screenshot_link_preview img").attr("src");
  Shiny.setInputValue("img_src", img_src);
}
'

ui <- navbarPage("Snapper app",
  navbarMenu("", icon = icon("save"),
    tabPanel(
      snapper::preview_link(
        "screenshot_link", ui = "body", previewId = "screenshot_link_preview", label = "Take a screenshot",
        opts = config(
          ignoreElements = "function (el) {return el.className === 'dropdown-menu';}"
        )
      )
    )
  ),
  tags$head(
    tags$style(HTML("img { max-width: 85% !important; height: auto; }")),
    tags$script(HTML(js)),
    snapper::load_snapper()
  )
)

server <- function(input, output, session) {
  observeEvent(input$screenshot_link, {
    showModal(
      modalDialog(
        title = "App screenshot",
        span(snapper::snapper_div(id = "screenshot_link_preview")),
        footer = tagList(
          downloadButton("download_screenshot", "Download (shiny)"),
          snapper::download_button(
            ui = "#screenshot_link_preview",
            label = "Download (snapper)",
            filename = "snapper-body.png"
          ),
          modalButton("Cancel"),
        ),
        size = "m",
        easyClose = TRUE
      )
    )
  })

  output$download_screenshot <- downloadHandler(
    filename = function() {
      "radiant-screenshot.png"
    },
    content = function(file) {
      session$sendCustomMessage("get_img_src", "")
      plt <- sub("data:.+base64,", "", input$img_src)
      plt <- png::readPNG(base64enc::base64decode(what = plt))
      png::writePNG(plt, file)
    }
  )
}

shinyApp(ui, server)

score 2 · Accepted Answer · answered May 09 '20 at 12:43

Here is a solution, using the onclick attribute of the download button.

library(shiny)
library(snapper)
library(base64enc)
library(png)

js <- '
function get_img_src(){
  var img_src = $("#screenshot_link_preview img").attr("src");
  Shiny.setInputValue("img_src", img_src);
}
'

ui <- navbarPage("Snapper app",
                 navbarMenu("", icon = icon("save"),
                            tabPanel(
                              snapper::preview_link(
                                "screenshot_link", ui = "body", previewId = "screenshot_link_preview", label = "Take a screenshot",
                                opts = config(
                                  ignoreElements = "function (el) {return el.className === 'dropdown-menu';}"
                                )
                              )
                            )
                 ),
                 tags$head(
                   tags$style(HTML("img { max-width: 85% !important; height: auto; }")),
                   tags$script(HTML(js)),
                   snapper::load_snapper()
                 )
)

server <- function(input, output, session) {
  observeEvent(input$screenshot_link, {
    showModal(
      modalDialog(
        title = "App screenshot",
        span(snapper::snapper_div(id = "screenshot_link_preview")),
        footer = tagList(
          downloadButton("download_screenshot", "Download (shiny)", 
                         onclick = "get_img_src();"),
          snapper::download_button(
            ui = "#screenshot_link_preview",
            label = "Download (snapper)",
            filename = "snapper-body.png"
          ),
          modalButton("Cancel"),
        ),
        size = "m",
        easyClose = TRUE
      )
    )
  })

  output$download_screenshot <- downloadHandler(
    filename = function() {
      "radiant-screenshot.png"
    },
    content = function(file) {
      plt <- sub("data:.+base64,", "", input$img_src)
      plt <- png::readPNG(base64enc::base64decode(what = plt))
      png::writePNG(plt, file)
    }
  )
}

shinyApp(ui, server)

Shiny.setInputValue only works on the 2nd try

1 Answers1

Linked