diff --git a/DESCRIPTION b/DESCRIPTION index 191665f..5f767a5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -34,3 +34,4 @@ Suggests: testthat, rsvg Roxygen: list(markdown = TRUE) +Config/testthat/edition: 3 diff --git a/R/fa.R b/R/fa.R index 85a3d1d..eb9d238 100644 --- a/R/fa.R +++ b/R/fa.R @@ -118,12 +118,7 @@ fa <- function(name, } # Initialize vectors for extra SVG attributes and for the tag - extra_attrs <- "" - title_tag <- "" - - # Generate the viewBox value through use of the only - # changing value: the width - viewbox_value <- c(`min-x` = 0, `min-y` = 0, width = svg_list$width, height = 512) + svg_attrs <- list() # Generate the appropriate height and width attributes based on # user input and the SVG viewBox dimensions @@ -159,7 +154,7 @@ fa <- function(name, get_length_value_unit(css_length = height) get_length_value_unit(css_length = width) - extra_attrs <- "preserveAspectRatio=\"none\" " + svg_attrs$preserveAspectRatio <- "none" height_attr <- height width_attr <- width @@ -167,69 +162,54 @@ fa <- function(name, # Generate accessibility attributes if either of # the "deco" or "sem" cases are chosen - if (a11y == "none") { + if (a11y == "deco") { - if (!is.null(title)) { - title_tag <- paste0("<title>", htmlEscape(title), "") - } - } else if (a11y == "deco") { + svg_attrs[["aria-hidden"]] <- "true" + svg_attrs$role <- "img" - extra_attrs <- paste0(extra_attrs, "aria-hidden=\"true\" role=\"img\" ") + } else if (a11y == "sem") { - if (!is.null(title)) { - title_tag <- paste0("", htmlEscape(title), "") - } + title <- title %||% fa_tbl$label[idx][1] + svg_attrs[["aria-label"]] <- htmlEscape(title, attribute = TRUE) + svg_attrs$role <- "img" - } else { - # The 'semantic' case - - if (is.null(title)) { - title <- fa_tbl$label[idx][1] - } - - extra_attrs <- - paste0( - extra_attrs, - "aria-label=\"", - htmlEscape(title, attribute = TRUE), "\" ", - "role=\"img\" " - ) - - title_tag <- - paste0("", htmlEscape(title), "") } - svg <- - paste0( - "", - title_tag, - svg_list$path, - "" + # Generate the viewBox value through use of the only + # changing value: the width + viewbox <- c(`min-x` = 0, `min-y` = 0, width = svg_list$width, height = 512) + + svg <- tags$svg( + !!!svg_attrs, + viewBox = paste0(viewbox, collapse = " "), + style = css( + height = height_attr, + width = width_attr, + vertical_align = "-0.125em", + margin_left = margin_left %||% "auto", + margin_right = margin_right %||% "auto", + font_size = "inherit", + fill = fill %||% "currentColor", + overflow = "visible", + fill_opacity = fill_opacity, + stroke = stroke, + stroke_width = stroke_width, + stroke_opacity = stroke_opacity, + position = position %||% "relative" ) + ) + + if (!is.null(title)) { + svg <- tagAppendChild(svg, tags$title(title)) + } - svg <- HTML(svg) + path_d <- extract_group(svg_list$path, 'path d="(.+)"') + svg <- tagAppendChild(svg, tags$path(d = path_d)) structure(svg, class = c("fontawesome", "svg", class(svg)), - viewbox = viewbox_value, + viewbox = viewbox, size = c(h = height_attr, w = width_attr) ) } diff --git a/R/utils.R b/R/utils.R index d633983..4943163 100644 --- a/R/utils.R +++ b/R/utils.R @@ -4,4 +4,9 @@ if (is.null(x)) y else x } +extract_group <- function(x, pattern, which = 1) { + matches <- regmatches(x, regexec(pattern, x)) + vapply(matches, function(x) x[which + 1], character(1)) +} + # nocov end diff --git a/tests/testthat/_snaps/fa_icon.md b/tests/testthat/_snaps/fa_icon.md new file mode 100644 index 0000000..cb5c809 --- /dev/null +++ b/tests/testthat/_snaps/fa_icon.md @@ -0,0 +1,32 @@ +# getting a basic FA icon works + + Code + fa(name = "file") + Output + + +--- + + Code + fa(name = "fas fa-file") + Output + + +# the `fa_i()` function returns an icon object + + Code + cat(as.character(icon)) + Output + + +--- + + Code + cat(as.character(fa_i(name = "r-project", height = "20px", title = "R project"))) + Output + + diff --git a/tests/testthat/test-fa_icon.R b/tests/testthat/test-fa_icon.R index 2761b10..3dcafc0 100644 --- a/tests/testthat/test-fa_icon.R +++ b/tests/testthat/test-fa_icon.R @@ -2,17 +2,11 @@ test_that("getting a basic FA icon works", { # Emit a Font Awesome icon (`file`) as SVG within `svg` tags; # refer to the icon with the 'short' name - expect_equal( - as.character(fa(name = "file")), - "" - ) + expect_snapshot(fa(name = "file")) # Emit a Font Awesome icon (`file`) as SVG within `` tags; # refer to the icon with the 'long' name - expect_equal( - as.character(fa(name = "fas fa-file")), - "" - ) + expect_snapshot(fa(name = "fas fa-file")) # In that case that an icon cannot be retrieved, # expect that the function stops @@ -41,13 +35,10 @@ test_that("the `fa_i()` function returns an icon object", { icon <- fa_i(name = "r-project") - expect_equal( - as.character(icon), - "" - ) + expect_snapshot(cat(as.character(icon))) # Expect that the `icon` object is a `shiny.tag` - expect_is(icon, "shiny.tag") + expect_s3_class(icon, "shiny.tag") # Expect that the `icon` object is a list with # specific element names @@ -69,13 +60,9 @@ test_that("the `fa_i()` function returns an icon object", { c("names", "class", "html_dependencies", "browsable_html") ) - # Add a style rule to the icon - icon_2 <- fa_i(name = "r-project", height = "20px") - # Expect the style property to render in the `` tag - expect_equal( - as.character(icon_2), - "" + expect_snapshot( + cat(as.character(fa_i(name = "r-project", height = "20px", title = "R project"))) ) })