diff --git a/NEWS.md b/NEWS.md
index 0a3d9b5aa..985f78daa 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -12,6 +12,13 @@
* bslib now re-exports `htmltools::css()` to make it easier to specify style declarations. (#1086)
+* `card_image()` was improved in a few ways (#1076):
+ * `alt` is now included in the function inputs and is set to `""` by default. This default value marks images as decorative; please describe the image in the `alt` attribute if it is not decorative.
+ * `border_radius` now defaults to `"auto"` by default, in which case the image's position in the card will automatically determine whether it should receive the `.card-img-top` (first child), `.card-img-bottom` (last child) or `.card-img` (only child).
+ * `file` is designed to accept a path to a local (server-side) file, but now recognizes remote files that start with a protocol prefix, e.g. `https://`, or two slashes, e.g. `//`. Local files are base64-encoded and embedded in the HTML output, while remote files are linked directly. To use a relative path for a file that will be served by the Shiny app, use `src` instead of file, e.g. `card_image(src = "cat.jpg")` where `cat.jpg` is stored in `www/`.
+ * `container` is now `NULL` by default to avoid wrapping the card image in an additional card body container and `fill` is now `FALSE` by default to avoid stretching the image. These changes makes it easier to construct [cards with image caps](https://getbootstrap.com/docs/5.3/components/card/#images).
+
+
## Bug fixes
* `toggle_sidebar()` once again correctly closes a sidebar. (@fredericva, #1043)
diff --git a/R/card.R b/R/card.R
index e782c738f..ab593eff3 100644
--- a/R/card.R
+++ b/R/card.R
@@ -90,6 +90,7 @@ card <- function(
attribs <- args[nzchar(argnames)]
children <- as_card_items(args[!nzchar(argnames)], wrapper = wrapper)
+ children <- card_image_add_classes(children)
is_shiny_input <- !is.null(id)
@@ -248,32 +249,94 @@ card_footer <- function(..., class = NULL) {
)
}
-#' @describeIn card_body Include static (i.e., pre-generated) images.
-#' @param file a file path pointing an image. The image will be base64 encoded
-#' and provided to the `src` attribute of the ``. Alternatively, you may
-#' set this value to `NULL` and provide the `src` yourself.
-#' @param href an optional URL to link to.
-#' @param border_radius where to apply `border-radius` on the image.
-#' @param mime_type the mime type of the `file`.
-#' @param container a function to generate an HTML element to contain the image.
-#' @param width Any valid [CSS unit][htmltools::validateCssUnit] (e.g., `width="100%"`).
+#' @describeIn card_body Include static images in a card, for example as an
+#' image cap at the top or bottom of the card.
+#'
+#' @param file A file path pointing an image. Local images (i.e. not a URI
+#' starting with `https://` or similar) will be base64 encoded and provided to
+#' the `src` attribute of the ``. Alternatively, you may directly set
+#' the image `src`, in which case `file` is ignored.
+#' @param alt Alternate text for the image, used by screen readers and assistive
+#' devices. Provide alt text with a description of the image for any images
+#' with important content. If alt text is not provided, the image will be
+#' considered to be decorative and will not be read or announced by screen
+#' readers.
+#'
+#' For more information, the Web Accessibility Initiative (WAI) has a
+#' [helpful tutorial on alt text](https://www.w3.org/WAI/tutorials/images/).
+#' @param src The `src` attribute of the `` tag. If provided, `file` is
+#' ignored entirely. Use `src` to provide a relative path to a file that will
+#' be served by the Shiny application and should not be base64 encoded.
+#' @param href An optional URL to link to when a user clicks on the image.
+#' @param border_radius Which side of the image should have rounded corners,
+#' useful when `card_image()` is used as an image cap at the top or bottom of
+#' the card.
+#'
+#' The value of `border_radius` determines whether the `card-img-top`
+#' (`"top"`), `card-img-bottom` (`"bottom"`), or `card-img` (`"all"`)
+#' [Bootstrap
+#' classes](https://getbootstrap.com/docs/5.3/components/card/#images) are
+#' applied to the card. The default `"auto"` value will use the image's
+#' position within a `card()` to automatically choose the appropriate class.
+#' @param mime_type The mime type of the `file` when it is base64 encoded. This
+#' argument is available for advanced use cases where [mime::guess_type()] is
+#' unable to automatically determine the file type.
+#' @param container A function to generate an HTML element to contain the image.
+#' Setting this value to `card_body()` places the image inside the card body
+#' area, otherwise the image will extend to the edges of the card.
+#' @param width Any valid [CSS unit][htmltools::validateCssUnit] (e.g.,
+#' `width="100%"`).
+#'
#' @export
card_image <- function(
- file, ..., href = NULL, border_radius = c("top", "bottom", "all", "none"),
- mime_type = NULL, class = NULL, height = NULL, fill = TRUE, width = NULL, container = card_body) {
-
- src <- NULL
- if (length(file) > 0) {
- src <- base64enc::dataURI(
- file = file, mime = mime_type %||% mime::guess_type(file)
- )
+ file,
+ ...,
+ alt = "",
+ src = NULL,
+ href = NULL,
+ border_radius = c("auto", "top", "bottom", "all", "none"),
+ mime_type = NULL,
+ class = NULL,
+ height = NULL,
+ fill = FALSE,
+ width = NULL,
+ container = NULL
+) {
+ if (any(!nzchar(rlang::names2(list(...))))) {
+ rlang::abort(c(
+ "Unnamed arguments were included in `...`.",
+ i = "All additional arguments to `card_image()` in `...` should be named attributes for the `` tag."
+ ))
+ }
+
+ border_radius <- rlang::arg_match(border_radius)
+
+ if (is.null(src)) {
+ if (grepl("^([[:alnum:]]+:)?//|data:", file)) {
+ src <- file
+ } else {
+ if (!file.exists(file)) {
+ rlang::abort(c(
+ sprintf("`file` does not exist: %s", file),
+ i = sprintf(
+ "If `file` is a remote file or will be served by the Shiny app, use a URL or set `src = \"%s\"`.",
+ file
+ )
+ ))
+ }
+ src <- base64enc::dataURI(
+ file = file,
+ mime = mime_type %||% mime::guess_type(file)
+ )
+ }
}
image <- tags$img(
src = src,
+ alt = alt,
class = "img-fluid",
class = switch(
- match.arg(border_radius),
+ border_radius,
all = "card-img",
top = "card-img-top",
bottom = "card-img-bottom",
@@ -295,11 +358,41 @@ card_image <- function(
if (is.function(container)) {
image <- container(image)
+ } else {
+ image <- as.card_item(image)
}
+ class(image) <- c(
+ if (border_radius == "auto") "card_image_auto",
+ "card_image",
+ class(image)
+ )
+
image
}
+card_image_add_classes <- function(children) {
+ for (idx_child in seq_along(children)) {
+ if (inherits(children[[idx_child]], "card_image_auto")) {
+ card_img_class <-
+ if (length(children) == 1) {
+ "card-img"
+ } else if (idx_child == 1) {
+ "card-img-top"
+ } else if (idx_child == length(children)) {
+ "card-img-bottom"
+ }
+
+ children[[idx_child]] <- tagAppendAttributes(
+ children[[idx_child]],
+ class = card_img_class
+ )
+ }
+ }
+
+ children
+}
+
#' @describeIn card_body Mark an object as a card item. This will prevent the
#' [card()] from putting the object inside a `wrapper` (i.e., a
#' `card_body()`).
diff --git a/man/card_body.Rd b/man/card_body.Rd
index ce29c2a78..fe67651c2 100644
--- a/man/card_body.Rd
+++ b/man/card_body.Rd
@@ -32,14 +32,16 @@ card_footer(..., class = NULL)
card_image(
file,
...,
+ alt = "",
+ src = NULL,
href = NULL,
- border_radius = c("top", "bottom", "all", "none"),
+ border_radius = c("auto", "top", "bottom", "all", "none"),
mime_type = NULL,
class = NULL,
height = NULL,
- fill = TRUE,
+ fill = FALSE,
width = NULL,
- container = card_body
+ container = NULL
)
as.card_item(x)
@@ -76,19 +78,46 @@ container.}
\item{class}{Additional CSS classes for the returned UI element.}
-\item{container}{a function to generate an HTML element to contain the image.}
+\item{container}{A function to generate an HTML element to contain the image.
+Setting this value to \code{card_body()} places the image inside the card body
+area, otherwise the image will extend to the edges of the card.}
+
+\item{file}{A file path pointing an image. Local images (i.e. not a URI
+starting with \verb{https://} or similar) will be base64 encoded and provided to
+the \code{src} attribute of the \verb{}. Alternatively, you may directly set
+the image \code{src}, in which case \code{file} is ignored.}
+
+\item{alt}{Alternate text for the image, used by screen readers and assistive
+devices. Provide alt text with a description of the image for any images
+with important content. If alt text is not provided, the image will be
+considered to be decorative and will not be read or announced by screen
+readers.
+
+For more information, the Web Accessibility Initiative (WAI) has a
+\href{https://www.w3.org/WAI/tutorials/images/}{helpful tutorial on alt text}.}
+
+\item{src}{The \code{src} attribute of the \verb{} tag. If provided, \code{file} is
+ignored entirely. Use \code{src} to provide a relative path to a file that will
+be served by the Shiny application and should not be base64 encoded.}
-\item{file}{a file path pointing an image. The image will be base64 encoded
-and provided to the \code{src} attribute of the \verb{}. Alternatively, you may
-set this value to \code{NULL} and provide the \code{src} yourself.}
+\item{href}{An optional URL to link to when a user clicks on the image.}
-\item{href}{an optional URL to link to.}
+\item{border_radius}{Which side of the image should have rounded corners,
+useful when \code{card_image()} is used as an image cap at the top or bottom of
+the card.
-\item{border_radius}{where to apply \code{border-radius} on the image.}
+The value of \code{border_radius} determines whether the \code{card-img-top}
+(\code{"top"}), \code{card-img-bottom} (\code{"bottom"}), or \code{card-img} (\code{"all"})
+\href{https://getbootstrap.com/docs/5.3/components/card/#images}{Bootstrap classes} are
+applied to the card. The default \code{"auto"} value will use the image's
+position within a \code{card()} to automatically choose the appropriate class.}
-\item{mime_type}{the mime type of the \code{file}.}
+\item{mime_type}{The mime type of the \code{file} when it is base64 encoded. This
+argument is available for advanced use cases where \code{\link[mime:guess_type]{mime::guess_type()}} is
+unable to automatically determine the file type.}
-\item{width}{Any valid \link[htmltools:validateCssUnit]{CSS unit} (e.g., \code{width="100\%"}).}
+\item{width}{Any valid \link[htmltools:validateCssUnit]{CSS unit} (e.g.,
+\code{width="100\%"}).}
\item{x}{an object to test (or coerce to) a card item.}
}
@@ -111,7 +140,8 @@ documentation.
\item \code{card_footer()}: A header (with border and background color) for the \code{card()}. Typically appears after a \code{card_body()}.
-\item \code{card_image()}: Include static (i.e., pre-generated) images.
+\item \code{card_image()}: Include static images in a card, for example as an
+image cap at the top or bottom of the card.
\item \code{as.card_item()}: Mark an object as a card item. This will prevent the
\code{\link[=card]{card()}} from putting the object inside a \code{wrapper} (i.e., a
diff --git a/tests/testthat/_snaps/card.md b/tests/testthat/_snaps/card.md
new file mode 100644
index 000000000..a044444dc
--- /dev/null
+++ b/tests/testthat/_snaps/card.md
@@ -0,0 +1,73 @@
+# card_image()
+
+ Code
+ show_raw_html(card(card_image("https://example.com/image.jpg"), card_body(
+ "image cap on top of card")))
+ Output
+
+
+
image cap on top of card
+
+
+
+---
+
+ Code
+ show_raw_html(card(card_body("image cap on bottom of card"), card_image(
+ "https://example.com/image.jpg")))
+ Output
+
+
image cap on bottom of card
+
+
+
+
+---
+
+ Code
+ show_raw_html(card(card_header("header"), card_image(
+ "https://example.com/image.jpg"), card_body("image not a cap")))
+ Output
+
+