Modal Dialog in Shiny: Can Adjust Width But Not Height

How to adjust Shiny modalDialog() width to a DT object to fully show the table information?

Had a similar problem. I fixed by making css changes.
Try changing your ui to:

ui = basicPage(
tags$style(
type = 'text/css',
'.modal-dialog { width: fit-content !important; }'
),
actionButton("show", "Show modal dialog")
),

EDIT:
You could go about defining your own modal function (I just copied the modalDialog function) as the original does not let you add a class to the modal-dialog. I am simply pasting the variable idcss into the div created by the original function.

Furthermore I did the css only for one modal. Also sorry for the bad variable-names and input-names (just slapped an s on to make them differ).

require(shiny)
require(DT)

mymodal <- function (..., title = NULL, footer = modalButton("Dismiss"),
size = c("m", "s", "l"), easyClose = FALSE, fade = TRUE, idcss = "")
{
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 = paste("modal-dialog", idcss), 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();"))
}

shinyApp(
ui = basicPage(
tags$style(
type = 'text/css',
'.modal-dialog.test{ width: fit-content !important; }'
),
actionButton("show", "Show modal dialog"),
actionButton("shows", "Show modal dialog2")
),

server = function(input, output) {

# Render DT
output$dt <- DT::renderDT(cbind(iris, iris))

# Modal management
observeEvent(input$show, {
showModal(
mymodal(easyClose = T,

DT::DTOutput("dt"),

footer = tagList(
modalButton("Cancel"),
actionButton("ok", "OK")
),
idcss = "test"
)
)
})

observeEvent(input$shows, {
showModal(
mymodal(easyClose = T,

DT::DTOutput("dt"),

footer = tagList(
modalButton("Cancel"),
actionButton("ok", "OK")
),
idcss = "tests"
)
)
})
}
)

Set R shiny modal width when theme is defined by bslib

Use tags$style(".modal-dialog {max-width: 80vw;}") instead. It makes sure your modal is always 80% of the entire window, resize automatically when you change window size.

How to limit the height of the modal?

Use viewport units with calc. Like this:

.img-responsive {
max-height: calc(100vh - 225px);
}

...where the 225px corresponds to the combined height of the top and bottom sections of the viewport which surround the dialog.

Also, in order to take care of the width of the modal we need to set a few more properties:

.modal {
text-align:center;
}
.modal-dialog {
display: inline-block;
width: auto;
}

Updated Fiddle (Resize the viewport height to see the effect)


Alternatively:

We can replace calc with a padding + negative margin technique like so:

.img-responsive {
max-height: 100vh;
margin: -113px 0;
padding: 113px 0;
}

FIDDLE

PS: browser support for viewport units is very good

Is there an efficient way to reactively import text into R shiny modal dialog?

In response to Roman's suggestion, I moved the text into a separate Global.R file. It is now out of my App file and is much cleaner and easier to follow. For any others stuck in the same place, below is the complete working code for the MWE above. I saved both under the same directory.

App.R file:

library(shiny)
source("./Global.R")

ui <- fluidPage(style = "margin-top:20px",
fluidRow
(column(12,
actionButton("explain1",
strong("Gettyburg Address"),
icon = icon("info-circle"),
style="font-size:19px;
position:fixed")
) # closes column
), # closes fluid row
) # fluid page

server <- function(input, output) {
AbeLincoln(input,"explain1")
} # closes server

shinyApp(ui = ui, server = server)

Global.R file (more text than necessary for a MWE but I LOVE that speech):

AbeLincoln <- function(input,value){

observeEvent(input[[value]], {
showModal(modalDialog(

title = "Background and text of the Gettysburg Address",

tags$ul(

tags$li("Gettysburg Address is a speech that Abraham Lincoln delivered at
the dedication of the Soldiers' National Cemetery in Gettysburg, PA."),
tags$li("On the afternoon of November 19, 1863."),
tags$li("Four and a half months after the Union armies defeated those of the
Confederacy at the Battle of Gettysburg."),
tags$li("It is one of the best-known speeches in American history.")),

tags$p(strong("Text of speech:")),

"Four score and seven years ago our fathers brought forth upon this continent,
a new nation, conceived in Liberty, and dedicated to the proposition that all men
are created equal.",tags$p(""),
"Now we are engaged in a great civil war, testing whether that nation, or any
nation so conceived and so dedicated, can long endure. We are met on a great
battle-field of that war. We have come to dedicate a portion of that field, as
a final resting place for those who here gave their lives that that nation might
live. It is altogether fitting and proper that we should do this.",tags$p(""),

"",tags$p(""),

"But, in a larger sense, we can not dedicate—we can not consecrate—we can not
hallow—this ground. The brave men, living and dead, who struggled here, have
consecrated it, far above our poor power to add or detract. The world will little
note, nor long remember what we say here, but it can never forget what they did here.
It is for us the living, rather, to be dedicated here to the unfinished work which
they who fought here have thus far so nobly advanced. It is rather for us to be here
dedicated to the great task remaining before us—that from these honored dead we take
increased devotion to that cause for which they gave the last full measure of devotion
— that we here highly resolve that these dead shall not have died in vain—that this
nation, under God, shall have a new birth of freedom—and that government of the
people, by the people, for the people, shall not perish from the earth."

) # close modal dialog
) # close show modal
}) # close observe event
} # close function

Adjust size of Shiny progress bar and center it

I wrote a progress bar function in the package shinyWidgets, you can put it in a modal, but it's tricky to use with shiny::showModal, so you can create your own modal manually like the below. It's more code to write but it works fine.

library("shiny")
library("shinyWidgets")

ui <- fluidPage(
actionButton(inputId = "go", label = "Launch long calculation"), #, onclick = "$('#my-modal').modal().focus();"

# You can open the modal server-side, you have to put this in the ui :
tags$script("Shiny.addCustomMessageHandler('launch-modal', function(d) {$('#' + d).modal().focus();})"),
tags$script("Shiny.addCustomMessageHandler('remove-modal', function(d) {$('#' + d).modal('hide');})"),

# Code for creating a modal
tags$div(
id = "my-modal",
class="modal fade", tabindex="-1", `data-backdrop`="static", `data-keyboard`="false",
tags$div(
class="modal-dialog",
tags$div(
class = "modal-content",
tags$div(class="modal-header", tags$h4(class="modal-title", "Calculation in progress")),
tags$div(
class="modal-body",
shinyWidgets::progressBar(id = "pb", value = 0, display_pct = TRUE)
),
tags$div(class="modal-footer", tags$button(type="button", class="btn btn-default", `data-dismiss`="modal", "Dismiss"))
)
)
)
)

server <- function(input, output, session) {

value <- reactiveVal(0)

observeEvent(input$go, {
shinyWidgets::updateProgressBar(session = session, id = "pb", value = 0) # reinitialize to 0 if you run the calculation several times
session$sendCustomMessage(type = 'launch-modal', "my-modal") # launch the modal
# run calculation
for (i in 1:10) {
Sys.sleep(0.5)
newValue <- value() + 1
value(newValue)
shinyWidgets::updateProgressBar(session = session, id = "pb", value = 100/10*i)
}
Sys.sleep(0.5)
# session$sendCustomMessage(type = 'remove-modal', "my-modal") # hide the modal programmatically
})

}

shinyApp(ui = ui, server = server)

Open Shiny Modal dialog box by clicking on multiple divs

You can use a workaround, as per https://github.com/daattali/shinyjs/issues/167

library(shiny)
library(shinyjs)

shinyApp(
ui = fluidPage(
useShinyjs(), # Set up shinyjs
div(id = "Div1", style = "height: 100px; width: 100px; background-color: red;"),
div(id = "Div2", style = "height: 100px; width: 100px; background-color: blue;")
),
server = function(input, output, session) {

ids <- c("Div1", "Div2")
for (id in ids) {
local({
shinyjs::onclick(id, {
showModal(modalDialog(
div(id = "Div3", style = "height: 100px; width: 100px; background-color: black;", tableOutput("tab")),
))
})
})
}
}
)


Related Topics



Leave a reply



Submit