support xaringan

Author: lorenzwalthert

R/expr-is.R

@@ -110,16 +110,18 @@ is_subset_expr <- function(pd) {
 #' style_text("#!/usr/bin/env Rscript")
 #' @keywords internal
 is_shebang <- function(pd) {
-  is_first_comment <- is_comment(pd) & (pd$pos_id == 1L)
+  is_first_comment <- pd$pos_id == 1L
   is_first_comment[is_first_comment] <- grepl(
     "^#!", pd$text[is_first_comment],
     perl = TRUE
   )
   is_first_comment
 }
 
-#' Identify spinning code chunk header
+#' Identify spinning code chunk header or xaringan
 #'
+#' Wrongly identifies a comment without a preceding line break as a code chunk
+#' header.
 #' See https://yihui.name/knitr/demo/stitch/#spin-comment-out-texts for details.
 #' @examples
 #' style_text(c(
@@ -130,10 +132,10 @@ is_shebang <- function(pd) {
 #' ))
 #' @param pd A parse table.
 #' @keywords internal
-is_code_chunk_header <- function(pd) {
+is_code_chunk_header_or_xaringan <- function(pd) {
   is_comment <- is_comment(pd)
   is_comment[is_comment] <- grepl(
-    "^#[\\+|\\-]", pd$text[is_comment],
+    "^#[\\+|\\-|<<]", pd$text[is_comment],
     perl = TRUE
   )
   is_comment

R/rules-spacing.R

@@ -294,13 +294,19 @@ set_space_between_levels <- function(pd_flat) {
 #' @importFrom purrr map_chr
 #' @keywords internal
 start_comments_with_space <- function(pd, force_one = FALSE) {
-  comment_pos <- is_comment(pd) & !is_shebang(pd) & !is_code_chunk_header(pd)
-  if (!any(comment_pos)) {
+  is_comment <- is_comment(pd)
+
+  if (any(is_comment)) {
+    is_comment <- is_comment & !is_shebang(pd) & !is_code_chunk_header_or_xaringan(pd)
+    if (!any(is_comment)) {
+      return(pd)
+    }
+  } else {
     return(pd)
   }
 
   comments <- rematch2::re_match(
-    pd$text[comment_pos],
+    pd$text[is_comment],
     "^(?<prefix>#+['\\*]*)(?<space_after_prefix> *)(?<text>.*)$"
   )
   comments$space_after_prefix <- nchar(
@@ -312,14 +318,14 @@ start_comments_with_space <- function(pd, force_one = FALSE) {
     force_one
   )
 
-  pd$text[comment_pos] <-
+  pd$text[is_comment] <-
     paste0(
       comments$prefix,
       map_chr(comments$space_after_prefix, rep_char, char = " "),
       comments$text
     ) %>%
     trimws("right")
-  pd$short[comment_pos] <- substr(pd$text[comment_pos], 1, 5)
+  pd$short[is_comment] <- substr(pd$text[is_comment], 1, 5)
   pd
 }
 

inst/WORDLIST

@@ -203,6 +203,7 @@ Walthert
 withr
 writeLines
 www
+xaringan
 xenial
 xfun
 Xie

man/is_code_chunk_header.Rd renamed to man/is_code_chunk_header_or_xaringan.Rd

@@ -0,0 +1,12 @@
+foo(
+  data = mtcars,
+  x = cyl,
+  y = wt #<<
+)
+
+
+library(ggplot2)
+
+ggplot(aes(x, y), data) +
+  geom_point() + #<<
+  scale_x_continuous() #<<

tests/testthat/parse_comments/xaringan-in.R

@@ -0,0 +1,12 @@
+foo(
+  data = mtcars,
+  x = cyl,
+  y = wt #<<
+)
+
+
+library(ggplot2)
+
+ggplot(aes(x, y), data) +
+  geom_point() + #<<
+  scale_x_continuous() #<<

tests/testthat/parse_comments/xaringan-in_tree

@@ -55,6 +55,13 @@ test_that("hashbangs are respected", {
   ), NA)
 })
 
+test_that("xaringan markers are respected", {
+  expect_warning(test_collection("parse_comments",
+                                 "xaringan",
+                                 transformer = style_text
+  ), NA)
+})
+
 test_that("code chunk headers for spinning are respected", {
   expect_warning(test_collection("parse_comments",
     "spinning_code_chunk_headers",