Javascript in R Shiny app : wait "busy" UI before continuing

41 views Asked by At

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 :

  1. What would be a better way to achieve what is done in this minimal example ?
  2. Does anyone have an explanation why a solution with shiny:idle like 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)
0

There are 0 answers