Linking notification to tab in shinydashboard

问题

I'd like to link a notificattion to an (internal) tab.

To do so I came accross this: How to use href in shiny notificationItem?

This seems to work right after loading of the app, but after some navigation in the sidebar the link does not work anymore.

ui.R

library(shiny)
library(shinydashboard)

notification <- notificationItem(icon = icon("exclamation-triangle"), status = "danger", paste0("noti"))
notification$children[[1]] <- a(href="#shiny-tab-dashboard","data-toggle"="tab", "data-value"="dashboard",list(notification$children[[1]]$children))

header <- dashboardHeader(dropdownMenu(notification), title = "Dashboard")

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Test",
             menuSubItem("test1", tabName = "test1", href = NULL, newtab = TRUE,
                         icon = shiny::icon("angle-double-right"), selected = F),
             menuSubItem("test2", tabName = "test2", href = NULL, newtab = TRUE,
                         icon = shiny::icon("angle-double-right"), selected = T)
    )
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName = "dashboard",
            h2("Dashboard tab content")
    ),

    tabItem(tabName = "test1",
            h2("Widgets tab1 content")
    ),

    tabItem(tabName = "test2",
            h2("Widgets tab2 content")
    )
  )
)

dashboardPage(
  header,
  sidebar,
  body
)

server.R

function(input, output) {

}

回答1:

As before bad hack variant )

ideas

1) Add onclick

2) from js to shiny

 tags$script(HTML("function clickFunction(link){ 
                       Shiny.onInputChange('linkClicked',link);
    }"))

3) observeEvent + re-render menu

4) If dont wnat to re-render full menu your can use menu as

output$dropdown=renderMenu({dropdownMenu(type = "tasks", badgeStatus = "danger",.list = d$tasks_now)})

where d=reactiveValues({tasks_now=get_noti()}) and in observeEvent update d$tasks_now

Server

library(shiny)

get_noti=function(){
  notification <- notificationItem(icon = icon("exclamation-triangle"), status = "danger", paste0("noti"))
  notification$children[[1]] <- a(href="#shiny-tab-dashboard","onclick"=paste0("clickFunction('",paste0(substr(as.character(runif(1, 0, 1)),1,6),"noti"),"'); return false;"),list(notification$children[[1]]$children))
  return(notification)
}

shinyServer(function(input, output, session) {
  output$dropdown=renderMenu({dropdownMenu(get_noti())})
  observeEvent(input$linkClicked,{
    print(input$linkClicked)
    updateTabItems(session,"sidemenu",selected = "dashboard")
    output$dropdown=renderMenu({dropdownMenu(get_noti())})
  })
  })

UI

library(shiny)
library(shinydashboard)
header <- dashboardHeader(dropdownMenuOutput('dropdown'), title = "Dashboard")
 sidebar <- dashboardSidebar(
  sidebarMenu(id="sidemenu",
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Test",
             menuSubItem("test1", tabName = "test1", href = NULL, newtab = TRUE,
                         icon = shiny::icon("angle-double-right"), selected = F),
             menuSubItem("test2", tabName = "test2", href = NULL, newtab = TRUE,
                         icon = shiny::icon("angle-double-right"), selected = T)
    )))
body <- dashboardBody(
  tags$script(HTML("function clickFunction(link){ 
                       Shiny.onInputChange('linkClicked',link);
    }")),
  tabItems(
    tabItem(tabName = "dashboard",
            h2("Dashboard tab content")
    ),

    tabItem(tabName = "test1",
            h2("Widgets tab1 content")
    ),

    tabItem(tabName = "test2",
            h2("Widgets tab2 content")
    )
  )
)
dashboardPage(
  header,
  sidebar,
  body
)

来源：https://stackoverflow.com/questions/35728623/linking-notification-to-tab-in-shinydashboard