r - Shiny 仪表板标题中的自动换行或换行

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) { }
)