add chunk addin

DESCRIPTION

@@ -35,4 +35,4 @@ VignetteBuilder:
     knitr
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1

NAMESPACE

@@ -11,6 +11,7 @@ S3method(mask_rx,default)
 S3method(mask_rx,with_flair)
 S3method(print,with_flair)
 export("%>%")
+export(chunk_addin)
 export(decorate)
 export(decorate_chunk)
 export(decorate_code)

NEWS.md

@@ -5,6 +5,9 @@
 - `txt_style()` now accepts a `class` argument specifying a vector of classes to
   be applied to the `<span>` of the decorated text (@gadenbuie, #18).
 
+- `chunk_addin()` RStudio addin have been added. add `decorate()` chunk after
+selected chunk when used.
+
 ## Bugs and fixes
 
 * NULL document types are now treated as default html

R/chunk_addin.R

@@ -0,0 +1,75 @@
+#' Add decorate chunk after chunk
+#'
+#' Call this function as an addin to add a decorate chunk after a selected
+#' chunk.
+#'
+#' @export
+chunk_addin <- function() {
+
+  # Gets The active Documeent
+  ctx <- rstudioapi::getActiveDocumentContext()
+
+  # Checks that a document is active
+  if (!is.null(ctx)) {
+
+    # Extracts selection as a string
+    selected_text <- ctx$selection[[1]]$text
+
+    # modify string
+    selected_text <- add_flair_chunk(selected_text)
+
+    # replaces selection with string
+    rstudioapi::modifyRange(ctx$selection[[1]]$range, selected_text)
+  }
+}
+
+add_flair_chunk  <- function(x) {
+  x <- stringr::str_split(x, "\n")[[1]]
+  header_loc <- stringr::str_detect(x, "```\\{r")
+  end_loc <- stringr::str_detect(x, "^```$")
+
+  if (!any(header_loc) || !any(end_loc)) {
+    stop("No chunk detected")
+  }
+
+  chunk_header <- x[header_loc][1]
+
+  chunk_header <- stringr::str_remove(chunk_header, "```\\{r *,{0,1} *")
+
+  chunk_header <- stringr::str_remove(chunk_header, "\\}")
+
+  chunk_params <- stringr::str_split(chunk_header, ", *")[[1]]
+
+  if (all(stringr::str_detect(chunk_params, "=")) || chunk_params == "") {
+    stop("Chunk must be named")
+  }
+
+  chunk_name <- chunk_params[!stringr::str_detect(chunk_params, "=")]
+
+  flair_chunk <- c(
+    '',
+    glue::glue('```{r [chunk_name]_flair, echo = FALSE}',
+               .open = "[", .close = "]"),
+    glue::glue('decorate("{chunk_name}")'),
+    '```'
+  )
+
+  chunk_params <- chunk_params[!stringr::str_detect(chunk_params, "include")]
+
+  chunk_params <- c(chunk_params, "include = FALSE")
+
+  x[which(header_loc)[1]] <- paste0("```{r ",
+                                    paste(chunk_params, collapse = ", "),
+                                    "}")
+
+  res <- c(
+    x[seq(1, which(end_loc)[1])],
+    flair_chunk
+  )
+
+  if (which(end_loc)[1] < length(x)) {
+    res <- c(res, x[seq(which(end_loc)[1] + 1, length(x))])
+  }
+
+  stringr::str_c(res, collapse = "\n")
+}

inst/rstudio/addins.dcf

@@ -0,0 +1,5 @@
+Name: Add decorate flair chunk
+Description: Add decorate flair chunk
+Binding: chunk_addin
+Interactive: false
+

tests/testthat/test-chunk_addin.R

@@ -0,0 +1,144 @@
+test_that("add_flair_chunk works", {
+expect_equal(
+  add_flair_chunk(
+'
+```{r name}
+mean(x)
+```
+'
+  ),
+'
+```{r name, include = FALSE}
+mean(x)
+```
+
+```{r name_flair, echo = FALSE}
+decorate("name")
+```
+'
+)
+
+expect_equal(
+  add_flair_chunk(
+'
+
+```{r name}
+mean(x)
+```
+
+'
+  ),
+'
+
+```{r name, include = FALSE}
+mean(x)
+```
+
+```{r name_flair, echo = FALSE}
+decorate("name")
+```
+
+'
+)
+
+})
+
+test_that("add_flair_chunk only affects first chunk", {
+expect_equal(
+  add_flair_chunk(
+    '
+
+```{r name}
+mean(x)
+```
+
+```{r sum}
+sum(x)
+```
+
+'
+  ),
+  '
+
+```{r name, include = FALSE}
+mean(x)
+```
+
+```{r name_flair, echo = FALSE}
+decorate("name")
+```
+
+```{r sum}
+sum(x)
+```
+
+'
+)
+
+})
+
+test_that("add_flair_chunk flips include = TRUE", {
+  expect_equal(
+    add_flair_chunk(
+      '
+
+```{r name, include = TRUE}
+mean(x)
+```
+
+```{r sum}
+sum(x)
+```
+
+'
+    ),
+    '
+
+```{r name, include = FALSE}
+mean(x)
+```
+
+```{r name_flair, echo = FALSE}
+decorate("name")
+```
+
+```{r sum}
+sum(x)
+```
+
+'
+  )
+
+})
+
+test_that("add_flair_chunk throws errors", {
+  expect_error(
+    add_flair_chunk(
+      '
+```{r name}
+mean(x)
+'
+    )
+  )
+
+  expect_error(
+    add_flair_chunk(
+      '
+```{r}
+sum(x)
+```
+'
+    )
+  )
+
+  expect_error(
+    add_flair_chunk(
+      '
+```{r, eval=FALSE}
+sum(x)
+```
+'
+    )
+  )
+
+})