Merge pull request #334 from carpentries/link-attributes

add link attributes and custom css

DESCRIPTION

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

NEWS.md

@@ -1,3 +1,12 @@
+# sandpaper 0.9.5
+
+* css and js can now be embedded into individual pages for custom styling
+  (see <https://bookdown.org/yihui/rmarkdown-cookbook/html-css.html> for
+  implementation details).
+* The pandoc extension `link_attributes` has been added to process custom link
+  classes (see <https://pandoc.org/MANUAL.html#extension-link_attributes> for
+  details).
+
 # sandpaper 0.9.4
 
 * The CLI styling of an important message about {renv} has been fixed to be more

R/render_html.R

@@ -68,13 +68,14 @@ construct_pandoc_args <- function(path_in, output, to = "html", ...) {
     "autolink_bare_uris",
     "emoji",
     "footnotes",
+    "header_attributes",
     "inline_notes",
+    "link_attributes",
+    "markdown_in_html_blocks",
+    "native_divs",
     "tex_math_dollars",
     "tex_math_single_backslash",
-    "markdown_in_html_blocks",
     "yaml_metadata_block",
-    "header_attributes",
-    "native_divs",
     sep = "+"
   )
   from <- paste0("markdown", "-hard_line_breaks", "+", exts)

R/utils-callr.R

@@ -22,8 +22,31 @@ callr_build_episode_md <- function(path, hash, workenv, outpath, workdir, root,
   # Set knitr options for output ---------------------------
   ochunk <- knitr::opts_chunk$get()
   oknit  <- knitr::opts_knit$get()
+  keng   <- knitr::knit_engines$get()
   on.exit(knitr::opts_chunk$restore(ochunk), add = TRUE)
   on.exit(knitr::opts_knit$restore(oknit), add = TRUE)
+  on.exit(knitr::knit_engines$set(keng), add = TRUE)
+
+  # START IMPORT
+  # modified from knitr on 2022-08-30
+  # https://github.com/yihui/knitr/blob/83fb5084daa1161d3ee2f000b637e48bdcf64617/R/engine.R
+  # helper to create engines the wrap embedded html assets (e.g. css,js)
+  eng_html_asset = function(prefix, postfix) {
+    function(options) {
+      out = if (options$eval) { # remove markdown exclusion here
+        paste(c(prefix, options$code, postfix), collapse = "\n")
+      }
+      options$results = 'asis'
+      knitr::engine_output(options, options$code, out)
+    }
+  }
+  # include js in a script tag (ignore if not html output)
+  eng_js = eng_html_asset('<script type="text/javascript">', '</script>')
+  # include css in a style tag (ignore if not html output)
+  eng_css = eng_html_asset('<style type="text/css">', '</style>')
+  # END IMPORT
+
+  knitr::knit_engines$set(css = eng_css, js = eng_js)
 
   slug <- file_path_sans_ext(basename(outpath))
 

R/utils-xml.R

@@ -56,7 +56,10 @@ fix_figures <- function(nodes = NULL) {
   figs <- xml2::xml_find_all(nodes, ".//img")
   caps <- xml2::xml_find_all(nodes, ".//p[@class='caption']")
   fig_element <- xml2::xml_parent(figs)
-  xml2::xml_set_attr(figs, "class", "figure mx-auto d-block")
+  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))
   xml2::xml_set_name(caps, "figcaption")
   xml2::xml_set_attr(caps, "class", NULL)
   xml2::xml_set_name(fig_element, "figure")

tests/testthat/_snaps/render_html.md

@@ -29,9 +29,9 @@
          [Para [Str "How",Space,Str "do",Space,Str "you",Space,Str "write",Space,Str "markdown",Space,Str "divs?"]
          ,Para [Str "This",Space,Link ("",[],[]) [Str "link",Space,Str "should",Space,Str "be",Space,Str "transformed"] ("Setup.html","")]
          ,Para [Str "This",Space,Link ("",[],[]) [Str "rmd",Space,Str "link",Space,Str "also"] ("01-Introduction.html","")]
-         ,Para [Str "This",Space,Link ("",[],[]) [Str "rmd",Space,Str "is",Space,Str "safe"] ("https://example.com/01-Introduction.Rmd","")]
+         ,Para [Str "This",Space,Link ("",["newclass"],[]) [Str "rmd",Space,Str "is",Space,Str "safe"] ("https://example.com/01-Introduction.Rmd","")]
          ,Para [Str "This",Space,Link ("",[],[]) [Str "too"] ("Setup.html#windows-setup","windows setup")]
-         ,Para [Image ("",[],[("alt","alt text")]) [Str "link",Space,Str "should",Space,Str "be",Space,Str "transformed"] ("fig/Setup.png","fig:")]]]]
+         ,Para [Image ("fig-first",["imgclass"],[("alt","alt text")]) [Str "link",Space,Str "should",Space,Str "be",Space,Str "transformed"] ("fig/Setup.png","fig:")]]]]
       ,Div ("accordionSolution1",["accordion","challenge-accordion","accordion-flush"],[])
        [Div ("",["accordion-item"],[])
         [RawBlock (Format "html") "<button class=\"accordion-button solution-button collapsed\" type=\"button\" data-bs-toggle=\"collapse\" data-bs-target=\"#collapseSolution1\" aria-expanded=\"false\" aria-controls=\"collapseSolution1\">\n  <h4 class=\"accordion-header\" id=\"headingSolution1\">\n  Write now\n  </h4>\n</button>"
@@ -113,10 +113,10 @@
       <p>How do you write markdown divs?</p>
       <p>This <a href="Setup.html">link should be transformed</a></p>
       <p>This <a href="01-Introduction.html">rmd link also</a></p>
-      <p>This <a href="https://example.com/01-Introduction.Rmd">rmd is safe</a></p>
+      <p>This <a href="https://example.com/01-Introduction.Rmd" class="newclass">rmd is safe</a></p>
       <p>This <a href="Setup.html#windows-setup" title="windows setup">too</a></p>
       <div class="figure">
-      <img src="fig/Setup.png" alt="alt text" alt="" />
+      <img src="fig/Setup.png" id="fig-first" class="imgclass" alt="alt text" alt="" />
       <p class="caption">link should be transformed</p>
       </div>
       </div>

tests/testthat/examples/ex.md

@@ -25,11 +25,11 @@ This [link should be transformed](../learners/Setup.md)
 
 This [rmd link also](../episodes/01-Introduction.Rmd)
 
-This [rmd is safe](https://example.com/01-Introduction.Rmd)
+This [rmd is safe](https://example.com/01-Introduction.Rmd){.newclass}
 
 This [too](learners/Setup.md#windows-setup 'windows setup')
 
-![link should be transformed](../episodes/fig/Setup.png){alt='alt text'}
+![link should be transformed](../episodes/fig/Setup.png){#fig-first .imgclass alt='alt text'}
 
 ::: solution
 

tests/testthat/test-utils-callr.R

@@ -9,7 +9,7 @@
   fs::dir_create(src)
   fs::dir_create(out)
   copy_template("license", src, "test1.md")
-  writeLines("---\ntitle: a\n---\n\nHello from `r R.version.string`\n", t2)
+  writeLines("---\ntitle: a\n---\n\nHello from `r R.version.string`\n\n```{css}\n#| echo: false\n.my-class {padding: 25px};\n```\n", t2)
   withr::defer({
     fs::dir_delete(src)
     fs::dir_delete(out)
@@ -44,6 +44,7 @@ test_that("callr_build_episode_md() works with Rmarkdown", {
   })
   expect_true(fs::file_exists(o2))
   expect_match(grep("Hello", readLines(o2), value = TRUE), "Hello from R (version|Under)")
+  expect_match(grep("css", readLines(o2), value = TRUE), "style type=.text/css.")
 
 })
 
@@ -61,5 +62,6 @@ test_that("callr_build_episode_md() works with Rmarkdown using renv", {
   })
   expect_true(fs::file_exists(o2))
   expect_match(grep("Hello", readLines(o2), value = TRUE), "Hello from R (version|Under)")
+  expect_match(grep("css", readLines(o2), value = TRUE), "style type=.text/css.")
 
 })