使用bs4Dash嵌套Box时updateBox导致所有Box标题变更的问题

问题 #

在R Shiny中使用bs4Dash库创建嵌套Box组件，各Box均设置了独立ID，但调用updateBox函数更新最外层services_box的标题时，所有嵌套Box的标题会同步变更。需求是勾选「Service_1」复选框时，仅更新最外层Box的标题，不影响内部其他Box。

原因 #

bs4Dash的updateBox函数在处理嵌套结构时，内部的CSS选择器会匹配目标Box下所有.card-header元素，导致子Box的标题也被意外修改。

解决方法 #

绕过updateBox的默认标题更新逻辑，直接通过自定义JS指令精准定位最外层Box的标题元素进行修改：

• 在server端使用session$sendCustomMessage发送标题更新指令
• 前端用jQuery根据Box的ID精准选择其对应的标题元素，避免影响子Box

修正后的代码 #

library(shiny)
library(bs4Dash)
library(shinyWidgets)

ui <- bs4Dash::dashboardPage(
  bs4Dash::dashboardHeader(),
  bs4Dash::dashboardSidebar(disable = TRUE),
  bs4Dash::dashboardBody(
    # 引入自定义JS处理标题更新
    tags$script(HTML("
      Shiny.addCustomMessageHandler('updateBoxTitle', function(message) {
        // 精准定位目标Box的标题元素
        $('#' + message.id).find('.card-header:first').html(message.title);
      });
    ")),
    bs4Dash::box(
      id = "services_box",
      title = "Select Services",
      width = NULL,
      solidHeader = TRUE,
      status = "warning",
      fluidRow(
        bs4Dash::box(
          title = "Group 1",
          id = "Group_1",
          width = 4,
          collapsible = FALSE,
          fluidRow(column(
            width = 6,
            shinyWidgets::prettyCheckbox(
              "service_checkbox",
              label = "Service_1",
              status = "warning",
              shape = "curve",
              animation = "smooth",
              fill = TRUE,
              icon = icon("check")
            )
          ))
        )
      ),
      
      hr(),
      bs4Dash::box(
        title = "Screening Questions",
        id = "question_box",
        width = 12,
        collapsible = FALSE,
        column(
          width = 12,
          shinyWidgets::prettyCheckbox(
            "question_checkbox",
            label = "Question 1",
            status = "success",
            shape = "curve",
            animation = "smooth",
            fill = TRUE
          )
        )
      )
    )
  )
)

server <- function(input, output, session) {
  observeEvent(input$service_checkbox, ignoreInit = TRUE, {
    # 发送自定义消息更新标题
    session$sendCustomMessage(
      type = "updateBoxTitle",
      message = list(
        id = "services_box",
        title = as.character(shiny::h2("Updated Title"))
      )
    )
  })
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Logan