diff --git a/DESCRIPTION b/DESCRIPTION index e98b7dd..79c1a68 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,3 +10,8 @@ License: GPL (>= 3) Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.3 +Imports: + htmltools, + jsonlite +Suggests: + shiny diff --git a/NAMESPACE b/NAMESPACE index 6ae9268..d2561f8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,2 +1,5 @@ # Generated by roxygen2: do not edit by hand +export(a11yCheckboxGroupInput) +export(a11yFileInput) +export(a11yRadioButtons) diff --git a/R/a11yCheckboxGroupInput.R b/R/a11yCheckboxGroupInput.R new file mode 100644 index 0000000..ce29f25 --- /dev/null +++ b/R/a11yCheckboxGroupInput.R @@ -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()) +} diff --git a/R/a11yFileInput.R b/R/a11yFileInput.R new file mode 100644 index 0000000..38c49cb --- /dev/null +++ b/R/a11yFileInput.R @@ -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") + ) + ) +} diff --git a/R/a11yRadioButtons.R b/R/a11yRadioButtons.R new file mode 100644 index 0000000..5bc5fd9 --- /dev/null +++ b/R/a11yRadioButtons.R @@ -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()) +} diff --git a/R/deps.R b/R/deps.R new file mode 100644 index 0000000..3ef7f4f --- /dev/null +++ b/R/deps.R @@ -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 + ) + ) +} diff --git a/inst/css/a11yShinyInputs.css b/inst/css/a11yShinyInputs.css new file mode 100644 index 0000000..1448033 --- /dev/null +++ b/inst/css/a11yShinyInputs.css @@ -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; +} \ No newline at end of file diff --git a/inst/js/a11yCheckboxGroupInput.js b/inst/js/a11yCheckboxGroupInput.js new file mode 100644 index 0000000..f9606a8 --- /dev/null +++ b/inst/js/a11yCheckboxGroupInput.js @@ -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); \ No newline at end of file diff --git a/inst/js/a11yShinyInputs.js b/inst/js/a11yShinyInputs.js new file mode 100644 index 0000000..41541dc --- /dev/null +++ b/inst/js/a11yShinyInputs.js @@ -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; +}; \ No newline at end of file diff --git a/man/a11yCheckboxGroupInput.Rd b/man/a11yCheckboxGroupInput.Rd new file mode 100644 index 0000000..c884308 --- /dev/null +++ b/man/a11yCheckboxGroupInput.Rd @@ -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()}} +} diff --git a/man/a11yFileInput.Rd b/man/a11yFileInput.Rd new file mode 100644 index 0000000..525c4b6 --- /dev/null +++ b/man/a11yFileInput.Rd @@ -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()}} +} diff --git a/man/a11yRadioButtons.Rd b/man/a11yRadioButtons.Rd new file mode 100644 index 0000000..831dd00 --- /dev/null +++ b/man/a11yRadioButtons.Rd @@ -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()}} +}