Fabian Gehring
Fabian Gehring

Reputation: 1173

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) {

}

Upvotes: 3

Views: 2449

Answers (1)

Batanichek
Batanichek

Reputation: 7871

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
)

Upvotes: 2

Related Questions