Added method for removing the title from a shinydashboard::box and added htmlAddBoxHelpLink function

DESCRIPTION

@@ -14,9 +14,11 @@ Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.3
 Imports: 
-    htmltools
+    htmltools,
+    rlang
 Suggests: 
     shiny,
     shinydashboard,
+    slugify,
     testthat (>= 3.0.0)
-Config/testthat/edition: 3
+Config/testthat/edition: 3

NAMESPACE

@@ -1,12 +1,14 @@
 # Generated by roxygen2: do not edit by hand
 
 export(htmlAddBoxAttributes)
+export(htmlAddBoxHelpLink)
 export(htmlAddBoxRegionFromTitle)
 export(htmlDisableAutocomplete)
 export(htmlFixBoxCollapseButtonAria)
 export(htmlMarkOptional)
 export(htmlMarkRequired)
 export(htmlRemoveAttributes)
+export(htmlRemoveBoxTitle)
 export(htmlReplaceBoxTitleLevel)
 export(htmlSetMaxLength)
 export(htmlSetMinLength)

R/htmlBoxManipulation.R

@@ -87,3 +87,93 @@ htmlFixBoxCollapseButtonAria <- function(box, context = NULL) {
     addAttrs(`aria-label` = paste0("Expand/Collapse ", context))$
     allTags()
 }
+
+#' Adds a "help" (question mark) icon to a box tools section (right side)
+#'
+#' The uri to load can have a replacement marker supplied '%box%' which will be
+#' substituded with a sanitized copy of the box title. Preference is given to
+#' the slugify package, however if unavailable a warning is generated and the
+#' fallback of URLEncode is used.
+#'
+#' @param box The box to add a help icon/link to
+#' @param href The help uri to load
+#' @param title Optional title for the help link. Defaults to box title
+#'
+#' @return The modified box
+#' @export
+#'
+#' @examples
+#' x <- shinydashboard::box(title = "This is a box")
+#' htmlAddBoxHelpLink(x, href = "http://example.com/help-guide#%box%")
+htmlAddBoxHelpLink <- function(box, href, title = NULL) {
+  header_tags <- htmltools::tagQuery(box)$find(".box-header")$selectedTags()
+  if (length(header_tags) == 0) {
+    return(box)
+  }
+
+  tools_tags <- htmltools::tagQuery(box)$find(".box-tools")$selectedTags()
+  if (length(tools_tags) == 0) {
+    box <- htmltools::tagInsertChildren(
+        box,
+        after = 0,
+        .cssSelector = ".box-header",
+        htmltools::tags$div(class = "box-tools pull-right")
+      )
+  }
+
+  box_title <- getBoxTitle(box)
+  if (is.null(box_title)) {
+    box_title <- "UNDEFINED"
+  }
+  if (is.null(title)) {
+    title <- box_title
+  }
+
+  if (requireNamespace("slugify")) {
+    box_title <- slugify::slugify(box_title)
+  } else {
+    rlang::warn(
+      "slugify is not installed, resorting to URLencode",
+      .frequency = "regularly",
+      .frequency_id = "htmlAddBoxHelpLink::slugify"
+    )
+    box_title <- utils::URLencode(box_title)
+  }
+
+  htmltools::tagInsertChildren(
+    box,
+    after = 0,
+    .cssSelector = ".box-tools",
+    htmltools::tags$a(
+      href = gsub("%box%", box_title, href),
+      target = "_blank",
+      class = "btn btn-box-tool pl-3 pr-3",
+      htmlRemoveAttributes(shiny::icon("question"), "aria-label"),
+      title = paste(trimws(title), " help link")
+    )
+  )
+}
+
+#' Removes title from box element (leaving an un-titled box with header if required)
+#'
+#' @param box The box to remove the title from
+#' @param removeHeader Remove the header as well
+#'
+#' @return The modified box
+#' @export
+#'
+#' @examples
+#' x <- shinydashboard::box(title = "TBR")
+#' htmlRemoveBoxTitle(x)
+htmlRemoveBoxTitle <- function(box, removeHeader = FALSE) {
+  if (removeHeader) {
+    htmltools::tagQuery(box)$find(".box-header")$remove()$allTags()
+  } else {
+    htmltools::tagQuery(box)$
+      find(".box-title")$
+      replace(htmltools::tags$span(
+        class = "empty-box-title", htmltools::HTML("&nbsp;")
+      ))$
+      allTags()
+  }
+}

man/htmlAddBoxHelpLink.Rd

@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlBoxManipulation.R
+\name{htmlAddBoxHelpLink}
+\alias{htmlAddBoxHelpLink}
+\title{Adds a "help" (question mark) icon to a box tools section (right side)}
+\usage{
+htmlAddBoxHelpLink(box, href, title = NULL)
+}
+\arguments{
+\item{box}{The box to add a help icon/link to}
+
+\item{href}{The help uri to load}
+
+\item{title}{Optional title for the help link. Defaults to box title}
+}
+\value{
+The modified box
+}
+\description{
+The uri to load can have a replacement marker supplied '\%box\%' which will be
+substituded with a sanitized copy of the box title. Preference is given to
+the slugify package, however if unavailable a warning is generated and the
+fallback of URLEncode is used.
+}
+\examples{
+x <- shinydashboard::box(title = "This is a box")
+htmlAddBoxHelpLink(x, href = "http://example.com/help-guide#\%box\%")
+}

man/htmlRemoveBoxTitle.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlBoxManipulation.R
+\name{htmlRemoveBoxTitle}
+\alias{htmlRemoveBoxTitle}
+\title{Removes title from box element (leaving an un-titled box with header if required)}
+\usage{
+htmlRemoveBoxTitle(box, removeHeader = FALSE)
+}
+\arguments{
+\item{box}{The box to remove the title from}
+
+\item{removeHeader}{Remove the header as well}
+}
+\value{
+The modified box
+}
+\description{
+Removes title from box element (leaving an un-titled box with header if required)
+}
+\examples{
+x <- shinydashboard::box(title = "TBR")
+htmlRemoveBoxTitle(x)
+}