Merge pull request #434 from jonmcalder/style-rnw

- Add support for .Rnw files (#434).

Author: lorenzwalthert

R/addins.R

@@ -25,11 +25,13 @@ style_active_file <- function() {
   )
   context <- get_rstudio_context()
   if (is_rmd_file(context$path)) {
-    out <- transform_rmd(context$contents, transformer)
+    out <- transform_mixed(context$contents, transformer, filetype = "Rmd")
+  } else if (is_rnw_file(context$path)) {
+    out <- transform_mixed(context$contents, transformer, filetype = "Rnw")
   } else if (is_plain_r_file(context$path) | is_unsaved_file(context$path)) {
     out <- try_transform_as_r_file(context, transformer)
   } else {
-    stop("Can only style .R and .Rmd files.", call. = FALSE)
+    stop("Can only style .R, .Rmd and .Rnw files.", call. = FALSE)
   }
   rstudioapi::modifyRange(
     c(1, 1, length(context$contents) + 1, 1),

R/set-assert-args.R

@@ -38,10 +38,10 @@ set_and_assert_arg_filetype <- function(filetype) {
 #' @param lowercase_filetype A vector with file types to check, all lower case.
 #' @keywords internal
 assert_filetype <- function(lowercase_filetype) {
-  if (!all(lowercase_filetype %in% c("r", "rmd"))) {
+  if (!all(lowercase_filetype %in% c("r", "rmd", "rnw"))) {
     stop(
       "filetype must not contain other values than 'R'",
-      "or 'Rmd' (case is ignored).",
+      "'Rmd' or 'Rnw' (case is ignored).",
       call. = FALSE
     )
   }

R/testing.R

@@ -27,7 +27,7 @@ test_collection <- function(test, sub_test = NULL,
 
   pattern <- paste0(
     if (!is.null(sub_test)) paste0("^", sub_test, ".*"),
-    "in\\.R(?:|md)$"
+    "in\\.R(?:|md|nw)$"
   )
 
   in_names <- list.files(
@@ -66,7 +66,7 @@ test_collection <- function(test, sub_test = NULL,
 #' ))
 #' @keywords internal
 construct_out <- function(in_paths) {
-  gsub("\\-in([.]R(?:|md))$", "\\-out\\1", in_paths)
+  gsub("\\-in([.]R(?:|md|nw))$", "\\-out\\1", in_paths)
 }
 
 #' Construct paths of a tree object given the paths of *-in.R files

R/transform-code.R

@@ -1,7 +1,7 @@
-#' Transform code from R or Rmd files
+#' Transform code from R, Rmd or Rnw files
 #'
 #' A wrapper for [enc::transform_lines_enc()] which initiates the styling of
-#' either R or Rmd files by passing the relevant transformer function for each
+#' either R, Rmd or Rnw files by passing the relevant transformer function for each
 #' case.
 #'
 #' @inheritParams enc::transform_lines_enc
@@ -12,43 +12,49 @@ transform_code <- function(path, fun, verbose = FALSE, ...) {
     enc::transform_lines_enc(path, fun = fun, ..., verbose = verbose)
   } else if (is_rmd_file(path)) {
     enc::transform_lines_enc(path,
-      fun = partial(transform_rmd, transformer_fun = fun), ...,
+      fun = partial(transform_mixed, transformer_fun = fun, filetype = "Rmd"), ...,
+      verbose = verbose
+    )
+  } else if (is_rnw_file(path)) {
+    enc::transform_lines_enc(path,
+      fun = partial(transform_mixed, transformer_fun = fun, filetype = "Rnw"), ...,
       verbose = verbose
     )
   } else {
-    stop(path, " is not an R or Rmd file")
+    stop(path, " is not an R, Rmd or Rnw file")
   }
 }
 
-#' Transform Rmd contents
+#' Transform mixed contents
 #'
 #' Applies the supplied transformer function to code chunks identified within
-#' an Rmd file and recombines the resulting (styled) code chunks with the text
+#' an Rmd or Rnw file and recombines the resulting (styled) code chunks with the text
 #' chunks.
 #'
-#' @param lines A character vector of lines from an Rmd file
-#' @param transformer_fun A styler transformer function
+#' @param transformer_fun A styler transformer function.
+#' @inheritParams separate_chunks
 #' @importFrom purrr flatten_chr
 #' @keywords internal
-transform_rmd <- function(lines, transformer_fun) {
-  chunks <- separate_chunks(lines)
+transform_mixed <- function(lines, transformer_fun, filetype) {
+  chunks <- separate_chunks(lines, filetype)
   chunks$r_chunks <- map(chunks$r_chunks, transformer_fun)
 
   map2(chunks$text_chunks, c(chunks$r_chunks, list(character(0))), c) %>%
     flatten_chr()
 }
 
-
-#' Separate chunks within Rmd contents
+#' Separate chunks within Rmd and Rnw contents
 #'
 #' Identifies and separates the code and text chunks (the latter includes non-R
-#' code) within an Rmd file, and returns these separately.
-#' @param lines a character vector of lines from an Rmd file
+#' code) within an Rmd or Rnw file, and returns these separately.
+#' @param lines A character vector of lines from an Rmd or Rnw file.
+#' @param filetype A string indicating the filetype - either 'Rmd' or 'Rnw'.
 #' @importFrom purrr map2
 #' @importFrom rlang seq2
 #' @keywords internal
-separate_chunks <- function(lines) {
-  r_raw_chunks <- identify_r_raw_chunks(lines)
+separate_chunks <- function(lines, filetype) {
+  r_raw_chunks <- identify_raw_chunks(lines, filetype = filetype)
+
   r_chunks <- map2(
     r_raw_chunks$starts, r_raw_chunks$ends, ~lines[seq2(.x + 1, .y - 1)]
   )
@@ -60,32 +66,39 @@ separate_chunks <- function(lines) {
   lst(r_chunks, text_chunks)
 }
 
-#' Identifies raw R code chunks
+#' Identifies raw Rmd or Rnw code chunks
 #'
 #' Raw in the sense that these chunks don't contain pure R code, but they
 #' contain a header and footer of markdown. Only code chunks that have an engine
 #' whose name matches `engine-pattern` are considered as R code.
 #' @inheritParams separate_chunks
 #' @param engine_pattern A regular expression that must match the engine name.
 #' @keywords internal
-identify_r_raw_chunks <- function(lines, engine_pattern = get_engine_pattern()) {
-  pattern <- get_knitr_pattern(lines)
+identify_raw_chunks <- function(lines, filetype, engine_pattern = get_engine_pattern()) {
+  pattern <- get_knitr_pattern(filetype)
   if (is.null(pattern$chunk.begin) || is.null(pattern$chunk.end)) {
     stop("Unrecognized chunk pattern!", call. = FALSE)
   }
-  chunks <- grep("^[\t >]*```+\\s*", lines, perl = TRUE)
-  starts <- odd(chunks)
-  ends <- even(chunks)
+
+  if (filetype == "Rmd") {
+    chunks <- grep("^[\t >]*```+\\s*", lines, perl = TRUE)
+    starts <- odd(chunks)
+    ends <- even(chunks)
+    is_r_code <- grepl(
+      paste0("^[\t >]*```+\\s*\\{\\s*", engine_pattern, "[\\s\\},]"),
+      lines[starts],
+      perl = TRUE
+    )
+  } else if (filetype == "Rnw") {
+    starts <- grep(pattern$chunk.begin, lines, perl = TRUE)
+    ends <- grep(pattern$chunk.end, lines, perl = TRUE)
+    is_r_code <- rep(TRUE, length(starts))
+  }
 
   if (length(starts) != length(ends)) {
     stop("Malformed file!", call. = FALSE)
   }
 
-  is_r_code <- grepl(
-    paste0("^[\t >]*```+\\s*\\{\\s*", engine_pattern, "[\\s\\},]"),
-    lines[starts],
-    perl = TRUE
-  )
   list(starts = starts[is_r_code], ends = ends[is_r_code])
 }
 
@@ -110,6 +123,10 @@ get_engine_pattern <- function() {
 #'
 #' @inheritParams separate_chunks
 #' @keywords internal
-get_knitr_pattern <- function(lines) {
-  knitr::all_patterns[["md"]]
+get_knitr_pattern <- function(filetype) {
+  if(filetype == "Rnw") {
+    knitr::all_patterns[["rnw"]]
+  } else if (filetype == "Rmd") {
+    knitr::all_patterns[["md"]]
+  }
 }

R/ui.R

@@ -6,7 +6,8 @@ NULL
 #' Prettify R source code
 #'
 #' Performs various substitutions in all `.R` files in a package
-#' (code and tests).
+#' (code and tests). One can also (optionally) style `.Rmd` and/or
+#' `.Rnw` files (vignettes and readme) by changing the `filetype` argument.
 #' Carefully examine the results after running this function!
 #'
 #' @param pkg Path to a (subdirectory of an) R package.
@@ -19,8 +20,8 @@ NULL
 #'   conveniently constructed via the `style` argument and `...`. See
 #'   'Examples'.
 #' @param filetype Vector of file extensions indicating which file types should
-#'   be styled. Case is ignored, and the `.` is optional, e.g. `c(".R", ".Rmd")`
-#'   or `c("r", "rmd")`.
+#'   be styled. Case is ignored, and the `.` is optional, e.g. `c(".R", ".Rmd",
+#'   ".Rnw")` or `c("r", "rmd", "rnw")`.
 #' @param exclude_files Character vector with paths to files that should be
 #'   excluded from styling.
 #' @param include_roxygen_examples Whether or not to style code in roxygen
@@ -58,7 +59,7 @@ NULL
 #' @family stylers
 #' @examples
 #' \dontrun{
-#' 
+#'
 #' style_pkg(style = tidyverse_style, strict = TRUE)
 #' style_pkg(
 #'   scope = "line_breaks",
@@ -102,6 +103,16 @@ prettify_pkg <- function(transformers,
     readme <- dir(pattern = "^readme\\.rmd$", ignore.case = TRUE)
   }
 
+  if ("\\.rnw" %in% filetype) {
+    vignette_files <- append(
+      vignette_files,
+      dir(
+        path = "vignettes", pattern = "\\.rnw$",
+        ignore.case = TRUE, recursive = TRUE, full.names = TRUE
+      )
+    )
+  }
+
   files <- setdiff(c(r_files, vignette_files, readme), exclude_files)
   transform_files(files, transformers, include_roxygen_examples)
 }
@@ -136,7 +147,8 @@ style_text <- function(text,
 
 #' Prettify arbitrary R code
 #'
-#' Performs various substitutions in all `.R` files in a directory.
+#' Performs various substitutions in all `.R`, `.Rmd` and/or `.Rnw` files
+#' in a directory (by default only `.R` files are styled - see `filetype` argument).
 #' Carefully examine the results after running this function!
 #' @param path Path to a directory with files to transform.
 #' @param recursive A logical value indicating whether or not files in subdirectories
@@ -188,7 +200,7 @@ prettify_any <- function(transformers,
   )
 }
 
-#' Style `.R` and/or `.Rmd` files
+#' Style `.R`, `.Rmd` or `.Rnw` files
 #'
 #' Performs various substitutions in the files specified.
 #' Carefully examine the results after running this function!

R/utils.R

@@ -93,6 +93,10 @@ is_rmd_file <- function(path) {
   grepl("\\.Rmd$", path, ignore.case = TRUE)
 }
 
+is_rnw_file <- function(path) {
+  grepl("\\.Rnw$", path, ignore.case = TRUE)
+}
+
 is_unsaved_file <- function(path) {
   path == ""
 }