Shiny.setInputValue 仅在第二次尝试时有效

Question

@yonicd 最近创建了一个新的 R 包来生成闪亮应用（和闪亮应用的元素）的屏幕截图，它运行良好 (https://github.com/yonicd/snapper)。对于我正在开发的另一个应用程序，我想 (1) 以模式显示 snapper 屏幕截图，然后 (2) 提取 img 并将其保存到磁盘。在下面的示例中，“下载 (snapper)”按钮按预期工作。但是，“下载（闪亮）”按钮在您第一次单击时失败，因为“input$img_src”返回 NULL。第二次点击它，它工作正常。当然，我也希望它第一次工作。

我可以在浏览器控制台中看到该图像可用 ($("#screenshot_link_preview img").attr("src");) 但似乎input$img_src 的更新速度不够快。我尝试在 js 和 R 中使用sleep，但没有运气。有什么建议么？

为什么是这个自定义按钮？如果我能做到这一点，也应该可以使用shinyFiles 在服务器端保存图像，这正是我所需要的。

编辑：@Stéphane Laurent 解决方案适用于 shinyFiles（开发版）和闪亮的下载按钮。看 gist 完整示例

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)

Answer 1

这是一个解决方案，使用下载按钮的onclick 属性。

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)