Reputation: 37
I'm building out a datatable in R Shiny and part of it will include tooltips unique to each cell. I've accomplished that, however, I seem to be unable to insert HTML content into the tooltip itself. In the example below, I'm inserting HTML content into a cell in the datatable, and then aim to insert that same content into a tooltip, but the HTML only renders in the datatable, and not in the tooltip.
I've played around with a few ideas but can't find any that work. I can get the HTML to appear (as text) in the tooltip by removing the HTML function, but then, obviously, it's escaped and is just text. I am able to bold text within the tooltip using tags$b(), however, I am hoping for a solution more similar to my example below as I have more complex HTML content I would like add to the tooltip beyond just text.
Any ideas? Thanks very much!
library(shiny)
library(shinyBS)
library(DT)
ui <- fluidPage(
bsTooltip('tbutton',''),
mainPanel(dataTableOutput('df'))
)
server <- function(input, output) {
df <- data.frame(A = c(1:5), B = c(LETTERS[1:5]))
output$df <- renderDataTable({
cell <- paste0('<svg width="30" height="30">',
'<text x="1%" y="75%" font-weight="bold" font-size="16" >B</text>',
'</svg>')
df[2,2] <- as.character(popify(tags$div(HTML(cell)),
title = 'Tooltip:',
placement = 'left',
content = paste0(tags$div(HTML(cell))),
trigger = c('hover', 'click')))
datatable(df, escape=FALSE)
})
}
shinyApp(ui = ui, server = server)
Upvotes: 0
Views: 351
Reputation: 84679
To attach a popover to a cell, you can use bsPopover
if this cell has an id
. To set an id
to the cells, you can use the datatables option createdCell
.
Then the HTML code works in the popover content, but not the SVG (or at least I didn't manage to make it work).
library(shiny)
library(shinyBS)
library(DT)
df <- data.frame(A = 1:5, B = LETTERS[1:5])
css <- "
.red {color: red;}
"
ui <- fluidPage(
tags$head(tags$style(HTML(css))),
mainPanel(
DTOutput('df'),
bsPopover(
id = "id2",
title = "test",
content = '<p class="red">TEST</p>'
)
)
)
server <- function(input, output) {
output$df <- renderDT({
datatable(
df,
options = list(
columnDefs = list(
list(
targets = 2,
createdCell = JS(
"function (td, cellData, rowData, row, col) {",
" $(td).attr('id', 'id' + (row+1));",
"}"
)
)
)
)
)
})
}
shinyApp(ui = ui, server = server)
Upvotes: 0