diff --git a/NEWS.md b/NEWS.md index f27abae..e32235c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ The existing custom language engines for knitr, `glue` and `glue_sql`, are documented in a new vignette (#71). +`glue_col()` gives special treatment to styling functions from the crayon package, e.g. `glue_col("{blue foo}")` "just works" now, even if crayon is not attached (but is installed) (#241). + Unterminated backticks trigger the same error as unterminated single or double quotes (#237). # glue 1.5.0 diff --git a/R/color.R b/R/color.R index ccb69df..83d27c2 100644 --- a/R/color.R +++ b/R/color.R @@ -26,6 +26,8 @@ #' #' glue_col("{blue 1 + 1 = {1 + 1}}") #' +#' glue_col("{blue 2 + 2 = {green {2 + 2}}}") +#' #' white_on_grey <- bgBlack $ white #' glue_col("{white_on_grey #' Roses are {red {colors()[[552]]}} @@ -35,14 +37,12 @@ #' }") #' } glue_col <- function(..., .envir = parent.frame(), .na = "NA") { - loadNamespace("crayon") glue(..., .envir = .envir, .na = .na, .transformer = color_transformer) } #' @rdname glue_col #' @export glue_data_col <- function(.x, ..., .envir = parent.frame(), .na = "NA") { - loadNamespace("crayon") glue_data(.x, ..., .envir = .envir, .na = .na, .transformer = color_transformer) } @@ -64,5 +64,16 @@ color_transformer <- function(code, envir) { fun <- captures[[1]] text <- captures[[2]] out <- glue(text, .envir = envir, .transformer = color_transformer) - (get(fun, envir = envir, mode = "function"))(out) + + color_fun <- get0(fun, envir = envir, mode = "function") + if (is.null(color_fun) && requireNamespace("crayon", quietly = TRUE)) { + color_fun <- get0(fun, envir = asNamespace("crayon"), mode = "function") + } + + if (is.null(color_fun)) { + # let nature take its course, i.e. throw the usual error + get(fun, envir = envir, mode = "function") + } else { + color_fun(out) + } } diff --git a/man/glue_col.Rd b/man/glue_col.Rd index e322f20..634179a 100644 --- a/man/glue_col.Rd +++ b/man/glue_col.Rd @@ -42,6 +42,8 @@ if (require(crayon)) { glue_col("{blue 1 + 1 = {1 + 1}}") + glue_col("{blue 2 + 2 = {green {2 + 2}}}") + white_on_grey <- bgBlack $ white glue_col("{white_on_grey Roses are {red {colors()[[552]]}} diff --git a/tests/testthat/test-color.R b/tests/testthat/test-color.R index 9dbcea6..1f714f0 100644 --- a/tests/testthat/test-color.R +++ b/tests/testthat/test-color.R @@ -1,36 +1,49 @@ -skip_if_not_installed("crayon") -library(crayon) - -describe("glue_col", { - it("returns the string if no substations needed", { - expect_identical(glue_col("foo"), as_glue("foo")) - }) - it("works the same as glue for parsable expressions", { - expect_identical(glue_col("1 + 1 = {1 + 1}"), glue("1 + 1 = {1 + 1}")) - }) - it("applies crayon functions", { - expect_identical(glue_col("{blue foo}"), as_glue(blue("foo"))) - - blue_and_white <- bgBlue $ white - expect_identical(glue_col("{blue_and_white foo}"), as_glue(blue_and_white("foo"))) - - expect_identical(glue_col("{blue_and_white {1 + 1}}"), as_glue(blue_and_white("2"))) - }) - it("works on multiline strings", { - expect_identical( - glue_col(" - {red foo +test_that("glue_col() is just glue() when it should be", { + skip_if_not_installed("crayon") + expect_identical(glue_col("foo"), as_glue("foo")) + expect_identical(glue_col("1 + 1 = {1 + 1}"), glue("1 + 1 = {1 + 1}")) +}) + +test_that("glue_col() applies crayon functions, crayon not attached", { + skip_if_not_installed("crayon") + skip_if("crayon" %in% (.packages())) + + expect_identical(glue_col("{blue foo}"), as_glue(crayon::blue("foo"))) +}) + +test_that("glue_col() applies crayon functions, crayon is attached", { + skip_if_not_installed("crayon") + if( !"crayon" %in% (.packages())) { + withr::local_package("crayon") + } + + blue_and_white <- bgBlue $ white + expect_identical(glue_col("{blue_and_white foo}"), as_glue(blue_and_white("foo"))) + expect_identical(glue_col("{blue_and_white {1 + 1}}"), as_glue(blue_and_white("2"))) +}) + +test_that("glue_col() works on multiline strings", { + skip_if_not_installed("crayon") + expect_identical( + glue_col(" + {red foo bar - }"), as_glue(red("foo\nbar"))) - }) - it("works on nested colors", { - expect_identical(glue_col("{red This is a {green serious} problem}"), - as_glue(red("This is a " %+% green("serious") %+% " problem"))) - }) - - it("errors if there is invalid syntax or fun is not found", { - expect_error(glue_col("{_}"), "unexpected input") + }"), as_glue(crayon::red("foo\nbar"))) +}) +test_that("glue_col() works on nested colors", { + skip_if_not_installed("crayon") + if( !"crayon" %in% (.packages())) { + withr::local_package("crayon") + } + expect_identical( + glue_col("{red This is a {green serious} problem}"), + as_glue(red("This is a " %+% green("serious") %+% " problem")) + ) +}) + +test_that("glue_col() errors for invalid syntax or when color_fun can't be found", { + expect_error(glue_col("{_}"), "unexpected input") expect_error(glue_col("{foo _}"), "object 'foo' of mode 'function' was not found") foo <- 1 @@ -38,13 +51,16 @@ describe("glue_col", { foo <- crayon::blue expect_identical(glue_col("{foo _}"), as_glue(foo("_"))) - }) }) -describe("glue_data_col", { - it("works as expected", { - mt <- head(mtcars) - expect_identical(glue_data_col(mt, "A {blue {gear}} speed car with {bold {hp}} hp!"), - as_glue("A " %+% blue(mt$gear) %+% " speed car with " %+% bold(mt$hp) %+% " hp!")) - }) +test_that("glue_data_col() works", { + skip_if_not_installed("crayon") + if( !"crayon" %in% (.packages())) { + withr::local_package("crayon") + } + mt <- head(mtcars) + expect_identical( + glue_data_col(mt, "A {blue {gear}} speed car with {bold {hp}} hp!"), + as_glue("A " %+% blue(mt$gear) %+% " speed car with " %+% bold(mt$hp) %+% " hp!") + ) })