r - 单击退出时隐藏 Shiny 仪表板上的下拉选项

Question

当我单击该字段外部时，我想退出一个选项(menuSubItem)，但当我单击外部时该选项不会消失。我尝试了使用 CSS 的解决方案，但没有奏效!我的代码:

library(shiny)
library(shinydashboard)

header <- dashboardHeader(title = "Dashboard", titleWidth = 320)

sidebar <- dashboardSidebar(
  width = 320,
  sidebarMenu(
    menuItem(
      text = "A1"
    ),
    menuItem(
      text = "A2",
      menuSubItem(
        text = "AA1"
      ),
      menuSubItem(
        text = "AA2"
      ), 
      menuSubItem(
        text = "AA3"
      )
    )
  )
)

body <- dashboardBody()

ui <- dashboardPage(header = header, sidebar, body)

server <- function(input, output) {
  
}

shinyApp(ui, server)

我想在 A2 外部单击，并在单击完成后让它 (A2) 关闭下拉菜单。

我尝试在正文中插入此代码:

body <- dashboardBody(

  HTML(
  "<script>

  $(function() {

    $(document).on('click', function() {
      $('.skin-blue .treeview-menu>li>a').slideUp();
    });
 
  });

  </script>"
  )

)

但不工作。

Answer 1

我们可以为 menuItem 提供一个 id 并移除 css 类 menu-open:

library(shiny)
library(shinydashboard)

header <- dashboardHeader(title = "Dashboard", titleWidth = 320)

sidebar <- dashboardSidebar(width = 320,
                            sidebarMenu(
                              menuItem(text = "A1"),
                              menuItem(
                                text = "A2",
                                id = "A2ID",
                                menuSubItem(text = "AA1"),
                                menuSubItem(text = "AA2"),
                                menuSubItem(text = "AA3")
                              )
                            ))

body <- dashboardBody(tags$script(
  HTML(
    "$(document).on('shiny:connected', function(event) {
        $(document).on('click', function(evt) {
          if($(evt.target).closest('#sidebarItemExpanded > ul > li.treeview').length)
            return;
          var el = document.getElementById('A2ID');
          el.style.display = 'none';
          el.classList.remove('menu-open');
      });
    });"
  )
))

ui <- dashboardPage(header = header, sidebar, body)

server <- function(input, output, session) {}

shinyApp(ui, server)

一些相关链接:

jQuery click anywhere in the page except on 1 div

https://github.com/rstudio/shinydashboard/issues/347