From f279ad890685274703288b10b21076297e360fde Mon Sep 17 00:00:00 2001 From: Matthew de Queljoe Date: Mon, 1 Apr 2019 12:19:01 +0200 Subject: [PATCH 1/2] color brackets by scope --- R/brackets.R | 74 +++++++++++++++++++++++++++++++++ R/highlight.R | 7 ++++ R/style.R | 9 ++-- man/color_brackets.Rd | 39 +++++++++++++++++ man/default_style.Rd | 4 +- tests/testthat/test-brackets.R | 60 ++++++++++++++++++++++++++ tests/testthat/test-highlight.R | 7 ++++ tests/testthat/test-style.R | 2 +- 8 files changed, 197 insertions(+), 5 deletions(-) create mode 100644 R/brackets.R create mode 100644 man/color_brackets.Rd create mode 100644 tests/testthat/test-brackets.R diff --git a/R/brackets.R b/R/brackets.R new file mode 100644 index 0000000..37e4493 --- /dev/null +++ b/R/brackets.R @@ -0,0 +1,74 @@ +open_brackets <- function() { + c("(", "{", "[") +} + +close_brackets <- function(){ + c(")", "}", "]") +} + +bracket_tokens <- function() { + s <- c(open_brackets(), close_brackets()) + c(paste0("'", s, "'"), "LBB") +} + +apply_color <- function(x, lvl, l){ + k <- (lvl - 1) %% length(l) + 1 + l[[k]](x) +} + +#' Colored brackets +#' +#' Add color to brackets. Brackets will be coloured consecutively with the +#' colors provided in \code{color_seq} by scope. +#' +#' @param x a character vector of brackets consisting of a valid sequence of any +#' of the following: \code{'[[', '[', ']', '(', ')', '{', '}'} +#' @param color_seq a list of functions that take and return a character scalar. The +#' ordering defines the sequence of color functions to apply to a given scope level. +#' Color functions are recycled when the scope level exceeds the length of \code{color_seq} +#' +#' @details Meant for coloring brackets encountered within \code{highlight}. +#' Note that occurrences of 'orphan' brackets are not taken into account +#' mainly due to the fact that cases such as +#' +#' \code{foo <- function(x){ `[[`(x, 1) }} +#' +#' will either be converted to +#' +#' \code{foo <- function(x){ x[[1]] }} +#' +#' before the brackets are coloured if passed in as +#' \code{highlight(deparse(foo))} or will be identified as a +#' 'SYMBOL_FUNCTION_CALL' token instead of 'LBB' if passed in as +#' +#' \code{highlight("foo <- function(x){ `[[`(x, 1) }")} +#' +#' Similarly, invalid code that would lead to orphaned brackets is not taken +#' into account as this would be caught before hand in \code{highlight}. +#' +#' @keywords internal +color_brackets <- function(x, color_seq = list(yellow, blue, cyan)) { + stopifnot(vapply(color_seq, is.function, logical(1))) + open <- c(open_brackets(), "[[") + o <- character() + lvl <- 0 + i <- 1 + while (i <= length(x)) { + + if (x[i] %in% open) { + o[length(o) + 1] <- x[i] + lvl <- lvl + 1 + x[i] <- apply_color(x[i], lvl, color_seq) + i <- i + 1 + next + } + + j <- nchar(o[length(o)]) + x[i:(i + j - 1)] <- + apply_color(x[i:(i + j - 1)], lvl, color_seq) + i <- i + j + lvl <- lvl - 1 + o <- o[-length(o)] + } + x +} diff --git a/R/highlight.R b/R/highlight.R index dc627ee..3a42ca1 100644 --- a/R/highlight.R +++ b/R/highlight.R @@ -12,6 +12,7 @@ reserved_words <- function() { "REPEAT", "WHILE", "FOR", "IN", "NEXT", "BREAK") } + #' Syntax highlight R code #' #' @param code Character vector, each element is one line of code. @@ -72,6 +73,12 @@ highlight <- function(code, style = default_style()) { comment <- data$token == "COMMENT" hitext[comment] <- style$comment(data$text[comment]) } + + ## Brackets + if (!is.null(style$bracket)){ + bracket <- data$token %in% bracket_tokens() + hitext[bracket] <- color_brackets(data$text[bracket], style$bracket) + } do_subst(code, data, hitext) } diff --git a/R/style.R b/R/style.R index 8297eeb..111f17c 100644 --- a/R/style.R +++ b/R/style.R @@ -10,10 +10,12 @@ #' * `call`: function calls #' * `string`: character literals #' * `comment`: comments +#' * `bracket`: brackets: \code{(){}[]} #' #' Each entry in a list must be a function that takes a character -#' scalar, and returns a character scalar. The default style adds -#' ANSI formatting to the code. +#' scalar, and returns a character scalar with the exception of `bracket` +#' which should be a list of these type of functions defining a color sequence. +#' The default style adds ANSI formatting to the code. #' #' Note that you can also change the code if you like, e.g. to include #' a unicode arrow character instead of the two-character assignment @@ -33,6 +35,7 @@ default_style <- function() { operator = green, call = cyan, string = yellow, - comment = combine_styles(make_style("darkgrey"), italic) + comment = combine_styles(make_style("darkgrey"), italic), + bracket = c(yellow, blue, cyan) ) } diff --git a/man/color_brackets.Rd b/man/color_brackets.Rd new file mode 100644 index 0000000..318ec92 --- /dev/null +++ b/man/color_brackets.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/brackets.R +\name{color_brackets} +\alias{color_brackets} +\title{Colored brackets} +\usage{ +color_brackets(x, color_seq = list(yellow, blue, cyan)) +} +\arguments{ +\item{x}{a character vector of brackets consisting of a valid sequence of any +of the following: \code{'[[', '[', ']', '(', ')', '{', '}'}} + +\item{color_seq}{a list of functions that take and return a character scalar} +} +\description{ +Add color to brackets. Brackets will be coloured consecutively with the +colors provided in \code{color_seq} by scope. +} +\details{ +Meant for coloring brackets encountered within \code{highlight}. +Note that occurrences of 'orphan' brackets are not taken into account +mainly due to the fact that cases such as + +\code{foo <- function(x){ `[`(x, 1) }} + +will either be converted to + +\code{foo <- function(x){ x[1]}} + +before the brackets are coloured if passed in as +\code{highlight(deparse(foo))} or will be identified as a +'SYMBOL_FUNCTION_CALL' token instead of 'LBB' if passed in as + +\code{highlight("foo <- function(x){ `[`(x, 1) }")} + +Similarly, invalid code that would lead to orphaned brackets is not taken +into account as this would be caught before hand in \code{highlight}. +} +\keyword{internal} diff --git a/man/default_style.Rd b/man/default_style.Rd index b612673..4486a4c 100644 --- a/man/default_style.Rd +++ b/man/default_style.Rd @@ -17,11 +17,13 @@ entries: \item \code{call}: function calls \item \code{string}: character literals \item \code{comment}: comments +\item \code{bracket}: brackets: \code{(){}[]} } } \details{ Each entry in a list must be a function that takes a character -scalar, and returns a character scalar. The default style adds +scalar, and returns a character scalar with the exception of \code{bracket} +which should be a list of functions defining a color sequence. The default style adds ANSI formatting to the code. Note that you can also change the code if you like, e.g. to include diff --git a/tests/testthat/test-brackets.R b/tests/testthat/test-brackets.R new file mode 100644 index 0000000..32c8be7 --- /dev/null +++ b/tests/testthat/test-brackets.R @@ -0,0 +1,60 @@ + +context("colour_brackets") + +test_that("bracket highlighting", { + + # [](){} + expect_equal( + color_brackets(c("[", "]", "(", ")", "{", "}")), + c( + "\033[33m[\033[39m", + "\033[33m]\033[39m", + "\033[33m(\033[39m", + "\033[33m)\033[39m", + "\033[33m{\033[39m", + "\033[33m}\033[39m" + ) + ) + + # [({[({})]})] + expect_equal( + color_brackets(c( + "[", "(", "{", "[", "(", "{", "}", ")", "]", "}", ")", "]" + )), + c( + "\033[33m[\033[39m", + "\033[34m(\033[39m", + "\033[36m{\033[39m", + "\033[33m[\033[39m", + "\033[34m(\033[39m", + "\033[36m{\033[39m", + "\033[36m}\033[39m", + "\033[34m)\033[39m", + "\033[33m]\033[39m", + "\033[36m}\033[39m", + "\033[34m)\033[39m", + "\033[33m]\033[39m" + ) + ) + + # [[ [] ]][[ ()() ]] + expect_equal( + color_brackets(c( + "[[", "[", "]", "]", "]", "[[", "(", ")", "(", ")", "]", "]" + )), + c( + "\033[33m[[\033[39m", + "\033[34m[\033[39m", + "\033[34m]\033[39m", + "\033[33m]\033[39m", + "\033[33m]\033[39m", + "\033[33m[[\033[39m", + "\033[34m(\033[39m", + "\033[34m)\033[39m", + "\033[34m(\033[39m", + "\033[34m)\033[39m", + "\033[33m]\033[39m", + "\033[33m]\033[39m" + ) + ) +}) diff --git a/tests/testthat/test-highlight.R b/tests/testthat/test-highlight.R index aa1963f..054977c 100644 --- a/tests/testthat/test-highlight.R +++ b/tests/testthat/test-highlight.R @@ -103,3 +103,10 @@ test_that("comment", { c("C", " ls() C") ) }) + +test_that("bracket", { + expect_equal( + highlight("foo <- function(x){x}", list(bracket = list(function(x) "B"))), + "foo <- functionBxBBxB" + ) +}) diff --git a/tests/testthat/test-style.R b/tests/testthat/test-style.R index 2902144..6c8a9fc 100644 --- a/tests/testthat/test-style.R +++ b/tests/testthat/test-style.R @@ -7,7 +7,7 @@ test_that("default_style", { expect_true( all( names(def) %in% - c("reserved", "number", "null", "operator", "call", "string", "comment") + c("reserved", "number", "null", "operator", "call", "string", "comment", "bracket") ) ) }) From dcdca0cd617448d9426112594c2a700ff234c25e Mon Sep 17 00:00:00 2001 From: Matthew de Queljoe Date: Mon, 1 Apr 2019 13:00:29 +0200 Subject: [PATCH 2/2] fix bracket tests : rm use of crayon functions --- tests/testthat/test-brackets.R | 80 +++++++++++++++++----------------- 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/tests/testthat/test-brackets.R b/tests/testthat/test-brackets.R index 32c8be7..d3482eb 100644 --- a/tests/testthat/test-brackets.R +++ b/tests/testthat/test-brackets.R @@ -1,60 +1,60 @@ + context("colour_brackets") +col_seq <- list(function(x) + paste0("1", x), + function(x) + paste0("2", x), + function(x) + paste0("3", x)) + test_that("bracket highlighting", { - # [](){} - expect_equal( - color_brackets(c("[", "]", "(", ")", "{", "}")), - c( - "\033[33m[\033[39m", - "\033[33m]\033[39m", - "\033[33m(\033[39m", - "\033[33m)\033[39m", - "\033[33m{\033[39m", - "\033[33m}\033[39m" - ) - ) + expect_equal(color_brackets(c("[", "]", "(", ")", "{", "}"), col_seq), + c("1[", "1]", "1(", "1)", "1{", "1}")) # [({[({})]})] expect_equal( color_brackets(c( "[", "(", "{", "[", "(", "{", "}", ")", "]", "}", ")", "]" - )), + ), + col_seq), c( - "\033[33m[\033[39m", - "\033[34m(\033[39m", - "\033[36m{\033[39m", - "\033[33m[\033[39m", - "\033[34m(\033[39m", - "\033[36m{\033[39m", - "\033[36m}\033[39m", - "\033[34m)\033[39m", - "\033[33m]\033[39m", - "\033[36m}\033[39m", - "\033[34m)\033[39m", - "\033[33m]\033[39m" + "1[", + "2(", + "3{", + "1[", + "2(", + "3{", + "3}", + "2)", + "1]", + "3}", + "2)", + "1]" ) ) # [[ [] ]][[ ()() ]] expect_equal( - color_brackets(c( - "[[", "[", "]", "]", "]", "[[", "(", ")", "(", ")", "]", "]" - )), + color_brackets( + c("[[", "[", "]", "]", "]", "[[", "(", ")", "(", ")", "]", "]"), + col_seq + ), c( - "\033[33m[[\033[39m", - "\033[34m[\033[39m", - "\033[34m]\033[39m", - "\033[33m]\033[39m", - "\033[33m]\033[39m", - "\033[33m[[\033[39m", - "\033[34m(\033[39m", - "\033[34m)\033[39m", - "\033[34m(\033[39m", - "\033[34m)\033[39m", - "\033[33m]\033[39m", - "\033[33m]\033[39m" + "1[[", + "2[", + "2]", + "1]", + "1]", + "1[[", + "2(", + "2)", + "2(", + "2)", + "1]", + "1]" ) ) })