Addin to style highlighted region

DESCRIPTION

@@ -18,6 +18,7 @@ Suggests:
     data.tree,
     here,
     knitr,
+    mockr,
     rmarkdown,
     rstudioapi,
     testthat,
@@ -35,6 +36,7 @@ Roxygen: list(markdown = TRUE, roclets = c("rd", "namespace", "collate", "pkgapi
 RoxygenNote: 6.0.1.9000
 VignetteBuilder: knitr
 Collate: 
+    'addins.R'
     'modify_pd.R'
     'nested.R'
     'nested_to_tree.R'

R/addins.R

@@ -0,0 +1,115 @@
+#' Style the active file
+#'
+#' Helper function for RStudio Addin.
+style_active_file <- function() {
+  context <- find_active_context()
+  style_file(context$path, style = tidyverse_style)
+}
+
+
+#' Style the highlighted region
+#'
+#' Helper function for RStudio Addin. This function is complicated because of
+#' one thing: You can highlight also just parts of lines.
+#' @importFrom rlang seq2
+style_active_region <- function() {
+  context <- find_active_context()
+  if (all(context$start == context$end)) stop("No region selected")
+  all_text <- utf8::read_lines_enc(context$path)
+  styled_expr <- style_region(all_text, context)
+  neighbourhood <- extract_neighbourhood(all_text, context)
+
+  styled_lines <- complete_styled_expr(context, styled_expr, neighbourhood)
+
+  merged_text <- append(neighbourhood$lines_not_to_style, styled_lines, context$start[1] - 1)
+  utf8::write_lines_enc(merged_text, context$path)
+}
+
+#' Helper to extract and preprocess relevant attributes from
+#' [rstudioapi::getActiveDocumentContext()].
+#'
+find_active_context <- function() {
+  context <- get_rstudio_context()
+  path <- context$path
+  start <- context$selection[[1]]$range$start
+  end <- context$selection[[1]]$range$end
+  if (end[2] == 1 & !all(start == end)) {
+    end[1] <- end[1] - 1
+    end[2] <- 1000000L # because of range constraint in substr()
+  }
+  list(start = start, end = end, path = path)
+}
+
+get_rstudio_context <- function() {
+  rstudioapi::getActiveDocumentContext()
+}
+
+#' Style a region of text given context
+#'
+#' First extracts the relevant expression from `text` and returns after styling.
+#' @param text Character vector that contains the highlighted region.
+#' @param context The context from [find_active_context()].
+style_region <- function(text, context) {
+  ind_to_style <- seq2(context$start[1], context$end[1])
+  lines_to_style <- text[ind_to_style]
+  last <- length(lines_to_style)
+  lines_to_style[1] <- substring(lines_to_style[1], context$start[2])
+  start_if_on_same_line <- ifelse(context$start[1] == context$end[1], context$start[2], 0)
+  lines_to_style[last] <- substring(
+    lines_to_style[last],
+    1,
+    context$end[2] - start_if_on_same_line
+  )
+  styled_lines <- style_text(lines_to_style)
+  styled_lines
+}
+
+#' Complete styled expression with unstyled fraction on start / end line
+#'
+#' Essentially adding the parts before the highlighted area on the line where
+#' the higlighted area starts to the styled expression. Also, after the styled
+#' expression, the remainder of that line that was not styled is added.
+#' @param context The context from [find_active_context()].
+#' @param styled_expr Character vector consisting of the styled expression.
+#' @param neighbourhood Neighbourhood obtained from [extract_neighbourhood()].
+complete_styled_expr <- function(context,
+                                 styled_expr,
+                                 neighbourhood) {
+  if (context$start[1] == context$end[1]) {
+    styled_expr[1] <-
+      paste0(neighbourhood$start, styled_expr[1], neighbourhood$end)
+  } else {
+    last <- length(styled_expr)
+    first_line <- paste0(neighbourhood$start, styled_expr[1])
+    last_line <- paste0(styled_expr[last], neighbourhood$end)
+    styled_expr[1] <- first_line
+    styled_expr[last] <- last_line
+  }
+  styled_lines <- styled_expr
+  styled_lines
+}
+
+#' Extract text around the highlighted text
+#'
+#' Extracts unselected text on highlighted lines and text on other lines
+#' @param text Character vector that contains highlighted area.
+#' @param context The context from [find_active_context()].
+#' @return A character vector of length three.
+#'   * The first element corresponds to the text on the start line that was not
+#'     selected.
+#'   * The second element to the text on the end line that was not selected.
+#'   * The third element are the lines that are not overlapping with the
+#'     highlighted text.
+extract_neighbourhood <- function(text, context) {
+  ind_to_style <- seq2(context$start[1], context$end[1])
+  lines_to_style <- text[ind_to_style]
+  lines_not_to_style <- text[setdiff(seq_along(text), ind_to_style)]
+  fract_of_line_start <- substring(lines_to_style[1], 1, context$start[2] - 1)
+  last <- length(lines_to_style)
+  fract_of_line_end <- substring(lines_to_style[last], context$end[2])
+  list(
+    start = fract_of_line_start,
+    end = fract_of_line_end,
+    lines_not_to_style = lines_not_to_style
+  )
+}

R/serialized_tests.R

@@ -209,3 +209,10 @@ style_op <- function(text) {
   transformed_text
 
 }
+
+#' Create the path to a test that file
+#' @param ... Arguments passed to [file.path()] to construct the path after
+#'   ".../tests/testthat/"
+testthat_file <- function(...) {
+  file.path(rprojroot::find_testthat_root_file(), ...)
+}

R/ws.R

@@ -150,11 +150,3 @@ prettify_one <- function(transformers, path) {
   if (!grepl("\\.[Rr]$", path)) stop(path, " is not a .R file")
   transform_files(path, transformers)
 }
-
-#' Style the active file
-#'
-#' Helper function fot RStudio Add-in.
-style_active_file <- function() {
-  file <- rstudioapi::getActiveDocumentContext()$path
-  style_file(file, style = tidyverse_style)
-}

README.Rmd

@@ -47,7 +47,8 @@ There are a few variants of `style_text()`:
 * `style_file()` styles a single .R file.
 * `style_dir()` styles all .R files in a directory.
 * `style_pkg()` styles the source files of an R package.
-* An RStudio Addin that styles the active file .R file
+* RStudio Addins for styling the active file, styling the current package and 
+  styling the highlighted code region.
 
 ```{r, out.width = "650px", echo = FALSE}
 knitr::include_graphics("https://raw.githubusercontent.com/lorenzwalthert/some_raw_data/master/styler_0.1.gif")

README.md

@@ -23,7 +23,7 @@ There are a few variants of `style_text()`:
 -   `style_file()` styles a single .R file.
 -   `style_dir()` styles all .R files in a directory.
 -   `style_pkg()` styles the source files of an R package.
--   An RStudio Addin that styles the active file .R file
+-   RStudio Addins for styling the active file, styling the current package and styling the highlighted code region.
 
 <img src="https://raw.githubusercontent.com/lorenzwalthert/some_raw_data/master/styler_0.1.gif" width="650px" />
 

inst/rstudio/addins.dcf

@@ -1,9 +1,14 @@
 Name: style package
 Description: Pretty-print package source code
 Binding: style_pkg
-Interactive: false
+Interactive: true
 
 Name: style active file
 Description: Pretty-print active file
 Binding: style_active_file
-Interactive: false
+Interactive: true
+
+Name: style active region
+Description: Pretty-print active region
+Binding: style_active_region
+Interactive: true

tests/testthat/public-api/xyzaddin/addin_region-in.R

@@ -0,0 +1 @@
+fjkdsfa 2jy+wj/ 1+1 <?+d

tests/testthat/public-api/xyzaddin/addin_region-out.R

@@ -0,0 +1 @@
+fjkdsfa 2jy+wj/ 1 + 1<?+d

tests/testthat/test-exception_handling.R

@@ -4,11 +4,9 @@ test_that("style_text returns custom error", {
   expect_error(style_text("a <- 3 4"), "unexpected numeric constant")
 })
 
-
-base <- rprojroot::find_testthat_root_file("exception_handling")
 test_that("style_file returns custom error", {
   expect_warning(
-    style_file(paste0(base, "/parser-error.R")),
+    style_file(testthat_file("exception_handling", "/parser-error.R")),
     "When processing"
   )
 })

tests/testthat/test-parse_comments.R

@@ -19,10 +19,6 @@ test_that("spacing within comments is done correctly", {
                                  transformer = style_text), NA)
 })
 
-test_that("spacing before comments is done correctly", {
-
-})
-
 test_that("comments are treated corectly", {
   expect_warning(test_collection("parse_comments",
                                  "mixed",