javascript - Shiny.setInputValue 仅适用于第二次尝试

Question

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

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

为什么是这个自定义按钮？如果我可以让它工作，也应该可以使用 shinyFiles 在服务器端保存图像这最终是我需要的。

编辑:@Stéphane Laurent 解决方案适用于 ShinyFiles(开发版)和 Shiny 的下载按钮。看
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)