shinyBS Modal within checkbox group

问题

I use shinyBS::bsModal() to place explanations of the UI elements there. It works great when I place a bsButton() behind the title of the checkbox.

Now I want to place it behind the checkbox options. A first hint could be this answer where the same for a tooltip is done (but my modification do not work).

Minimal Example:

library(shiny)
library(shinyBS)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("qualdim",  
                         tags$span("Chekboxoptions",   
                             bsButton("modalbt", "?", style = "inverse", size = "extra-small")),

                         c("Option_1" = "Option_1", 
                           "Option_2" = "Option_2"))
    ),

    mainPanel(
      bsModal("modalExample", "Modal", "modalbt", size = "large",
           verbatimTextOutput("helptext")))
  )
)

server <- function(input, output) {
  output$helptext <- renderText({"I can trigger a shinyBS::bsModal() from here, but I want to place two buttons behind `Option_1` and     `Option_2`" })
}

shinyApp(ui = ui, server = server)

回答1:

The bsModal works anywhere and just takes the button id as a trigger. So the only thing you need to do is to get a suitable button inside the checkboxGroup. From the previous Question/Answer you linked, you already have the function to get a bsButton inside the group input. (Just erase the line where the tooltip has been assigned. This is not needed here.)

The code below basically is copy paste now. I just added some extra bsButton settings like size, style and id (this one is important! was not important in the linked question with the tooltips!), such that you can use the function more like you would use bsButton.

library(shiny)
library(shinyBS)

makeCheckboxButton <- function(checkboxValue, buttonId, buttonLabel, size = "default", style = "default"){
    size <- switch(size, `extra-small` = "btn-xs", small = "btn-sm", 
        large = "btn-lg", "default")
    style <- paste0("btn-", style)

    tags$script(HTML(paste0("
          $(document).ready(function() {
            var inputElements = document.getElementsByTagName('input');
            for(var i = 0; i < inputElements.length; i++){
              var input = inputElements[i];

              if(input.getAttribute('value') == '", checkboxValue, "'){

                var button = document.createElement('button');
                button.setAttribute('id', '", buttonId, "');
                button.setAttribute('type', 'button');
                button.setAttribute('class', '", paste("btn action-button", style , size), "');
                button.appendChild(document.createTextNode('", buttonLabel, "'));

                input.parentElement.parentElement.appendChild(button);
             };
            }
          });
        ")))
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("qualdim", label = "Chekboxoptions", choices = c("Option_1", "Option_2")),
      makeCheckboxButton("Option_1", "modalbt", "?", size = "extra-small", style = "inverse")
    ),

    mainPanel(
      bsModal("modalExample", "Modal", "modalbt", size = "large",
           verbatimTextOutput("helptext")))
  )
)

server <- function(input, output) {
  output$helptext <- renderText({"I can trigger a shinyBS::bsModal() from here, but I want to place two buttons behind `Option_1` and     `Option_2`" })
}

shinyApp(ui = ui, server = server)

来源：https://stackoverflow.com/questions/37521669/shinybs-modal-within-checkbox-group

标签

Shiny

shinybs