I am trying to add a button to a column name in a dabletable and a bsPopover to that button when it is hovered over. I can successfully create the popover and button outside of datatable, and I can add in a button to a datatable. But getting the popover to work in the datatable has proved unsuccessful. I am choosing 'hover' as the trigger so that clicking preserves column sorting capabilities. See reprex below:
library(shiny)
library(shinyBS)
library(DT)
ui <- fluidPage(
titlePanel('Making a Popover Work in DataTable'),
mainPanel(
fluidRow(
#popover button
p(bsButton("workingPop",
label = "",
icon = icon("question"),
style = "info",
size = "extra-small")
),
#popover content
bsPopover(id = "workingPop", title = "This Popover Works",
content = "It works very well",
placement = "right",
trigger = "hover",
options = list(container = "body")
)),
fluidRow(dataTableOutput('myTable'),
bsPopover(id="notWorking", title = "This one does not work",
content = "I'd like to give information about hp: it means horsepower. I want a popover, because my real example has lot's of text.",
placement = "top",
trigger = "hover",
options = list(container = "body")))
)
)
server <- function(input, output, session) {
output$myTable <- DT::renderDataTable({
datatable(mtcars %>%
rename("hp <button type='button' id='notWorking' class='btn action-button btn-info btn-xs shiny-bound-input'>
<i class='fa fa-question' role='presentation' aria-label='question icon'></i>
</button>"=hp),
rownames=TRUE,
selection='none',
escape=FALSE)
})
}
shinyApp(ui = ui, server = server)
Please consider using alternatives of {shinyBs}.
I would recommend you to try my package {spsComps} which has similar bsPopover
functions but with a lot more you can do, like color, opacity, font size, weight, etc.
shinyBs has not been updated for more than 5 years, I am sure you know what it means. It is not me trying to advertise my package so say something bad about shinyBs. I developed these functions because I don't see them in other packages or they didn't keep updating the package.
Here is the use case for your example:
library(shiny)
library(spsComps)
library(DT)
library(dplyr)
# define the question button in a button since we need to uses multiple times
infoBtn <- function(id) {
actionButton(id,
label = "",
icon = icon("question"),
style = "info",
size = "extra-small",
class='btn action-button btn-info btn-xs shiny-bound-input'
)
}
ui <- fluidPage(
titlePanel('Making a Popover Work in DataTable'),
mainPanel(
fluidRow(
#popover button
infoBtn('workingPop') %>%
bsPopover(title = "This Popover Works",
content = "It works very well",
placement = "right",
trigger = "hover"
)
),
fluidRow(dataTableOutput('myTable'))
)
)
server <- function(input, output, session) {
output$myTable <- DT::renderDataTable({
# construct the title and convert to text
hp_text <- tags$span(
"hp",
infoBtn('notWorking') %>%
bsPopover(title = "This one does not work",
content = "I'd like to give information about hp: it means horsepower. I want a popover, because my real example has lot's of text.",
placement = "top",
trigger = "hover")
) %>%
as.character()
# use !! and := to inject variable as text
datatable(mtcars %>% rename(!!hp_text:=hp),
rownames=TRUE,
selection='none',
escape=FALSE)
})
}
shinyApp(ui = ui, server = server)
other popOver utilities you can do with spsComps:
There are demos you can explore spsComps and docs you can read.