While I was building a Shiny dashboard sidebar with menu subitems linked to Tabpanels as described in this SO question, there is a small part of the JS code that I would like to better understand (full code at the end of the post). It is related to 2 click() calls within runjs :
runjs(paste0(
"var x = document.getElementById('", paste0(mit,"_parent"), "');
console.log(x);
x.click();"))
Sys.sleep(1)
runjs(paste0(
"var x = document.getElementById('", paste0("mv_", mit, "_", subi), "');
console.log(x);
x.click();"))})})} )
The 1st one leads to changes in the UI, and the 2nd must intervene onyl once these have taken place. A way to make it work was to add a short Sys.sleep in between. I found this solution not very clean (how long exactly should it be put to sleep?), thus I tried many solutions to detect directly in the JS code the exact moment when the flow can continue (i.a. relying on shiny:busy, shiny:idle, .hasClass('shiny-busy'), etc.), but found nothing working.
So I have two questions :
- What would be a better way to achieve what is done in this minimal example ?
- Does anyone have an explanation why a solution with
shiny:idlelike the one here below does not work in this context ?
runjs("
var firstClick = function() {
var x = document.getElementById('", paste0(mit,"_parent"), "');
x.click();
$(document).off('shiny:idle', firstClick);
};
var secondClick = function() {
var x = document.getElementById('", paste0("mv_", mit, "_", subi), "');
x.click();
$(document).off('shiny:idle', secondClick);
};
$(document).on('shiny:idle', firstClick);
$(document).on('shiny:idle', secondClick);
")
Full code of a reproducible example (given my low level in js, it really gave me a hard time - any suggestions for improving the code are welcome) :
require(shiny)
require(shinyjs)
require(shinydashboard)
require(shinydashboardPlus)
mymenu <- list(list(menuitem=c("Tab1" = "tab1"),
subitems=c("Tabpan1" = "tsp1_tabpan1", "Tabpan2"="tsp1_tabpan2"),
menuIcon="upload",
subMenuIcon = "angles-right"))
getMenuSubmenuItems <- function(list_item){
lapply(list_item, function(x){
subs <- x[["subitems"]]
men <- x[["menuitem"]]
menusubits <- lapply(seq_along(subs), function(i){
HTML(paste0('<li><a id="mv_',men,'_',subs[i] , '" href="#shiny-tab-',men ,'" class="action-button" data-value="',men,'">
<i class="fas fa-', x[["subMenuIcon"]], '" role="presentation" aria-label="',x[["subMenuIcon"]] ,' icon"></i> ',
names(subs)[i],'</a></li>'))
})
list( HTML(paste0('<li class="treeview">
<a href="#" id="', as.character(men) ,'_parent" class="action-button">
<i class="fas fa-', x[["menuIcon"]],'" role="presentation" aria-label="', x[["menuIcon"]],' icon"></i>
<span>', names(men), '</span>
<i class="fas fa-angle-left pull-right" role="presentation" aria-label="angle-left icon"></i>
</a>
<ul class="treeview-menu" style="display: none;" data-expanded="', names(men),'" id="', as.character(men),'">')),
menusubits,
HTML("</ul></li>"))})}
generate_home_menu <-function(mymenu){
lapply(mymenu, function(menuit){
mi <- menuit[["menuitem"]]
si <- menuit[["subitems"]]
start <- paste0("<h4>", names(mi), "</h4><ul>")
its <- paste0(sapply(seq_along(si), function(i){
paste0('<li><a id="see_', as.character(si[i]), '" class="action-button" >
Go to ', names(si)[i], '</a></li><br>')
}), collapse="")
end <- paste0("</ul>")
HTML(paste0(c(start, its, end), collapse=""))})}
generate_subitem_panels <- function(mymenu){
lapply(mymenu, function(x){
mi <- x[["menuitem"]]
si <- x[["subitems"]]
tabItem(tabName = as.character(mi),
h1(names(mi)),
tabsetPanel(id=paste0(mi, "_tabset"),
### iterate over menuSubItems to create corresponding tabPanels
!!!lapply(seq_along(si), function(i){
tabPanel(names(si)[i], value = paste0(mi, "_", si[i]),
h4(names(si[i])))})))})}
getMenuItem <- function(id, label, icon){
return(HTML(paste0('<li><a href="#shiny-tab-', id, '" id="', id , '_btn" data-toggle="tab" class="action-button"
data-value="', id, '">
<i class="fas fa-', icon, '" role="presentation" aria-label="', icon, ' icon"></i>
<span>', label, '</span>
</a></li>')))}
ui <- dashboardPage(
dashboardHeader(title = ""),
dashboardSidebar(
sidebarMenu(id="sidebar",
getMenuItem("home", "Accueil", "igloo"),
getMenuSubmenuItems(mymenu),
getMenuItem("settings", "Settings", "gears"))),
dashboardBody(
useShinyjs(),
do.call(tabItems,c(list(
tabItem(tabName = "home", ## tabName should match id used in getMenuItem !!
h1("Home"),
generate_home_menu(mymenu)
)),
generate_subitem_panels(mymenu),
list(tabItem(tabName = "settings", ## tabName should match id used in getMenuItem !!
h1("Settings")))))))
server = function(input, output, session) {
lapply(mymenu, function(mi){
mit <- as.character(mi[["menuitem"]])
si <- mi[["subitems"]]
lapply(si, function(subi){
observeEvent(input[[paste0("see_", subi)]],{
runjs(paste0(
"var x = document.getElementById('", paste0(mit,"_parent"), "');
x.click();"))
Sys.sleep(1)
runjs(paste0(
"var x = document.getElementById('", paste0("mv_", mit, "_", subi), "');
x.click();"))})})} )
lapply(c("home", "settings"), function(tab){
observeEvent(input[[paste0(tab, "_btn")]], {
runjs(paste0("console.log('clicked ", tab, "');
var elements = document.querySelectorAll('ul.sidebar-menu ul.treeview-menu.menu-open');
console.log(elements);
elements.forEach(function(element) {
element.classList.remove('menu-open');
element.style.display = 'none';});"))})})
lapply(mymenu, function(m){
mi <- as.character(m[["menuitem"]])
msi <- m[["subitems"]]
lapply(msi, function(it){
observeEvent(input[[paste0(mi, "_tabset")]],{
if(input[[paste0(mi, "_tabset")]] == paste0(mi, "_", it)){
btnid <- paste0("mv_", mi, "_", it)
runjs(paste0(
"var btn = document.getElementById('", btnid, "');",
"var allLi = btn.closest('ul').getElementsByTagName('li');
for (var i = 0; i < allLi.length; i++) {
if(allLi[i].querySelector('a').id == '",btnid, "'){",
"allLi[i].querySelector('a').dataset.value='", mi, "';",
"} else{",
"allLi[i].querySelector('a').dataset.value='",mi, "_foo';",
"}
allLi[i].classList.remove('active');
}
var z = btn.closest('li');
z.classList.add('active');"
))}})})})
lapply(mymenu, function(x){
men <- as.character(x[["menuitem"]])
stopifnot(length(men) == 1)
subits <- x[["subitems"]]
lapply(seq_along(subits), function(i){
btnid <- paste0("mv_", men, "_", subits[i])
observeEvent(input[[btnid]],{
updateTabItems(session, "sidebar", selected = men)
updateTabItems(session, inputId = paste0(men, "_tabset"),
selected = paste0(men, "_", subits[i]))
})})})}
shinyApp(ui, server)