Brilliant: how to create a confirmation dialog

Question

I would like to ask if it is possible to have a confirmation dialog consisting of two shiny buttons. Say, if I click the "Delete" button, a dialog box will open. The user selects a selection and returns. The application acts according to the choice of the user.

Answer 1

I changed part of your code to call

js_string <- 'confirm("Are You Sure?");' session$sendCustomMessage(type='jsCode', list(value = js_string)) 

to display a confirmation dialog box, not a warning dialog box. Then

 tags$script( HTML(' Shiny.addCustomMessageHandler( type = "jsCode" ,function(message) { Shiny.onInputChange("deleteConfirmChoice",eval(message.value)); }) ') ) 

to send the value returned by the confirmation dialog. Then I simply checeked the input value of $ deleteConfirmChoice to determine what action should be done. Many thanks! Now I understand how to send and receive messages in R and Javascript.

Answer 2

Update with sweetalertR

 #install_github("timelyportfolio/sweetalertR") library(shiny) library(sweetalertR) runApp(shinyApp( ui = fluidPage( actionButton("go", "Go"), sweetalert(selector = "#go", text = "hello", title = "world") ), server = function(input, output, session) { } )) 

Example 1

You can do something like this, note that the code is taken from the demo on the submit button with a popup (IN PROGRESS)

 rm(list = ls()) library(shiny) ui =basicPage( tags$head( tags$style(type='text/css', "select, textarea, input[type='text'] {margin-bottom: 0px;}" , "#submit { color: rgb(255, 255, 255); text-shadow: 0px -1px 0px rgba(0, 0, 0, 0.25); background-color: rgb(189,54,47); background-image: -moz-linear-gradient(center top , rgb(238,95,91), rgb(189,54,47)); background-repeat: repeat-x; border-color: rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25); }" ), tags$script(HTML(' Shiny.addCustomMessageHandler("jsCode", function(message) { eval(message.value); } );' )) ) , textInput(inputId = "inText", label = "", value = "Something here") , actionButton(inputId = "submit", label = "Submit") # # alternative approach: button with pop-up # , tags$button("Activate", id = "ButtonID", type = "button", class = "btn action-button", onclick = "return confirm('Are you sure?');" ) , tags$br() , tags$hr() , uiOutput("outText") ) server = ( function(session, input, output) { observe({ if (is.null(input$submit) || input$submit == 0){return()} js_string <- 'alert("Are You Sure?");' session$sendCustomMessage(type='jsCode', list(value = js_string)) text <- isolate(input$inText) output$outText <- renderUI({ h4(text) }) }) } ) runApp(list(ui = ui, server = server)) 

Example 2

Using ShinyBS package

 rm(list = ls()) library(shiny) library(shinyBS) campaigns_list <- letters[1:10] ui =fluidPage( checkboxGroupInput("campaigns","Choose campaign(s):",campaigns_list), actionLink("selectall","Select All"), bsModal("modalExample", "Yes/No", "selectall", size = "small",wellPanel( actionButton("no_button", "Yes"), actionButton("yes_button", "No") )) ) server = function(input, output, session) { observe({ if(input$selectall == 0) return(NULL) else if (input$selectall%%2 == 0) { updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list) } else { updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list) } }) } runApp(list(ui = ui, server = server)) 

Edit for Apricot

 rm(list = ls()) library(shiny) library(shinyBS) campaigns_list <- letters[1:10] ui =fluidPage( checkboxGroupInput("campaigns","Choose campaign(s):",campaigns_list), actionLink("selectall","Select All"), bsModal("modalExample", "Yes/No", "selectall", size = "small",wellPanel( actionButton("yes_button", "Yes"), actionButton("no_button", "No") )) ) server = function(input, output, session) { observeEvent(input$no_button,{ updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list) }) observeEvent(input$yes_button,{ updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list) }) } runApp(list(ui = ui, server = server))