Ultimately, I think this request could make for some useful features in the rintrojs
library. In any case, your problems are two-fold:
introjs
should not fire until the modal is available in the HTML. The easiest way to do this is to use a button within the modal to fire the tutorial. If you want it to be automatic, you will need some JavaScript that waits until the Modal is ready before firing.
introjs
wants to grey out the background and highlight the current item in the tutorial. This means it needs to "interleave" with the modal children. Because the modal is its own stacking context, introjs
needs to be fired from within the modal to look at modal children. If you want to look at the entire modal, then it is sufficient to fire introjs
from the parent. This functionality does not seem to be in the rintrojs
package yet, but is in the JavaScript library.
In order to accomplish #1, I added a JavaScript function to fire introjs on Modal load (after a configurable delay for HTML elements to load). This requires the shinyjs
package. Notice the introJs(modal_id)
, this ensures that the tutorial fires within the modal. In pure JavaScript, it would be introJs('#modal')
:
run_introjs_on_modal_up <- function(
modal_id
, input_data
, wait
) {
runjs(
paste0(
"$('"
, modal_id
, "').on('shown.bs.modal', function(e) {
setTimeout(function(){
introJs('", modal_id, "').addSteps("
, jsonlite::toJSON(input_data, auto_unbox=TRUE)
, ").start()
}, ", wait, ")
})"
)
)
}
I also added a simple helper for closing the introjs
tutorial when navigating away from the modal.
introjs_exit <- function(){
runjs("introJs().exit()")
}
There was also a single line of CSS necessary to fix the modal-backdrop from getting over-eager and taking over the DOM:
.modal-backdrop { z-index: -10;}
And a (large / not minimal) working example with multiple modals.
library(rintrojs)
library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinyjs)
intro_df <- data.frame(element = c('#plot_box', '#bttn2', '#box', '#modal'),
intro = c('test plot_box', 'test bttn2', 'test box', 'test modal'))
intro_df2 <- data.frame(element = c('#plot_box2'),
intro = c('test plot_box'))
run_introjs_on_modal_up <- function(
modal_id
, input_data
, wait
) {
runjs(
paste0(
"$('"
, modal_id
, "').on('shown.bs.modal', function(e) {
setTimeout(function(){
introJs('", modal_id, "').addSteps("
, jsonlite::toJSON(input_data, auto_unbox=TRUE)
, ").start()
}, ", wait, ")
})"
)
)
}
introjs_exit <- function(){
runjs("introJs().exit()")
}
ui <- shinyUI(fluidPage(
useShinyjs(),
tags$head(tags$style(".modal-backdrop { z-index: -10;}")),
introjsUI(),
mainPanel(
bsModal('modal', '', '', uiOutput('plot_box'), size = 'large'),
bsModal('modalblah', '', '', uiOutput('plot_box2'), size = 'large'),
actionButton("bttn", "Start intro")
)))
server <- shinyServer(function(input, output, session) {
output$plot <- renderPlot({
plot(rnorm(50))
})
output$plot2 <- renderPlot({
plot(rnorm(50))
})
output$plot_box <- renderUI({
box(id = 'box',
actionButton('bttn2', 'dummy'),
plotOutput('plot'), width = '100%'
)
})
output$plot_box2 <- renderUI({
box(id = 'box2',
plotOutput('plot2'), width = '100%'
)
})
run_introjs_on_modal_up("#modal",intro_df, 1000)
run_introjs_on_modal_up("#modalblah",intro_df2, 1000)
observeEvent(input$bttn,{
toggleModal(session, 'modal', toggle = 'toggle')
})
observeEvent(input$bttn2, {
toggleModal(session, 'modal', toggle = 'toggle')
introjs_exit()
toggleModal(session, 'modalblah', toggle = 'toggle')
})
})
shinyApp(ui = ui, server = server)