R/AVSDevR.A11yShinyInputs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Accessible alternatives for radioButtons, checkboxGroupInput and fileInput added

Browse Source
This commit is contained in:
Craig Williams
2026-01-26 13:20:11 +00:00
parent 7ca1a44d91
commit 04e12d1a36
12 changed files with 499 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
DESCRIPTION
View File

@@ -10,3 +10,8 @@ License: GPL (>= 3)
Encoding: UTF-8 Encoding: UTF-8
Roxygen: list(markdown = TRUE) Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.3 RoxygenNote: 7.3.3
Imports:
htmltools,
jsonlite
Suggests:
shiny

3
NAMESPACE
View File

@@ -1,2 +1,5 @@
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
export(a11yCheckboxGroupInput)
export(a11yFileInput)
export(a11yRadioButtons)

64
R/a11yCheckboxGroupInput.R Normal file
View File

@@ -0,0 +1,64 @@
#' Checkbox Group Input Control
#'
#' Creates more accessible shiny group of shiny checkboxes
#'
#' @inheritParams shiny::checkboxGroupInput
#'
#' @param withSelectAll Create additional "select all"/"clear all" controls
#'
#' @seealso [shiny::checkboxGroupInput()]
#'
#' @export
a11yCheckboxGroupInput <- function(
inputId, label, choices = NULL, selected = NULL, inline = FALSE,
width = NULL, choiceNames = NULL, choiceValues = NULL, withSelectAll = FALSE
) {
args <- shiny:::normalizeChoicesArgs(
choices, choiceNames, choiceValues, FALSE
)
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
)
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
)
htmltools::attachDependencies(fieldset, accessibleShinyInputsDependency())
}

72
R/a11yFileInput.R Normal file
View File

@@ -0,0 +1,72 @@
#' File Upload Control
#'
#' Creates more accessible shiny file upload input.
#'
#' @inheritParams shiny::fileInput
#'
#' @seealso [shiny::fileInput()]
#'
#' @export
a11yFileInput <- function(
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)
}
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 = "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")
)
)
}

44
R/a11yRadioButtons.R Normal file
View File

@@ -0,0 +1,44 @@
#' Create radio buttons
#'
#' Creates more accessible shiny radio buttons
#'
#' @inheritParams shiny::radioButtons
#'
#' @seealso [shiny::radioButtons()]
#'
#' @export
a11yRadioButtons <- function(
inputId, label, choices = NULL, selected = NULL, inline = FALSE,
width = NULL, choiceNames = NULL, choiceValues = NULL
) {
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")
}
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")
}
fieldset <- htmltools::tags$fieldset(
id = inputId,
style = htmltools::css(width = htmltools::validateCssUnit(width)),
class = ctnrClass,
htmltools::tags$legend(label),
options
)
htmltools::attachDependencies(fieldset, accessibleShinyInputsDependency())
}

19
R/deps.R Normal file
View File

@@ -0,0 +1,19 @@
accessibleShinyInputsDependency <- function() {
if (getOption("shiny.minified", TRUE)) {
js <- c("js/a11yShinyInputs.min.js", "js/a11yCheckboxGroupInput.min.js")
css <- "css/a11yShinyInputs.min.css"
} else {
js <- c("js/a11yShinyInputs.js", "js/a11yCheckboxGroupInput.js")
css <- "css/a11yShinyInputs.css"
}
list(
htmltools::htmlDependency(
"A11yShinyInputs",
as.character(utils::packageVersion("AVSDevR.A11yShinyInputs")),
c(file = system.file(package = "AVSDevR.A11yShinyInputs")),
script = js,
stylesheet = css
)
)
}

18
inst/css/a11yShinyInputs.css Normal file
View File

@@ -0,0 +1,18 @@
fieldset.shiny-input-container {
}
fieldset.shiny-input-container .shiny-options-group div.radio:first-child,
fieldset.shiny-input-container .shiny-options-group div.checkbox:first-child {
margin-top: 0px;
}
fieldset.shiny-input-container legend {
margin-bottom: 5px !important;
font-weight: 700 !important;
}
fieldset.shiny-input-container div.select-all-container {
margin-top: -5px;
margin-bottom: 10px;
}

89
inst/js/a11yCheckboxGroupInput.js Normal file
View File

@@ -0,0 +1,89 @@
var a11yCheckboxGroupBinding = new Shiny.InputBinding();
$.extend(a11yCheckboxGroupBinding, {
find: function(scope) {
return $(scope).find(".shiny-input-a11ycheckboxgroup");
},
getValue: function(el) {
// Select the checkbox objects that have name equal to the grouping div's id
const $objs = $('input:checkbox[name="' + el.id + '"]:checked');
const values = new Array($objs.length);
for (let i = 0; i < $objs.length; i++) {
values[i] = $objs[i].value;
}
return values;
},
setValue: function(el, value) {
// Null value should be treated as empty array
value = value || [];
// Clear all checkboxes
$('input:checkbox[name="' + el.id + '"]').prop("checked", false);
// Accept array
if (value instanceof Array) {
for (let i = 0; i < value.length; i++) {
$('input:checkbox[name="' + el.id + '"][value="' + value[i] + '"]')
.prop("checked", true);
}
// Else assume it's a single value
} else {
$('input:checkbox[name="' + el.id + '"][value="' + value + '"]')
.prop("checked", true);
}
},
getState: function(el) {
const $objs = $('input:checkbox[name="' + el.id + '"]');
// Store options in an array of objects, each with with value and label
const options = new Array($objs.length);
for (let i = 0; i < options.length; i++) {
options[i] = {
value: $objs[i].value,
label: getLabel($objs[i])
};
}
return {
label: getLabelNode(el).text(),
value: this.getValue(el),
options: options,
};
},
receiveMessage: async function(el, data) {
const $el = $(el);
// This will replace all the options
if (Object.prototype.hasOwnProperty.call(data, "options") && data["options"] !== undefined) {
// Clear existing options and add each new one
$el.find("div.shiny-options-group").remove();
// Backward compatibility: for HTML generated by shinybootstrap2 package
$el.find("label.checkbox").remove();
$el.append(data.options);
$el.find('.select-all-container').appendTo($el)
}
if (Object.prototype.hasOwnProperty.call(data, "value") && data["value"] !== undefined) {
this.setValue(el, data.value);
}
if (Object.prototype.hasOwnProperty.call(data, "label") && data["label"] !== undefined) {
await updateLabel(data.label, $el.find("legend"));
}
$(el).trigger("change");
},
subscribe: function(el, callback) {
$(el).on("change.checkboxGroupInputBinding", function () {
callback(false);
});
},
unsubscribe: function(el) {
$(el).off(".checkboxGroupInputBinding");
}
});
Shiny.inputBindings.register(a11yCheckboxGroupBinding);

14
inst/js/a11yShinyInputs.js Normal file
View File

@@ -0,0 +1,14 @@
const checkAll = function(event) {
event.preventDefault();
const $input = $(event.target).closest('.shiny-input-a11ycheckboxgroup');
$input.find('input[type=\"checkbox\"]').prop('checked', true);
$input.trigger('change');
return false;
};
const clearAll = function(event) {
event.preventDefault();
const $input = $(event.target).closest('.shiny-input-a11ycheckboxgroup');
$input.find('input[type=\"checkbox\"]').prop('checked', false);
$input.trigger('change');
return false;
};

54
man/a11yCheckboxGroupInput.Rd Normal file
View File

@@ -0,0 +1,54 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/a11yCheckboxGroupInput.R
\name{a11yCheckboxGroupInput}
\alias{a11yCheckboxGroupInput}
\title{Checkbox Group Input Control}
\usage{
a11yCheckboxGroupInput(
inputId,
label,
choices = NULL,
selected = NULL,
inline = FALSE,
width = NULL,
choiceNames = NULL,
choiceValues = NULL,
withSelectAll = FALSE
)
}
\arguments{
\item{inputId}{The \code{input} slot that will be used to access the value.}
\item{label}{Display label for the control, or \code{NULL} for no label.}
\item{choices}{List of values to show checkboxes for. If elements of the list
are named then that name rather than the value is displayed to the user. If
this argument is provided, then \code{choiceNames} and \code{choiceValues}
must not be provided, and vice-versa. The values should be strings; other
types (such as logicals and numbers) will be coerced to strings.}
\item{selected}{The values that should be initially selected, if any.}
\item{inline}{If \code{TRUE}, render the choices inline (i.e. horizontally)}
\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
see \code{\link[shiny:validateCssUnit]{validateCssUnit()}}.}
\item{choiceNames, choiceValues}{List of names and values, respectively,
that are displayed to the user in the app and correspond to the each
choice (for this reason, \code{choiceNames} and \code{choiceValues}
must have the same length). If either of these arguments is
provided, then the other \emph{must} be provided and \code{choices}
\emph{must not} be provided. The advantage of using both of these over
a named list for \code{choices} is that \code{choiceNames} allows any
type of UI object to be passed through (tag objects, icons, HTML code,
...), instead of just simple text. See Examples.}
\item{withSelectAll}{Create additional "select all"/"clear all" controls}
}
\description{
Creates more accessible shiny group of shiny checkboxes
}
\seealso{
\code{\link[shiny:checkboxGroupInput]{shiny::checkboxGroupInput()}}
}

65
man/a11yFileInput.Rd Normal file
View File

@@ -0,0 +1,65 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/a11yFileInput.R
\name{a11yFileInput}
\alias{a11yFileInput}
\title{File Upload Control}
\usage{
a11yFileInput(
inputId,
label,
multiple = FALSE,
accept = NULL,
width = NULL,
buttonLabel = "Browse...",
placeholder = "No file selected",
capture = NULL
)
}
\arguments{
\item{inputId}{The \code{input} slot that will be used to access the value.}
\item{label}{Display label for the control, or \code{NULL} for no label.}
\item{multiple}{Whether the user should be allowed to select and upload
multiple files at once. \strong{Does not work on older browsers, including
Internet Explorer 9 and earlier.}}
\item{accept}{A character vector of "unique file type specifiers" which gives
the browser a hint as to the type of file the server expects. Many browsers
use this prevent the user from selecting an invalid file.
A unique file type specifier can be:
\itemize{
\item A case insensitive extension like \code{.csv} or \code{.rds}.
\item A valid MIME type, like \code{text/plain} or \code{application/pdf}
\item One of \verb{audio/*}, \verb{video/*}, or \verb{image/*} meaning any audio, video,
or image type, respectively.
}}
\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
see \code{\link[shiny:validateCssUnit]{validateCssUnit()}}.}
\item{buttonLabel}{The label used on the button. Can be text or an HTML tag
object.}
\item{placeholder}{The text to show before a file has been uploaded.}
\item{capture}{What source to use for capturing image, audio or video data.
This attribute facilitates user access to a device's media capture
mechanism, such as a camera, or microphone, from within a file upload
control.
A value of \code{user} indicates that the user-facing camera and/or microphone
should be used. A value of \code{environment} specifies that the outward-facing
camera and/or microphone should be used.
By default on most phones, this will accept still photos or video. For
still photos only, also use \code{accept="image/*"}. For video only, use
\code{accept="video/*"}.}
}
\description{
Creates more accessible shiny file upload input.
}
\seealso{
\code{\link[shiny:fileInput]{shiny::fileInput()}}
}

52
man/a11yRadioButtons.Rd Normal file
View File

@@ -0,0 +1,52 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/a11yRadioButtons.R
\name{a11yRadioButtons}
\alias{a11yRadioButtons}
\title{Create radio buttons}
\usage{
a11yRadioButtons(
inputId,
label,
choices = NULL,
selected = NULL,
inline = FALSE,
width = NULL,
choiceNames = NULL,
choiceValues = NULL
)
}
\arguments{
\item{inputId}{The \code{input} slot that will be used to access the value.}
\item{label}{Display label for the control, or \code{NULL} for no label.}
\item{choices}{List of values to select from (if elements of the list are
named then that name rather than the value is displayed to the user). If
this argument is provided, then \code{choiceNames} and \code{choiceValues} must not
be provided, and vice-versa. The values should be strings; other types
(such as logicals and numbers) will be coerced to strings.}
\item{selected}{The initially selected value. If not specified, then it
defaults to the first item in \code{choices}. To start with no items selected,
use \code{character(0)}.}
\item{inline}{If \code{TRUE}, render the choices inline (i.e. horizontally)}
\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
see \code{\link[shiny:validateCssUnit]{validateCssUnit()}}.}
\item{choiceNames, choiceValues}{List of names and values, respectively, that
are displayed to the user in the app and correspond to the each choice (for
this reason, \code{choiceNames} and \code{choiceValues} must have the same length).
If either of these arguments is provided, then the other \emph{must} be provided
and \code{choices} \emph{must not} be provided. The advantage of using both of these
over a named list for \code{choices} is that \code{choiceNames} allows any type of UI
object to be passed through (tag objects, icons, HTML code, ...), instead
of just simple text. See Examples.}
}
\description{
Creates more accessible shiny radio buttons
}
\seealso{
\code{\link[shiny:radioButtons]{shiny::radioButtons()}}
}