Merge branch 'carpentries:main' into l2d

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sandpaper
 Title: Create and Curate Carpentries Lessons
-Version: 0.11.17
+Version: 0.12.0
 Authors@R: c(
     person(given = "Zhian N.",
            family = "Kamvar",

NEWS.md

@@ -1,4 +1,28 @@
-# sandpaper 0.11.17 (unreleased)
+# sandpaper 0.12.0 (2023-05-19)
+
+## NEW FEATURES
+
+* Aggregate instructor notes now have headings that link back to the source
+  instructor note (reported: @tobyhodges, #463; fixed: @zkamvar, #468)
+* The internal function `sandpaper:::render_html()` now explicitly sets the
+  pandoc version before running the subprocess. This allows lesson developers to
+  use the {pandoc} package to set their pandoc versions. (reported: @zkamvar,
+  #465; fixed: @zkamvar, #465)
+
+## BUG FIX
+
+* Callout block anchor links now point to the correct ID of the block derived
+  from the title of the block (as opposed to the generic ID). 
+  (reported: @debpaul, 
+  https://github.com/datacarpentry/OpenRefine-ecology-lesson/issues/292 and
+  @bencomp, #454; fixed: @zkamvar, #467).
+* Inline images no longer automatically transform to figure blocks
+  (reported: @ostephens, #445; fixed: @zkamvar, #446). This bug was preventing
+  image links (e.g. MyBinder badges) from being rendered as links with images
+  in them. This fixes that issue. It also helps distinguish inline images
+  between figures in the DOM.
+
+# sandpaper 0.11.17 (2023-05-16)
 
 ## NEW FEATURES
 

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/build_instructor_notes.R

@@ -5,9 +5,9 @@ build_instructor_notes <- function(pkg, pages = NULL, built = NULL, quiet) {
   path <- root_path(pkg$src_path)
   this_lesson(path)
   outpath <- fs::path(pkg$dst_path, "instructor-notes.html")
-  already_built <- template_check$valid() && 
-    fs::file_exists(outpath) && 
-    !is.null(built) && 
+  already_built <- template_check$valid() &&
+    fs::file_exists(outpath) &&
+    !is.null(built) &&
     !"instructor-notes" %in% get_slug(built)
   if (!already_built) {
     page_globals <- setup_page_globals()
@@ -35,24 +35,25 @@ build_instructor_notes <- function(pkg, pages = NULL, built = NULL, quiet) {
     build_html(template = "extra", pkg = pkg, nodes = html,
       global_data = page_globals, path_md = "instructor-notes.html", quiet = TRUE)
   }
-  build_agg_page(pkg = pkg, 
-    pages = pages, 
-    title = this_dat$pagetitle, 
-    slug = "instructor-notes", 
-    aggregate = "/div[contains(@class, 'instructor-note')]//div[@class='accordion-body']", 
+  agg <- "/div[contains(@class, 'instructor-note')]//*[@class='accordion-body' or @class='accordion-header']"
+  build_agg_page(pkg = pkg,
+    pages = pages,
+    title = this_dat$pagetitle,
+    slug = "instructor-notes",
+    aggregate = agg,
     append = "section[@id='aggregate-instructor-notes']",
-    prefix = FALSE, 
+    prefix = FALSE,
     quiet = quiet)
 }
 
 #' Make a section of aggregated instructor notes
 #'
 #' This will append instructor notes from the inline sections of the lesson to
-#' the instructor-notes page, separated by section and `<hr>` elements. 
+#' the instructor-notes page, separated by section and `<hr>` elements.
 #'
 #' @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
 #' @note On the learner view, instructor notes will not be present
 #'
@@ -62,19 +63,19 @@ build_instructor_notes <- function(pkg, pages = NULL, built = NULL, quiet) {
 #' 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
 #' notes <- get_content("instructor-notes", content =
 #'   "section[@id='aggregate-instructor-notes']", pkg = pkg, instructor = TRUE)
 #' agg <- "/div[contains(@class, 'instructor-note')]//div[@class='accordion-body']"
 #' note_content <- get_content("01-introduction", content = agg, pkg = pkg)
-#' make_instructornotes_section("01-introduction", contents = note_content, 
+#' make_instructornotes_section("01-introduction", contents = note_content,
 #'   parent = notes)
 #'
 #' # NOTE: if the object for "contents" ends with "_learn", no content will be
 #' # appended
 #' note_learn <- note_content
-#' make_instructornotes_section("01-introduction", contents = note_learn, 
+#' make_instructornotes_section("01-introduction", contents = note_learn,
 #'   parent = notes)
 #'
 #' }
@@ -94,10 +95,33 @@ make_instructornotes_section <- function(name, contents, parent) {
   </section>"
   section <- xml2::read_xml(glue::glue(new_section))
   for (element in contents) {
+    is_heading  <- xml2::xml_name(element) == "h3" &
+      xml2::xml_attr(element, "class") == "accordion-header"
+    if (is_heading) {
+      # when we have an instructor note heading, we need to just add it and
+      # then skip to the next section, which is the body.
+      lnk <- make_instructor_note_linkback(element, name)
+      xml2::xml_add_child(section, lnk)
+      next
+    }
     for (child in xml2::xml_children(element)) {
       xml2::xml_add_child(section, child)
     }
     xml2::xml_add_child(section, "hr")
+    xml2::xml_add_child(section, "br")
   }
   xml2::xml_add_child(parent, section)
 }
+
+make_instructor_note_linkback <- function(node, name) {
+  # we need to just make a completely new node out of the heading because
+  # the accordion contains a bunch of junk.
+  title <- trimws(xml2::xml_text(node))
+  id <- xml2::xml_attr(node, "id")
+  newid <- glue::glue("{name}-{id}")
+  anchor <- glue::glue("<a class='anchor' aria-label='anchor' href='#{newid}'></a>")
+  new <- "<h3><a href='{name}.html#{id}'>{title}</a>{anchor}</h3>"
+  node <- xml2::read_xml(glue::glue(new))
+  xml2::xml_set_attr(node, "id", newid)
+  node
+}

R/render_html.R

@@ -2,11 +2,11 @@
 #'
 #' This uses [rmarkdown::pandoc_convert()] to render HTML from a markdown file.
 #' We've specified pandoc extensions that align with the features desired in the
-#' Carpentries such as `markdown_in_html_blocks`, `tex_math_dollars`, and 
+#' Carpentries such as `markdown_in_html_blocks`, `tex_math_dollars`, and
 #' `native_divs`.
 #'
 #' @param path_in path to a markdown file
-#' @param quiet if `TRUE`, no output is produced. Default is `FALSE`, which 
+#' @param quiet if `TRUE`, no output is produced. Default is `FALSE`, which
 #'   reports the markdown build via pandoc
 #' @param ... extra options (e.g. lua filters) to be passed to pandoc
 #'
@@ -18,12 +18,12 @@
 #' if (rmarkdown::pandoc_available("2.11")) {
 #' # first example---markdown to HTML
 #' tmp <- tempfile()
-#' ex <- c("# Markdown", 
-#'   "", 
-#'   "::: challenge", 
-#'   "", 
+#' ex <- c("# Markdown",
+#'   "",
+#'   "::: challenge",
+#'   "",
 #'   "How do you write markdown divs?",
-#'   "", 
+#'   "",
 #'   ":::"
 #' )
 #' writeLines(ex, tmp)
@@ -46,7 +46,7 @@ render_html <- function(path_in, ..., quiet = FALSE) {
   on.exit(unlink(htm), add = TRUE)
   links <- getOption("sandpaper.links")
   if (length(links) && fs::file_exists(links)) {
-    # if we have links, we concatenate our input files 
+    # if we have links, we concatenate our input files
     tmpin <- tempfile(fileext = ".md")
     fs::file_copy(path_in, tmpin)
     cat("\n", file = tmpin, append = TRUE)
@@ -56,7 +56,16 @@ render_html <- function(path_in, ..., quiet = FALSE) {
   }
   args <- construct_pandoc_args(path_in, output = htm, to = "html", ...)
   sho <- !(quiet || identical(Sys.getenv("TESTTHAT"), "true"))
-  callr::r(function(...) rmarkdown::pandoc_convert(...), args = args, 
+  # Ensure we use the _loaded version_ of pandoc in case folks are using
+  # the {pandoc} package: https://github.com/carpentries/sandpaper/issues/465
+  this_pandoc <- rmarkdown::find_pandoc()
+  callr::r(function(d, v, ...) {
+    rmarkdown::find_pandoc(dir = d, version = v)
+    rmarkdown::pandoc_convert(...)
+  },
+    args = c(d = as.character(this_pandoc$dir),
+      v = as.character(this_pandoc$version),
+      args),
     show = !quiet, spinner = sho)
   paste(readLines(htm), collapse = "\n")
 }
@@ -87,8 +96,8 @@ construct_pandoc_args <- function(path_in, output, to = "html", ...) {
     to      = to,
     options = c(
       "--preserve-tabs",
-      "--indented-code-classes=sh", 
-      "--section-divs", 
+      "--indented-code-classes=sh",
+      "--section-divs",
       "--mathjax",
       ...,
       "--lua-filter",