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
a11yCheckboxGroupInput <- function(
inputId, label, choices = NULL, selected = NULL, inline = FALSE,
width = NULL, choiceNames = NULL, choiceValues = NULL, withSelectAll = FALSE
inputId, label, choices = NULL, selected = NULL, inline = FALSE,
width = NULL, choiceNames = NULL, choiceValues = NULL, withSelectAll = FALSE
) {
args <- shiny:::normalizeChoicesArgs(
choices, choiceNames, choiceValues, FALSE
)
args <- shiny:::normalizeChoicesArgs(
choices, choiceNames, choiceValues, FALSE
)
selected <- shiny::restoreInput(id = inputId, default = selected)
if (!is.null(selected)) {
selected <- as.character(selected)
}
selected <- shiny::restoreInput(id = inputId, default = selected)
if (!is.null(selected)) {
selected <- as.character(selected)
}
options <- shiny:::generateOptions(
inputId, selected, inline, "checkbox", args$choiceNames,
args$choiceValues
)
options <- shiny:::generateOptions(
inputId, selected, inline, "checkbox", args$choiceNames,
args$choiceValues
)
ctnrClass <- "form-group shiny-input-a11ycheckboxgroup shiny-input-container"
if (inline) {
ctnrClass <- paste(ctnrClass, "shiny-input-container-inline")
}
ctnrClass <- "form-group shiny-input-a11ycheckboxgroup shiny-input-container"
if (inline) {
ctnrClass <- paste(ctnrClass, "shiny-input-container-inline")
}
selectAll <- NULL
if (withSelectAll) {
sa <- htmltools::tags$a(
href = "#",
onclick = "return checkAll(event)",
"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
selectAll <- NULL
if (withSelectAll) {
sa <- htmltools::tags$a(
href = "#",
onclick = "return checkAll(event)",
"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"
)
}
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
a11yFileInput <- function(
inputId, label, multiple = FALSE, accept = NULL, width = NULL,
buttonLabel = "Browse...", placeholder = "No file selected",
capture = NULL
inputId, label, multiple = FALSE, accept = NULL, width = NULL,
buttonLabel = "Browse...", placeholder = "No file selected",
capture = NULL
) {
restoredValue <- shiny::restoreInput(id = inputId, default = NULL)
if (!is.null(restoredValue) && !is.data.frame(restoredValue)) {
warning("Restored value for ", inputId, " has incorrect format.")
restoredValue <- NULL
}
if (!is.null(restoredValue)) {
restoredValue <- jsonlite::toJSON(restoredValue, strict_atomic = FALSE)
}
restoredValue <- shiny::restoreInput(id = inputId, default = NULL)
if (!is.null(restoredValue) && !is.data.frame(restoredValue)) {
warning("Restored value for ", inputId, " has incorrect format.")
restoredValue <- NULL
}
if (!is.null(restoredValue)) {
restoredValue <- jsonlite::toJSON(restoredValue, strict_atomic = FALSE)
}
inputTag <- htmltools::tags$input(
id = inputId,
class = "shiny-input-file",
name = inputId,
type = "file",
style = "position: absolute !important; top: -99999px !important; left: -99999px !important;",
`data-restore` = restoredValue
)
if (multiple) {
inputTag$attribs$multiple <- "multiple"
}
if (length(accept) > 0) {
inputTag$attribs$accept <- paste(accept, collapse = ",")
}
if (!is.null(capture)) {
inputTag$attribs$capture <- capture
}
inputTag <- htmltools::tags$input(
id = inputId,
class = "shiny-input-file",
name = inputId,
type = "file",
style = "position: absolute !important; top: -99999px !important; \
left: -99999px !important;",
`data-restore` = restoredValue
)
if (multiple) {
inputTag$attribs$multiple <- "multiple"
}
if (length(accept) > 0) {
inputTag$attribs$accept <- paste(accept, collapse = ",")
}
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(
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(
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")
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")
)
)
}

View File

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

View File

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