Fixed lintr & complexity issues

This commit is contained in:
2026-02-03 14:50:18 +00:00
parent de80828968
commit e28403929d
4 changed files with 130 additions and 128 deletions

View File

@@ -10,55 +10,55 @@
#' #'
#' @export #' @export
a11yCheckboxGroupInput <- function( a11yCheckboxGroupInput <- function(
inputId, label, choices = NULL, selected = NULL, inline = FALSE, inputId, label, choices = NULL, selected = NULL, inline = FALSE,
width = NULL, choiceNames = NULL, choiceValues = NULL, withSelectAll = FALSE width = NULL, choiceNames = NULL, choiceValues = NULL, withSelectAll = FALSE
) { ) {
args <- shiny:::normalizeChoicesArgs( args <- shiny:::normalizeChoicesArgs(
choices, choiceNames, choiceValues, FALSE choices, choiceNames, choiceValues, FALSE
) )
selected <- shiny::restoreInput(id = inputId, default = selected) selected <- shiny::restoreInput(id = inputId, default = selected)
if (!is.null(selected)) { if (!is.null(selected)) {
selected <- as.character(selected) selected <- as.character(selected)
} }
options <- shiny:::generateOptions( options <- shiny:::generateOptions(
inputId, selected, inline, "checkbox", args$choiceNames, inputId, selected, inline, "checkbox", args$choiceNames,
args$choiceValues args$choiceValues
) )
ctnrClass <- "form-group shiny-input-a11ycheckboxgroup shiny-input-container" ctnrClass <- "form-group shiny-input-a11ycheckboxgroup shiny-input-container"
if (inline) { if (inline) {
ctnrClass <- paste(ctnrClass, "shiny-input-container-inline") ctnrClass <- paste(ctnrClass, "shiny-input-container-inline")
} }
selectAll <- NULL selectAll <- NULL
if (withSelectAll) { if (withSelectAll) {
sa <- htmltools::tags$a( sa <- htmltools::tags$a(
href = "#", href = "#",
onclick = "return checkAll(event)", onclick = "return checkAll(event)",
"select all", "select all",
class = "link select-all" class = "link select-all"
)
sn <- htmltools::tags$a(
href = "#",
onclick = "return clearAll(event)",
"clear all",
class = "link select-none"
)
selectAll <- htmltools::tags$div(
"(", sa, "/", sn, ")", class = "select-all-container"
)
}
fieldset <- htmltools::tags$fieldset(
id = inputId,
style = htmltools::css(width = htmltools::validateCssUnit(width)),
class = ctnrClass,
htmltools::tags$legend(label),
options,
selectAll
) )
sn <- htmltools::tags$a(
href = "#",
onclick = "return clearAll(event)",
"clear all",
class = "link select-none"
)
selectAll <- htmltools::tags$div(
"(", sa, "/", sn, ")", class = "select-all-container"
)
}
htmltools::attachDependencies(fieldset, accessibleShinyInputsDependency()) fieldset <- htmltools::tags$fieldset(
id = inputId,
style = htmltools::css(width = htmltools::validateCssUnit(width)),
class = ctnrClass,
htmltools::tags$legend(label),
options,
selectAll
)
htmltools::attachDependencies(fieldset, a11yShinyInputsDependency())
} }

View File

@@ -8,65 +8,67 @@
#' #'
#' @export #' @export
a11yFileInput <- function( a11yFileInput <- function(
inputId, label, multiple = FALSE, accept = NULL, width = NULL, inputId, label, multiple = FALSE, accept = NULL, width = NULL,
buttonLabel = "Browse...", placeholder = "No file selected", buttonLabel = "Browse...", placeholder = "No file selected",
capture = NULL capture = NULL
) { ) {
restoredValue <- shiny::restoreInput(id = inputId, default = NULL) restoredValue <- shiny::restoreInput(id = inputId, default = NULL)
if (!is.null(restoredValue) && !is.data.frame(restoredValue)) { if (!is.null(restoredValue) && !is.data.frame(restoredValue)) {
warning("Restored value for ", inputId, " has incorrect format.") warning("Restored value for ", inputId, " has incorrect format.")
restoredValue <- NULL restoredValue <- NULL
} }
if (!is.null(restoredValue)) { if (!is.null(restoredValue)) {
restoredValue <- jsonlite::toJSON(restoredValue, strict_atomic = FALSE) restoredValue <- jsonlite::toJSON(restoredValue, strict_atomic = FALSE)
} }
inputTag <- htmltools::tags$input( inputTag <- htmltools::tags$input(
id = inputId, id = inputId,
class = "shiny-input-file", class = "shiny-input-file",
name = inputId, name = inputId,
type = "file", type = "file",
style = "position: absolute !important; top: -99999px !important; left: -99999px !important;", style = "position: absolute !important; top: -99999px !important; \
`data-restore` = restoredValue left: -99999px !important;",
) `data-restore` = restoredValue
if (multiple) { )
inputTag$attribs$multiple <- "multiple" if (multiple) {
} inputTag$attribs$multiple <- "multiple"
if (length(accept) > 0) { }
inputTag$attribs$accept <- paste(accept, collapse = ",") if (length(accept) > 0) {
} inputTag$attribs$accept <- paste(accept, collapse = ",")
if (!is.null(capture)) { }
inputTag$attribs$capture <- capture if (!is.null(capture)) {
} inputTag$attribs$capture <- capture
}
htmltools::tags$div(
class = "form-group shiny-input-container",
style = htmltools::css(width = htmltools::validateCssUnit(width)),
htmltools::tags$label(
label,
class = "control-label",
class = if (is.null(label)) "shiny-label-null",
id = paste0(inputId, "-label"),
`for` = inputId
),
htmltools::tags$div( htmltools::tags$div(
class = "form-group shiny-input-container", class = "input-group",
style = htmltools::css(width = htmltools::validateCssUnit(width)), htmltools::tags$label(
htmltools::tags$label( class = "input-group-btn input-group-prepend",
label, htmltools::tags$span(
class = "control-label", class = "btn btn-default btn-file", buttonLabel, inputTag
class = if (is.null(label)) "shiny-label-null",
id = paste0(inputId, "-label"),
`for` = inputId
),
htmltools::tags$div(
class = "input-group",
htmltools::tags$label(
class = "input-group-btn input-group-prepend",
htmltools::tags$span(
class = "btn btn-default btn-file", buttonLabel, inputTag
)),
htmltools::tags$input(
type = "text",
class = "form-control",
placeholder = placeholder,
readonly = "readonly",
`aria-label` = "Uploaded file name"
)
),
htmltools::tags$div(
id = paste(inputId, "_progress", sep = ""),
class = "progress active shiny-file-input-progress",
htmltools::tags$div(class = "progress-bar")
) )
),
htmltools::tags$input(
type = "text",
class = "form-control",
placeholder = placeholder,
readonly = "readonly",
`aria-label` = "Uploaded file name"
)
),
htmltools::tags$div(
id = paste(inputId, "_progress", sep = ""),
class = "progress active shiny-file-input-progress",
htmltools::tags$div(class = "progress-bar")
) )
)
} }

View File

@@ -8,37 +8,37 @@
#' #'
#' @export #' @export
a11yRadioButtons <- function( a11yRadioButtons <- function(
inputId, label, choices = NULL, selected = NULL, inline = FALSE, inputId, label, choices = NULL, selected = NULL, inline = FALSE,
width = NULL, choiceNames = NULL, choiceValues = NULL width = NULL, choiceNames = NULL, choiceValues = NULL
) { ) {
args <- shiny:::normalizeChoicesArgs(choices, choiceNames, choiceValues) args <- shiny:::normalizeChoicesArgs(choices, choiceNames, choiceValues)
selected <- shiny::restoreInput(id = inputId, default = selected) selected <- shiny::restoreInput(id = inputId, default = selected)
if (is.null(selected)) { if (is.null(selected)) {
selected <- args$choiceValues[[1]] selected <- args$choiceValues[[1]]
} else { } else {
selected <- as.character(selected) selected <- as.character(selected)
} }
if (length(selected) > 1) { if (length(selected) > 1) {
stop("The 'selected' argument must be of length 1") stop("The 'selected' argument must be of length 1")
} }
options <- shiny:::generateOptions( options <- shiny:::generateOptions(
inputId, selected, inline, "radio", args$choiceNames, args$choiceValues inputId, selected, inline, "radio", args$choiceNames, args$choiceValues
) )
ctnrClass <- "form-group shiny-input-radiogroup shiny-input-container" ctnrClass <- "form-group shiny-input-radiogroup shiny-input-container"
if (inline) { if (inline) {
ctnrClass <- paste(ctnrClass, "shiny-input-container-inline") ctnrClass <- paste(ctnrClass, "shiny-input-container-inline")
} }
fieldset <- htmltools::tags$fieldset( fieldset <- htmltools::tags$fieldset(
id = inputId, id = inputId,
style = htmltools::css(width = htmltools::validateCssUnit(width)), style = htmltools::css(width = htmltools::validateCssUnit(width)),
class = ctnrClass, class = ctnrClass,
htmltools::tags$legend(label), htmltools::tags$legend(label),
options options
) )
htmltools::attachDependencies(fieldset, accessibleShinyInputsDependency()) htmltools::attachDependencies(fieldset, a11yShinyInputsDependency())
} }

View File

@@ -1,4 +1,4 @@
accessibleShinyInputsDependency <- function() { a11yShinyInputsDependency <- function() {
if (getOption("shiny.minified", TRUE)) { if (getOption("shiny.minified", TRUE)) {
js <- c("js/a11yShinyInputs.min.js", "js/a11yCheckboxGroupInput.min.js") js <- c("js/a11yShinyInputs.min.js", "js/a11yCheckboxGroupInput.min.js")
css <- "css/a11yShinyInputs.min.css" css <- "css/a11yShinyInputs.min.css"