Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Have fa() return a htmltools::tag() object #59

Open
wants to merge 5 commits into
base: main
Choose a base branch
from
Open

Have fa() return a htmltools::tag() object #59

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
1790590
Close #58: have fa() return a htmltools::tag() object
cpsievert May 11, 2021
14af9b8
Use vapply() instead of sapply()
cpsievert May 11, 2021
94f91e9
Update R/fa.R
cpsievert May 11, 2021
18f2dbf
Fix fa_i() snapshot tests and add one with a title
cpsievert May 11, 2021
876bc6e
code review
cpsievert May 12, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,3 +34,4 @@ Suggests:
testthat,
rsvg
Roxygen: list(markdown = TRUE)
Config/testthat/edition: 3
96 changes: 38 additions & 58 deletions R/fa.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -118,12 +118,7 @@ fa <- function(name,
}

# Initialize vectors for extra SVG attributes and for the <title> 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
Expand Down Expand Up @@ -159,77 +154,62 @@ 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
}

# 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), "</title>")
cpsievert marked this conversation as resolved.
Show resolved Hide resolved
}

} 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("<title>", htmlEscape(title), "</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("<title>", htmlEscape(title), "</title>")
}

svg <-
paste0(
"<svg ",
extra_attrs,
"viewBox=\"", paste0(viewbox_value, collapse = " "), "\" " ,
"style=\"",
"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;",
if (!is.null(fill_opacity)) paste0("fill-opacity:", fill_opacity, ";"),
if (!is.null(stroke)) paste0("stroke:", stroke, ";"),
if (!is.null(stroke_width)) paste0("stroke-width:", stroke_width, ";"),
if (!is.null(stroke_opacity)) paste0("stroke-opacity:", stroke_opacity, ";"),
"position:", position %||% "relative", ";",
"\">",
title_tag,
svg_list$path,
"</svg>"
# 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)
)
}
Expand Down
5 changes: 5 additions & 0 deletions R/utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
32 changes: 32 additions & 0 deletions tests/testthat/_snaps/fa_icon.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,32 @@
# getting a basic FA icon works

Code
fa(name = "file")
Output
<svg aria-hidden="true" role="img" viewBox="0 0 384 512" style="height:1em;width:0.75em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;">
<path d="M224 136V0H24C10.7 0 0 10.7 0 24v464c0 13.3 10.7 24 24 24h336c13.3 0 24-10.7 24-24V160H248c-13.2 0-24-10.8-24-24zm160-14.1v6.1H256V0h6.1c6.4 0 12.5 2.5 17 7l97.9 98c4.5 4.5 7 10.6 7 16.9z"></path>
</svg>

---

Code
fa(name = "fas fa-file")
Output
<svg aria-hidden="true" role="img" viewBox="0 0 384 512" style="height:1em;width:0.75em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;">
<path d="M224 136V0H24C10.7 0 0 10.7 0 24v464c0 13.3 10.7 24 24 24h336c13.3 0 24-10.7 24-24V160H248c-13.2 0-24-10.8-24-24zm160-14.1v6.1H256V0h6.1c6.4 0 12.5 2.5 17 7l97.9 98c4.5 4.5 7 10.6 7 16.9z"></path>
</svg>

# the `fa_i()` function returns an icon object

Code
cat(as.character(icon))
Output
<i class="fab fa-r-project" role="presentation" aria-label="r-project icon"></i>

---

Code
cat(as.character(fa_i(name = "r-project", height = "20px", title = "R project")))
Output
<i class="fab fa-r-project" role="presentation" aria-label="r-project icon" height="20px" title="R project"></i>

25 changes: 6 additions & 19 deletions tests/testthat/test-fa_icon.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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")),
"<svg aria-hidden=\"true\" role=\"img\" viewBox=\"0 0 384 512\" style=\"height:1em;width:0.75em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;\"><path d=\"M224 136V0H24C10.7 0 0 10.7 0 24v464c0 13.3 10.7 24 24 24h336c13.3 0 24-10.7 24-24V160H248c-13.2 0-24-10.8-24-24zm160-14.1v6.1H256V0h6.1c6.4 0 12.5 2.5 17 7l97.9 98c4.5 4.5 7 10.6 7 16.9z\"/></svg>"
)
expect_snapshot(fa(name = "file"))

# Emit a Font Awesome icon (`file`) as SVG within `<svg>` tags;
# refer to the icon with the 'long' name
expect_equal(
as.character(fa(name = "fas fa-file")),
"<svg aria-hidden=\"true\" role=\"img\" viewBox=\"0 0 384 512\" style=\"height:1em;width:0.75em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;\"><path d=\"M224 136V0H24C10.7 0 0 10.7 0 24v464c0 13.3 10.7 24 24 24h336c13.3 0 24-10.7 24-24V160H248c-13.2 0-24-10.8-24-24zm160-14.1v6.1H256V0h6.1c6.4 0 12.5 2.5 17 7l97.9 98c4.5 4.5 7 10.6 7 16.9z\"/></svg>"
)
expect_snapshot(fa(name = "fas fa-file"))

# In that case that an icon cannot be retrieved,
# expect that the function stops
Expand Down Expand Up @@ -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),
"<i class=\"fab fa-r-project\" role=\"presentation\" aria-label=\"r-project icon\"></i>"
)
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
Expand All @@ -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 `<i>` tag
expect_equal(
as.character(icon_2),
"<i class=\"fab fa-r-project\" role=\"presentation\" aria-label=\"r-project icon\" height=\"20px\"></i>"
expect_snapshot(
cat(as.character(fa_i(name = "r-project", height = "20px", title = "R project")))
)
})

Expand Down