由网友(独念旧)分享简介:我要将通知链接到(内部)选项卡。为此,我遇到了以下情况:How to use href in shiny notificationItem?这似乎在应用程序加载后立即起作用,但在侧边栏中导航后,该链接不再起作用。ui.Rlibrary(shiny)library(shinydashboard)notification...
我要将通知链接到(内部)选项卡。
为此,我遇到了以下情况:How to use href in shiny notificationItem?
这似乎在应用程序加载后立即起作用,但在侧边栏中导航后,该链接不再起作用。
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
)
服务器.R
function(input, output) {
}
推荐答案
和以前一样糟糕的黑客变体)
想法
1)添加onClick
2)从js到闪亮
tags$script(HTML("function clickFunction(link){
Shiny.onInputChange('linkClicked',link);
}"))
3)observeEvent
+重新渲染菜单
4)如果不想重新呈现完整菜单,您可以将菜单用作
output$dropdown=renderMenu({dropdownMenu(type = "tasks", badgeStatus = "danger",.list = d$tasks_now)})
其中d=reactiveValues({tasks_now=get_noti()})
和观察事件更新d$tasks_now
服务器
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())})
})
})
用户界面
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
)
相关推荐
最新文章