我正在尝试构建一个闪亮的仪表板，其菜单子项应与选项卡面板相对应。我还需要主页上有一个移动到这些选项卡面板的按钮。这部分工作还不错。当我尝试使用一些 Javascript 来更新侧边栏中的“活动”项目时，问题就出现了（下面是可重现的示例）。
我的主要问题如下：
<li>classList.add('active');removestyle.display = 'none';observeEventlapply有人可以帮我调试以下应用程序吗？
require(shiny)
require(shinyjs)
require(shinydashboard)
require(shinydashboardPlus)
mymenu <- list(list(menuitem=c("Tab1" = "tab1"),
subitems=c("Tabpan1" = "tsp1_tabpan1", "Tapan2"="tsp1_tabpan2"),
icon="upload"))
build_menu <- 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-angles-right" role="presentation" aria-label="angles-right icon"></i> ', names(subs)[i],'</a></li>'))
})
menuItem(names(men), id=as.character(men), icon = icon(x[["icon"]]),menusubits)
})
}
ui <- dashboardPage(
dashboardHeader(title = ""),
dashboardSidebar(
sidebarMenu(id="sidebar",
menuItem("Accueil",tabName = "home", icon = icon("igloo")),
build_menu(mymenu),
menuItem("Réglages", tabName = "settings", icon = icon("gears"))
)),
dashboardBody(
useShinyjs(),
tabItems(
tabItem(tabName = "home",
h1("Home"),
HTML('<br><br><ul><li><a id="see_tab1_pan1" class="action-button" >
Go to tab1 pan1</a></li><br><br>
<li><a id="see_tab1_pan2" class="action-button" >
Go to tab1 pan2</a></li>'),),
tabItem(tabName = "tab1",
h1("Tab1"),
tabsetPanel(id="tab1_tabset",
tabPanel("TabPan1", value=paste0("tab1_tsp1_tabpan1"),
h4("tp tit1")
),
tabPanel("TabPan2", value=paste0("tab1_tsp1_tabpan2"),
h4("tp tit2")
),)),
tabItem(tabName = "settings",
h1("Settings")
))))
server = function(input, output, session) {
observeEvent(input$see_tab1_pan1,{
cat(paste0("click_test\n"))
# debug see_tab1_pan2 first :-)
})
observeEvent(input$see_tab1_pan2,{
cat(paste0("click_test\n"))
runjs(paste0(
# emulate a click on menusubitem :
"var x = document.getElementById('", "mv_tab1_tsp1_tabpan2", "'); ",
"console.log(x);",
"x.click();",
# "// leaving Home -> remove active class ",
"const $parent = $('.sidebar-menu [data-value=\"home\"]').closest('li');",
"console.log('parent');",
"console.log($parent);",
"$parent.removeClass('active');",
#"// expand the correspondign menuitem
"var y = document.getElementById('", "tab1", "'); ",
"console.log('y');",
"console.log(y);",
"y.style.display = 'block';",
"y.classList.add('menu-open');"#,
))})
### collapse menuitems if I am in home or settings
observe({
if(input$sidebar == "home" | input$sidebar == "settings"){
#"// collapse the tab1 menuitem
runjs(paste0("var y = document.getElementById('", "tab1", "'); ",
"console.log('y');",
"console.log(y);",
"y.style.display = 'none';",
"y.classList.remove('menu-open');"#,
))
}
})
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]],{
cat( paste0("click ",btnid,"\n") )
updateTabItems(session, "sidebar", selected = men)
updateTabItems(session, inputId = paste0(men, "_tabset"),
selected = paste0(men, "_", subits[i]))
runjs(paste0(
#"// find all other <li> elements of the menuitem and remove active class",
"var btn = document.getElementById('", btnid, "');",
"console.log('btn');",
"console.log(btn);",
"var allLi = btn.closest('ul').getElementsByTagName('li');",
" for (var i = 0; i < allLi.length; i++) {",
"console.log('allLi[i] - BEFORE');",
"console.log(allLi[i]);",
" allLi[i].classList.remove('active');", #### NOT WORKING ????
"console.log('allLi[i] - AFTER');",
"console.log(allLi[i]);",
"}" ,
# "// add 'active' class to <li> of the corresponding menusubitem button ",
"var z = btn.closest('li');",
"console.log('will add active to');",
"console.log(z);",
" z.classList.add('active');",
" console.log('after set active class');", #### NOT WORKING ????
"console.log(z);"
))
}
)})})}
shinyApp(ui, server)
我找到了以下解决方法，但我发现它根本不干净，仍在等待更好的答案......
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)
我还在为这部分而苦苦挣扎：
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();"))
（发布在另一个SO问题）