Fixed lintr & complexity issues

This commit is contained in:
2026-02-03 14:50:35 +00:00
parent 27bccf2b84
commit 868b4f3d98
6 changed files with 52 additions and 86 deletions

View File

@@ -20,12 +20,11 @@ getBoxTitle <- function(box) {
#'
#' @examples
#' x <- shinydashboard::box()
#' htmlAddBoxAttributes(x, role = "region", `aria-label` = "This is a special box")
#' htmlAddBoxAttributes(
#' x, role = "region", `aria-label` = "This is a special box"
#' )
htmlAddBoxAttributes <- function(box, ...) {
htmltools::tagQuery(box)$
find(".box")$
addAttr(...)$
allTags()
htmltools::tagQuery(box)$find(".box")$addAttr(...)$allTags()
}
#' Creates an aria landmark for a `shinydashboard::box` from the box title
@@ -84,8 +83,7 @@ htmlFixBoxCollapseButtonAria <- function(box, context = NULL) {
}
htmltools::tagQuery(box)$
find(".box-tools button.btn-box-tool")$
addAttrs(`aria-label` = paste0("Expand/Collapse ", context))$
allTags()
addAttrs(`aria-label` = paste0("Expand/Collapse ", context))$allTags()
}
#' Adds a "help" (question mark) icon to a box tools section (right side)
@@ -114,11 +112,11 @@ htmlAddBoxHelpLink <- function(box, href, title = NULL) {
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,
after = 0,
.cssSelector = ".box-header",
htmltools::tags$div(class = "box-tools pull-right")
)
}
box_title <- getBoxTitle(box)
@@ -154,7 +152,8 @@ htmlAddBoxHelpLink <- function(box, href, title = NULL) {
)
}
#' Removes title from box element (leaving an un-titled box with header if required)
#' 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
@@ -169,11 +168,10 @@ 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(
htmltools::tagQuery(box)$find(".box-title")$replace(
htmltools::tags$span(
class = "empty-box-title", htmltools::HTML("&nbsp;")
))$
allTags()
)
)$allTags()
}
}

View File

@@ -10,7 +10,5 @@
#' htmlDisableAutocomplete(x)
htmlDisableAutocomplete <- function(input) {
htmltools::tagQuery(input)$
find("input")$
addAttr(autocomplete = "off")$
allTags()
find("input")$addAttr(autocomplete = "off")$allTags()
}

View File

@@ -13,23 +13,15 @@ htmlMarkOptional <- function(input, optClass = "text-muted font-italic") {
opt_span <- htmltools::tags$span(class = optClass, " (optional)")
tq <- htmltools::tagQuery(input)
if (tq$hasClass("shiny-input-checkboxgroup")) {
tq <- tq$
children("label")$append(opt_span)$
reset()
tq <- tq$children("label")$append(opt_span)$reset()
} else if (tq$find(".shiny-options-group")$length() > 0) {
tq <- tq$
children("label")$append(opt_span)$
reset()
tq <- tq$children("label")$append(opt_span)$reset()
} else if (tq$find(".btn-file")$length() > 0) {
tq <- tq$
children("label")$append(opt_span)$
reset()
tq <- tq$children("label")$append(opt_span)$reset()
} else {
tq <- tq$
children(".checkbox")$find("label span")$append(opt_span)$
reset()$
find("label.control-label")$append(opt_span)$
reset()
children(".checkbox")$find("label span")$append(opt_span)$reset()$
find("label.control-label")$append(opt_span)$reset()
}
tq$allTags()
}

View File

@@ -13,42 +13,34 @@ htmlMarkRequired <- function(input, reqClass = "text-danger required") {
req_span <- htmltools::tags$span(class = reqClass, "*")
tq <- htmltools::tagQuery(input)
if (tq$hasClass("shiny-input-checkboxgroup")) {
tq <- tq$
addAttr(`aria-required` = "true")$
reset()$
children("label")$append(req_span)$
reset()
tq <- tq$addAttr(`aria-required` = "true")$reset()
tq <- tq$children("label")$append(req_span)$reset()
} else if (tq$find(".shiny-options-group")$length() > 0) {
tq <- tq$
children("label")$append(req_span)$
reset()$
addAttr(`aria-required` = "true")$
reset()$
find("input")$addAttr(required = "true", `aria-required` = "true")$
reset()
tq <- tq$children("label")$append(req_span)$reset()
tq <- tq$addAttr(`aria-required` = "true")$reset()
tq <- tq$find("input")$addAttr(
required = "true", `aria-required` = "true"
)$reset()
} else if (tq$find(".btn-file")$length() > 0) {
tq <- tq$
children("label")$append(req_span)$
reset()$
addAttr(`aria-required` = "true")$
reset()$
find(".shiny-input-file")$
addAttr(required = "true", `aria-required` = "true")$
reset()
tq <- tq$children("label")$append(req_span)$reset()
tq <- tq$addAttr(`aria-required` = "true")$reset()
tq <- tq$find(".shiny-input-file")$addAttr(
required = "true", `aria-required` = "true"
)$reset()
} else {
tq <- tq$
# Update the label
children(".checkbox")$find("label span")$append(req_span)$
reset()$
find("label.control-label")$append(req_span)$
reset()$
tq <- tq$children(".checkbox")$find("label span")$append(req_span)$reset()
tq <- tq$find("label.control-label")$append(req_span)$reset()
# Update the inputs
find("input")$addAttr(required = "true", `aria-required` = "true")$
reset()$
find("textarea")$addAttr(required = "true", `aria-required` = "true")$
reset()$
find("select")$addAttr(required = "true", `aria-required` = "true")$
reset()
tq <- tq$find("input")$addAttr(
required = "true", `aria-required` = "true"
)$reset()
tq <- tq$find("textarea")$addAttr(
required = "true", `aria-required` = "true"
)$reset()
tq <- tq$find("select")$addAttr(
required = "true", `aria-required` = "true"
)$reset()
}
tq$allTags()
}

View File

@@ -10,7 +10,5 @@
#' x <- shiny::icon("wrench")
#' htmlRemoveAttributes(x, "aria-label")
htmlRemoveAttributes <- function(el, ...) {
htmltools::tagQuery(el)$
removeAttrs(list(...))$
allTags()
htmltools::tagQuery(el)$removeAttrs(list(...))$allTags()
}

View File

@@ -11,15 +11,9 @@
#' htmlSetMaxLength(x, 50)
htmlSetMaxLength <- function(input, length) {
htmltools::tagQuery(input)$
find(".shiny-input-password")$
addAttr(maxlength = length)$
reset()$
find(".shiny-input-text")$
addAttr(maxlength = length)$
reset()$
find("textarea")$
addAttr(maxlength = length)$
allTags()
find(".shiny-input-password")$addAttr(maxlength = length)$reset()$
find(".shiny-input-text")$addAttr(maxlength = length)$reset()$
find("textarea")$addAttr(maxlength = length)$allTags()
}
#' Set the minimum length on a text or textarea input
@@ -35,13 +29,7 @@ htmlSetMaxLength <- function(input, length) {
#' htmlSetMinLength(x, 3)
htmlSetMinLength <- function(input, length) {
htmltools::tagQuery(input)$
find(".shiny-input-password")$
addAttr(minlength = length)$
reset()$
find(".shiny-input-text")$
addAttr(minlength = length)$
reset()$
find("textarea")$
addAttr(minlength = length)$
allTags()
find(".shiny-input-password")$addAttr(minlength = length)$reset()$
find(".shiny-input-text")$addAttr(minlength = length)$reset()$
find("textarea")$addAttr(minlength = length)$allTags()
}