ShinyBS bsPopover and updateSelectInput

Question

Я хочу добавить подсказки к динамическому пользовательскому интерфейсу. Когда я инициализировать интерфейс подсказки инструмента работают отлично

selectInput(ns("Main2_1"),"Label","abc", selectize = TRUE, multiple = TRUE), 
bsPopover(ns("Main2_1"), "Label", "content", placement = "left", trigger = "focus"), 

, но как только я использую, чтобы обновить выбор Main2_1 в моем сценарии сервера с

updateSelectInput(session, "Main2_1", choices=foo) 

он удаляет кончик инструмента тоже. Добавление нового наконечника инструмента с addPopover на стороне сервера не устраняет проблему

Answer 1

Я согласен, это плохой дизайн прямо там. Я даже не могу сказать, почему addPopover не будет работать. Может быть, потому, что наблюдатели не выполняют команды один за другим ...

Однако, есть способ добраться до вашей вещи. Переписывая bsPopover, мы можем принять во внимание изменения соответствующего элемента.

Я создал функцию updateResistantPopover, которая добавляет дополнительный элемент eventListener (mutationListener) к элементу, указанному whos id, который переустанавливает popover всякий раз, когда изменяется какой-либо дочерний элемент этого элемента.

Пример кода ниже:

library(shiny) 
library(shinyBS) 

updateResistantPopover <- function(id, title, content, placement = "bottom", trigger = "hover", options = NULL){ 
    options = shinyBS:::buildTooltipOrPopoverOptionsList(title, placement, trigger, options, content) 
    options = paste0("{'", paste(names(options), options, sep = "': '", collapse = "', '"), "'}") 
    bsTag <- shiny::tags$script(shiny::HTML(paste0(" 
    $(document).ready(function() { 
     var target = document.querySelector('#", id, "'); 
     var observer = new MutationObserver(function(mutations) { 
     setTimeout(function() { 
      shinyBS.addTooltip('", id, "', 'popover', ", options, "); 
     }, 200); 
     }); 
     observer.observe(target, { childList: true }); 
    }); 
    "))) 
    htmltools::attachDependencies(bsTag, shinyBS:::shinyBSDep) 
} 

ui <- shinyUI(fluidPage(
    selectInput("Main2_1","Label","abc", selectize = TRUE, multiple = TRUE), 
    updateResistantPopover("Main2_1", "Label", "content", placement = "right", trigger = "focus"), 
    actionButton("destroy", "destroy!")  
)) 

server <- function(input, output, session){  
    observeEvent(input$destroy, { 
    updateSelectInput(session, "Main2_1", choices="foo") 
    }) 
} 

shinyApp(ui, server)