Accessible alternatives for radioButtons, checkboxGroupInput and fileInput added

2026-01-26 13:20:11 +00:00
parent 7ca1a44d91
commit 04e12d1a36
12 changed files with 499 additions and 0 deletions
--- a/R/a11yFileInput.R
+++ 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")
+        )
+    )
+}