How to implement a pop-up bubble when hovering the cursor over the image rendered in the table using R shiny?

Question

The below code is getting close to what I need. I'm trying to modify it so that hovering the cursor over each question mark in the rendered table causes a pop-up bubble to show the help text, instead of rendering the text at the bottom of the screen and requiring the user to click on "close". Moving the cursor off the question mark should cause the pop-up bubble to disappear. As shown in the image.

Any recommendations for how to do this?

I am trying to learn some javascript and CSS through W3 School, but it is slow going.

Code:

library(magrittr)
library(htmlwidgets)
library(rhandsontable)
library(shiny)

DF = data.frame(
  Col_1 = c("This is row 1","This is row 2"), 
  Col_Help = c(
    "https://as1.ftcdn.net/v2/jpg/03/35/13/14/1000_F_335131435_DrHIQjlOKlu3GCXtpFkIG1v0cGgM9vJC.jpg",
    "https://as1.ftcdn.net/v2/jpg/03/35/13/14/1000_F_335131435_DrHIQjlOKlu3GCXtpFkIG1v0cGgM9vJC.jpg"
  ),
  text = c("Row 1 does xxx","Row 2 does yyy"),
  stringsAsFactors = FALSE
)

ui <- fluidPage(br(),rHandsontableOutput('my_table'))

server <- function(input, output, session) {
  output$my_table <- renderRHandsontable({
    rhandsontable::rhandsontable(
      DF,
      allowedTags = "<em><b><strong><a><big>"
      ) %>%
        hot_cols(colWidths = c(200, 80)) %>%
        hot_col(1, renderer = htmlwidgets::JS("safeHtmlRenderer")) %>%
        hot_col(2, renderer = "
          function(instance, td, row, col, prop, value, cellProperties) {
            var escaped = Handsontable.helper.stringify(value),
              img;
        
            if (escaped.indexOf('http') === 0) {
              img = document.createElement('IMG');
              img.src = value; img.style.width = 'auto'; img.style.height = '20px';
        
              Handsontable.dom.addEvent(img, 'mousedown', function (e){
                var exists = document.getElementById('test')
                if (exists === null){
                  var textBlock = instance.params.data[[row]][[2]];
                  var popup = document.createElement('div');
                  popup.className = 'popup';
                  popup.id = 'test';
                  var cancel = document.createElement('div');
                  cancel.className = 'cancel';
                  cancel.innerHTML = '<center><b>close</b></center>';
                  cancel.onclick = function(e) {
                    popup.parentNode.removeChild(popup)
                  }
                  var message = document.createElement('span');
                  message.innerHTML = '<center>' + textBlock + '</center>';
                  popup.appendChild(message);
                  popup.appendChild(cancel);
                  document.body.appendChild(popup);
                }
              });
        
              Handsontable.dom.empty(td);
              td.appendChild(img);
              
            }
            else {
              // render as text
              Handsontable.renderers.TextRenderer.apply(this, arguments);
            }
            return td;
          }") %>% 
      hot_cols(colWidths = ifelse(names(DF) != "text", 100, 0.1))
  })
}

shinyApp(ui, server)

Answer 1

Why don't you simply allow displaying img tags and provide them with a title?

library(magrittr)
library(htmlwidgets)
library(rhandsontable)
library(shiny)

DF = data.frame(
  Col_1 = c("This is row 1","This is row 2"), 
  Col_Help = c(
    as.character(img(src = "https://images.plot.ly/language-icons/api-home/python-logo.png", title = "My first help text", style = "width: 50px;")),
    as.character(img(src = "https://images.plot.ly/language-icons/api-home/r-logo.png", title = "My second help text", style = "width: 50px;"))
  ),
  text = c("Row 1 does xxx","Row 2 does yyy"),
  stringsAsFactors = FALSE
)

ui <- fluidPage(br(),rHandsontableOutput('my_table'))

server <- function(input, output, session) {
  output$my_table <- renderRHandsontable({
    rhandsontable::rhandsontable(
      DF,
      allowedTags = "<em><b><strong><a><big><img>"
    ) %>%
      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)