[pull] l2d from carpentries:main (#44)

* Open new episodes for editing in interactive sessions

* enforce lf line ending for shim

* skip snapshot test on non-utf-8 compatible windows

* use explicit return

* update NEWS

* sprinkle open args through create_episode family

* make sure create_episode() behaves in examples

That is, make sure it does not accidentally open a file when
lessons are being created or when running examples.

* silence create_episode() msg in tests

We have the tests to ensure the basic functionality works and we know
that usethis is testing for the messaging funcationality, we do not need
to further test it and it is better to silence the messages than test
for them.

---------

Co-authored-by: Milan Malfait <m.malfait@ucl.ac.uk>
Co-authored-by: Zhian N. Kamvar <zkamvar@gmail.com>

.gitattributes

@@ -0,0 +1 @@
+inst/pkgdown/shim.R text eol=lf

.github/workflows/R-CMD-check.yaml

@@ -30,6 +30,8 @@ jobs:
           - {os: macOS-latest, cache: '~/Library/Application Support/renv', r: 'release'}
 
           - {os: windows-latest, r: 'release'}
+          # Use 3.6 to trigger usage of RTools35
+          - {os: windows-latest, cache: '~\AppData\Local\renv', r: '3.6'}
           # use 4.1 to check with rtools40's older compiler
           # - {os: windows-latest, r: '4.1'}
 

NEWS.md

@@ -4,13 +4,16 @@
 
 * Using `handout: true` in `config.yaml` will cause a handout to be generated
   for the lesson website under `/files/code-handout.R`. At the moment, this is
-  only relevant for R-based lessons (implemented: @froggleston, #527) and
-  supersedes the need for specifying `options(sandpaper.handout = TRUE)`
+  only relevant for R-based lessons (implemented: @froggleston, #527,
+  reviewed: @zkamvar) and supersedes the need for specifying
+  `options(sandpaper.handout = TRUE)`
 * Content for learners now accessible through instructor view. The instructor
   view "More" dropdown menu item will now have links to learner view items
   appended. Note that when clicking these links, the user will remain in
   instructor view. This behaviour may change in future iterations (reported:
   @karenword, #394; fixed: @ErinBecker, #530, reviewed: @zkamvar)
+* `create_episode()` will now open new episodes for editing in interactive
+  sessions (implemented: @milanmlft, #534, reviewed: @zkamvar)
 * The `site/` folder is now customisable to any writable directory on your
   system by setting the experimental `SANDPAPER_SITE` environment variable to
   any valid and empty folder. This is most useful in the context of Docker

R/build_lesson.R

@@ -56,7 +56,7 @@
 #'
 #' tmp <- tempfile()
 #' create_lesson(tmp, open = FALSE, rmd = FALSE)
-#' create_episode("first-script", path = tmp)
+#' create_episode("first-script", path = tmp, open = FALSE)
 #' check_lesson(tmp)
 #' build_lesson(tmp)
 build_lesson <- function(path = ".", rebuild = FALSE, quiet = !interactive(), preview = TRUE, override = list()) {

R/create_episode.R

@@ -15,14 +15,19 @@
 #' @param add (logical or numeric) If numeric, it represents the position the
 #'   episode should be added. If `TRUE`, the episode is added to the end of the
 #'   schedule. If `FALSE`, the episode is added as a draft episode.
+#' @param open if interactive, the episode will open in a new editor window.
 #' @export
 #' @examples
 #' tmp <- tempfile()
 #' create_lesson(tmp, open = FALSE, rmd = FALSE)
 #' create_episode_md("getting-started", path = tmp)
-create_episode <- function(title, ext = "Rmd", make_prefix = FALSE, add = TRUE, path = ".") {
+create_episode <- function(title, ext = "Rmd", make_prefix = FALSE, add = TRUE, path = ".",
+                           open = rlang::is_interactive()) {
   check_lesson(path)
-  ext <- switch(match.arg(tolower(ext), c("rmd", "md")), rmd = ".Rmd", md = ".md")
+  ext <- switch(match.arg(tolower(ext), c("rmd", "md")),
+    rmd = ".Rmd",
+    md = ".md"
+  )
   prefix <- ""
   if (make_prefix) {
     episodes <- fs::path_file(fs::dir_ls(path_episodes(path), regexp = "*.[Rr]?md"))
@@ -33,34 +38,36 @@ create_episode <- function(title, ext = "Rmd", make_prefix = FALSE, add = TRUE,
   slug <- slugify(title)
   ename <- paste0(prefix, slug, ext)
   copy_template("episode", fs::path(path, "episodes"), ename,
-    values = list(title = siQuote(title), md = ext == ".md"))
+    values = list(title = siQuote(title), md = ext == ".md")
+  )
   if (add) {
     move_episode(ename, position = add, write = TRUE, path = path)
   }
-  invisible(fs::path(path, "episodes", ename))
+  new_file <- usethis::edit_file(fs::path(path, "episodes", ename), open = open)
+  return(new_file)
 }
 
 
 #' @export
 #' @rdname create_episode
-create_episode_md <- function(title, make_prefix = FALSE, add = TRUE, path = ".") {
-  create_episode(title, ext = "md", make_prefix = make_prefix, add = add, path = path)
+create_episode_md <- function(title, make_prefix = FALSE, add = TRUE, path = ".", open = rlang::is_interactive()) {
+  create_episode(title, ext = "md", make_prefix = make_prefix, add = add, path = path, open = open)
 }
 
 #' @export
 #' @rdname create_episode
-create_episode_rmd <- function(title, make_prefix = FALSE, add = TRUE, path = ".") {
-  create_episode(title, ext = "Rmd", make_prefix = make_prefix, add = add, path = path)
+create_episode_rmd <- function(title, make_prefix = FALSE, add = TRUE, path = ".", open = rlang::is_interactive()) {
+  create_episode(title, ext = "Rmd", make_prefix = make_prefix, add = add, path = path, open = open)
 }
 
 #' @export
 #' @rdname create_episode
-draft_episode_md <- function(title, make_prefix = FALSE, path = ".") {
-  create_episode(title, ext = "md", make_prefix = make_prefix, add = FALSE, path = path)
+draft_episode_md <- function(title, make_prefix = FALSE, path = ".", open = rlang::is_interactive()) {
+  create_episode(title, ext = "md", make_prefix = make_prefix, add = FALSE, path = path, open = open)
 }
 
 #' @export
 #' @rdname create_episode
-draft_episode_rmd <- function(title, make_prefix = FALSE, path = ".") {
-  create_episode(title, ext = "Rmd", make_prefix = make_prefix, add = FALSE, path = path)
+draft_episode_rmd <- function(title, make_prefix = FALSE, path = ".", open = rlang::is_interactive()) {
+  create_episode(title, ext = "Rmd", make_prefix = make_prefix, add = FALSE, path = path, open = open)
 }

R/create_lesson.R

@@ -91,7 +91,7 @@ create_lesson <- function(path, name = fs::path_file(path), rmd = TRUE, rstudio
   create_site(path)
 
   cli::cli_status_update("{cli::symbol$arrow_right} Creating first episode ...")
-  ep <- create_episode("introduction", ext = if (rmd) "Rmd" else "md", path = path)
+  ep <- create_episode("introduction", ext = if (rmd) "Rmd" else "md", path = path, open = FALSE)
   cli::cli_alert_success("First episode created in {.file {ep}}")
 
   if (rstudio) {

R/move_episode.R

@@ -18,22 +18,22 @@
 #' if (interactive() || Sys.getenv("CI") != "") {
 #'   tmp <- tempfile()
 #'   create_lesson(tmp)
-#'   create_episode_md("getting-started", path = tmp)
-#'   create_episode_rmd("plotting", path = tmp)
-#'   create_episode_md("experimental", path = tmp, add = FALSE)
-#'   set_episodes(tmp, c("getting-started.md", "introduction.Rmd", "plotting.Rmd"), 
+#'   create_episode_md("getting-started", path = tmp, open = FALSE)
+#'   create_episode_rmd("plotting", path = tmp, open = FALSE)
+#'   create_episode_md("experimental", path = tmp, add = FALSE, open = FALSE)
+#'   set_episodes(tmp, c("getting-started.md", "introduction.Rmd", "plotting.Rmd"),
 #'     write = TRUE)
 #'
 #'   # Default episode order is alphabetical, we can use this to nudge episodes
 #'   get_episodes(tmp)
 #'   move_episode("introduction.Rmd", 1L, path = tmp) # by default, it shows you the change
 #'   move_episode("introduction.Rmd", 1L, write = TRUE, path = tmp) # write the results
 #'   get_episodes(tmp)
-#' 
+#'
 #'   # Add episodes from the drafts
 #'   get_drafts(tmp)
 #'   move_episode("experimental.md", 2L, path = tmp) # view where it will live
-#'   move_episode("experimental.md", 2L, write = TRUE, path = tmp) 
+#'   move_episode("experimental.md", 2L, write = TRUE, path = tmp)
 #'   get_episodes(tmp)
 #'
 #'   # Unpublish episodes by setting position to zero
@@ -92,7 +92,7 @@ move_episode <- function(ep = NULL, position = NULL, write = FALSE, path = ".")
     # be coerced to 0L.
     position <- if (isTRUE(position)) n else position
   }
-  
+
   eps <- eps[-ins]
   n <- length(eps)
   if (n == 0) {
@@ -120,11 +120,11 @@ move_episode <- function(ep = NULL, position = NULL, write = FALSE, path = ".")
 
 #' Have user select position for an episode from a list
 #'
-#' This function is interactive at the while loop where it will check if the 
+#' This function is interactive at the while loop where it will check if the
 #' position element is finite (failing on anything that can not be coerced to
 #' an integer) and if it is in bounds. It will repeat until a correct choice has
 #' been selected.
-#' 
+#'
 #' For testing, it will return -1 and trigger an error in `move_episode()`
 #'
 #' @param eps a vector of episode names
@@ -136,7 +136,7 @@ user_find_position <- function(eps, draft = FALSE) {
   position <- -1L
   cli::cli_div()
   cli::cli_alert_info("Select a number to insert your episode")
-  cli::cli_text("(if an episode already occupies that position, it will be shifted down)") 
+  cli::cli_text("(if an episode already occupies that position, it will be shifted down)")
   cli::cli_text()
   choices <- if (draft) c(eps, "[insert at end]") else eps
   n <- length(choices)
@@ -157,14 +157,14 @@ user_find_position <- function(eps, draft = FALSE) {
 #' files by a two-digit number to force a specific order by filename. This
 #' function will strip these numbers from the filename and set the schedule
 #' according to the original order.
-#' 
+#'
 #' @inheritParams move_episode
-#' @return when `write = TRUE`, the modified list of episodes. When 
+#' @return when `write = TRUE`, the modified list of episodes. When
 #'  `write = FALSE`, the modified call is returned.
 #'
 #' @note git will recognise this as deleting a file and then adding a new file
 #'   in the stage. If you run `git add`, it should recognise that it is a rename.
-#' 
+#'
 #' @export
 #' @seealso [create_episode()] for creating new episodes, [move_episode()] for
 #'   moving individual episodes around.
@@ -188,7 +188,7 @@ strip_prefix <- function(path = ".", write = FALSE) {
   scheduled_episodes <- all_episodes[all_episodes %in% episodes]
   moved_episodes <- trimws(sub("^[0-9]{2}(\\.[0-9]+)?[-]", "", scheduled_episodes, perl = TRUE))
   if (write) {
-    fs::file_move(fs::path(epathodes, scheduled_episodes), 
+    fs::file_move(fs::path(epathodes, scheduled_episodes),
       fs::path(epathodes, moved_episodes))
     return(set_episodes(path = path, order = moved_episodes, write = TRUE))
   } else {

R/set_dropdown.R

@@ -18,7 +18,7 @@
 #'   path = tmp,
 #'   write = TRUE
 #' )
-#' create_episode("using-R", path = tmp)
+#' create_episode("using-R", path = tmp, open = FALSE)
 #' print(sched <- get_episodes(tmp))
 #'
 #' # reverse the schedule

tests/testthat/test-build_lesson.R

@@ -253,9 +253,10 @@ test_that("Lesson websites contains instructor metadata", {
 })
 
 test_that("single files can be built", {
-
-  create_episode("_Second_ Episode!", path = tmp)
-  suppressMessages(s <- get_episodes(tmp))
+  suppressMessages({
+    create_episode("_Second_ Episode!", path = tmp, open = FALSE)
+    s <- get_episodes(tmp)
+  })
   set_episodes(tmp, s, write = TRUE)
 
   rdr <- sandpaper_site(fs::path(tmp, "episodes", "second-episode.Rmd"))

tests/testthat/test-build_markdown.R

@@ -1,7 +1,9 @@
 # setup test fixture
 {
   tmp <- res <- restore_fixture()
-  create_episode("second-episode", path = tmp)
+  suppressMessages({
+    create_episode("second-episode", path = tmp, open = FALSE)
+  })
   instruct <- fs::path(tmp, "instructors", "pyramid.md")
   writeLines(
     c(