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 #' @examples
#' x <- shinydashboard::box() #' 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, ...) { htmlAddBoxAttributes <- function(box, ...) {
htmltools::tagQuery(box)$ htmltools::tagQuery(box)$find(".box")$addAttr(...)$allTags()
find(".box")$
addAttr(...)$
allTags()
} }
#' Creates an aria landmark for a `shinydashboard::box` from the box title #' Creates an aria landmark for a `shinydashboard::box` from the box title
@@ -84,8 +83,7 @@ htmlFixBoxCollapseButtonAria <- function(box, context = NULL) {
} }
htmltools::tagQuery(box)$ htmltools::tagQuery(box)$
find(".box-tools button.btn-box-tool")$ find(".box-tools button.btn-box-tool")$
addAttrs(`aria-label` = paste0("Expand/Collapse ", context))$ addAttrs(`aria-label` = paste0("Expand/Collapse ", context))$allTags()
allTags()
} }
#' Adds a "help" (question mark) icon to a box tools section (right side) #' Adds a "help" (question mark) icon to a box tools section (right side)
@@ -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 box The box to remove the title from
#' @param removeHeader Remove the header as well #' @param removeHeader Remove the header as well
@@ -169,11 +168,10 @@ htmlRemoveBoxTitle <- function(box, removeHeader = FALSE) {
if (removeHeader) { if (removeHeader) {
htmltools::tagQuery(box)$find(".box-header")$remove()$allTags() htmltools::tagQuery(box)$find(".box-header")$remove()$allTags()
} else { } else {
htmltools::tagQuery(box)$ htmltools::tagQuery(box)$find(".box-title")$replace(
find(".box-title")$ htmltools::tags$span(
replace(htmltools::tags$span(
class = "empty-box-title", htmltools::HTML("&nbsp;") class = "empty-box-title", htmltools::HTML("&nbsp;")
))$ )
allTags() )$allTags()
} }
} }

View File

@@ -10,7 +10,5 @@
#' htmlDisableAutocomplete(x) #' htmlDisableAutocomplete(x)
htmlDisableAutocomplete <- function(input) { htmlDisableAutocomplete <- function(input) {
htmltools::tagQuery(input)$ htmltools::tagQuery(input)$
find("input")$ find("input")$addAttr(autocomplete = "off")$allTags()
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)") opt_span <- htmltools::tags$span(class = optClass, " (optional)")
tq <- htmltools::tagQuery(input) tq <- htmltools::tagQuery(input)
if (tq$hasClass("shiny-input-checkboxgroup")) { if (tq$hasClass("shiny-input-checkboxgroup")) {
tq <- tq$ tq <- tq$children("label")$append(opt_span)$reset()
children("label")$append(opt_span)$
reset()
} else if (tq$find(".shiny-options-group")$length() > 0) { } else if (tq$find(".shiny-options-group")$length() > 0) {
tq <- tq$ tq <- tq$children("label")$append(opt_span)$reset()
children("label")$append(opt_span)$
reset()
} else if (tq$find(".btn-file")$length() > 0) { } else if (tq$find(".btn-file")$length() > 0) {
tq <- tq$ tq <- tq$children("label")$append(opt_span)$reset()
children("label")$append(opt_span)$
reset()
} else { } else {
tq <- tq$ tq <- tq$
children(".checkbox")$find("label span")$append(opt_span)$ children(".checkbox")$find("label span")$append(opt_span)$reset()$
reset()$ find("label.control-label")$append(opt_span)$reset()
find("label.control-label")$append(opt_span)$
reset()
} }
tq$allTags() tq$allTags()
} }

View File

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

View File

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

View File

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