How to selective change modal backdrop in R Shiny - r

I have two modals. When the first is opened, the background should be grayed out, as is default. But this should not happen with the second one. The code is:
library(shiny)
ui <- fluidPage(
tags$style(type = 'text/css', '.modal-backdrop { display: none }'),
actionButton('modal1', 'Modal1'),
actionButton('modal2', 'Modal2'),
)
server <- function(input, output) {
observeEvent(input$modal1,
showModal(modalDialog(title = "Modal1"))
)
observeEvent(input$modal2,
showModal(modalDialog(title = "Modal2"))
)
}
shinyApp(ui = ui, server = server)
The css code should be connected to the id of the second modal dialog, but it is not possible to include an id in the function 'modalDialog'.
Any ideas about how to apply the css code selectively to only the second modal?

You can add JS code to hide the backdrop after showing the second modal using tags$script just after modalDialog.
library(shiny)
ui <- fluidPage(
actionButton('modal1', 'Modal1'),
actionButton('modal2', 'Modal2'),
)
server <- function(input, output) {
observeEvent(input$modal1,
showModal(modalDialog(title = "Modal1"))
)
observeEvent(input$modal2, {
showModal(
list(
modalDialog(title = "Modal2"),
tags$script("$('.modal-backdrop').css('display', 'none');")
)
)
})
}
shinyApp(ui = ui, server = server)

Related

Change html with an animation effect in a shiny app

I am having a shiny app with some ui elements.
Is there a way to replace some HTML (e.g. div / div content) with an animation effect, similar to what shinyjs::show(anim=T) does?
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
actionButton("change","change"),
tags$div(id="someDiv",
"test"),
hidden(tags$div(id="withAnim", "Displayed with animation"))
)
server <- function(input, output) {
observeEvent(input$change, {
shinyjs::html("someDiv", "changed without animation")
shinyjs::delay(1000, show("withAnim", anim=T, animType="fade"))
})
}
shinyApp(ui = ui, server = server)
the shinyjs::html doesn't provide this utility. We can write our own js code and use shinyjs::runjs to run it when button is clicked.
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
actionButton("change","change"),
tags$div(id="someDiv",
"test"),
hidden(tags$div(id="withAnim", "Displayed with animation"))
)
server <- function(input, output) {
observeEvent(input$change, {
shinyjs::runjs("$('#someDiv').fadeOut(500, function(){$(this).text('changed without animation').fadeIn();})")
shinyjs::delay(1000, show("withAnim", anim=T, animType="fade"))
})
}
shinyApp(ui = ui, server = server)

Why is renderUI not working in custom modal?

I have a shiny app with a modal that is displayed when I click on a button. I couldn't use shiny::modalDialog() so I adapted this example from W3schools.
Here's what it looks like:
library(shiny)
library(shinyjs)
ui <- fluidPage(
tags$head(
tags$link(rel="stylesheet", href="https://www.w3schools.com/w3css/4/w3.css")
),
useShinyjs(),
actionButton("modal", "open modal"),
div(
id = "my_modal",
class = "w3-modal",
div(
class = "w3-modal-content w3-animate-zoom",
div(
class = "w3-container w3-padding",
actionButton("generate_ui", "generate UI"),
uiOutput("new_ui"),
div(
class="w3-container w3-padding",
tags$button(class="w3-button w3-right w3-white w3-border",
onclick="document.getElementById('my_modal').style.display='none'",
"Close")
)
)
)
),
tags$script(
HTML( '// Get the modal
var modal = document.getElementById("my_modal");
// When the user clicks anywhere outside of the modal, close it
window.onclick = function(event) {
if (event.target == modal) {
modal.style.display = "none";
}
}')
)
)
server <- function(input, output) {
shinyjs::onclick(
"modal",
shinyjs::runjs(
"document.getElementById('my_modal').style.display='block'"
)
)
observeEvent(input$generate_ui, {
print("hello from modal")
output$new_ui <- renderUI({
tagList(
p("This is the new UI")
)
})
})
}
shinyApp(ui = ui, server = server)
In the modal, I have a button that is supposed to render some text. However, when I click on the button, nothing is rendered. This is not a problem with observeEvent() because the statement in print() is correctly displayed in the RStudio console.
Why is renderUI() not working in this situation?
Also asked on RStudio Community
This is because render events are controlled by Javascripts in Shiny. By default, if the dynamic rendering UI is hidden, in your case is the uiOutput element, Shiny would not render it unless it is visible. The term visible here is more than just toggle the css display state to be block. It needs to hear instructions from javascript listeners. In this case, it explicitly listens to a "shown" type of listener. So the way to solve it is in addition to change the display, you also need to trigger the shown event.
Method 1, just use {shinyjs} package, the easiest way
shinyjs::onclick(
"modal",
shinyjs::show("my_modal")
)
Method 2, use jquery, which is what behind {shinyjs}
shinyjs::onclick(
"modal",
shinyjs::runjs("$('#my_modal').show(); $('#new_ui').trigger('shown');")
)
Full code
library(shiny)
library(shinyjs)
ui <- fluidPage(
tags$head(
tags$link(rel="stylesheet", href="https://www.w3schools.com/w3css/4/w3.css")
),
useShinyjs(),
actionButton("modal", "open modal"),
div(
id = "my_modal",
class = "w3-modal",
div(
class = "w3-modal-content w3-animate-zoom",
div(
class = "w3-container w3-padding",
actionButton("generate_ui", "generate UI"),
uiOutput("new_ui"),
div(
class="w3-container w3-padding",
tags$button(class="w3-button w3-right w3-white w3-border",
onclick="document.getElementById('my_modal').style.display='none'",
"Close")
)
)
)
),
tags$script(
HTML( '// Get the modal
var modal = document.getElementById("my_modal");
// When the user clicks anywhere outside of the modal, close it
window.onclick = function(event) {
if (event.target == modal) {
modal.style.display = "none";
}
}')
)
)
server <- function(input, output) {
shinyjs::onclick(
"modal",
# shinyjs::runjs("$('#my_modal').show(); $('#new_ui').trigger('shown');")
shinyjs::show("my_modal")
)
observeEvent(input$generate_ui, {
print("hello from modal")
output$new_ui <- renderUI({
tagList(
p("This is the new UI")
)
})
})
}
shinyApp(ui = ui, server = server)

Set image as cursor in R Shiny

Is there a way to use a web image as cursor when hovering over a button?
I tried something like this:
tags$head(tags$style(HTML(" .custom { cursor: url(https://c2.staticflickr.com/2/1907/31794847918_04f9e687e1_b.jpg), auto;
} ")))
which has no effect, and I can't find any other examples on the web how to manage this in R shiny.
library(shiny)
ui <- fluidPage(
actionButton(inputId = 'messagebutton', label = 'click me')
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
This example works for me. I think your image isnt working, but I'm not sure why exactly. It might be too big.
library(shiny)
csscode <- HTML("
#messagebutton {
cursor: url(http://www.javascriptkit.com/ajax.gif), auto;
}
")
ui <- fluidPage(
tags$head(tags$style(csscode)),
actionButton(inputId = 'messagebutton', label = 'click me')
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)

How can I change the text size in Shiny modals?

I successfully changed the text sizes in shiny dashboard interface by editing css file.
Or I use following structure:
div(DTOutput(outputId = "table"), style = "font-size:85%"))
However, I couldn't find the node name of shiny modals. Is it possible to change the text size in shiny modals through .css?
Are you looking for something like this?
shinyApp(
ui = basicPage(
actionButton("show", "Show modal dialog")
),
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
title = "Important message",
div("This is an important message!", style="font-size:160%")
))
})
}
)
ModalDialog takes as its first argument(s) UI elements. This appears to be the same kind of arguments accepted by other shiny elements. Compare for example: ?siderbarPanel and ?modalDialog. So if you can do it in the body of an app, you can probably do it in a modal.
For example, I stuck a sidebar layout inside a modal:
shinyApp(
ui = basicPage(
actionButton("show", "Show modal dialog")
),
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
sidebarLayout(sidebarPanel("yeah"),mainPanel("cool"))
))
})
}
)

R Shiny: Present a ShinyBS Modal Popup on page visit (no user action)

I used bsModal successfully in my code before. However, I can't seem to get a modal pop up to show just when the user visits an app's first page by default. I thought something like this would work, but not. Any idea how I can trigger a bsModal on page visit?
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
I simply need to alert the user with a message when they visit the app and then allow them to close the modal pop up and navigate the rest of the app freely. I am using Shinydashboard. So, eventually, this has to work with that.
You can use toggleModal to manually trigger the popup from the server.
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
toggleModal(session, "startupModal", toggle = "open")
}
shinyApp(ui = ui, server = server)
Here is a solution using JS to trigger bsModal when page load "onload" from ui without waiting for the server. Along with a solution proposed here to prevent end users from accidentally closing the modal by clicking outside the modal or press Esc
library(shiny)
library(shinyBS)
bsModalNoClose <-function(...) {
b = bsModal(...)
b[[2]]$`data-backdrop` = "static"
b[[2]]$`data-keyboard` = "false"
return(b)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
bsModalNoClose("window", "Window",
title="Enter Login Details",size='small',
textInput('username', 'Username'),
passwordInput('pwInp', 'Password'),
actionButton('butLogin', 'Login', class = 'btn action-button btn-success', icon = icon('sign-in')),
footer = h4(actionLink('create_account','Create an account'),align='right'),
tags$head(tags$style("#window .modal-footer{display:none}
.modal-header .close{display:none}"),
tags$script("$(document).ready(function(){
$('#window').modal();
});")
))
)
,mainPanel()
))
server <- function(input, output, session) {}
shinyApp(ui, server)
I hope it may be helpful for future readers.

Resources