How to create a popover in shiny that appears at tab switch?

Question

I would like to create a popover/tooltip in my Shiny app that appears right away when the users switches to the tab that contains a data table that the popover is attached to. With the shinybs package, I can create a popover that appear on click or hover, but I would like it to appear without needing to hover or click. My guess is that this could be achieved with the trigger = "manual" option, but I don't know how to define a manual trigger. I'm not wedded to shinybs; any other solution that can achieve the desired results is equally appreciated.

Ideally I would also like the popover to be placed such that it points to a particular row. I have previously used the rowCallback = JS(rowCallback) parameter along with the shinyjs package in data tables to get hover-over tooltips for individual rows. I don't know JavaScript; so I have no idea whether this could be modified such that the tooltip appears without hovering.

In any case, I also need an option to close the popover/tooltip. I'd really appreciate your help.

Here is a minimal example with a shinybs popover with a click trigger (not what I need):

library(shiny)
library(shinyBS)
library(DT)

data <- as.data.frame(rbind(c(1,2,3), c(4,5,6)))
colnames(data) <- c("Var1", "Var2", "Var3")

ui <- navbarPage(
  title = "Title", id = "navbar", 
  tabsetPanel(id="tabs", 
              tabPanel(value = "tab1", title = "Tab1",
                       actionButton("action1", "Switch tabs")
                       ),
              
  )
)

server <- function(input, output, session) {
    observeEvent(input$action1, {
      insertTab(inputId = "tabs", target = "tab1", select=T,
                tabPanel(value = "tab2", title = "Tab2",
                         dataTableOutput("table1"),
                         bsPopover(id="table1", title="A popover",
                                   placement = "bottom", trigger = "click")
                ) 
      )
    })
  
  output$table1 <- renderDataTable({
    datatable(data)
  })
}

shinyApp(ui, server)

Answer 1

I give it a shot:

1. Define a function (make_popover) which adds the necessary HTML to create a popover element (cf. the Bootstrap Popover Docs. In particular set data-trigger to manual to trigger it only manually.
2. Replace one cell in the table with this mark up and use escape = FALSE in datatable to not esacpe this HTML.
3. Include an observer which fires upon tab change and calls a JS function to eventually show the popover. We could use shinyjs but we use the canonical shiny solution by using addCustomMessageHandler.
4. Eventually add a click handler, which closes the popover again, as soon as a click on the second panel is registered.

library(shiny)
library(DT)

my_data <- data.frame(
   a = c(1, 4),
   b = c(2, 5),
   c = c(3, 6)
)

js <- HTML("
   $(function () {
      $('[data-toggle=\"popover\"]').popover({});
      $('div[data-value=\"tab2\"]').on('click', () => $('[data-toggle=\"popover\"]').popover('hide'));
   });
   Shiny.addCustomMessageHandler('show_popover', function(message) {
      setTimeout(() => $('[data-toggle=\"popover\"]').popover('show'), 100); // timeout needed to avoid that the element is not shown yet
   })"
)

make_popover <- function(x, title, content) {
   a(x,
     style = "text-decoration: none; color: inherit;",
     "data-toggle" = "popover",
     "data-trigger" = "manual",
     title = title,
     "data-content" = content) %>% 
      as.character()   
}

ui <- navbarPage(
   title = "Popup Example",
   header = tags$head(tags$script(js)),
   tabsetPanel(
      id = "tabs",
      tabPanel(
         value = "tab1",
         title = "Tab 1",
      ),
      tabPanel(
         value = "tab2",
         title = "Tab 2",
         dataTableOutput("tbl")
      )
   ),
   id = "navbar"
)


server <- function(input, output, session) {
   output$tbl <- renderDataTable({
      dat <- my_data
      dat[2, "b"] <- make_popover(dat[2, "b"],
                                  "Dismissible popover",
                                  "And here's some amazing content. It's very engaging. Right?")
      datatable(
         dat,
         escape = FALSE)
   })
   
   observeEvent(input$tabs, {
      if (input$tabs == "tab2") {
         session$sendCustomMessage("show_popover", 1)
      }
   })
}

shinyApp(ui, server)