Shiny.setInputValue работает только со второй попытки

Question

@ yonicd недавно создал новый пакет R для создания снимков экрана shinyapps (и элементов shinyapp), и он хорошо работает (https://github.com/yonicd/snapper). Для другого приложения, над которым я работаю, я хотел (1) показать снимок экрана snapper в модальном режиме, а затем (2) извлечь img и сохранить его на диск. В приведенном ниже примере кнопка «Загрузить (снимок)» работает должным образом. Однако кнопка «Загрузить (блестящая)» не работает при первом нажатии, потому что «input $ img_sr c» возвращает NULL. Щелкните его второй раз, и он работает нормально. Конечно, хочется, чтобы и с первого раза заработало.

Я вижу в консоли браузера, что изображение доступно ($("#screenshot_link_preview img").attr("src");), но кажется, что input$img_src не обновляется достаточно быстро. Я пробовал использовать sleep в js и R, но безуспешно. Какие-либо предложения?

Почему эта кастомная кнопка? Если я смогу заставить это работать, также должна быть возможность сохранять изображения на стороне сервера, используя shinyFiles , что в конечном итоге мне нужно.

EDIT: решение @ 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)