如何根据所选选项卡更改提示工具提示？

Question

我有一个应用程序，带有来自

shinydashboard

的侧边栏和

tabBox

中的多个选项卡。在侧边栏中，我想要一个信息按钮 - 当您将鼠标悬停在它上面时，根据您当前所在的选项卡，应该显示不同的文本。

一个可行的解决方案，但在我看来相当丑陋，是为每个选项卡定义具有不同工具提示的相同信息按钮，如下所示：

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(tippy)

ui <- dashboardPage(
  skin = 'blue',
  dashboardHeader(),
  dashboardSidebar(width = 275,
                   sidebarMenu(conditionalPanel(condition = "input.my_tabbox == 'panel_1'",
                                                actionBttn(inputId = "info_button",label = NULL,style = 'material-circle',color = 'primary',
                                                           icon = icon('info')),
                                                tippy_this("info_button",tooltip = "You are on panel 1",trigger = 'mouseenter focus',
                                                           placement = 'right')),
                               conditionalPanel(condition = "input.my_tabbox == 'panel_2'",
                                                actionBttn(inputId = "info_button_2",label = NULL,style = 'material-circle',color = 'primary',
                                                           icon = icon('info')),
                                                tippy_this("info_button_2",tooltip = "You are on panel 2",trigger = 'mouseenter focus',
                                                           placement = 'right')))),

  dashboardBody(
    fluidRow(column(width = 12,
                    tabBox(width = 12,id = "my_tabbox",
                           tabPanel(title = "Panel 1",value = "panel_1"),
                           tabPanel(title = "Panel 2",value = "panel_2"))))
  )
)

server <- function(input,output){}
shinyApp(ui = ui,server = server)

但是，如果我想更改信息按钮的外观或行为，我必须为每个选项卡重做此操作。所以我寻找不同的解决方案：是否可以仅定义一次按钮并仅更改工具提示文本？我尝试用

tippy_this

外包

renderUI

，但是没有成功，这是我的一次失败的尝试：

ui <- dashboardPage(
  skin = 'blue',
  dashboardHeader(),
  dashboardSidebar(width = 275,
                   sidebarMenu(actionBttn(inputId = "info_button",label = NULL,style = 'material-circle',color = 'primary',icon = icon('info')),
                               uiOutput("my_tippy"))),
  dashboardBody(
    fluidRow(column(width = 12,
                    tabBox(width = 12,id = "my_tabbox",
                           tabPanel(title = "Panel 1",value = "panel_1"),
                           tabPanel(title = "Panel 2",value = "panel_2"))))
  )
)

get_tippy_sentence <- function(tabbox_input){
  if(tabbox_input == "panel_1"){
    return("You are on panel 1")
  }else if(tabbox_input == "panel_2"){
    return("You are on panel 2")
  }
}

server <- function(input,output){
  
  output$my_tippy <- renderUI({
    tippy_this("info_button",tooltip = get_tippy_sentence(input$my_tabbox),trigger = 'mouseenter focus',placement = 'right')
  })
}

我还尝试将工具提示设为

reactive

并用

observeEvent(input$my_tabbox,{...})

进行更改，但这些迭代都没有设法为第二个选项卡显示任何不同的内容。

Answer 1

如果您使用一点自定义功能，这是可能的

JS

。在下文中，与您的示例类似，

tippy

的文本是根据哪个选项卡处于活动状态动态生成的。最初，显示选项卡 1。

$(document).ready(function() {

    tippy('#info_button', {
        content: 'You are on panel 1',
        placement: 'right'
    });

    $('#my_tabbox').on('shown.bs.tab', function() {
        var panelText = $('#my_tabbox').children('.active').prop('innerText');
        var hoverText = 'You are on ' + panelText;

        document.querySelector('#info_button')._tippy.setContent(hoverText);
    });
})

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(tippy)

js <- "
$(document).ready(function() {

    tippy('#info_button', {
        content: 'You are on panel 1',
        placement: 'right'
    });

    $('#my_tabbox').on('shown.bs.tab', function() {
        var panelText = $('#my_tabbox').children('.active').prop('innerText');
        var hoverText = 'You are on ' + panelText;

        document.querySelector('#info_button')._tippy.setContent(hoverText)
    });
})
"

ui <- dashboardPage(skin = 'blue',
                    dashboardHeader(),
                    dashboardSidebar(width = 275,
                                     sidebarMenu(
                                         actionBttn(
                                             inputId = "info_button",
                                             label = NULL,
                                             style = 'material-circle',
                                             color = 'primary',
                                             icon = icon('info')
                                         ),
                                         tippy_this(
                                             "info_button",
                                             tooltip = "",
                                             trigger = 'mouseenter focus',
                                             placement = 'right'
                                         )
                                     )),

dashboardBody(tags$head(tags$script(JS(js))),
              fluidRow(column(
                  width = 12,
                  tabBox(
                      width = 12,
                      id = "my_tabbox",
                      tabPanel(title = "Panel 1", value = "panel_1"),
                      tabPanel(title = "Panel 2", value = "panel_2")
                  )
              )))
)

server <- function(input, output) {
    
}
shinyApp(ui = ui, server = server)