How to use bslib package pop up window inside a table rendered with rhandsontable in R Shiny?

In the code at the bottom I am trying to follow the template used in R Shiny - Popup window when hovering over icon, the Laurent answer, and am trying to pull it into a rhandsontable table. I simply want to render the popup window as shown in the image below. Why does my code not work?

Code:

library(rhandsontable)
library(shiny)
library(bslib)

css <- '
.tooltip {
  pointer-events: none;
}
.tooltip > .tooltip-inner {
  pointer-events: none;
  background-color: #73AD21;
  color: #FFFFFF;
  border: 1px solid green;
  padding: 10px;
  font-size: 25px;
  font-style: italic;
  text-align: justify;
  margin-left: 0;
  max-width: 1000px;
}
.tooltip > .arrow::before {
  border-right-color: #73AD21;
}
'

js <- "
$(function () {
  $('[data-toggle=tooltip]').tooltip()
})
"
ui = fluidPage(
  theme = bs_theme(version = 4),
  tags$head(
    tags$style(HTML(css)),
    tags$script(HTML(js))
  ),
  br(),
  rHandsontableOutput('my_table')
)

server = function(input,output,session){
  DF = data.frame(
    Col_1 = c("This is row 1","This is row 2"), 
    Col_Help = c(
      as.character(
        span(
          "Example",
          span(
            `data-toggle` = "tooltip", `data-placement` = "right",
            title = "A tooltip",
            icon("info-circle")
          )
        )
      ),
      as.character(
        span(
          "Example",
          span(
            `data-toggle` = "tooltip", `data-placement` = "right",
            title = "A tooltip",
            icon("info-circle")
          )
        )
      )
    ),
    text = c("Row 1 does xxx","Row 2 does yyy"),
    stringsAsFactors = FALSE
  )
  
  output$my_table <- renderRHandsontable({
    rhandsontable::rhandsontable(
      DF
    ) %>%
      hot_cols(colWidths = c(200, 80)) %>%
      hot_col(1:2, renderer = htmlwidgets::JS("safeHtmlRenderer")) %>%
      hot_cols(colWidths = ifelse(names(DF) != "text", 100, 0.1))
  })
  
}
  
shinyApp(ui, server)

Solution

You need to provide allowedTags to mark which HTML tags should be rendered by the safeHTMLRenderer.

A small nuisance is that the icon is not rendered properly unless you add the fontawesome::fa_html_dependency manually. My guess is that because of the special way handsontable is rendering its content, the necessary dependencies for the fontawesome icons are not properly loaded.

Finally, again because of rendering reasons, you have to call .tooltip once the content is rendered, which is apparently not the case when the DOM is ready. Thus, you should use htmlwidgets::onRender instead of $().

Having said this, here is an example which does what you eant:

library(rhandsontable)
library(shiny)
library(bslib)

css <- '
.tooltip {
  pointer-events: none;
}
.tooltip > .tooltip-inner {
  pointer-events: none;
  background-color: #73AD21;
  color: #FFFFFF;
  border: 1px solid green;
  padding: 10px;
  font-size: 25px;
  font-style: italic;
  text-align: justify;
  margin-left: 0;
  max-width: 1000px;
}
.tooltip > .arrow::before {
  border-right-color: #73AD21;
}
'

ui = fluidPage(
  theme = bs_theme(version = 4),
  tags$head(
    tags$style(HTML(css)),
    fontawesome::fa_html_dependency(),
  ),
  br(),
  rHandsontableOutput('my_table')
)

server = function(input,output,session){
  DF = data.frame(
    Col_1 = c("This is row 1","This is row 2"), 
    Col_Help = c(
      as.character(
        span(
          "Example",
          span(
            `data-toggle` = "tooltip", `data-placement` = "right",
            title = "A tooltip",
            icon("info-circle")
          )
        )
      ),
      as.character(
        span(
          "Example",
          span(
            `data-toggle` = "tooltip", `data-placement` = "right",
            title = "A tooltip",
            icon("info-circle")
          )
        )
      )
    ),
    text = c("Row 1 does xxx","Row 2 does yyy"),
    stringsAsFactors = FALSE
  )

  output$my_table <- renderRHandsontable({
    rhandsontable::rhandsontable(
      DF, allowedTags = "<span><i>"
    ) %>%
      hot_cols(colWidths = c(200, 80)) %>%
      hot_col(1:2, renderer = htmlwidgets::JS("safeHtmlRenderer")) %>%
      hot_cols(colWidths = ifelse(names(DF) != "text", 100, 0.1)) %>%
      htmlwidgets::onRender("function() {$('[data-toggle=tooltip]').tooltip()}")
  })

}

shinyApp(ui, server)