Only process standalone images into figures

NEWS.md

@@ -7,7 +7,8 @@
   (reported: @debpaul, 
   https://github.com/datacarpentry/OpenRefine-ecology-lesson/issues/292 and
   @bencomp, #454; fixed: @zkamvar, #467)
-
+* Inline images are no longer automatically transformed to figure blocks.
+  (reported: @ostephens, #445; fixed: @zkamvar, #446)
 
 ## MISC
 

R/build_images.R

@@ -1,11 +1,11 @@
 #' @rdname build_agg
 build_images <- function(pkg, pages = NULL, quiet = FALSE) {
-  build_agg_page(pkg = pkg, 
-    pages = pages, 
-    title = "All Images", 
-    slug = "images", 
-    aggregate = "/figure", 
-    prefix = FALSE, 
+  build_agg_page(pkg = pkg,
+    pages = pages,
+    title = "All Images",
+    slug = "images",
+    aggregate = "/img/..",
+    prefix = FALSE,
     quiet = quiet)
 }
 
@@ -16,7 +16,7 @@ build_images <- function(pkg, pages = NULL, quiet = FALSE) {
 #'
 #' @param name the name of the section, (may or may not be prefixed with `images-`)
 #' @param contents an `xml_nodeset` of figure elements from [get_content()]
-#' @param parent the parent div of the images page 
+#' @param parent the parent div of the images page
 #' @return the section that was added to the parent
 #'
 #' @keywords internal
@@ -25,7 +25,7 @@ build_images <- function(pkg, pages = NULL, quiet = FALSE) {
 #' if (FALSE) {
 #' lsn <- "/path/to/lesson"
 #' pkg <- pkgdown::as_pkgdown(fs::path(lsn, "site"))
-#' 
+#'
 #' # read in the All in One page and extract its content
 #' img <- get_content("images", content = "self::*", pkg = pkg)
 #' fig_content <- get_content("01-introduction", content = "/figure", pkg = pkg)
@@ -44,7 +44,7 @@ make_images_section <- function(name, contents, parent) {
     content <- contents[[element]]
     alt     <- xml2::xml_text(xml2::xml_find_all(content, "./img/@alt"))
     n <- length(alt)
-    xml2::xml_add_child(section, "h3", glue::glue("Figure {element}"), 
+    xml2::xml_add_child(section, "h3", glue::glue("Figure {element}"),
       id = glue::glue("{name}-figure-{element}"))
     for (i in seq_along(alt)) {
       txt <- alt[[i]]

R/utils-xml.R

@@ -53,20 +53,31 @@ add_code_heading <- function(codes = NULL, labels = "OUTPUT") {
 
 fix_figures <- function(nodes = NULL) {
   if (length(nodes) == 0) return(nodes)
-  figs <- xml2::xml_find_all(nodes, ".//img")
+  imgs <- xml2::xml_find_all(nodes, ".//img")
+  add_class(imgs, "figure")
+  # make sure to grab the figures. These could be obvious
+  fig_XPath <- ".//div[@class='figure' or @class='float']/img"
+  # or they could be bare HTML image tags that were never converted
+  lone_img_XPath <- ".//p[count(descendant::*)=1 and count(text())=0]/img"
+  XPath <- glue::glue("{fig_XPath} | {lone_img_XPath}")
+  figs <- xml2::xml_find_all(nodes, XPath)
   caps <- xml2::xml_find_all(nodes, ".//p[@class='caption']")
   fig_element <- xml2::xml_parent(figs)
-  classes <- xml2::xml_attr(figs, "class")
-  classes <- ifelse(is.na(classes), "", classes)
-  classes <- paste(classes, "figure mx-auto d-block")
-  xml2::xml_set_attr(figs, "class", trimws(classes))
+  add_class(figs, "mx-auto d-block")
   xml2::xml_set_name(caps, "figcaption")
   xml2::xml_set_attr(caps, "class", NULL)
   xml2::xml_set_name(fig_element, "figure")
   xml2::xml_set_attr(fig_element, "class", NULL)
   invisible(nodes)
 }
 
+add_class <- function(nodes, new) {
+  classes <- xml2::xml_attr(nodes, "class")
+  classes <- ifelse(is.na(classes), "", classes)
+  classes <- paste(classes, new)
+  xml2::xml_set_attr(nodes, "class", trimws(classes))
+}
+
 add_anchors <- function(nodes, ids) {
   anchor <- paste0(
     "<a class='anchor' aria-label='anchor' href='#", ids, "'></a>"

tests/testthat/examples/figures.md

@@ -0,0 +1,14 @@
+[![](https://placekitten.com/100/100){alt="hey cutie"}](https://example.com/thing)
+
+ - one
+ - two
+ - kitty! ![look at her](https://placekitten.com/20/20){alt="cutie"}
+
+an inline image ![hey](https://placekitten.com/30/30){alt="cutie too"}
+
+![this is a normal image](https://placekitten.com/400/400){alt="test alt"}
+
+<img src="https://placekitten.com/404/404" alt='should also be a normal image'>
+
+![this is a harder normal image pt 1](https://placekitten.com/500/500){alt="test alt again"}
+![this is a harder normal image pt 2](https://placekitten.com/600/600){alt="test alt again"}

tests/testthat/test-utils-xml.R

@@ -24,6 +24,32 @@ test_that("paths in instructor view that are nested or not HTML get diverted", {
 })
 
 
+
+test_that("fix figures account for inline images and do not clobber them into figures", {
+  skip_if_not(rmarkdown::pandoc_available("2.11"))
+  test_md <- fs::path_abs(test_path("examples/figures.md"))
+  raw <- render_html(test_md)
+  html <- xml2::read_html(raw)
+  fix_figures(html)
+
+  # there should be six images, but only two of them are figures
+  figgies <- xml2::xml_find_all(html, ".//figure")
+  kitties <- xml2::xml_find_all(html, ".//img")
+  expect_length(figgies, 2L)
+  expect_length(kitties, 7L)
+  expected_classes <- c("figure", "figure", "figure",
+    "figure mx-auto d-block", "figure mx-auto d-block", "figure", "figure")
+  expect_equal(xml2::xml_attr(kitties, "class"), expected_classes)
+
+  # The immediate parents of the kitties should be a link, list, paragraph, and
+  # two figures and a paragraph.
+  rents   <- xml2::xml_parent(kitties)
+  expect_equal(xml2::xml_name(rents),
+    c("a", "li", "p", "figure", "figure", "p"))
+})
+
+
+
 test_that("callout ids are processed correctly", {
   html_test <- xml2::read_html(test_path("examples/callout-ids.html"))
   fix_callouts(html_test)