发送电子邮件后向用户提供闪亮的反馈

Question

我需要一些闪亮的智慧，拜托。下面的代码在shinyserver 部分运行良好；当用户单击ui 部分中的actionButton("mailButton", "e-mail!") 时，它会发送一封电子邮件，其中包含通过gmailr 附加的PDF 报告。我遇到的唯一问题是没有向用户反馈是否已发送电子邮件。理想情况下，我希望在屏幕中间有一个消息框（可能带有叠加层）。当发送电子邮件时，它会告诉按下input$mailButton 的用户（并且该框可能会在15 秒的超时后消失）。此事件大致应对应于以下代码中的print("message sent") 点（这确实会打印到终端）。向用户显示电子邮件确实已发送并在发送过程中阻止输入（通常需要 4 秒）的好方法是什么？

    # email sender ------------------------------------------------------------
     observeEvent(input$mailButton,{
        isolate( {
            
            library(gmailr)
            
            params <- list(startDate = min(dashData()$mdate), 
                           endDate = max(dashData()$mdate), 
                           dfSurvey = dashData(), 
                           onePerson = input$checkOnePt, 
                           onePersonNumber = input$patientNumber, 
                           showAvg = input$checkAvgLine, 
                           alphaAvg = alphaAvg)            
            
            toAddress <- input$emailAddr
            
            if (input$checkOnePt) {
                mailSubject <- paste("Feedback graph for ", input$patientNumber)
                mailText <- paste("Hello, please see the attached report from us for ",input$patientNumber)
            } else {
                mailSubject <- paste("Feedback graph")
                mailText <- paste("Hello, please see the attached report from us.")
            }
            
                
            library(rmarkdown)
            out <- render('hwu-weekly.Rmd',
                              params = params,
                              pdf_document(),
                              envir = new.env(parent = globalenv())
                )

            
            gm_auth_configure(path  = "credentials.json")
            gm_auth(email = TRUE, cache = ".secret")
            
            email <- gm_mime() %>%
                gm_to(toAddress) %>%
                gm_from("user.us@gmail.com") %>%
                gm_subject(mailSubject) %>%
                gm_text_body( mailText ) %>% 
                gm_attach_file(filename = "hwu-weekly.pdf")
            
            gm_send_message(email)

            print("message sent")
        })
    
    })

Answer 1

这似乎是withProgress() 和showNotification() 的一个很好的用例：

library(shiny)

ui <- fluidPage(
  actionButton('go', 'go')
)

server <- function(input, output, session) {
  observeEvent(input$go, {
    withProgress(message = "Please Wait", {
      Sys.sleep(1)
      setProgress(0.25, detail = "1 Sec")
      Sys.sleep(1)
      setProgress(0.5, detail = "2 Sec")
      Sys.sleep(1)
      setProgress(0.75, detail = "3 Sec")
      Sys.sleep(1)
      setProgress(1, detail = "4 Sec")
   })
    showNotification("Your message here", type = "message", duration = 15)
  })
}

shinyApp(ui, server)

notifications 和 progress indicators 的闪亮文档的链接。

您还可以使用modal 来表示用户在继续之前必须关闭的更明显的内容：

library(shiny)

ui <- fluidPage(
  actionButton('go', 'go')
)

server <- function(input, output, session) {
  observeEvent(input$go, {
    withProgress(message = "Please Wait", {
      Sys.sleep(1)
      setProgress(0.25, detail = "1 Sec")
      Sys.sleep(1)
      setProgress(0.5, detail = "2 Sec")
      Sys.sleep(1)
      setProgress(0.75, detail = "3 Sec")
      Sys.sleep(1)
      setProgress(1, detail = "4 Sec")
   })
    showModal(modalDialog(title = 'Message', h2("Content Here")))
  })
}

shinyApp(ui, server)