Shinydashboard 标题中的自动换行或换行

Question

我使用的是shinydashboard，但是当标题太长时，它无法换行。我曾尝试使用<br/> 来完成此操作，但在这种情况下，即使使用HTML() 也无法正常工作。

我知道我可以使用titleWidth 使标题空间更宽，但在许多情况下看起来并不那么好。

实现这一目标的最简单方法是什么？

这是一个例子：

library(shiny)
library(shinydashboard)

## Only run this example in interactive R sessions
if (interactive()) {
    header <- dashboardHeader(title = "This title is just way too long")

    sidebar <- dashboardSidebar(
        sidebarUserPanel("User Name",
                         subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
                         # Image file should be in www/ subdir
                         image = "userimage.png"
        ),
        sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
        sidebarMenu(
            # Setting id makes input$tabs give the tabName of currently-selected tab
            id = "tabs",
            menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
            menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new",
                     badgeColor = "green"),
            menuItem("Charts", icon = icon("bar-chart-o"),
                     menuSubItem("Sub-item 1", tabName = "subitem1"),
                     menuSubItem("Sub-item 2", tabName = "subitem2")
            )
        )
    )

    body <- dashboardBody(
        tabItems(
            tabItem("dashboard",
                    div(p("Dashboard tab content"))
            ),
            tabItem("widgets",
                    "Widgets tab content"
            ),
            tabItem("subitem1",
                    "Sub-item 1 tab content"
            ),
            tabItem("subitem2",
                    "Sub-item 2 tab content"
            )
        )
    )

    shinyApp(
        ui = dashboardPage(header, sidebar, body),
        server = function(input, output) { }
    )
}

我们的目标是应用自动换行，以便我们可以阅读整个标题（即"This title is just way too long"）。

Answer 1

header <- dashboardHeader(title = h4(HTML("This title<br/>is just way too long")))

shinyApp(
  ui = dashboardPage(header, sidebar, body),
  server = function(input, output) { }
)