1#' Construct strings with color 2#' 3#' @description 4#' The [crayon][crayon::crayon] package defines a number of functions used to 5#' color terminal output. `glue_col()` and `glue_data_col()` functions provide 6#' additional syntax to make using these functions in glue strings easier. 7#' 8#' Using the following syntax will apply the function [crayon::blue()] to the text 'foo bar'. 9#' 10#' ``` 11#' {blue foo bar} 12#' ``` 13#' 14#' If you want an expression to be evaluated, simply place that in a normal brace 15#' expression (these can be nested). 16#' 17#' ``` 18#' {blue 1 + 1 = {1 + 1}} 19#' ``` 20#' 21#' If the text you want to color contains, e.g., an unpaired quote or a comment 22#' character, specify `.literal = TRUE`. 23#' 24#' @inheritParams glue 25#' @export 26#' @examplesIf require(crayon) 27#' library(crayon) 28#' 29#' glue_col("{blue foo bar}") 30#' 31#' glue_col("{blue 1 + 1 = {1 + 1}}") 32#' 33#' glue_col("{blue 2 + 2 = {green {2 + 2}}}") 34#' 35#' white_on_black <- bgBlack $ white 36#' glue_col("{white_on_black 37#' Roses are {red {colors()[[552]]}}, 38#' Violets are {blue {colors()[[26]]}}, 39#' `glue_col()` can show \\ 40#' {red c}{yellow o}{green l}{cyan o}{blue r}{magenta s} 41#' and {bold bold} and {underline underline} too! 42#' }") 43#' 44#' # this would error due to an unterminated quote, if we did not specify 45#' # `.literal = TRUE` 46#' glue_col("{yellow It's} happening!", .literal = TRUE) 47#' 48#' # `.literal = TRUE` also prevents an error here due to the `#` comment 49#' glue_col( 50#' "A URL: {magenta https://github.com/tidyverse/glue#readme}", 51#' .literal = TRUE 52#' ) 53#' 54#' # `.literal = TRUE` does NOT prevent evaluation 55#' x <- "world" 56#' y <- "day" 57#' glue_col("hello {x}! {green it's a new {y}!}", .literal = TRUE) 58glue_col <- function(..., .envir = parent.frame(), .na = "NA", .literal = FALSE) { 59 glue(..., .envir = .envir, .na = .na, .literal = .literal, .transformer = color_transformer) 60} 61 62#' @rdname glue_col 63#' @export 64glue_data_col <- function(.x, ..., .envir = parent.frame(), .na = "NA", .literal = FALSE) { 65 glue_data(.x, ..., .envir = .envir, .na = .na, .literal = .literal, .transformer = color_transformer) 66} 67 68color_transformer <- function(code, envir) { 69 res <- tryCatch(parse(text = code, keep.source = FALSE), error = function(e) e) 70 if (!inherits(res, "error")) { 71 return(eval(res, envir = envir)) 72 } 73 74 code <- glue_collapse(code, "\n") 75 m <- regexpr("(?s)^([[:alnum:]_]+)[[:space:]]+(.+)", code, perl = TRUE) 76 has_match <- m != -1 77 if (!has_match) { 78 stop(res) 79 } 80 starts <- attr(m, "capture.start") 81 ends <- starts + attr(m, "capture.length") - 1L 82 captures <- substring(code, starts, ends) 83 fun <- captures[[1]] 84 text <- captures[[2]] 85 out <- glue(text, .envir = envir, .transformer = color_transformer) 86 87 color_fun <- get0(fun, envir = envir, mode = "function") 88 if (is.null(color_fun) && requireNamespace("crayon", quietly = TRUE)) { 89 color_fun <- get0(fun, envir = asNamespace("crayon"), mode = "function") 90 } 91 92 if (is.null(color_fun)) { 93 # let nature take its course, i.e. throw the usual error 94 get(fun, envir = envir, mode = "function") 95 } else { 96 color_fun(out) 97 } 98} 99