#' Show or remove a modal dialog #' #' This causes a modal dialog to be displayed in the client browser, and is #' typically used with \code{\link{modalDialog}}. #' #' @param ui UI content to show in the modal. #' @param session The \code{session} object passed to function given to #' \code{shinyServer}. #' #' @seealso \code{\link{modalDialog}} for examples. #' @export showModal <- function(ui, session = getDefaultReactiveDomain()) { res <- processDeps(ui, session) session$sendModal("show", list( html = res$html, deps = res$deps ) ) } #' @rdname showModal #' @export removeModal <- function(session = getDefaultReactiveDomain()) { session$sendModal("remove", NULL) } #' Create a modal dialog UI #' #' This creates the UI for a modal dialog, using Bootstrap's modal class. Modals #' are typically used for showing important messages, or for presenting UI that #' requires input from the user, such as a username and password input. #' #' @param ... UI elements for the body of the modal dialog box. #' @param title An optional title for the dialog. #' @param footer UI for footer. Use \code{NULL} for no footer. #' @param size One of \code{"s"} for small, \code{"m"} (the default) for medium, #' or \code{"l"} for large. #' @param easyClose If \code{TRUE}, the modal dialog can be dismissed by #' clicking outside the dialog box, or be pressing the Escape key. If #' \code{FALSE} (the default), the modal dialog can't be dismissed in those #' ways; instead it must be dismissed by clicking on the dismiss button, or #' from a call to \code{\link{removeModal}} on the server. #' @param fade If \code{FALSE}, the modal dialog will have no fade-in animation #' (it will simply appear rather than fade in to view). #' #' @examples #' if (interactive()) { #' # Display an important message that can be dismissed only by clicking the #' # dismiss button. #' shinyApp( #' ui = basicPage( #' actionButton("show", "Show modal dialog") #' ), #' server = function(input, output) { #' observeEvent(input$show, { #' showModal(modalDialog( #' title = "Important message", #' "This is an important message!" #' )) #' }) #' } #' ) #' #' #' # Display a message that can be dismissed by clicking outside the modal dialog, #' # or by pressing Esc. #' shinyApp( #' ui = basicPage( #' actionButton("show", "Show modal dialog") #' ), #' server = function(input, output) { #' observeEvent(input$show, { #' showModal(modalDialog( #' title = "Somewhat important message", #' "This is a somewhat important message.", #' easyClose = TRUE, #' footer = NULL #' )) #' }) #' } #' ) #' #' #' # Display a modal that requires valid input before continuing. #' shinyApp( #' ui = basicPage( #' actionButton("show", "Show modal dialog"), #' verbatimTextOutput("dataInfo") #' ), #' #' server = function(input, output) { #' # reactiveValues object for storing current data set. #' vals <- reactiveValues(data = NULL) #' #' # Return the UI for a modal dialog with data selection input. If 'failed' is #' # TRUE, then display a message that the previous value was invalid. #' dataModal <- function(failed = FALSE) { #' modalDialog( #' textInput("dataset", "Choose data set", #' placeholder = 'Try "mtcars" or "abc"' #' ), #' span('(Try the name of a valid data object like "mtcars", ', #' 'then a name of a non-existent object like "abc")'), #' if (failed) #' div(tags$b("Invalid name of data object", style = "color: red;")), #' #' footer = tagList( #' modalButton("Cancel"), #' actionButton("ok", "OK") #' ) #' ) #' } #' #' # Show modal when button is clicked. #' observeEvent(input$show, { #' showModal(dataModal()) #' }) #' #' # When OK button is pressed, attempt to load the data set. If successful, #' # remove the modal. If not show another modal, but this time with a failure #' # message. #' observeEvent(input$ok, { #' # Check that data object exists and is data frame. #' if (!is.null(input$dataset) && nzchar(input$dataset) && #' exists(input$dataset) && is.data.frame(get(input$dataset))) { #' vals$data <- get(input$dataset) #' removeModal() #' } else { #' showModal(dataModal(failed = TRUE)) #' } #' }) #' #' # Display information about selected data #' output$dataInfo <- renderPrint({ #' if (is.null(vals$data)) #' "No data selected" #' else #' summary(vals$data) #' }) #' } #' ) #' } #' @export modalDialog <- function(..., title = NULL, footer = modalButton("Dismiss"), size = c("m", "s", "l"), easyClose = FALSE, fade = TRUE) { size <- match.arg(size) cls <- if (fade) "modal fade" else "modal" div(id = "shiny-modal", class = cls, tabindex = "-1", `data-backdrop` = if (!easyClose) "static", `data-keyboard` = if (!easyClose) "false", div( class = "modal-dialog", class = switch(size, s = "modal-sm", m = NULL, l = "modal-lg"), div(class = "modal-content", if (!is.null(title)) div(class = "modal-header", tags$h4(class = "modal-title", title) ), div(class = "modal-body", ...), if (!is.null(footer)) div(class = "modal-footer", footer) ) ), tags$script("$('#shiny-modal').modal().focus();") ) } #' Create a button for a modal dialog #' #' When clicked, a \code{modalButton} will dismiss the modal dialog. #' #' @inheritParams actionButton #' @seealso \code{\link{modalDialog}} for examples. #' @export modalButton <- function(label, icon = NULL) { tags$button(type = "button", class = "btn btn-default", `data-dismiss` = "modal", validateIcon(icon), label ) }