Last active
May 21, 2020 11:29
-
-
Save JohnCoene/9835623d154f325b8a8e225c317028a4 to your computer and use it in GitHub Desktop.
shinydashboard overlay waiter on tab content
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
## app.R ## | |
library(shiny) | |
library(waiter) | |
library(shinydashboard) | |
# add JavaScript to add an id to the <section> tag so we can overlay waiter on top of it | |
add_id_to_section <- " | |
$( document ).ready(function() { | |
var section = document.getElementsByClassName('content'); | |
section[0].setAttribute('id', 'waiter-content'); | |
}); | |
" | |
ui <- dashboardPage( | |
dashboardHeader(title = "Basic dashboard"), | |
dashboardSidebar( | |
sidebarMenu( | |
id = "tabs", # add id to pick up events server side with input$tabs | |
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), | |
menuItem("Widgets", tabName = "widgets", icon = icon("th")) | |
) | |
), | |
dashboardBody( | |
# import our custom JavaScript | |
tags$head( | |
tags$script(add_id_to_section) | |
), | |
use_waiter(), | |
tabItems( | |
# First tab content | |
tabItem( | |
tabName = "dashboard", | |
div( | |
# force minimum height of DIV otherwise overlayed waiter is too small | |
# you should not need this | |
style = "min-height: 100vh;", | |
uiOutput("tab1") | |
) | |
), | |
# Second tab content | |
tabItem( | |
tabName = "widgets", | |
div( | |
style = "min-height: 100vh;", | |
uiOutput("tab2") | |
) | |
) | |
) | |
) | |
) | |
server <- function(input, output) { | |
w <- Waiter$new("waiter-content") | |
# vector to track already loaded tabs | |
loaded_tabs <- c() | |
observeEvent(input$tabs, { | |
# only show loading screen once | |
if(!input$tabs %in% loaded_tabs){ | |
# add tab to loaded | |
loaded_tabs <<- c(loaded_tabs, input$tabs) | |
w$show() | |
} | |
}) | |
output$tab1 <- renderUI({ | |
Sys.sleep(3) | |
w$hide() | |
h2("Dashboard rendered!") | |
}) | |
output$tab2 <- renderUI({ | |
Sys.sleep(3) | |
w$hide() | |
h2("Widgets rendered!") | |
}) | |
} | |
shinyApp(ui, server) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment