Fix up knitr paths relative to the output directory

hadley · hadley · commit 5703b34f85bc · 2024-04-25T17:03:40.000-05:00
For some unknown reason, `knitr_print()` methods sometimes produces paths are relative to the input directory, rather than to the output directory. This PR re-parents those to paths to be relative to the output directory making them work again. Fixes r-lib#2334. Fixes r-lib#2341.
diff --git a/R/rmarkdown.R b/R/rmarkdown.R
@@ -56,7 +56,8 @@ render_rmarkdown <- function(pkg, input, output, ..., seed = NULL, copy_images =
     update_html(
       path,
       tweak_rmarkdown_html,
-      input_path = path_dir(input_path),
+      output_dir = path_dir(output_path),
+      input_dir = path_dir(input_path),
       pkg = pkg
     )
   }
diff --git a/R/tweak-page.R b/R/tweak-page.R
@@ -37,19 +37,37 @@ tweak_page <- function(html, name, pkg = list(bs_version = 3)) {
   }
 }
 
-tweak_rmarkdown_html <- function(html, input_path, pkg = list(bs_version = 3)) {
+tweak_rmarkdown_html <- function(html, input_dir, output_dir, pkg = list(bs_version = 3)) {
   # Tweak classes of navbar
   toc <- xml2::xml_find_all(html, ".//div[@id='tocnav']//ul")
   xml2::xml_attr(toc, "class") <- "nav nav-pills nav-stacked"
 
-  # Make sure all images use relative paths
   img <- xml2::xml_find_all(html, "//img")
   src <- xml2::xml_attr(img, "src")
+
+  # Drop the logo and any inline images
+  is_ok <- !grepl("^data:", src) & xml2::xml_attr(img, "class", default = "") != "logo"
+  img <- img[is_ok]
+  src <- src[is_ok]
+
+  # Fix up absoluate paths to be relative to input_dir
   abs_src <- is_absolute_path(src)
   if (any(abs_src)) {
     purrr::walk2(
       img[abs_src],
-      path_rel(src[abs_src], input_path),
+      path_rel(src[abs_src], input_dir),
+      xml2::xml_set_attr,
+      attr = "src"
+    )
+  }
+
+  # Fix up paths that are relative to input_dir instead of output_dir
+  input_abs_path <- path_tidy(path(input_dir, src))
+  up_path <- !abs_src & path_has_parent(input_abs_path, output_dir)
+  if (any(up_path)) {
+    purrr::walk2(
+      img[up_path],
+      path_rel(path(input_dir, src[up_path]), output_dir),
       xml2::xml_set_attr,
       attr = "src"
     )
diff --git a/tests/testthat/test-tweak-page.R b/tests/testthat/test-tweak-page.R
@@ -125,7 +125,7 @@ test_that("h1 section headings adjusted to h2 (and so on)", {
       <h1>2</h1>
     </div>
   ")
-  tweak_rmarkdown_html(html)
+  tweak_rmarkdown_html(html, input_dir = ".", output_dir = ".")
   expect_equal(xpath_text(html, ".//h1"), "Title")
   expect_equal(xpath_text(html, ".//h2"), c("1", "2"))
   expect_equal(xpath_text(html, ".//h3"), "1.1")
diff --git a/vignettes/img-path.Rmd b/vignettes/img-path.Rmd
@@ -0,0 +1,29 @@
+---
+title: "imgpathdebug"
+---
+
+```{r}
+plot(1:5)
+```
+
+```{r}
+knitr::include_graphics("test/bacon.jpg")
+```
+
+```{r}
+# magick:::`knit_print.magick-image`()
+magick::image_read("https://jeroen.github.io/images/frink.png")
+```
+
+```{r}
+library(ggplot2)
+library(gganimate)
+
+p <- ggplot(mtcars, aes(factor(cyl), mpg)) + 
+  geom_point() + 
+  # Here comes the gganimate code
+  transition_states(gear)
+
+animate(p, nframes = 1)
+```
+

Original file line number	Diff line number	Diff line change
`@@ -56,7 +56,8 @@ render_rmarkdown <- function(pkg, input, output, ..., seed = NULL, copy_images =`
`56`	`56`	`update_html(`
`57`	`57`	`path,`
`58`	`58`	`tweak_rmarkdown_html,`
`59`		`- input_path = path_dir(input_path),`
	`59`	`+ output_dir = path_dir(output_path),`
	`60`	`+ input_dir = path_dir(input_path),`
`60`	`61`	`pkg = pkg`
`61`	`62`	`)`
`62`	`63`	`}`