在複選框組內的shinyBS Modal

Question

我使用shinyBS::bsModal()來說明UI元素的解釋。當我將bsButton()放在複選框的標題後面時，它很好用。

現在我想把它放在複選框選項後面。 第一個提示可能是this answer，其中工具提示也一樣（但我的修改不起作用）。

小例子：

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) 

Answer 1

的bsModal作品的任何地方，只需要按鈕標識作爲觸發。所以你唯一需要做的就是在checkboxGroup裏面找一個合適的按鈕。在上一個問題/答案中，您已經有了在組輸入中獲得bsButton的功能。 （只需擦除已分配工具提示的行，這裏不需要。）

下面的代碼現在基本上是複製粘貼。我只是增加了一些額外的bsButton設置，如大小，樣式和ID（這一個是重要的！在與工具提示鏈接的問題！）並不重要，這樣你可以使用更多的功能，如你會使用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)