Control color via an environment variable

DESCRIPTION

@@ -15,7 +15,6 @@ BugReports: https://github.com/r-Lib/rcmdcheck/issues
 Imports:
     callr (>= 3.1.1.9000),
     cli (>= 3.0.0),
-    crayon,
     curl,
     desc (>= 1.2.0),
     digest,

NAMESPACE

@@ -24,16 +24,6 @@ importFrom(cli,cli_progress_bar)
 importFrom(cli,cli_progress_update)
 importFrom(cli,is_dynamic_tty)
 importFrom(cli,symbol)
-importFrom(crayon,bgRed)
-importFrom(crayon,bold)
-importFrom(crayon,col_nchar)
-importFrom(crayon,cyan)
-importFrom(crayon,green)
-importFrom(crayon,make_style)
-importFrom(crayon,red)
-importFrom(crayon,underline)
-importFrom(crayon,white)
-importFrom(crayon,yellow)
 importFrom(curl,handle_setopt)
 importFrom(curl,multi_add)
 importFrom(curl,multi_cancel)

R/comparison-summary.R

@@ -6,7 +6,6 @@ summary.rcmdcheck_comparison <- function(object, ...) {
 }
 
 #' @export
-#' @importFrom crayon bgRed white green
 
 print.rcmdcheck_comparison_summary <- function(x, ...) {
   object <- x[[1]]
@@ -27,7 +26,7 @@ print.rcmdcheck_comparison_summary <- function(x, ...) {
     change_summary(object$cmp, "error"), " | ",
     change_summary(object$cmp, "warning"), " | ",
     change_summary(object$cmp, "note"),
-    style = make_style("darkgrey")
+    style = darkgrey
   )
 
   invisible(x)

R/comparison.R

@@ -65,7 +65,6 @@ install_failed <- function(stdout) {
 #'   printout.
 #' @param ... Additional arguments, currently ignored.
 #' @export
-#' @importFrom crayon red green bold
 
 print.rcmdcheck_comparison <- function(x, header = TRUE, ...) {
   if (header) {

R/error.R

@@ -1,6 +1,4 @@
 
-#' @importFrom crayon yellow red underline
-
 report_system_error <- function(msg, status) {
 
   if (status$status == 0) return()

R/options.R

@@ -0,0 +1,56 @@
+
+#' rcmdcheck configuration
+#'
+#' Options take precedence over environment variables. E.g. if both
+#' the `RCMDCHECK_NUM_COLORS` environment variables and the
+#' `rcmdcheck.num_colors` option are set, then the latter is used.
+#'
+#' rcmdcheck uses the cli package for much of its output, so you can
+#' configure the output via cli, see [cli::cli-config].
+#' 
+#' # Environment variables
+#'
+#' * `R_PROFILE_USER`: standard R environment variable to configure the
+#'   path to the user level R profile. See [base::R_PROFILE_USER].
+#'
+#' * `RCMDCHECK_BASE_URL`: URL to the root of the CRAN check web page.
+#'   You can use this to select an alternative CRAN mirror. Defaults to
+#'   `https://cran.r-project.org/web/checks/`.
+#'
+#' * `RCMDCHECK_DETAILS_URL`: URL to the root of the CRAN check output
+#'   page. Defaults to `https://www.r-project.org/nosvn/R.check/`.
+#' 
+#' * `RCMDCHECK_FLAVOURS_URL` URL to the CRAN check flavours page.
+#'   You can use this to select an alternative CRAN mirror. Defaults to
+#'   `https://cran.r-project.org/web/checks/check_flavors.html`.
+#' 
+#' * `RCMDCHECK_NUM_COLORS`: the number of ANSI colors to use in the output.
+#'   It can be used to override the number of colors detected or configured
+#'   by the cli package. See [cli::num_ansi_colors()]. This configuration
+#'   is only used for the output of rcmdcheck and it does not affect the
+#'   examples and test cases (and other code) of the checked package.
+#'   It not set, then the default of cli is uesed. The corresponding
+#'   option is `rcmdcheck.num_colors`.
+#'
+#' * `RCMDCHECK_TIMESTAMP_LIMIT`: lower limit is seconds, above which
+#'   rcmdcheck adds time stamps to the individual check steps. It may be
+#'   fractional. Defaults to 1/3 of a second. The corresponding option is
+#'   `rcmdcheck.timestamp_limit`.
+#' 
+#' # Options
+#'
+#' * `rcmdcheck.num_colors`: the number of ANSI colors to use in the output.
+#'   It can be used to override the number of colors detected or configured
+#'   by the cli package. See [cli::num_ansi_colors()]. This configuration
+#'   is only used for the output of rcmdcheck and it does not affect the
+#'   examples and test cases (and other code) of the checked package.
+#'   It not set, then the default of cli is uesed. The corresponding
+#'   environment variable is `RCMDCHECK_NUM_COLORS`.
+#'
+#' * `rcmdcheck.timestamp_limit`: lower limit is seconds, above which
+#'   rcmdcheck adds time stamps to the individual check steps. It may be
+#'   fractional. Defaults to 1/3 of a second. The corresponding environment
+#'   variable is `RCMDCHECK_TIMESTAMP_LIMIT`.
+#'
+#' @name rcmdcheck-config
+NULL

R/print.R

@@ -77,15 +77,11 @@ header_line <- function(left = "", right = "",
   substring(res, 1, width)
 }
 
-#' @importFrom crayon cyan
-
 cat_head <- function(left, right = "", style = cyan) {
   str <- header_line(left, right)
   cat_line(str, style = style)
 }
 
-#' @importFrom crayon red make_style
-
 print_entry <- function(entry, entry_style) {
 
   lines <- strsplit(entry, "\n", fixed = TRUE)[[1]]
@@ -124,8 +120,6 @@ print.rcmdcheck_summary <- function(x, ..., line = TRUE) {
   cat("\n")
 }
 
-#' @importFrom crayon green red
-
 summary_entry <- function(x, name) {
 
   len <- length(x[[name]])

R/styles.R

@@ -1,24 +1,59 @@
 
-#' @importFrom crayon red green make_style bold
+rcmdcheck_color <- function(f) {
+  function(...) {
+    num_cols <- as_integer(getOption(
+      "rcmdcheck.num_colors",
+      Sys.getenv("RCMDCHECK_NUM_COLORS", "NA")
+    ))
+    if (! is.na(num_cols)) {
+      withr::local_options(c(cli.num_colors = num_cols))
+    }
+    f(...)
+  }
+}
+
+the <- new.env(parent = emptyenv())
 
 style <- function(..., sep = "") {
 
   args <- list(...)
   st <- names(args)
 
-  styles <- list(
-    "ok"     = green,
-    "note"   = make_style("blue"),
-    "warn"   = make_style("magenta"),
-    "err"    = red,
-    "pale"   = make_style("darkgrey"),
-    "timing" = make_style("cyan")
+  the$styles <- the$styles %||% list(
+    "ok"     = rcmdcheck_color(cli::col_green),
+    "note"   = rcmdcheck_color(cli::col_blue),
+    "warn"   = rcmdcheck_color(cli::col_magenta),
+    "err"    = rcmdcheck_color(cli::col_red),
+    "pale"   = rcmdcheck_color(cli::col_grey),
+    "timing" = rcmdcheck_color(cli::col_cyan)
   )
 
   nms <- names(args)
   x <- lapply(seq_along(args), function(i) {
-    if (nzchar(nms[i])) styles[[nms[i]]](args[[i]]) else args[[i]]
+    if (nzchar(nms[i])) the$styles[[nms[i]]](args[[i]]) else args[[i]]
   })
 
   paste(unlist(x), collapse = sep)
 }
+
+red       <- NULL
+green     <- NULL
+yellow    <- NULL
+bold      <- NULL
+underline <- NULL
+bgRed     <- NULL
+white     <- NULL
+cyan      <- NULL
+darkgrey  <- NULL
+
+.onLoad <- function(libname, pkgname) {
+  red       <<- rcmdcheck_color(cli::col_red)
+  green     <<- rcmdcheck_color(cli::col_green)
+  yellow    <<- rcmdcheck_color(cli::col_yellow)
+  bold      <<- rcmdcheck_color(cli::style_bold)
+  underline <<- rcmdcheck_color(cli::style_underline)
+  bgRed     <<- rcmdcheck_color(cli::bg_red)
+  white     <<- rcmdcheck_color(cli::col_white)
+  cyan      <<- rcmdcheck_color(cli::col_cyan)
+  darkgrey  <<- rcmdcheck_color(cli::col_grey)
+}

R/utils.R

@@ -107,13 +107,11 @@ get_install_out <- function(path) {
   }
 }
 
-#' @importFrom crayon col_nchar
-
-col_align <- function(text, width = getOption("width"),
+col_align <- function(text, width = cli::console_width(),
                       align = c("left", "center", "right")) {
 
   align <- match.arg(align)
-  nc <- col_nchar(text)
+  nc <- cli::ansi_nchar(text, type = "width")
 
   if (width <= nc) {
     text
@@ -160,3 +158,7 @@ cat_line <- function(..., style = NULL) {
 duration <- function(start) {
   as.double(Sys.time() - start, units = "secs")
 }
+
+as_integer <- function(x) {
+  suppressWarnings(as.integer(x))
+}

_pkgdown.yml

@@ -27,3 +27,7 @@ reference:
   - compare_checks
   - compare_to_cran
   - print.rcmdcheck_comparison
+
+- title: Configuration
+  contents:
+  - rcmdcheck-config

tests/testthat/test-color.R

@@ -0,0 +1,18 @@
+
+test_that("colors can be turned on and off", {
+  # clean up state
+  withr::local_options(rcmdcheck.num_colors = NULL)
+  withr::local_envvar(RCMDCHECK_NUM_COLORS = NA_character_)
+
+  # by default let cli decide
+  withr:::local_options(cli.num_colors = 100)
+  expect_equal(rcmdcheck_color(cli::num_ansi_colors)(), 100)
+
+  # env var overrides
+  withr::local_envvar(RCMDCHECK_NUM_COLORS = 200)
+  expect_equal(rcmdcheck_color(cli::num_ansi_colors)(), 200)
+
+  # option overrides that
+  withr::local_options(rcmdcheck.num_colors = 300)
+  expect_equal(rcmdcheck_color(cli::num_ansi_colors)(), 300)
+})